hacking monitors, not working yet :P jk_new_structure
authorhlopkmar
Tue, 08 Nov 2011 13:48:55 +0000
branchjk_new_structure
changeset 1093 255c230a1c55
parent 1092 224cb55e1ab0
child 1094 68b154263d74
hacking monitors, not working yet :P
src/JavaContext.st
src/JavaObject.st
src/JavaVM.st
--- a/src/JavaContext.st	Tue Nov 08 09:35:58 2011 +0000
+++ b/src/JavaContext.st	Tue Nov 08 13:48:55 2011 +0000
@@ -42,7 +42,7 @@
 "{ Package: 'stx:libjava' }"
 
 Context variableSubclass:#JavaContext
-	instanceVariableNames:'exArg exPC byteCode constPool'
+	instanceVariableNames:'exArg exPC byteCode constPool acqrMonitors'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Languages-Java-Support'
@@ -357,11 +357,31 @@
 
 !JavaContext methodsFor:'accessing'!
 
+acquiredMonitors
+^acqrMonitors
+
+    "Created: / 08-11-2011 / 12:23:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+!
+
+addMonitor: mon
+acqrMonitors ifNil: [acqrMonitors := OrderedCollection new].
+acqrMonitors add: mon.
+
+    "Created: / 08-11-2011 / 14:19:21 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+!
+
 programmingLanguage
 
     ^JavaLanguage instance
 
     "Created: / 17-03-2011 / 10:17:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+removeMonitor: mon 
+    acqrMonitors ifNil: [ self halt: 'removing non existing monitor' ].
+    acqrMonitors remove: mon.
+
+    "Created: / 08-11-2011 / 14:19:58 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
 ! !
 
 !JavaContext methodsFor:'exception handler support'!
@@ -474,4 +494,4 @@
 
 version_SVN
     ^ '$Id$'
-! !
\ No newline at end of file
+! !
--- a/src/JavaObject.st	Tue Nov 08 09:35:58 2011 +0000
+++ b/src/JavaObject.st	Tue Nov 08 13:48:55 2011 +0000
@@ -376,6 +376,19 @@
     "Modified: 22.3.1997 / 00:56:54 / cg"
 ! !
 
+!JavaObject methodsFor:'unwind'!
+
+unwindHandlerInContext: aContext 
+    "given a context which has been marked for unwind,
+     retrieve the handler block. This method is called when ST
+     exception raises and stack is unwinding. JavaClass instance
+     has an opportunity to clean up monitors"
+    
+    ^ JavaVM unwindHandlerForJavaContext: aContext.
+
+    "Created: / 08-11-2011 / 12:25:15 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+! !
+
 !JavaObject class methodsFor:'documentation'!
 
 version
--- a/src/JavaVM.st	Tue Nov 08 09:35:58 2011 +0000
+++ b/src/JavaVM.st	Tue Nov 08 13:48:55 2011 +0000
@@ -15823,6 +15823,27 @@
     "Modified: / 9.1.1999 / 00:39:55 / cg"
 !
 
+unwindHandlerForJavaContext: aJavaContext 
+    "given a context which has been marked for unwind,
+     retrieve the handler block. This method is called when ST
+     exception raises and stack is unwinding. JavaClass instance
+     has an opportunity to clean up monitors"
+    
+    | cleanupBlock  acquiredMonitors |
+    acquiredMonitors := aJavaContext acquiredMonitors.
+    cleanupBlock := [
+            acquiredMonitors do: [
+                :each | 
+                each exit.
+                
+            ]
+        ].
+    self breakPoint: #mh.
+    ^ cleanupBlock.
+
+    "Created: / 08-11-2011 / 12:30:19 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+!
+
 waitFor:sema state:pState timeOut:tmo
     "wait"
 
@@ -16299,87 +16320,75 @@
     "Created: / 8.1.1999 / 15:12:28 / cg"
 !
 
