388 lines
8.9 KiB
Smalltalk
388 lines
8.9 KiB
Smalltalk
class Apex(nil)
|
|
{
|
|
}
|
|
|
|
class(#limited) Error(Apex)
|
|
{
|
|
pooldic Code
|
|
{
|
|
ENOERR := #\E0.
|
|
EGENERIC := #\E1.
|
|
ENOIMPL := #\E2.
|
|
ESYSERR := #\E3.
|
|
EINTERN := #\E4.
|
|
ESYSMEM := #\E5.
|
|
EOOMEM := #\E6.
|
|
EINVAL := #\E7.
|
|
ENOENT := #\E8.
|
|
EPERM := #\E12.
|
|
ERANGE := #\E20.
|
|
|
|
ELIMIT := #\E9999.
|
|
## add more items...
|
|
}
|
|
}
|
|
|
|
(*
|
|
pooldic Error.Code
|
|
{
|
|
ENOERR := #\E0.
|
|
EGENERIC := #\E1.
|
|
ENOIMPL := #\E2.
|
|
ESYSERR := #\E3.
|
|
EINTERN := #\E4.
|
|
ESYSMEM := #\E5.
|
|
EOOMEM := #\E6.
|
|
EINVAL := #\E7.
|
|
ENOENT := #\E8.
|
|
EPERM := #\E12.
|
|
ERANGE := #\E20.
|
|
|
|
ELIMIT := #\E9999.
|
|
## add more items...
|
|
} *)
|
|
|
|
(*pooldic Error.Code2
|
|
{
|
|
>> CAN I SUPPORT this kind of redefnition? as of now, it's not accepted because
|
|
>> Error.Code2.EGENERIC is not a literal. Should i treate pooldic members as a constant
|
|
>> and treat it as if it's a literal like? then even if the defined value changes,
|
|
>> the definition here won't see the change... what is the best way to tackle this issue?
|
|
|
|
EGENERIC := Error.Code2.EGENERIC.
|
|
}*)
|
|
|
|
extend Apex
|
|
{
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
method(#dual) dump
|
|
{
|
|
<primitive: #_dump>
|
|
}
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
method(#dual) yourself { ^self }
|
|
|
|
## -------------------------------------------------------
|
|
## INSTANTIATION & INITIALIZATION
|
|
## -------------------------------------------------------
|
|
method(#class,#primitive,#lenient) _basicNew.
|
|
method(#class,#primitive,#lenient) _basicNew: size.
|
|
|
|
method(#class,#primitive) basicNew.
|
|
method(#class,#primitive) basicNew: size.
|
|
(* the following definition is almost equivalent to the simpler definition
|
|
* method(#class,#primitive) basicNew: size.
|
|
* found above.
|
|
* in the following defintion, the primitiveFailed method is executed
|
|
* from the basicNew: context. but in the simpler definition, it is executed
|
|
* in the context of the caller of the basicNew:. the context of the basicNew:
|
|
* method is not even created
|
|
method(#class) basicNew: size
|
|
{
|
|
<primitive: #Apex__basicNew:>
|
|
self primitiveFailed(thisContext method)
|
|
}*)
|
|
|
|
method(#class) new
|
|
{
|
|
| x |
|
|
x := self basicNew.
|
|
x initialize. ## TODO: assess if it's good to call 'initialize' from new
|
|
^x.
|
|
}
|
|
|
|
method(#class) new: anInteger
|
|
{
|
|
| x |
|
|
x := self basicNew: anInteger.
|
|
x initialize. ## TODO: assess if it's good to call 'initialize' from new.
|
|
^x.
|
|
}
|
|
|
|
method initialize
|
|
{
|
|
(* a subclass may override this method *)
|
|
^self.
|
|
}
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
method(#dual,#primitive,#lenient) _shallowCopy.
|
|
method(#dual,#primitive) shallowCopy.
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
method(#dual,#primitive,#lenient) _basicSize.
|
|
method(#dual,#primitive) basicSize.
|
|
|
|
method(#dual,#primitive) basicAt: index.
|
|
method(#dual,#primitive) basicAt: index put: value.
|
|
|
|
method(#dual,#primitive) basicFillFrom: sindex with: value count: count.
|
|
method(#dual,#primitive) basicShiftFrom: sindex to: dindex count: count.
|
|
|
|
(* ------------------------------------------------------------------
|
|
* FINALIZATION SUPPORT
|
|
* ------------------------------------------------------------------ *)
|
|
method(#dual,#primitive) addToBeFinalized.
|
|
method(#dual,#primitive) removeToBeFinalized.
|
|
|
|
(* ------------------------------------------------------------------
|
|
* HASHING
|
|
* ------------------------------------------------------------------ *)
|
|
method(#dual,#primitive) hash.
|
|
|
|
(*
|
|
method(#dual) hash
|
|
{
|
|
<primitive: #Apex_hash>
|
|
self subclassResponsibility: #hash
|
|
}*)
|
|
|
|
(* ------------------------------------------------------------------
|
|
* IDENTITY TEST
|
|
* ------------------------------------------------------------------ *)
|
|
|
|
## check if the receiver is identical to anObject.
|
|
## this doesn't compare the contents
|
|
method(#dual, #primitive) == anObject.
|
|
|
|
method(#dual) ~~ anObject
|
|
{
|
|
<primitive: #'Apex_~~'>
|
|
^(self == anObject) not.
|
|
}
|
|
|
|
(* ------------------------------------------------------------------
|
|
* EQUALITY TEST
|
|
* ------------------------------------------------------------------ *)
|
|
method(#dual) = anObject
|
|
{
|
|
<primitive: #'Apex_='>
|
|
self subclassResponsibility: #=
|
|
}
|
|
|
|
method(#dual) ~= anObject
|
|
{
|
|
<primitive: #'Apex_~='>
|
|
^(self = anObject) not.
|
|
}
|
|
|
|
|
|
(* ------------------------------------------------------------------
|
|
* COMMON QUERIES
|
|
* ------------------------------------------------------------------ *)
|
|
|
|
method(#dual,#primitive) class.
|
|
|
|
method(#dual) isNil
|
|
{
|
|
## ^self == nil.
|
|
^false
|
|
}
|
|
|
|
method(#dual) notNil
|
|
{
|
|
## ^(self == nil) not
|
|
## ^self ~= nil.
|
|
^true.
|
|
}
|
|
|
|
method(#dual) isError
|
|
{
|
|
^false
|
|
}
|
|
|
|
method(#dual) notError
|
|
{
|
|
^true
|
|
}
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
|
|
method(#class) inheritsFrom: aClass
|
|
{
|
|
| c |
|
|
c := self superclass.
|
|
(* [c notNil] whileTrue: [
|
|
[ c == aClass ] ifTrue: [^true].
|
|
c := c superclass.
|
|
]. *)
|
|
while (c notNil)
|
|
{
|
|
if (c == aClass) { ^true }.
|
|
c := c superclass.
|
|
}.
|
|
^false
|
|
}
|
|
|
|
method(#class) isMemberOf: aClass
|
|
{
|
|
(* a class object is an instance of Class
|
|
* but Class inherits from Apex. On the other hand,
|
|
* most of ordinary classes are under Object again under Apex.
|
|
* special consideration is required here. *)
|
|
^aClass == Class
|
|
}
|
|
|
|
method isMemberOf: aClass
|
|
{
|
|
^self class == aClass
|
|
}
|
|
|
|
method(#dual) isKindOf: aClass
|
|
{
|
|
<primitive: #Apex_isKindOf:>
|
|
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
|
|
}
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
|
|
method(#dual,#primitive) respondsTo: selector.
|
|
|
|
## -------------------------------------------------------
|
|
## -------------------------------------------------------
|
|
|
|
method(#dual,#variadic,#primitive) perform(selector).
|
|
|
|
method(#dual) perform: selector
|
|
{
|
|
<primitive: #Apex_perform>
|
|
self primitiveFailed
|
|
}
|
|
|
|
method(#dual) perform: selector with: arg1
|
|
{
|
|
<primitive: #Apex_perform>
|
|
self primitiveFailed
|
|
}
|
|
|
|
method(#dual) perform: selector with: arg1 with: arg2
|
|
{
|
|
<primitive: #Apex_perform>
|
|
self primitiveFailed
|
|
}
|
|
|
|
method(#dual) perform: selector with: arg1 with: arg2 with: arg3
|
|
{
|
|
<primitive: #Apex_perform>
|
|
self primitiveFailed
|
|
}
|
|
|
|
(* ------------------------------------------------------------------
|
|
* COMMON ERROR/EXCEPTION HANDLERS
|
|
* ------------------------------------------------------------------ *)
|
|
method(#dual) error: msgText
|
|
{
|
|
(* TODO: implement this
|
|
Error signal: msgText. *)
|
|
msgText dump.
|
|
}
|
|
}
|
|
|
|
class Object(Apex)
|
|
{
|
|
|
|
}
|
|
|
|
class UndefinedObject(Apex)
|
|
{
|
|
method isNil
|
|
{
|
|
^true
|
|
}
|
|
|
|
method notNil
|
|
{
|
|
^false.
|
|
}
|
|
|
|
method handleException: exception
|
|
{
|
|
('### EXCEPTION NOT HANDLED #### ' & exception class name & ' - ' & exception messageText) dump.
|
|
## TODO: debug the current process???? "
|
|
## TODO: ensure to execute ensure blocks as well....
|
|
####Processor activeProcess terminate.
|
|
}
|
|
}
|
|
|
|
|
|
|
|
extend Error
|
|
{
|
|
(* ----------------------------
|
|
TODO: support nested pooldic/constant declaration...
|
|
|
|
pooldic/const
|
|
{
|
|
NONE := #\e0.
|
|
GENERIC := #\e1.
|
|
}
|
|
-------------------------------- *)
|
|
|
|
method isError
|
|
{
|
|
^true
|
|
}
|
|
|
|
method notError
|
|
{
|
|
^false
|
|
}
|
|
|
|
method(#primitive) asCharacter.
|
|
method asError { ^self }
|
|
method(#primitive) asInteger.
|
|
|
|
method(#primitive) asString.
|
|
|
|
method signal
|
|
{
|
|
| exctx exblk retval actpos ctx |
|
|
|
|
exctx := (thisContext sender) findExceptionContext.
|
|
|
|
while (exctx notNil)
|
|
{
|
|
exblk := exctx findExceptionHandlerFor: (self class).
|
|
if (exblk notNil and: [actpos := exctx basicSize - 1. exctx basicAt: actpos])
|
|
{
|
|
exctx basicAt: actpos put: false.
|
|
[ retval := exblk value: self ] ensure: [ exctx basicAt: actpos put: true ].
|
|
thisContext unwindTo: (exctx sender) return: nil.
|
|
System 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...
|
|
System logNl: '== BACKTRACE =='.
|
|
ctx := thisContext.
|
|
while (ctx notNil)
|
|
{
|
|
if (ctx class == MethodContext) { System logNl: (' ' & ctx method owner name & '>>' & ctx method name) }.
|
|
## TODO: include blockcontext???
|
|
ctx := ctx sender.
|
|
}.
|
|
System logNl: '== END OF BACKTRACE =='.
|
|
|
|
thisContext unwindTo: (thisProcess initialContext) return: nil.
|
|
('### ERROR NOT HANDLED #### ' & self class name & ' - ' & self asString) dump.
|
|
## TODO: debug the current process???? "
|
|
|
|
##Processor activeProcess terminate.
|
|
thisProcess terminate.
|
|
}
|
|
}
|