--- a/Block.st Sat Feb 05 13:09:31 1994 +0100
+++ b/Block.st Sat Feb 05 13:19:13 1994 +0100
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Block.st,v 1.9 1994-01-30 17:58:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Block.st,v 1.10 1994-02-05 12:18:38 claus Exp $
written spring 89 by claus
'!
@@ -78,9 +78,11 @@
initialize
"setup the signals"
- InvalidNewSignal := (Signal new).
- InvalidNewSignal mayProceed:false.
- InvalidNewSignal notifierString:'blocks are only created by the system'.
+ InvalidNewSignal isNil ifTrue:[
+ InvalidNewSignal := (Signal new).
+ InvalidNewSignal mayProceed:false.
+ InvalidNewSignal notifierString:'blocks are only created by the system'.
+ ]
! !
!Block class methodsFor:'queries'!
@@ -126,7 +128,7 @@
!Block methodsFor:'testing'!
isBlock
- "return true, if this is a block - yes we I am"
+ "return true, if this is a block - yes I am"
^ true
! !
@@ -194,10 +196,12 @@
!
code:anAddress
- "set the code field - danger alert.
+ "set the code field - DANGER ALERT.
This is not an object but the address of the blocks machine instructions.
- Therefore the argument must be an integer representing for this address.
- You can crash Smalltalk very badly when playing around here ..."
+ 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))
@@ -208,13 +212,13 @@
!
byteCode:aByteArray
- "set the bytecode field - danger alert"
+ "set the bytecode field - DANGER ALERT"
byteCode := aByteArray
!
nargs:numArgs
- "set the number of arguments I expect for evaluation - danger alert"
+ "set the number of arguments I expect for evaluation - DANGER ALERT"
nargs := numArgs
!
@@ -226,33 +230,33 @@
!
initialPC:initial
- "set the initial pc for evaluation - danger alert"
+ "set the initial pc for evaluation - DANGER ALERT"
initialPC := initial
!
literals:aLiteralArray
- "set the literal array for evaluation - danger alert"
+ "set the literal array for evaluation - DANGER ALERT"
literals := aLiteralArray
!
dynamic:aBoolean
"set the flag bit stating that the machine code was created
- dynamically and should be flushed on image-restart."
+ dynamically and should be flushed on image-restart.
+ Obsolete - now done in VM"
- |newFlags|
+%{ /* NOCONTEXT */
+ int newFlags = _intVal(_INST(flags));
- newFlags := flags.
-%{
/* made this a primitive to get define in stc.h */
if (aBoolean == true)
- newFlags = _MKSMALLINT(_intVal(newFlags) | F_DYNAMIC);
+ newFlags |= F_DYNAMIC;
else
- newFlags = _MKSMALLINT(_intVal(newFlags) & ~F_DYNAMIC);
+ newFlags &= ~F_DYNAMIC;
+
+ _INST(flags) = _MKSMALLINT(newFlags);
%}
-.
- flags := newFlags
! !
!Block methodsFor:'error handling'!
@@ -265,8 +269,9 @@
!
invalidMethod
- "this is sent by the bytecode interpreter when the blocks definition is bad.
- Can only happen when playing around with the blocks instvars
+ "this is sent by the bytecode interpreter when the blocks definition is bad
+ (bad literal array, missing bytecodes etc).
+ Can only happen when playing around with the blocks instvars (literal array)
or the Compiler/runtime system is buggy"
self error:'invalid block - not executable'
@@ -275,8 +280,8 @@
invalidByteCode
"this is sent by the bytecode interpreter when trying to execute
an invalid bytecode.
- Can only happen when playing around with the blocks instvars
- or the Compiler/runtime system is buggy"
+ Can only happen when playing around with the blocks instvars (byteCode)
+ or the Compiler/runtime system is buggy"
self error:'invalid byteCode in block - not executable'
!
@@ -700,6 +705,7 @@
"[:exit |
1 to:10 do:[:i |
+ Transcript showCr:i.
i == 5 ifTrue:[exit value:'thats it']
].
'regular block-value; never returned'
@@ -720,6 +726,7 @@
"|i|
i := 1.
[:exit |
+ Transcript showCr:i.
i == 5 ifTrue:[exit value:'thats it'].
i := i + 1
] loopWithExit"
@@ -778,7 +785,7 @@
home notNil ifTrue:[
^ '[] in ', home printString
].
- ^ '[] in ???'
+ ^ '[] in ???' "currently, cheap blocks dont know where they have been created"
!
printOn:aStream
@@ -793,6 +800,6 @@
aStream space.
(homeClass selectorForMethod:home) printOn:aStream
] ifFalse:[
- aStream nextPutAll:' ???'
+ aStream nextPutAll:' ???' "currently, cheap blocks dont know where they have been created"
]
! !
--- a/Class.st Sat Feb 05 13:09:31 1994 +0100
+++ b/Class.st Sat Feb 05 13:19:13 1994 +0100
@@ -45,7 +45,7 @@
WARNING: layout known by compiler and runtime system
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.8 1994-01-09 21:12:57 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.9 1994-02-05 12:18:46 claus Exp $
written Spring 89 by claus
'!
@@ -491,7 +491,21 @@
nargs := newSelector nArgsIfSelector.
+ "if I have no subclasses, all we have to flush is cached
+ data for myself ... (actually, in any case all that needs
+ to be flushed is info for myself and all of my subclasses)"
+"
+ problem: this is slower; since looking for all subclasses is (currently)
+ a bit slow :-(
+
+ self withAllSubclassesDo:[:aClass |
+ ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+ ObjectMemory flushMethodCacheFor:aClass
+ ].
+"
+
"actually, we would do better with less flushing ..."
+
ObjectMemory flushMethodCache.
ObjectMemory flushInlineCachesWithArgs:nargs.
--- a/Context.st Sat Feb 05 13:09:31 1994 +0100
+++ b/Context.st Sat Feb 05 13:19:13 1994 +0100
@@ -33,7 +33,7 @@
Warning: layout and size known by the compiler and runtime system - do not change.
-$Header: /cvs/stx/stx/libbasic/Context.st,v 1.10 1994-01-16 03:40:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Context.st,v 1.11 1994-02-05 12:19:13 claus Exp $
'!
!Context class methodsFor:'queries'!
@@ -329,72 +329,6 @@
self selector printOn:aStream
!
-XXfullPrintOn:aStream
- "obsolete"
- "append a printed description of the receiver, containing
- the contexts receiver, selector and args onto aStream."
-
- aStream nextPutAll:self receiverPrintString.
- aStream space.
- aStream nextPutAll:selector printString.
- self size ~~ 0 ifTrue: [
- aStream space.
- aStream nextPutAll:self argsPrintString
- ]
-!
-
-XXdebugPrint
- "obsolete"
-
- | n "{ Class: SmallInteger }" |
-
- 'context ' print. self address printNewline.
- 'receiver: ' print. receiver address printNewline.
- 'selector: ' print. selector address printNewline.
- n := self size.
- n ~~ 0 ifTrue:[
- 1 to:n do:[:index |
- 'arg ' print. index print. ' : ' print.
- (self at:index) address printNewline
- ]
- ].
- '' printNewline
-!
-
-XXdebugPrintAll
- "obsolete"
-
- |context|
- context := self.
- [context notNil] whileTrue:[
- context debugPrint.
- context := context sender
- ]
-!
-
-XXfullPrintString
- "obsolete"
-
- |aString|
-
- aString := self receiverPrintString , ' ' , selector printString.
- self size ~~ 0 ifTrue: [
- aString := aString , ' ' , (self argsPrintString)
- ].
- ^ aString
-!
-
-XXprintAll
- "obsolete"
-
- |context|
- context := self.
- [context notNil] whileTrue: [
- context print.
- context := context sender
- ]
-!
-
fullPrintAll
"print a full walkback starting at the receiver
- for MiniDebugger only"