tantalizingly close to opening debugger ...

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/instance/_signalIfError.st

@@ -1,13 +1,15 @@
 Private
 _signalIfError
   | debugger exception |
+  self handlingError
+    ifTrue: [ ^ super _signalIfError ].
   (self _gciLibrary GciErr_: gciErrSType) == 1
     ifFalse: [ ^ self ].
-  self halt.
+  handlingError := true.
   (gciErrSType number between: 4000 and: 4999)
     ifTrue: [ gciSessionId := 0 ].
   debugger := TDRemoteDebugger new
-    topez: self;
+    topez: self topez;
     debugProcessOop: gciErrSType context
       exceptionOop: gciErrSType exceptionObj
       session: self;

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/instance/handlingError.st

@@ -0,0 +1,3 @@
+accessing
+handlingError
+  ^ handlingError ifNil: [ handlingError := false ]

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/instance/topez..st

@@ -0,0 +1,4 @@
+accessing
+topez: anObject
+
+   topez := anObject

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/instance/topez.st

@@ -0,0 +1,4 @@
+accessing
+topez
+
+   ^topez

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/methodProperties.json

@@ -2,4 +2,7 @@
 	"class" : {
 		"sessionClass" : "dkh 09/07/2016 17:00" },
 	"instance" : {
-		"_signalIfError" : "dkh 09/08/2016 06:34" } }
+		"_signalIfError" : "dkh 09/08/2016 14:18",
+		"handlingError" : "dkh 09/08/2016 14:17",
+		"topez" : "dkh 09/08/2016 13:53",
+		"topez:" : "dkh 09/08/2016 13:53" } }

repository/Topez-GemStone-Server-33x-Core.package/TDGsExternalSession.class/properties.json

@@ -6,7 +6,8 @@
 		 ],
 	"commentStamp" : "",
 	"instvars" : [
-		 ],
+		"topez",
+		"handlingError" ],
 	"name" : "TDGsExternalSession",
 	"pools" : [
 		 ],

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/instance/frameList.st

@@ -0,0 +1,19 @@
+private
+frameList
+  | l stack frames |
+  stack := self theStack.
+  frames := stack frames.
+  l := frames
+    withIndexCollect: [ :frame :index | 
+      | str attributes |
+      attributes := {}.
+      str := index asString , '. ' , frame printString.
+      frame homeMethod == self homeMethod
+        ifTrue: [ attributes add: TextEmphasis bold ].
+      frame frameSelfOop == self receiverOop
+        ifTrue: [ 
+          attributes
+            add: TextEmphasis underlined;
+            add: TextEmphasis italic ].
+      Text string: str attributes: attributes ].
+  ^ l asArray

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/instance/itemSelected.listElement.selectedIndex.shiftPressed..st

@@ -0,0 +1,42 @@
+tools
+itemSelected: miniTool listElement: listElement selectedIndex: index shiftPressed: shiftPressed
+  | currentFrame sourceEditorSpec sourceClientElement enabled disabled |
+  theMiniTool := miniTool.
+  index = 0
+    ifTrue: [ ^ false ].
+  self theStack navigateFrame: index.
+  currentFrame := self theStack currentFrame.
+  self
+    homeMethod: currentFrame homeMethod;
+    receiverOop: currentFrame frameSelfOop.
+  sourceEditorSpec := (TDEditorSpec topez: self topez editorAspect: #'source')
+    parentObject: listElement parent;
+    windowId: sourceWindowId;
+    yourself.
+  enabled := disabled := {#'debuggingProcess'}.
+  debuggingProcess
+    ifTrue: [ disabled := {} ]
+    ifFalse: [ enabled := {} ].
+  ^ sourceWindowId
+    ifNil: [ 
+      sourceWindowId := currentFrame editUsing: sourceEditorSpec.
+      self objectSerializer
+        toString:
+          {#'setMenuCategories:'.
+          enabled.
+          #'clearMenuCategories:'.
+          disabled.
+          #'refreshList'.
+          nil} ]
+    ifNotNil: [ 
+      sourceClientElement := currentFrame clientElementUsing: sourceEditorSpec.
+      self objectSerializer
+        toString:
+          {#'setMenuCategories:'.
+          enabled.
+          #'clearMenuCategories:'.
+          disabled.
+          #'editStonElement:'.
+          sourceClientElement.
+          #'setList:'.
+          (self frameList)} ]

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/instance/receiverOop..st

@@ -0,0 +1,4 @@
+accessing
+receiverOop: anObject
+
+   receiverOop := anObject

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/instance/receiverOop.st

@@ -0,0 +1,4 @@
+accessing
+receiverOop
+
+   ^receiverOop

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/methodProperties.json

@@ -3,4 +3,8 @@
 		 },
 	"instance" : {
 		"createStackNodeFor:exception:session:" : "dkh 09/08/2016 06:51",
-		"debugProcessOop:exceptionOop:session:" : "dkh 09/08/2016 06:35" } }
+		"debugProcessOop:exceptionOop:session:" : "dkh 09/08/2016 06:35",
+		"frameList" : "dkh 09/08/2016 14:21",
+		"itemSelected:listElement:selectedIndex:shiftPressed:" : "dkh 09/08/2016 14:23",
+		"receiverOop" : "dkh 09/08/2016 14:22",
+		"receiverOop:" : "dkh 09/08/2016 14:22" } }

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteDebugger.class/properties.json

