*** empty log message ***
authorclaus
Sat, 05 Feb 1994 13:19:13 +0100
changeset 48 9f68393bea3c
parent 47 93f17a1b452c
child 49 f1c2d75f2eb6
*** empty log message ***
Block.st
Class.st
Context.st
--- 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"