hyung-hwan/moo
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented until and do..until loop

Browse Source
This commit is contained in:
hyunghwan.chung
2017-04-26 15:31:07 +00:00
parent 04864659a8
commit 6fe65f66fc
7 changed files with 257 additions and 350 deletions
Download Patch File Download Diff File Expand all files Collapse all files

212
moo/kernel/Apex.moo
View File

@ -61,23 +61,30 @@ extend Apex
}
## -------------------------------------------------------
## INSTANTIATION & INITIALIZATION
## -------------------------------------------------------
method(#class) __trailer_size
{
^0
}
method(#class) basicNew
{
| perr |
<primitive: #_basic_new>
self primitiveFailed.
## perr := thisProcess primError.
## if (perr == xxxx) { self cannotInstantiate }
## else { self primitiveFailed }.
}
method(#class) basicNew: size
{
| perr |
<primitive: #_basic_new>
self primitiveFailed.
## perr := thisProcess primError.
## if (perr == xxxx) { self cannotInstantiate }
## else { self primitiveFailed }.
}
method(#class) ngcNew
@ -183,39 +190,10 @@ extend Apex
else { self primitiveFailed }
}
(*
method(#class) basicAt: index
{
| perr |
<primitive: #_basic_at>
perr := thisProcess primError.
if (perr == Error.Code.ERANGE) { self index: index outOfRange: (self basicSize) }
elsif (perr == Error.Code.EPERM) { self messageProhibited: #basicAt:put: }
else { self primitiveFailed }
}
method(#dual) basicAt: index put: anObject
{
| perr |
<primitive: #_basic_at_put>
perr := thisProcess primError.
if (perr == Error.Code.ERANGE) { self index: index outOfRange: (self basicSize) }
elsif (perr == Error.Code.EPERM) { self messageProhibited: #basicAt:put: }
else { self primitiveFailed }
}*)
(* ------------------------------------------------------------------
* HASHING
* ------------------------------------------------------------------ *)
method hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
method(#class) hash
method(#dual) hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
@ -225,7 +203,7 @@ extend Apex
* IDENTITY TEST
* ------------------------------------------------------------------ *)
method == anObject
method(#dual) == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
@ -233,21 +211,7 @@ extend Apex
self primitiveFailed.
}
method ~~ anObject
{
<primitive: #_not_identical>
^(self == anObject) not.
}
method(#class) == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
self primitiveFailed.
}
method(#class) ~~ anObject
method(#dual) ~~ anObject
{
<primitive: #_not_identical>
^(self == anObject) not.
@ -256,76 +220,42 @@ extend Apex
(* ------------------------------------------------------------------
* EQUALITY TEST
* ------------------------------------------------------------------ *)
method = anObject
method(#dual) = anObject
{
<primitive: #_equal>
self subclassResponsibility: #=
}
method ~= anObject
method(#dual) ~= anObject
{
<primitive: #_not_equal>
^(self = anObject) not.
}
method(#class) = anObject
{
<primitive: #_equal>
self subclassResponsibility: #=
}
method(#class) ~= anObject
{
<primitive: #_not_equal>
^(self = anObject) not.
}
(* ------------------------------------------------------------------
* COMMON QUERIES
* ------------------------------------------------------------------ *)
method isNil
method(#dual) isNil
{
"^self == nil."
^false
}
method notNil
method(#dual) notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
method(#class) isNil
{
"^self == nil."
^false
}
method(#class) notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
method isError
method(#dual) isError
{
^false
}
method(#class) isError
{
^false
}
method notError
{
^true
}
method(#class) notError
method(#dual) notError
{
^true
}
@ -371,13 +301,7 @@ extend Apex
## -------------------------------------------------------
## -------------------------------------------------------
method(#class) respondsTo: selector
{
<primitive: #_responds_to>
self primitiveFailed
}
method respondsTo: selector
method(#dual) respondsTo: selector
{
<primitive: #_responds_to>
self primitiveFailed
@ -386,61 +310,32 @@ extend Apex
## -------------------------------------------------------
## -------------------------------------------------------
method(#class,#variadic) perform(selector)
method(#dual,#variadic) perform(selector)
{
<primitive: #_perform>
self primitiveFailed
}
method(#variadic) perform(selector)
method(#dual) perform: selector
{
<primitive: #_perform>
self primitiveFailed
}
method(#class) perform: selector
{
<primitive: #_perform>
self primitiveFailed
}
method perform: selector
method(#dual) perform: selector with: arg1
{
<primitive: #_perform>
self primitiveFailed
}
method(#class) perform: selector with: arg1
method(#dual) perform: selector with: arg1 with: arg2
{
<primitive: #_perform>
self primitiveFailed
}
method perform: selector with: arg1
{
<primitive: #_perform>
self primitiveFailed
}
method(#class) perform: selector with: arg1 with: arg2
{
<primitive: #_perform>
self primitiveFailed
}
method perform: selector with: arg1 with: arg2
{
<primitive: #_perform>
self primitiveFailed
}
method(#class) perform: selector with: arg1 with: arg2 with: arg3
{
<primitive: #_perform>
self primitiveFailed
}
method perform: selector with: arg1 with: arg2 with: arg3
method(#dual) perform: selector with: arg1 with: arg2 with: arg3
{
<primitive: #_perform>
self primitiveFailed
@ -458,57 +353,12 @@ extend Apex
(* ------------------------------------------------------------------
* COMMON ERROR/EXCEPTION HANDLERS
* ------------------------------------------------------------------ *)
method primitiveFailed
{
^self class primitiveFailed.
}
method cannotInstantiate
{
^self class cannotInstantiate
}
method doesNotUnderstand: messageSymbol
{
^self class doesNotUnderstand: messageSymbol
}
method index: index outOfRange: ubound
{
^self class index: index outOfRange: ubound.
}
method subclassResponsibility: method_name
{
^self class subclassResponsibility: method_name
}
method notImplemented: method_name
{
^self class notImplemented: method_name
}
method messageProhibited: method_name
{
^self class messageProhibited: method_name
}
method cannotExceptionizeError
{
^self class cannotExceptionizeError
}
method(#class) error: msgText
method(#dual) error: msgText
{
(* TODO: implement this
Error signal: msgText. *)
msgText dump.
}
method error: aString
{
self class error: aString.
}
}
class Object(Apex)

166
moo/kernel/Except.moo
View File

@ -33,39 +33,51 @@ class Exception(Apex)
^(self class name) & ' - ' & self.messageText.
}
(* TODO: remove this....
method __signal
{
self.signalContext := thisContext.
((thisContext sender) findExceptionContext) handleException: self.
}
}*)
method signal
{
| exctx exblk retval actpos |
| exctx exblk retval actpos ctx |
self.signalContext := thisContext.
exctx := (thisContext sender) findExceptionContext.
[exctx notNil] whileTrue: [
##[exctx notNil] whileTrue: [
while (exctx notNil)
{
exblk := exctx findExceptionHandlerFor: (self class).
(exblk notNil and:
[actpos := exctx basicSize - 1. exctx basicAt: actpos]) ifTrue: [
if (exblk notNil and:
[actpos := exctx basicSize - 1. exctx basicAt: actpos])
{
self.handlerContext := exctx.
exctx basicAt: actpos put: false.
[ retval := exblk value: self ] ensure: [
exctx basicAt: actpos put: true
].
[ retval := exblk value: self ] ensure: [ exctx basicAt: actpos put: true ].
thisContext unwindTo: (exctx sender) return: nil.
Processor return: retval to: (exctx sender).
].
}.
exctx := (exctx sender) findExceptionContext.
].
}.
## -----------------------------------------------------------------
## FATAL ERROR - no exception handler.
## -----------------------------------------------------------------
##thisContext unwindTo: nil return: nil.
##thisContext unwindTo: (Processor activeProcess initialContext) return: nil.
## TOOD: IMPROVE THIS EXPERIMENTAL BACKTRACE...
ctx := thisContext.
while (ctx notNil)
{
if (ctx class == MethodContext) { (ctx method owner name & '>>' & ctx method name) dump }.
## TODO: include blockcontext???
ctx := ctx sender.
}.
thisContext unwindTo: (thisProcess initialContext) return: nil.
('### EXCEPTION NOT HANDLED #### ' & self class name & ' - ' & self messageText) dump.
## TODO: debug the current process???? "
@ -88,31 +100,31 @@ class Exception(Apex)
method return: value
{
(self.handlerContext notNil) ifTrue: [
Processor return: value to: self.handlerContext.
].
if (self.handlerContext notNil) { Processor return: value to: self.handlerContext }
}
method retry
{
## TODO: verify if return:to: causes unnecessary stack growth.
(self.handlerContext notNil) ifTrue: [
if (self.handlerContext notNil)
{
self.handlerContext pc: 0.
Processor return: self to: self.handlerContext.
].
}
}
method resume: value
{
## TODO: verify if return:to: causes unnecessary stack growth.
## is this correct???
(self.signalContext notNil and: [self.handlerContext notNil]) ifTrue: [
| ctx |
| ctx |
if (self.signalContext notNil and: [self.handlerContext notNil])
{
ctx := self.signalContext sender.
self.signalContext := nil.
self.handlerContext := nil.
Processor return: value to: ctx.
].
}.
}
method resume
@ -143,10 +155,11 @@ extend Context
{
| ctx |
ctx := self.
[ ctx notNil ] whileTrue: [
(ctx isExceptionContext) ifTrue: [^ctx].
while (ctx notNil)
{
if (ctx isExceptionContext) { ^ctx }.
ctx := ctx sender.
].
}.
^nil
}
@ -157,26 +170,29 @@ extend Context
## private: called by VM upon unwinding
## -------------------------------------------------------------------
| ctx stop |
| ctx stop eb pending_pos |
ctx := self.
stop := false.
[stop] whileFalse: [
| eb |
until (stop)
{
eb := ctx ensureBlock.
(eb notNil) ifTrue: [
| donepos |
donepos := ctx basicSize - 1.
(ctx basicAt: donepos) ifFalse: [
ctx basicAt: donepos put: true.
if (eb notNil)
{
(* position of the temporary variable in the ensureBlock that indicates
* if the block has been evaluated *)
pending_pos := ctx basicSize - 1.
if (ctx basicAt: pending_pos)
{
ctx basicAt: pending_pos put: false.
eb value.
].
].
}
}.
stop := (ctx == context).
ctx := ctx sender.
## stop ifFalse: [ stop := ctx isNil ].
].
}.
^retval
}
@ -207,9 +223,7 @@ extend MethodContext
* instance variables of the method context. As MethodContex has
* 8 instance variables, the ensure block must be at the 9th position
* which translates to index 8 *)
(self.method preambleCode == 13) ifFalse: [^nil].
^self basicAt: 8.
^if (self.method preambleCode == 13) { self basicAt: 8 } else { nil }
}
@ -226,9 +240,10 @@ extend MethodContext
## TODO: change 8 to a constant when moo is enhanced to support constant definition
## or calcuate the minimum size using the class information.
(self isExceptionContext) ifTrue: [
| size exc |
| size exc |
if (self isExceptionContext)
{
(* NOTE: the following loop scans all parameters to the on:do: method.
* if the on:do: method contains local temporary variables,
* those must be skipped from scanning. *)
@ -236,9 +251,9 @@ extend MethodContext
size := self basicSize.
8 priorTo: size by: 2 do: [ :i |
exc := self basicAt: i.
((exception_class == exc) or: [exception_class inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
if ((exception_class == exc) or: [exception_class inheritsFrom: exc]) { ^self basicAt: (i + 1) }.
]
].
}.
^nil.
}
@ -261,12 +276,13 @@ extend MethodContext
actpos := (self basicSize) - 1.
excblk := self findExceptionHandlerFor: (exception class).
(excblk isNil or: [(self basicAt: actpos) not]) ifTrue: [
if (excblk isNil or: [(self basicAt: actpos) not])
{
## self is an exception context but doesn't have a matching
## exception handler or the exception context is already
## in the middle of evaluation.
^(self.sender findExceptionContext) handleException: exception.
].
}.
exception handlerContext: self.
@ -324,27 +340,24 @@ thisContext isExceptionContext dump.
method ensure: aBlock
{
| retval done |
| retval pending |
<ensure>
done := false.
pending := true.
retval := self value.
## the temporary variable 'done' may get changed
## during evaluation for exception handling.
done ifFalse: [
done := true.
aBlock value.
].
(* the temporary variable 'pending' may get changed
* during evaluation for exception handling.
* it gets chagned in Context>>unwindTo:return: *)
if (pending) { pending := false. aBlock value }.
^retval
}
method ifCurtailed: aBlock
{
| v ok |
ok := false.
[ v := self value. ok := true. ] ensure: [ ok ifFalse: [aBlock value] ].
| v pending |
pending := true.
[ v := self value. pending := false. ] ensure: [ if (pending) { aBlock value } ].
^v.
}
}
@ -389,55 +402,50 @@ class ProhibitedMessageException(Exception)
extend Apex
{
method(#class) primitiveFailed
method(#dual) primitiveFailed
{
## TODO: implement this
## experimental backtrace...
| ctx |
ctx := thisContext.
[ctx notNil] whileTrue: [
(ctx class == MethodContext)
ifTrue: [ (ctx method owner name & '>>' & ctx method name) dump ].
## TODO: include blockcontext???
ctx := ctx sender.
].
'------ END OF BACKTRACE -----------' dump.
PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
}
method(#class) cannotInstantiate
method(#dual) cannotInstantiate
{
## TOOD: accept a class
InstantiationFailureException signal: 'Cannot instantiate'.
## TODO: use displayString or something like that instead of name....
InstantiationFailureException signal: 'Cannot instantiate ' & (self name).
}
method(#class) doesNotUnderstand: message_name
method(#dual) doesNotUnderstand: message_name
{
## TODO: implement this properly
NoSuchMessageException signal: (message_name & ' not understood by ' & (self name)).
| class_name |
class_name := if (self class == Class) { self name } else { self class name }.
NoSuchMessageException signal: (message_name & ' not understood by ' & class_name).
}
method(#class) index: index outOfRange: ubound
method(#dual) index: index outOfRange: ubound
{
IndexOutOfRangeException signal: 'Out of range'.
}
method(#class) subclassResponsibility: method_name
method(#dual) subclassResponsibility: method_name
{
SubclassResponsibilityException signal: ('Subclass must implement ' & method_name).
}
method(#class) notImplemented: method_name
method(#dual) notImplemented: method_name
{
NotImplementedException signal: (method_name & ' not implemented by ' & (self name)).
| class_name |
class_name := if (self class == Class) { self name } else { self class name }.
NotImplementedException signal: (method_name & ' not implemented by ' & class_name).
}
method(#class) messageProhibited: method_name
method(#dual) messageProhibited: method_name
{
ProhibitedMessageException signal: (method_name & ' not allowed for ' & (self name)).
| class_name |
class_name := if (self class == Class) { self name } else { self class name }.
ProhibitedMessageException signal: (method_name & ' not allowed for ' & class_name).
}
method(#class) cannotExceptionizeError
method(#dual) cannotExceptionizeError
{
## todo: accept the object
ErrorExceptionizationFailureException signal: 'Cannot exceptionize an error'

12
moo/kernel/Process.moo
View File

@ -3,10 +3,16 @@ class(#pointer) Process(Object)
{
var initial_context, current_context, state, sp, prev, next, sem, perr.
method new
method(#class) basicNew
{
"instantiation is not allowed"
^nil. "TODO: raise an exception or return an error"
(* instantiation is not allowed. a process is strictly a VM managed object *)
self cannotInstantiate
}
method(#class) basicNew: size
{
(* instantiation is not allowed. a process is strictly a VM managed object *)
self cannotInstantiate
}
method prev { ^self.prev }