@@ -6,7 +6,7 @@
 		 ],
 	"commentStamp" : "",
 	"instvars" : [
-		 ],
+		"receiverOop" ],
 	"name" : "TDRemoteDebugger",
 	"pools" : [
 		 ],

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStack.class/instance/exceptionClass.st

@@ -3,5 +3,5 @@ exceptionClass
   | className |
   className := self session
     executeBlock: [ :anExceptionOop | (Object _objectForOop: anExceptionOop) class name ]
-    with: self execptionOop.
+    with: self exceptionOop.
   ^ GsSession currentSession symbolList objectNamed: className

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackX.class/instance/trimStackTo..st → repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStack.class/instance/trimStackTo..st

@@ -3,7 +3,9 @@ trimStackTo: level
   "Assume to be sent after successful accept of new version of method"
 
   self trimmed: true.
-  self process _trimStackToLevel: level.
+  self session
+    executeBlock: [ :procOop :level | (Object _objectForOop: procOop) _trimStackToLevel: level ]
+    with: self processOop.
   self resetFrames.
   self navigateFrame: 1.
   self refreshViews

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStack.class/methodProperties.json

@@ -5,7 +5,7 @@
 		"createFrames" : "dkh 09/08/2016 06:46",
 		"currentFrame" : "dkh 09/08/2016 06:47",
 		"exception" : "dkh 09/08/2016 06:53",
-		"exceptionClass" : "dkh 09/08/2016 06:52",
+		"exceptionClass" : "dkh 09/08/2016 13:57",
 		"exceptionOop" : "dkh 09/08/2016 06:46",
 		"exceptionOop:" : "dkh 09/08/2016 06:46",
 		"printOn:" : "dkh 09/08/2016 06:47",
@@ -15,4 +15,5 @@
 		"session" : "dkh 09/08/2016 06:46",
 		"session:" : "dkh 09/08/2016 06:46",
 		"signallerFrame:" : "dkh 09/08/2016 06:49",
-		"terminateProcess" : "dkh 09/08/2016 06:49" } }
+		"terminateProcess" : "dkh 09/08/2016 06:49",
+		"trimStackTo:" : "dkh 09/08/2016 10:08" } }

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/_nativeStack.st

