enhanced the vm logging interface
attempted to execute ensure blocks on process termination. (wip)
This commit is contained in:
@ -239,7 +239,6 @@
|
||||
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
|
||||
}
|
||||
|
||||
|
||||
## -------------------------------------------------------
|
||||
## -------------------------------------------------------
|
||||
"
|
||||
|
@ -108,8 +108,10 @@
|
||||
#pooldic Log
|
||||
{
|
||||
## -----------------------------------------------------------
|
||||
## defines log levels
|
||||
## these items must follow defintions in stix.h
|
||||
## -----------------------------------------------------------
|
||||
|
||||
#DEBUG := 1.
|
||||
#INFO := 2.
|
||||
#WARN := 4.
|
||||
@ -127,27 +129,50 @@
|
||||
|
||||
#dcl(#pooldic) Log.
|
||||
|
||||
#method log: message level: level
|
||||
#method atLevel: level log: message
|
||||
{
|
||||
<primitive: #_log>
|
||||
## do nothing upon logging failure
|
||||
}
|
||||
|
||||
#method logNl: message level: level
|
||||
#method atLevel: level log: message and: message2
|
||||
{
|
||||
self log: message level: level.
|
||||
self log: S'\n' level: level.
|
||||
^self.
|
||||
<primitive: #_log>
|
||||
## do nothing upon logging failure
|
||||
}
|
||||
|
||||
#method atLevel: level log: message and: message2 and: message3
|
||||
{
|
||||
<primitive: #_log>
|
||||
## do nothing upon logging failure
|
||||
}
|
||||
|
||||
#method atLevel: level logNl: message
|
||||
{
|
||||
## the #_log primitive accepts an array.
|
||||
## so the following lines should work also.
|
||||
## | x |
|
||||
## x := Array new: 2.
|
||||
## x at: 0 put: message.
|
||||
## x at: 1 put: S'\n'.
|
||||
## ^self atLevel: level log: x.
|
||||
|
||||
^self atLevel: level log: message and: S'\n'.
|
||||
}
|
||||
|
||||
#method atLevel: level logNl: message and: message2
|
||||
{
|
||||
^self atLevel: level log: message and: message2 and: S'\n'.
|
||||
}
|
||||
|
||||
#method log: message
|
||||
{
|
||||
^self log: message level: Log.INFO.
|
||||
^self atLevel: Log.INFO log: message.
|
||||
}
|
||||
|
||||
#method logNl: message
|
||||
{
|
||||
^self logNl: message level: Log.INFO.
|
||||
^self atLevel: Log.INFO logNl: message.
|
||||
}
|
||||
}
|
||||
|
||||
@ -164,3 +189,20 @@
|
||||
|
||||
}
|
||||
|
||||
#extend Apex
|
||||
{
|
||||
## -------------------------------------------------------
|
||||
## Association has been defined now. let's add association
|
||||
## creating methods
|
||||
## -------------------------------------------------------
|
||||
|
||||
#method(#class) -> object
|
||||
{
|
||||
^Association new key: self value: object
|
||||
}
|
||||
|
||||
#method -> object
|
||||
{
|
||||
^Association new key: self value: object
|
||||
}
|
||||
}
|
||||
|
@ -246,6 +246,4 @@
|
||||
{
|
||||
ip := self.source pc.
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
@ -165,6 +165,8 @@
|
||||
].
|
||||
stop := (ctx == context).
|
||||
ctx := ctx sender.
|
||||
|
||||
## stop ifFalse: [ stop := ctx isNil ].
|
||||
].
|
||||
|
||||
^retval
|
||||
|
@ -37,12 +37,19 @@
|
||||
##^Processor resume: self.
|
||||
}
|
||||
|
||||
#method terminate
|
||||
#method _terminate
|
||||
{
|
||||
<primitive: #_process_terminate>
|
||||
self primitiveFailed
|
||||
}
|
||||
|
||||
#method terminate
|
||||
{
|
||||
##search from the top contextof the process down to intial_contextand find ensure blocks and execute them.
|
||||
self.current_context unwindTo: self.initial_context return: nil.
|
||||
^self _terminate
|
||||
}
|
||||
|
||||
#method yield
|
||||
{
|
||||
<primitive: #_process_yield>
|
||||
@ -58,15 +65,6 @@
|
||||
{
|
||||
^self.initial_context
|
||||
}
|
||||
|
||||
#method sleep: seconds
|
||||
{
|
||||
| s |
|
||||
s := Semaphore new.
|
||||
Processor signal: s after: seconds.
|
||||
## Processor activeProcess dump.
|
||||
s wait.
|
||||
}
|
||||
}
|
||||
|
||||
#class Semaphore(Object)
|
||||
@ -405,4 +403,26 @@
|
||||
<primitive: #_processor_return_to>
|
||||
self primitiveFailed.
|
||||
}
|
||||
|
||||
#method sleepFor: secs
|
||||
{
|
||||
## -----------------------------------------------------
|
||||
## put the calling process to sleep for given seconds.
|
||||
## -----------------------------------------------------
|
||||
| s |
|
||||
s := Semaphore new.
|
||||
self signal: s after: secs.
|
||||
s wait.
|
||||
}
|
||||
|
||||
#method sleepFor: secs and: nanosecs
|
||||
{
|
||||
## -----------------------------------------------------
|
||||
## put the calling process to sleep for given seconds.
|
||||
## -----------------------------------------------------
|
||||
| s |
|
||||
s := Semaphore new.
|
||||
self signal: s after: secs and: nanosecs
|
||||
s wait.
|
||||
}
|
||||
}
|
||||
|
@ -21,6 +21,22 @@
|
||||
#class Association(Magnitude)
|
||||
{
|
||||
#dcl key value.
|
||||
|
||||
#method key: key value: value
|
||||
{
|
||||
self.key := key.
|
||||
self.value := value.
|
||||
}
|
||||
|
||||
#method key
|
||||
{
|
||||
^self.key
|
||||
}
|
||||
|
||||
#method value
|
||||
{
|
||||
^self.value
|
||||
}
|
||||
}
|
||||
|
||||
#class Character(Magnitude)
|
||||
|
@ -182,11 +182,11 @@
|
||||
s3 := Semaphore new.
|
||||
|
||||
t1 := [
|
||||
10 timesRepeat: ['BLOCK #1' dump. Processor activeProcess sleep: 1.].
|
||||
10 timesRepeat: ['BLOCK #1' dump. Processor sleepFor: 1.].
|
||||
s1 signal
|
||||
] newProcess.
|
||||
t2 := [
|
||||
5 timesRepeat: ['BLOCK #2' dump. "Processor activeProcess sleep: 1." ].
|
||||
5 timesRepeat: ['BLOCK #2' dump. "Processor sleepFor: 1." ].
|
||||
'SIGNALLING S2...' dump. s2 signal.
|
||||
] newProcess.
|
||||
|
||||
|
@ -221,7 +221,7 @@
|
||||
## on: Exception do: [:ex | ex messageText dump].
|
||||
|
||||
'SLEEPING FOR 10 seconds ....' dump.
|
||||
Processor activeProcess sleep: 10.
|
||||
Processor sleepFor: 10.
|
||||
|
||||
'>>>>> END OF MAIN' dump.
|
||||
}
|
||||
|
101
stix/kernel/test-013.st
Normal file
101
stix/kernel/test-013.st
Normal file
@ -0,0 +1,101 @@
|
||||
|
||||
#include 'Stix.st'.
|
||||
|
||||
#################################################################
|
||||
## MAIN
|
||||
#################################################################
|
||||
|
||||
## TODO: use #define to define a class or use #class to define a class.
|
||||
## use #extend to extend a class
|
||||
## using #class for both feels confusing.
|
||||
|
||||
#extend Apex
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
#extend SmallInteger
|
||||
{
|
||||
#method getTrue: anInteger
|
||||
{
|
||||
^anInteger + 9999.
|
||||
}
|
||||
|
||||
#method inc
|
||||
{
|
||||
^self + 1.
|
||||
}
|
||||
}
|
||||
|
||||
#class TestObject(Object)
|
||||
{
|
||||
#dcl(#class) Q R.
|
||||
#dcl(#classinst) a1 a2.
|
||||
|
||||
#method test999
|
||||
{
|
||||
^self.Q
|
||||
}
|
||||
}
|
||||
|
||||
#class B.TestObject(Object)
|
||||
{
|
||||
#dcl(#class) Q R.
|
||||
#dcl(#classinst) a1 a2.
|
||||
|
||||
#method test000
|
||||
{
|
||||
^self.Q
|
||||
}
|
||||
}
|
||||
|
||||
#pooldic ABC
|
||||
{
|
||||
#KKK := 20.
|
||||
}
|
||||
|
||||
|
||||
#class MyObject(TestObject)
|
||||
{
|
||||
#method(#class) main
|
||||
{
|
||||
| v1 v2 |
|
||||
System logNl: 'START OF MAIN'.
|
||||
v2 := [
|
||||
[ v1 := [ System logNl: 'xxxxxxxxxxxxxxxxc'. Exception signal: 'qqqqq' ] value.
|
||||
'OK OK OK' dump. ] ensure: [ System logNl: 'ENSURE ENSURE ENSURE'].
|
||||
]
|
||||
on: Exception
|
||||
do: [:ex |
|
||||
System logNl: ('Exception: ', ex messageText).
|
||||
ex return: 10.
|
||||
##ex retry.
|
||||
System logNl: '--- THIS MUST NOT BE PRINTED ---'.
|
||||
].
|
||||
|
||||
|
||||
System logNl: '---------------------'.
|
||||
System log: 'v1=>'; log: v1; log: ' v2=>'; logNl: v2.
|
||||
|
||||
v1 := [
|
||||
[
|
||||
[
|
||||
1 to: 10000 by: 1 do: [:i | System logNl: i asString. Processor sleepFor: 5. ]
|
||||
] ensure: [ System logNl: '<<<PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP>>>' ].
|
||||
|
||||
] ensure: [ System logNl: '<<--------------------->>' ].
|
||||
] newProcess.
|
||||
|
||||
System logNl: 'RESUMING v1'.
|
||||
v1 resume.
|
||||
v1 terminate.
|
||||
|
||||
##[
|
||||
## [ Processor activeProcess terminate. ] ensure: [System logNl: '<<<PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP>>>' ].
|
||||
##] ensure: [ System logNl: '<<--------------------->>' ].
|
||||
|
||||
System logNl: S'\0\0\0END OF MAIN\0AB\0\0\0C\0\0\0'.
|
||||
}
|
||||
|
||||
}
|
||||
|
Reference in New Issue
Block a user