-_MONITORENTER:someObject
-    |mon thisProcess objString |
-
-    someObject isNil ifTrue:[
+_MONITORENTER: someObject 
+    | mon  thisProcess  objString |
+    someObject isNil ifTrue: [
         self throwNullPointerException.
         self halt.
         ^ self
     ].
-
     self syncMonitorCache.
-
     LeftMonitorObject := nil.
-
     thisProcess := Processor activeProcess.
-
-    mon := self monitorFor:someObject.
-
-    MonitorTrace ifTrue:[
-        someObject isJavaClass ifTrue:[
-            objString := someObject name
-        ] ifFalse:[
-            objString := someObject class name , '@' , someObject identityHash printString.
-        ].
-
-        ('====> entering monitor for ' , objString , ' in ' , thisProcess name , ' ...') printCR.
+    mon := self monitorFor: someObject.
+    MonitorTrace ifTrue: [
+        someObject isJavaClass ifTrue: [ objString := someObject name ] ifFalse: [
+            objString := someObject class name , '@' 
+                        , someObject identityHash printString.
+        ].
+        ('====> entering monitor for ' , objString , ' in ' , thisProcess name 
+            , ' ...') printCR.
     ].
     mon enter.
-    MonitorTrace ifTrue:[
+    self assert: (thisContext sender isJavaContext).
+    thisContext sender addMonitor: mon.
+    MonitorTrace ifTrue: [
         ('====> entered it in ' , thisProcess name , ' ...') printCR.
     ].
-
-    (self enteredMonitorsOfProcess:thisProcess) add:someObject.
+    (self enteredMonitorsOfProcess: thisProcess) add: someObject.
 
     "Created: / 08-01-1999 / 14:23:10 / cg"
     "Modified: / 08-01-1999 / 18:47:26 / cg"
     "Modified: / 10-08-2011 / 20:19:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-_MONITOREXIT:someObject
-    |mon thisProcess wasBlocked lastMon objString |
-
-    someObject isNil ifTrue:[
+    "Modified: / 08-11-2011 / 14:24:35 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+!
+
+_MONITOREXIT: someObject 
+    | mon  thisProcess  wasBlocked  lastMon  objString |
+    someObject isNil ifTrue: [
         self throwNullPointerException.
         self halt.
         ^ self
     ].
-
     self syncMonitorCache.
-
     thisProcess := Processor activeProcess.
-
-    mon := self monitorFor:someObject.
-
-    MonitorTrace ifTrue:[
-        someObject isJavaClass ifTrue:[
-            objString := someObject name
-        ] ifFalse:[
-            objString := someObject class name , '@' , someObject identityHash printString.
-        ].
-
-        ('====> leaving monitor for ' , objString , ' in ' , thisProcess name , ' ...') printCR.
+    mon := self monitorFor: someObject.
+    MonitorTrace ifTrue: [
+        someObject isJavaClass ifTrue: [ objString := someObject name ] ifFalse: [
+            objString := someObject class name , '@' 
+                        , someObject identityHash printString.
+        ].
+        ('====> leaving monitor for ' , objString , ' in ' , thisProcess name 
+            , ' ...') printCR.
     ].
     mon exit.
-    MonitorTrace ifTrue:[
+    self assert: (thisContext sender isJavaContext).
+        thisContext sender removeMonitor: mon.
+    MonitorTrace ifTrue: [
         ('====> left it in ' , thisProcess name , ' ...') printCR.
     ].
-
-    lastMon := (self enteredMonitorsOfProcess:thisProcess) removeLast.
-    lastMon ~~ someObject ifTrue:[
-        self halt:'oops - monitor enter/exit nesting wrong'
-    ].
-
+    lastMon := (self enteredMonitorsOfProcess: thisProcess) removeLast.
+    lastMon ~~ someObject ifTrue: [
+        self halt: 'oops - monitor enter/exit nesting wrong'
+    ].
     wasBlocked := OperatingSystem blockInterrupts.
-    mon count == 0 ifTrue:[
-        LeftMonitorObject := someObject
-    ].
-    wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ]
+    mon count == 0 ifTrue: [ LeftMonitorObject := someObject ].
+    wasBlocked ifFalse: [ OperatingSystem unblockInterrupts ]
 
     "Created: / 08-01-1999 / 14:23:19 / cg"
     "Modified: / 08-01-1999 / 18:47:08 / cg"
     "Modified: / 10-08-2011 / 20:20:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 08-11-2011 / 14:24:58 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
 !
 
 _MULTINEW2: classRef _: dim1