@@ -0,0 +1,13 @@
+private
+_nativeStack
+  ^ (self dynamicInstVarAt: #'_nativeStack')
+    ifNil: [ 
+      | _nativeStack |
+      _nativeStack := self session
+        executeBlock: [ :processOop :fIndex | 
+          | process |
+          process := Object _objectForOop: processOop.
+          process _nativeStack ]
+        with: self processOop
+        with: self frameIndex.
+      self dynamicInstVarAt: #'_nativeStack' put: _nativeStack ]

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/argAndTempNames.st

@@ -1,4 +1,23 @@
-as yet unclassified
+private
 argAndTempNames
-    argAndTempNames ifNil: [ argAndTempNames := (self frameContents at: 9) collect: [ :each | each asString ] ].
-    ^ argAndTempNames
+  argAndTempNames
+    ifNil: [ 
+      | resultString |
+      resultString := self session
+        executeBlock: [ :processOop | 
+          | process fc strm ar sz |
+          strm := WriteStream on: String new.
+          strm nextPut: $[.
+          process := Object _objectForOop: processOop.
+          ar := fc := process _frameContentsAt: 9.
+          sz := ar size.
+          1 to: sz do: [ :i | 
+            strm
+              space;
+              nextPutAll: (ar at: i) asString.
+            i < sz
+              ifTrue: [ strm nextPut: $, ] ].
+          strm nextPut: $].
+          strm contents ].
+      argAndTempNames := STON fromString: resultString ].
+  ^ argAndTempNames

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/argAndTempNamesAt..st

@@ -1,3 +1,4 @@
-as yet unclassified
+private
 argAndTempNamesAt: index
-    ^ self frameContents at: 10 + index
+  self halt.
+  ^ self frameContents at: 10 + index

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/baseNodeMap.st

@@ -1,4 +1,4 @@
-as yet unclassified
+private
 baseNodeMap
   | map |
   map := Dictionary new.
@@ -7,7 +7,7 @@ baseNodeMap
     yourself.
   self isMethodForBlock
     ifTrue: [ 
-      self receiver ~~ self frameSelf
+      self rawReceiverOop ~~ self frameSelfOop
         ifTrue: [ 
           map
             add: '(receiver)' -> #'receiver';

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/baseNodeNames.st

@@ -1,3 +1,3 @@
-as yet unclassified
+private
 baseNodeNames
     ^ self baseNodeMap keys

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/calculateSelectionRange.st

@@ -1,23 +1,8 @@
-as yet unclassified
+private
 calculateSelectionRange
   | method stepPoint begin end |
   method := self method.
-  (method respondsTo: #'_stepPointForIp:level:isNative:')
-    ifTrue: [ 
-      stepPoint := method
-        perform: #'_stepPointForIp:level:isNative:'
-        withArguments:
-          {(self ipOffset).
-          (self frameIndex).
-          (self process _nativeStack)} ]
-    ifFalse: [ 
-      "v3.3"
-      stepPoint := method
-        perform: #'_stepPointForIp:level:useNext:'
-        withArguments:
-          {(self ipOffset).
-          (self frameIndex).
-          (self process _nativeStack)} ].
+  stepPoint := self stepPoint.
   begin := method _sourceOffsetsAt: stepPoint.
   end := self calculateSourceRangeEnd: begin in: method sourceString.
   ^ begin to: end

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/calculateSourceRangeEnd.in..st

@@ -1,4 +1,4 @@
-as yet unclassified
+private
 calculateSourceRangeEnd: start in: string
     | scan i char characterStack beginners enders |
     i := start.

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/dotSelfLiteralArray.st

@@ -1,4 +1,4 @@
-as yet unclassified
+private
 dotSelfLiteralArray
   | litVarArray tempNames |
   litVarArray := {}.

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/dotSelfObject.st

@@ -1,3 +1,3 @@
-as yet unclassified
+private
 dotSelfObject
   ^ self frameSelf

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/dotSelfWorkspace..st

@@ -1,4 +1,4 @@
-as yet unclassified
+private
 dotSelfWorkspace: topez
   | strm |
   strm := WriteStream on: String new.

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/elementNodeNames.st

@@ -1,4 +1,4 @@
-as yet unclassified
+private
 elementNodeNames
   self process == nil
     ifTrue: [ ^ #() ].

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/findFrameSuchThat..st

@@ -1,14 +1,12 @@
-as yet unclassified
+private
 findFrameSuchThat: testBlock
   "Search self and my sender chain for first one that satisfies testBlock.  Return nil if none satisfy"
 
   | frame |
   frame := self.
   [ frame isNil ]
     whileFalse: [ 
-      self frameContents ~~ nil
-        ifTrue: [ 
-          (testBlock value: frame)
-            ifTrue: [ ^ frame ] ].
+      (testBlock value: frame)
+        ifTrue: [ ^ frame ].
       frame := frame next ].
   ^ nil

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/frameIndex..st

@@ -1,3 +1,3 @@
-as yet unclassified
+private
 frameIndex: anInteger
     frameIndex := anInteger

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/frameIndex.st

@@ -1,3 +1,3 @@
-as yet unclassified
+private
 frameIndex
     ^ frameIndex

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/frameSelfClass.st

@@ -0,0 +1,18 @@
+accessing
+frameSelfClass
+  ^ (self dynamicInstVarAt: #'frameSelfClass')
+    ifNil: [ 
+      | className class |
+      className := self session
+        executeBlock: [ :processOop :fIndex | 
+          | receiver process fc |
+          process := Object _objectForOop: processOop.
+          fc := process _frameContentsAt: fIndex.
+          receiver := (fc at: 8)
+            ifNotNil: [ :frameSelf | frameSelf ]
+            ifNil: [ fc at: 10 ].
+          receiver class name ]
+        with: self processOop
+        with: self frameIndex.
+      class := GsSession currentSession symbolList objectNamed: className.
+      self dynamicInstVarAt: #'frameSelfClass' put: class ]

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/frameSelfOop.st

@@ -0,0 +1,3 @@
+private
+frameSelfOop
+  ^ self receiverOop

repository/Topez-GemStone-Server-33x-Core.package/TDRemoteStackFrame.class/instance/homeMethod.st

@@ -1,3 +1,3 @@
-as yet unclassified
+private
 homeMethod
     ^ self method homeMethod