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

renamed stix to moo

Browse Source
This commit is contained in:
hyunghwan.chung
2017-01-09 10:25:22 +00:00
parent f7e98b7fc7
commit b2fb361df4
135 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

450
moo/kernel/Apex.st Normal file
View File

@ -0,0 +1,450 @@
class Apex(nil)
{
dcl(#class) sysdic.
## -------------------------------------------------------
## -------------------------------------------------------
method(#class) dump
{
<primitive: #_dump>
}
method dump
{
<primitive: #_dump>
}
## -------------------------------------------------------
## -------------------------------------------------------
method(#class) yourself
{
^self.
}
method yourself
{
^self.
}
## -------------------------------------------------------
## -------------------------------------------------------
method(#class) basicNew
{
<primitive: #_basic_new>
self primitiveFailed.
}
method(#class) basicNew: anInteger
{
<primitive: #_basic_new_with_size>
self primitiveFailed.
}
method(#class) ngcNew
{
<primitive: #_ngc_new>
self primitiveFailed.
}
method(#class) ngcNew: anInteger
{
<primitive: #_ngc_new_with_size>
self primitiveFailed.
}
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 |
## TODO: check if the class is a fixed class.
## if so, raise an exception.
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 ngcDispose
{
<primitive: #_ngc_dispose>
self primitiveFailed.
}
## -------------------------------------------------------
## -------------------------------------------------------
method shallowCopy
{
<primitive: #_shallow_copy>
self primitiveFailed.
}
## -------------------------------------------------------
## -------------------------------------------------------
method class
{
<primitive: #_class>
}
method(#class) class
{
<primitive: #_class>
^Class
}
## -------------------------------------------------------
## -------------------------------------------------------
method basicSize
{
<primitive: #_basic_size>
self primitiveFailed.
}
method(#class) basicSize
{
<primitive: #_basic_size>
self primitiveFailed.
}
method basicAt: index
{
<primitive: #_basic_at>
self index: index outOfRange: (self basicSize).
}
method basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self index: index outOfRange: (self basicSize).
}
method(#class) basicAt: index
{
<primitive: #_basic_at>
self index: index outOfRange: (self basicSize).
}
method(#class) basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self index: index outOfRange: (self basicSize).
}
(* ------------------------------------------------------------------
* HASHING
* ------------------------------------------------------------------ *)
method hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
method(#class) hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
(* ------------------------------------------------------------------
* IDENTITY TEST
* ------------------------------------------------------------------ *)
method == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
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
{
<primitive: #_not_identical>
^(self == anObject) not.
}
(* ------------------------------------------------------------------
* EQUALITY TEST
* ------------------------------------------------------------------ *)
method = anObject
{
<primitive: #_equal>
self subclassResponsibility: #=
}
method ~= 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
{
"^self == nil."
^false
}
method notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
method(#class) isNil
{
"^self == nil."
^false
}
method(#class) notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
method isError
{
^false
}
method(#class) isError
{
^false
}
method notError
{
^true
}
method(#class) notError
{
^true
}
## -------------------------------------------------------
## -------------------------------------------------------
method(#class) inheritsFrom: aClass
{
| c |
c := self superclass.
[c notNil] whileTrue: [
[ c == aClass ] ifTrue: [^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(#class) isKindOf: aClass
{
^(self isMemberOf: aClass) or: [self inheritsFrom: aClass].
}
method isMemberOf: aClass
{
^self class == aClass
}
method isKindOf: aClass
{
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
}
(* -----------------
method(#class) respondsTo: selectorSymbol
{
TODO: find selectorSymbol in the class method dictionary...
}
method respondsTo: selectorSymbol
{
TODO: find selectorSymbol in the method dictionary...
}
------------ *)
method exceptionizeError: trueOrFalse
{
<primitive: #_exceptionize_error>
self class cannotExceptionizeError
}
(* ------------------------------------------------------------------
* 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 cannotExceptionizeError
{
^self class cannotExceptionizeError
}
method(#class) error: msgText
{
(* TODO: implement this
Error signal: msgText. *)
msgText dump.
}
method error: aString
{
self class error: aString.
}
}
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.
}
}
pooldic ErrorCode
{
(* migrate it into Error class *)
#NONE := error(0).
#GENERIC := error(1).
#NOENT := error(2).
}
class Error(Apex)
{
(* ----------------------------
TODO: support constant declaration...
#const
{
#NONE := error(0).
#GENERIC := error(1).
}
-------------------------------- *)
method isError
{
^true
}
method notError
{
^false
}
method asInteger
{
<primitive: #_error_as_integer>
}
method asCharacter
{
<primitive: #_error_as_character>
}
method asString
{
<primitive: #_error_as_string>
}
}

91
moo/kernel/Boolean.st Normal file
View File

@ -0,0 +1,91 @@
class Boolean(Object)
{
(* TODO: do i need to really define methods defined in True and False here?
and call subclassResponsibiltiy?" *)
}
class True(Boolean)
{
method not
{
^false
}
method & aBoolean
{
^aBoolean
}
method | aBoolean
{
^true
}
method and: aBlock
{
^aBlock value
}
method or: aBlock
{
^true
}
method ifTrue: trueBlock ifFalse: falseBlock
{
^trueBlock value.
}
method ifTrue: trueBlock
{
^trueBlock value.
}
method ifFalse: falseBlock
{
^nil.
}
}
class False(Boolean)
{
method not
{
^true
}
method & aBoolean
{
^false
}
method | aBoolean
{
^aBoolean
}
method and: aBlock
{
^false
}
method or: aBlock
{
^aBlock value
}
method ifTrue: trueBlock ifFalse: falseBlock
{
^falseBlock value.
}
method ifTrue: trueBlock
{
^nil.
}
method ifFalse: falseBlock
{
^falseBlock value.
}
}

50
moo/kernel/Class.st Normal file
View File

@ -0,0 +1,50 @@
##
## the Class object should be a variable-pointer object because
## it needs to accomodate class instance variables.
##
class(#pointer) Class(Apex)
{
dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
method(#class) basicNew
{
## you must not instantiate a new class this way.
self cannotInstantiate.
}
method(#class) initialize
{
^self.
}
(* most of the following methods can actually become class methods of Apex.
* if the instance varibles can be made accessible from the Apex class. *)
method name
{
^self.name
}
method superclass
{
^self.superclass
}
method specNumInstVars
{
## shift right by 7 bits.
## see moo-prv.h for details.
^self.spec bitShift: -7
}
(*method inheritsFrom: aSuperclass
{
| c |
c := self superclass.
[c notNil] whileTrue: [
[ c == aSuperclass ] ifTrue: [^true].
c := c superclass.
].
^false
}*)
}

506
moo/kernel/Collect.st Normal file
View File

@ -0,0 +1,506 @@
class Collection(Object)
{
}
## -------------------------------------------------------------------------------
class(#pointer) Array(Collection)
{
method size
{
^self basicSize
}
method at: anInteger
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
method first
{
^self at: 0.
}
method last
{
^self at: (self basicSize - 1).
}
method do: aBlock
{
0 priorTo: (self basicSize) do: [:i | aBlock value: (self at: i)].
}
method copy: anArray
{
0 priorTo: (anArray basicSize) do: [:i | self at: i put: (anArray at: i) ].
}
}
## -------------------------------------------------------------------------------
class(#character) String(Array)
{
method & string
{
(* TOOD: make this a primitive for performance. *)
(* concatenate two strings. *)
| newsize newstr cursize appsize |
cursize := self basicSize.
appsize := string basicSize.
newsize := cursize + appsize.
(*newstr := self class basicNew: newsize.*)
newstr := String basicNew: newsize.
0 priorTo: cursize do: [:i | newstr at: i put: (self at: i) ].
0 priorTo: appsize do: [:i | newstr at: (i + cursize) put: (string at: i) ].
^newstr
}
method asString
{
^self
}
}
## -------------------------------------------------------------------------------
class(#character) Symbol(String)
{
method asString
{
(* TODO: make this a primitive for performance *)
(* convert a symbol to a string *)
| size str |
size := self basicSize.
str := String basicNew: size.
0 priorTo: size do: [:i | str at: i put: (self at: i) ].
^str.
}
method = anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_identical>
self primitiveFailed.
}
method ~= anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_not_identical>
^(self == anObject) not.
}
}
## -------------------------------------------------------------------------------
class(#byte) ByteArray(Collection)
{
method at: anInteger
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
}
## -------------------------------------------------------------------------------
class Set(Collection)
{
dcl tally bucket.
method initialize
{
self.tally := 0.
self.bucket := Array new: 128. (* TODO: initial size *)
}
method size
{
^self.tally
}
method __find: key or_upsert: upsert with: value
{
| hv ass bs index ntally |
bs := self.bucket size.
hv := key hash.
index := hv rem: bs.
[(ass := self.bucket at: index) notNil]
whileTrue: [
(key = ass key) ifTrue: [
(* found *)
upsert ifTrue: [ass value: value].
^ass
].
index := (index + 1) rem: bs.
].
upsert ifFalse: [^ErrorCode.NOENT].
ntally := self.tally + 1.
(ntally >= bs) ifTrue: [
| newbuc newsz |
(* expand the bucket *)
newsz := bs + 123. (* TODO: keep this growth policy in sync with VM(dic.c) *)
newbuc := Array new: newsz.
0 priorTo: bs do: [:i |
ass := self.bucket at: i.
(ass notNil) ifTrue: [
index := (ass key hash) rem: newsz.
[(newbuc at: index) notNil] whileTrue: [index := (index + 1) rem: newsz].
newbuc at: index put: ass
]
].
self.bucket := newbuc.
bs := self.bucket size.
index := hv rem: bs.
[(self.bucket at: index) notNil] whileTrue: [index := (index + 1) rem: bs ].
].
ass := Association key: key value: value.
self.tally := ntally.
self.bucket at: index put: ass.
^ass
}
method at: key
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass isError) ifTrue: [^ass].
^ass value
}
method at: key ifAbsent: error_block
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass isError) ifTrue: [^error_block value].
^ass value
}
method associationAt: key
{
^self __find: key or_upsert: false with: nil.
}
method associationAt: key ifAbsent: error_block
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass isError) ifTrue: [^error_block value].
^ass
}
method at: key put: value
{
(* returns the affected/inserted association *)
^self __find: key or_upsert: true with: value.
}
method includesKey: key
{
| ass |
ass := self __find: key or_upsert: false with: nil.
^ass notError
}
method includesAssociation: assoc
{
| ass |
ass := self __find: (assoc key) or_upsert: false with: nil.
^ass = assoc.
}
method includesKey: key value: value
{
| ass |
ass := self __find: key or_upsert: false with: nil.
^ass key = key and: [ass value = value]
}
method __find_index: key
{
| bs ass index |
bs := self.bucket size.
index := (key hash) rem: bs.
[(ass := self.bucket at: index) notNil]
whileTrue: [
(key = ass key) ifTrue: [^index].
index := (index + 1) rem: bs.
].
^ErrorCode.NOENT.
}
method __remove_at: index
{
| bs x y i v |
bs := self.bucket size.
v := self.bucket basicAt: index.
x := index.
y := index.
i := 0.
[i < self.tally] whileTrue: [
| ass z |
y := (y + 1) rem: bs.
ass := self.bucket at: i.
(ass isNil)
ifTrue: [
(* done. the slot at the current index is nil *)
i := self.tally
]
ifFalse: [
(* get the natural hash index *)
z := (ass key hash) rem: bs.
(* move an element if necessary *)
((y > x and: [(z <= x) or: [z > y]]) or:
[(y < x) and: [(z <= x) and: [z > y]]]) ifTrue: [
self.bucket at: x put: (self.bucket at: y).
x := y.
].
i := i + 1
].
].
self.bucket at: x put: nil.
self.tally := self.tally - 1.
(* return the affected association *)
^v
}
method removeKey: key
{
| index |
index := self __find_index: key.
(index isError) ifTrue: [ ^index ].
^self __remove_at: index.
}
method removeKey: key ifAbsent: error_block
{
| index |
index := self __find_index: key.
(index isError) ifTrue: [ ^error_block value ].
^self __remove_at: index.
}
method removeAllKeys
{
(* remove all items from a dictionary *)
| bs |
bs := self.bucket size.
0 priorTo: bs do: [:i | self.bucket at: i put: nil ].
self.tally := 0
}
(* TODO: ... keys is an array of keys.
method removeAllKeys: keys
{
self notImplemented: #removeAllKeys:
}
*)
method remove: assoc
{
^self removeKey: (assoc key)
}
method remove: assoc ifAbsent: error_block
{
^self removeKey: (assoc key) ifAbsent: error_block
}
method do: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass value]
].
}
method keysDo: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass key]
].
}
method keysAndValuesDo: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass key value: ass value]
].
}
}
class SymbolSet(Set)
{
}
class Dictionary(Set)
{
}
pooldic Log
{
## -----------------------------------------------------------
## defines log levels
## these items must follow defintions in moo.h
## -----------------------------------------------------------
#DEBUG := 1.
#INFO := 2.
#WARN := 4.
#ERROR := 8.
#FATAL := 16.
}
class SystemDictionary(Dictionary)
{
## the following methods may not look suitable to be placed
## inside a system dictionary. but they are here for quick and dirty
## output production from the moo code.
## System logNl: 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'.
##
dcl(#pooldic) Log.
method atLevel: level log: message
{
<primitive: #_log>
## do nothing upon logging failure
}
method atLevel: level log: message and: message2
{
<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 atLevel: Log.INFO log: message.
}
method log: message and: message2
{
^self atLevel: Log.INFO log: message and: message2.
}
method logNl: message
{
^self atLevel: Log.INFO logNl: message.
}
method logNl: message and: message2
{
^self atLevel: Log.INFO logNl: message and: message2.
}
method at: key
{
(key class ~= Symbol) ifTrue: [InvalidArgumentException signal: 'key is not a symbol'].
^super at: key.
}
method at: key put: value
{
(key class ~= Symbol) ifTrue: [InvalidArgumentException signal: 'key is not a symbol'].
^super at: key put: value
}
}
class Namespace(Set)
{
}
class PoolDictionary(Set)
{
}
class MethodDictionary(Dictionary)
{
}
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
}
}

206
moo/kernel/Console.st Normal file
View File

@ -0,0 +1,206 @@
class Point(Object)
{
dcl x y.
method(#class) new
{
^self basicNew x: 0 y: 0.
}
method(#class) x: x y: y
{
^self basicNew x: x y: y.
}
method x
{
^self.x
}
method y
{
^self.y
}
method x: x
{
self.x := x
}
method y: y
{
self.y := y
}
method x: x y: y
{
self.x := x.
self.y := y
}
}
extend SmallInteger
{
method @ y
{
^Point x: self y: y
}
}
class Console(Object)
{
dcl handle.
"
method finalize
{
handle notNil ifTrue: [
self _close: handle.
]
}
"
## method(#class) input
## {
## ^self new _open: filename mode: mode
## }
method(#class) output
{
| c |
c := self new.
c handle: (c _open).
^c
}
## method(#class) error
## {
## }
method handle: v
{
self.handle := v.
}
method close
{
self _close: self.handle.
self.handle := nil.
}
method write: text
{
^self _writeOn: self.handle text: text.
}
method clear
{
^self _clear: self.handle
}
method setCursor: point
{
^self _setCursor: self.handle point: point.
}
"
method _open: filename mode: mode
{
self.handle := self __open: filename mode: mode.
^self.
}
method __open: filename mode: mode
{
<primitive: #console.open>
##StdioException signal: ('cannot open ' & filename).
}
"
method _open
{
<primitive: #console.open>
}
method _close: handle
{
<primitive: #console.close>
self primitiveFailed.
}
method _clear: handle
{
<primitive: #console.clear>
self primitiveFailed.
}
method _writeOn: handle text: text
{
<primitive: #console.write>
self primitiveFailed.
}
method _setCursor: handle point: point
{
<primitive: #console.setcursor>
self primitiveFailed.
}
"
method(#class) open
{
<primitive: #console.open>
self primitiveFailed.
}
method close
{
<primitive: #console.close>
self primitiveFailed.
}
method setCursorTo: point
{
<primitive: #console.setcursor>
self primitiveFailed.
}
"
##x := Colsole new.
##x := Console open.
##(x isError) ifTrue: [
## handle error...
## ]
## ifFalse: [
## x setCursor (1, 2).
## x clear.
## x close.
## ]
##x := File open: 'abc.def'
##t := x read: 1000.
##x close.
}
"
Moo define: 'console_write'
forClass: Console
method: 'write: aString upto: length'
returns: 'size_t'
arguments: 'void* size_t'
---> produces a method like this internally...
class Console
{
method write: aString upto: length
{
<ffi: int console_write (int*, char*, [int, int, char]* )> <== parse the string, create a descriptor table, key is console_write, value is resolved to a function pointer.
}
}
"

326
moo/kernel/Context.st Normal file
View File

@ -0,0 +1,326 @@
class(#pointer) Context(Apex)
{
dcl sender ip sp ntmprs.
method sender
{
^self.sender
}
method isDead
{
^self.ip < 0
}
method temporaryCount
{
^self.ntmprs
}
(* ---------------------------------
method varargCount
{
method context,
^do calculation...
for a block context, it must access homeContext first and call varargCount
^self.home varargCount...
}
method varargAt: index
{
method context
^do calculation...
block context...
^self.home varargAt: index
}
---------------------------------- *)
}
class(#pointer) MethodContext(Context)
{
dcl method receiver home origin.
method pc
{
^self.ip
}
method pcplus1
{
^self.ip + 1
}
method goto: anInteger
{
<primitive: #_context_goto>
self primitiveFailed. ## TODO: need to make this a hard failure?
}
method pc: anInteger
{
self.ip := anInteger.
}
method sp
{
^self.sp.
}
method sp: new_sp
{
self.sp := new_sp
}
method pc: new_pc sp: new_sp
{
self.ip := new_pc.
self.sp := new_sp.
}
method method
{
^self.method
}
method vargCount
{
^self basicSize - self class specNumInstVars - self.ntmprs
}
method vargAt: index
{
^self basicAt: (index + self class specNumInstVars + self.ntmprs)
}
}
class(#pointer) BlockContext(Context)
{
dcl nargs source home origin.
method vargCount
{
^self.home vargCount
}
method vargAt: index
{
^self.home vargAt: index
}
method fork
{
"crate a new process in the runnable state"
^self newProcess resume.
}
method newProcess
{
"create a new process in the suspended state"
<primitive: #_block_new_process>
self primitiveFailed.
}
method newProcessWith: anArray
{
"create a new process in the suspended state passing the elements
of anArray as block arguments"
<primitive: #_block_new_process>
self primitiveFailed.
}
method value
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a value: b
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a value: b value: c
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a value: b value: c value: d
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a value: b value: c value: d value: e
{
<primitive: #_block_value>
self primitiveFailed.
}
method ifTrue: aBlock
{
^(self value) ifTrue: aBlock.
}
method ifFalse: aBlock
{
^(self value) ifFalse: aBlock.
}
method ifTrue: trueBlock ifFalse: falseBlock
{
^(self value) ifTrue: trueBlock ifFalse: falseBlock
}
method whileTrue: aBlock
{
## --------------------------------------------------
## Naive implementation
## --------------------------------------------------
## (self value) ifFalse: [^nil].
## aBlock value.
## self whileTrue: aBlock.
## --------------------------------------------------
## --------------------------------------------------
## Non-recursive implementation
## --------------------------------------------------
| pc sp |
pc := thisContext pcplus1.
(self value) ifFalse: [ ^nil ].
aBlock value.
## the pc: method leaves thisContext and pc in the stack after
## having changes the instruction poointer.
## as a result, the stack keeps growing. the goto method
## clears thisContext and pc off the stack unlike normal methods.
##thisContext pc: pc.
thisContext goto: pc.
## --------------------------------------------------
}
method whileTrue
{
## (self value) ifFalse: [^nil].
## self whileTrue.
## --------------------------------------------------
## Non-recursive implementation
## --------------------------------------------------
| pc |
pc := thisContext pcplus1.
(self value) ifFalse: [ ^nil ].
thisContext goto: pc.
## --------------------------------------------------
}
method whileFalse: aBlock
{
## --------------------------------------------------
## Naive implementation
## --------------------------------------------------
## (self value) ifTrue: [^nil].
## aBlock value.
## self whileFalse: aBlock.
## --------------------------------------------------
## --------------------------------------------------
## Non-recursive implementation
## --------------------------------------------------
## The assignment to 'pc' uses the POP_INTO_TEMPVAR_1.
## It pops a value off the stack top, stores it to the second
## temporary variable(aBlock is the first temporary variable).
## It is a single byte instruction. 'pc' returned by
## 'thisContext pcplus1'' should point to the instruction after
## the POP_INTO_TEMPVAR_0 instruction.
##
## It would need the increment of 2 if the pair of
## STORE_INTO_TEMPVAR_1 and POP_STACKTOP were used.
## This implementation is subject to the instructions chosen
## by the compiler.
##
| pc |
pc := thisContext pcplus1.
(self value) ifTrue: [ ^nil "^self" ].
aBlock value.
thisContext goto: pc.
## --------------------------------------------------
}
method whileFalse
{
## (self value) ifTrue: [^nil].
## self whileFalse.
## --------------------------------------------------
## Non-recursive implementation
## --------------------------------------------------
| pc |
pc := thisContext pcplus1.
(self value) ifTrue: [ ^nil "^self" ].
thisContext goto: pc.
## --------------------------------------------------
}
method pc
{
^self.ip
}
method pc: anInteger
{
self.ip := anInteger.
}
method sp
{
^self.sp
}
method sp: anInteger
{
self.sp := anInteger.
}
method restart
{
ip := self.source pc.
}
}
class(#pointer) CompiledMethod(Object)
{
## dcl owner name preamble preamble_data_1 preamble_data_2 ntmprs nargs code source.
dcl owner name preamble preamble_data_1 preamble_data_2 ntmprs nargs source.
method preamble
{
^self.preamble
}
method preambleCode
{
(* TODO: make this a primtive for performance *)
^(self.preamble bitAnd: 16rFF) bitShift: -2.
}
method owner
{
^self.owner
}
method name
{
^self.name
}
}

436
moo/kernel/Except.st Normal file
View File

@ -0,0 +1,436 @@
##
## TODO: is it better to inherit from Object???
## or treat Exception specially like UndefinedObject or Class???
##
class Exception(Apex)
{
dcl signalContext handlerContext messageText.
method(#class) signal
{
^self new signal
}
method(#class) signal: text
{
^self new signal: text
}
method handlerContext: context
{
self.handlerContext := context.
}
method messageText
{
^self.messageText
}
method asString
{
^(self class name) & ' - ' & self.messageText.
}
method __signal
{
self.signalContext := thisContext.
((thisContext sender) findExceptionContext) handleException: self.
}
method signal
{
| exctx exblk retval actpos |
self.signalContext := thisContext.
exctx := (thisContext sender) findExceptionContext.
[exctx notNil] whileTrue: [
exblk := exctx findExceptionHandlerFor: (self class).
(exblk notNil and:
[actpos := exctx basicSize - 1. exctx basicAt: actpos]) ifTrue: [
self.handlerContext := exctx.
exctx basicAt: actpos put: false.
[ 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.
thisContext unwindTo: (thisProcess initialContext) return: nil.
('### EXCEPTION NOT HANDLED #### ' & self class name & ' - ' & self messageText) dump.
## TODO: debug the current process???? "
##Processor activeProcess terminate.
thisProcess terminate.
}
method signal: text
{
self.messageText := text.
^self signal.
}
method pass
{
## pass the exception to the outer context
((self.handlerContext sender) findExceptionContext) handleException: self.
}
method return: value
{
(self.handlerContext notNil) ifTrue: [
Processor return: value to: self.handlerContext.
].
}
method retry
{
## TODO: verify if return:to: causes unnecessary stack growth.
(self.handlerContext notNil) ifTrue: [
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 := self.signalContext sender.
self.signalContext := nil.
self.handlerContext := nil.
Processor return: value to: ctx.
].
}
method resume
{
^self resume: nil.
}
}
##============================================================================
extend Context
{
method isExceptionContext
{
^false
}
method isEnsureContext
{
^false
}
method ensureBlock
{
^nil
}
method findExceptionContext
{
| ctx |
ctx := self.
[ ctx notNil ] whileTrue: [
(ctx isExceptionContext) ifTrue: [^ctx].
ctx := ctx sender.
].
^nil
}
method unwindTo: context return: retval
{
## -------------------------------------------------------------------
## <<private>>
## private: called by VM upon unwinding
## -------------------------------------------------------------------
| ctx stop |
ctx := self.
stop := false.
[stop] whileFalse: [
| eb |
eb := ctx ensureBlock.
(eb notNil) ifTrue: [
| donepos |
donepos := ctx basicSize - 1.
(ctx basicAt: donepos) ifFalse: [
ctx basicAt: donepos put: true.
eb value.
].
].
stop := (ctx == context).
ctx := ctx sender.
## stop ifFalse: [ stop := ctx isNil ].
].
^retval
}
}
##============================================================================
extend MethodContext
{
method isExceptionContext
{
## 10 - MOO_METHOD_PREAMBLE_EXCEPTION in VM.
^self.method preambleCode == 10.
}
method isEnsureContext
{
## 10 - MOO_METHOD_PREAMBLE_ENSURE in VM.
^self.method preambleCode == 11
}
method ensureBlock
{
## TODO: change 8 to a constant when moo is enhanced to support constant definition
(* [ value-block ] ensure: [ ensure-block ]
* assuming ensure block is a parameter the ensure: method to a
* block context, the first parameter is placed after the fixed
* 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 == 11) ifFalse: [^nil].
^self basicAt: 8.
}
method findExceptionHandlerFor: exception_class
{
(* find an exception handler block for a given exception class.
*
* for this to work, self must be an exception handler context.
* For a single on:do: call,
* self class specNumInstVars must return 8.(i.e.MethodContext has 8 instance variables.)
* basicAt: 8 must be the on: argument.
* basicAt: 9 must be the do: argument *)
## 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 |
(* 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. *)
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)].
]
].
^nil.
}
method handleException: exception
{
(* -----------------------------------------------------------------
* <<private>>
* called by Exception>>signal.
* this method only exists in the MethodContext and UndefinedObject.
* the caller must make sure that the receiver object is
* a method context or nil. Exception>>signal invokes this method
* only for an exception context which is a method context. it
* invokes it for nil when no exception context is found.
* ---------------------------------------------------------------- *)
| excblk retval actpos |
(* position of the temporary variable 'active' in MethodContext>>on:do.
* for this code to work, it must be the last temporary variable in the method. *)
actpos := (self basicSize) - 1.
excblk := self findExceptionHandlerFor: (exception class).
(excblk isNil or: [(self basicAt: actpos) not]) ifTrue: [
## 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.
(* -----------------------------------------------------------------
* if an exception occurs within an exception handler block,
* the search will reach this context again as the exception block
* is evaluated before actual unwinding. set the temporary variable
* in the exception context to mask out this context from the search
* list.
* ---------------------------------------------------------------- *)
self basicAt: actpos put: false.
[ retval := excblk value: exception ] ensure: [
self basicAt: actpos put: true
].
##(self.sender isNil) ifTrue: [ "TODO: CANNOT RETURN" ].
(* -----------------------------------------------------------------
* return to self.sender which is a caller of the exception context (on:do:)
* pass the first ensure context between thisContext and self.sender.
* [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
* ---------------------------------------------------------------- *)
thisContext unwindTo: self.sender return: nil.
Processor return: retval to: self.sender.
}
}
##============================================================================
extend BlockContext
{
method on: anException do: anExceptionBlock
{
| exception_active |
<exception>
(* -------------------------------
thisContext isExceptionContext dump.
(thisContext basicSize) dump.
(thisContext basicAt: 8) dump. ## this should be anException
(thisContext basicAt: 9) dump. ## this should be anExceptionBlock
(thisContext basicAt: 10) dump. ## this should be handlerActive
'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump.
---------------------------------- *)
exception_active := true.
^self value.
}
method on: exc1 do: blk1 on: exc2 do: blk2
{
| exception_active |
<exception>
exception_active := true.
^self value.
}
method ensure: aBlock
{
| retval done |
<ensure>
done := false.
retval := self value.
## the temporary variable 'done' may get changed
## during evaluation for exception handling.
done ifFalse: [
done := true.
aBlock value.
].
^retval
}
method ifCurtailed: aBlock
{
| v ok |
ok := false.
[ v := self value. ok := true. ] ensure: [ ok ifFalse: [aBlock value] ].
^v.
}
}
##============================================================================
class PrimitiveFailureException(Exception)
{
}
class InstantiationFailureException(Exception)
{
}
class NoSuchMessageException(Exception)
{
}
class IndexOutOfRangeException(Exception)
{
}
class SubclassResponsibilityException(Exception)
{
}
class NotImplementedException(Exception)
{
}
class ErrorExceptionizationFailureException(Exception)
{
}
class InvalidArgumentException(Exception)
{
}
extend Apex
{
method(#class) 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
{
## TOOD: accept a class
InstantiationFailureException signal: 'Cannot instantiate'.
}
method(#class) doesNotUnderstand: message_name
{
## TODO: implement this properly
NoSuchMessageException signal: (message_name & ' not understood by ' & (self name)).
}
method(#class) index: index outOfRange: ubound
{
IndexOutOfRangeException signal: 'Out of range'.
}
method(#class) subclassResponsibility: method_name
{
SubclassResponsibilityException signal: ('Subclass must implement ' & method_name).
}
method(#class) notImplemented: method_name
{
NotImplementedException signal: (method_name & ' not implemented by ' & (self name)).
}
method(#class) cannotExceptionizeError
{
## todo: accept the object
ErrorExceptionizationFailureException signal: 'Cannot exceptionize an error'
}
}

306
moo/kernel/Magnitu.st Normal file
View File

@ -0,0 +1,306 @@
class Magnitude(Object)
{
}
class Association(Magnitude)
{
dcl key value.
method(#class) key: key value: value
{
^self new key: key value: value
}
method key: key value: value
{
self.key := key.
self.value := value.
}
method value: value
{
self.value := value
}
method key
{
^self.key
}
method value
{
^self.value
}
method = ass
{
^(self.key = ass key) and: [ self.value = ass value ]
}
method hash
{
^(self.key hash) + (self.value hash)
}
}
class Character(Magnitude)
{
## method basicSize
## {
## ^0
## }
}
class Number(Magnitude)
{
method + aNumber
{
<primitive: #_integer_add>
self primitiveFailed.
}
method - aNumber
{
<primitive: #_integer_sub>
self primitiveFailed.
}
method * aNumber
{
<primitive: #_integer_mul>
self primitiveFailed.
}
method quo: aNumber
{
<primitive: #_integer_quo>
self primitiveFailed.
}
method rem: aNumber
{
<primitive: #_integer_rem>
self primitiveFailed.
}
method // aNumber
{
<primitive: #_integer_quo2>
self primitiveFailed.
}
method \\ aNumber
{
<primitive: #_integer_rem2>
self primitiveFailed.
}
method = aNumber
{
<primitive: #_integer_eq>
self primitiveFailed.
}
method ~= aNumber
{
<primitive: #_integer_ne>
self primitiveFailed.
}
method < aNumber
{
<primitive: #_integer_lt>
self primitiveFailed.
}
method > aNumber
{
<primitive: #_integer_gt>
self primitiveFailed.
}
method <= aNumber
{
<primitive: #_integer_le>
self primitiveFailed.
}
method >= aNumber
{
<primitive: #_integer_ge>
self primitiveFailed.
}
method negated
{
<primitive: #_integer_negated>
^0 - self.
}
method bitAt: index
{
<primitive: #_integer_bitat>
^(self bitShift: index negated) bitAnd: 1.
}
method bitAnd: aNumber
{
<primitive: #_integer_bitand>
self primitiveFailed.
}
method bitOr: aNumber
{
<primitive: #_integer_bitor>
self primitiveFailed.
}
method bitXor: aNumber
{
<primitive: #_integer_bitxor>
self primitiveFailed.
}
method bitInvert
{
<primitive: #_integer_bitinv>
^-1 - self.
}
method bitShift: aNumber
{
(* positive number for left shift.
* negative number for right shift *)
<primitive: #_integer_bitshift>
self primitiveFailed.
}
method asString
{
^self printStringRadix: 10
}
method printStringRadix: aNumber
{
<primitive: #_integer_inttostr>
self primitiveFailed.
}
method to: end by: step do: aBlock
{
| i |
i := self.
(step > 0)
ifTrue: [
[ i <= end ] whileTrue: [
aBlock value: i.
i := i + step.
].
]
ifFalse: [
[ i >= end ] whileTrue: [
aBlock value: i.
i := i - step.
].
].
}
method to: end do: aBlock
{
^self to: end by: 1 do: aBlock.
}
method priorTo: end by: step do: aBlock
{
| i |
i := self.
(step > 0)
ifTrue: [
[ i < end ] whileTrue: [
aBlock value: i.
i := i + step.
].
]
ifFalse: [
[ i > end ] whileTrue: [
aBlock value: i.
i := i - step.
].
].
}
method priorTo: end do: aBlock
{
^self priorTo: end by: 1 do: aBlock.
}
method abs
{
self < 0 ifTrue: [^self negated].
^self.
}
method sign
{
self < 0 ifTrue: [^-1].
self > 0 ifTrue: [^1].
^0.
}
}
class Integer(Number)
{
method timesRepeat: aBlock
{
1 to: self by: 1 do: [ :count | aBlock value ].
}
}
class SmallInteger(Integer)
{
## method basicSize
## {
## ^0
## }
method asError
{
<primitive: #_smooi_as_error>
}
method asCharacter
{
<primitive: #_smooi_as_character>
}
}
class(#liword) LargeInteger(Integer)
{
}
class(#liword) LargePositiveInteger(LargeInteger)
{
method abs
{
^self.
}
method sign
{
^1.
}
}
class(#liword) LargeNegativeInteger(LargeInteger)
{
method abs
{
^self negated.
}
method sign
{
^-1.
}
}

86
moo/kernel/Moo.st Normal file
View File

@ -0,0 +1,86 @@
#include 'Apex.st'.
#include 'Context.st'.
#include 'Except.st'.
#include 'Class.st'.
#include 'Boolean.st'.
#include 'Magnitu.st'.
#include 'Collect.st'.
#include 'Process.st'.
class FFI(Object)
{
dcl name handle funcs.
method(#class) new: aString
{
^self new open: aString.
}
method open: aString
{
self.funcs := Dictionary new.
self.name := aString.
self.handle := self privateOpen: self.name.
"[ self.handle := self privateOpen: self.name ]
on: Exception do: [
]
on: XException do: [
]."
^self.
}
method close
{
self privateClose: self.handle.
self.handle := nil.
}
method call: aFunctionName withSig: aString withArgs: anArray
{
| f |
## f := self.funcs at: aFunctionName.
## f isNil ifTrue: [
## f := self privateGetSymbol: aFunctionName in: self.handle.
## f isNil ifTrue: [ self error: 'No such function' ].
## self.funcs at: aFunctionName put: f.
## ].
f := self privateGetSymbol: aFunctionName in: self.handle.
f isNil ifTrue: [ self error: 'No such function' ].
^self privateCall: f withSig: aString withArgs: anArray
}
method privateOpen: aString
{
<primitive: #_ffi_open>
^nil. ## TODO: Error signal: 'can not open'
}
method privateClose: aHandle
{
<primitive: #_ffi_close>
}
method privateCall: aSymbol withSig: aString withArgs: anArray
{
<primitive: #_ffi_call>
}
method privateGetSymbol: aString in: aHandle
{
<primitive: #_ffi_getsym>
^nil.
}
}
#########################################################################################
#include 'Stdio.st'.
#include 'Console.st'.

458
moo/kernel/Process.st Normal file
View File

@ -0,0 +1,458 @@
class(#pointer) Process(Object)
{
dcl initial_context current_context state sp prev next sem.
method new
{
"instantiation is not allowed"
^nil. "TODO: raise an exception"
}
method prev
{
^self.prev.
}
method next
{
^self.next.
}
method next: process
{
self.next := process.
}
method prev: process
{
self.prev := process.
}
method resume
{
<primitive: #_process_resume>
self primitiveFailed
##^Processor resume: self.
}
method _terminate
{
<primitive: #_process_terminate>
self primitiveFailed
}
method _suspend
{
<primitive: #_process_suspend>
self primitiveFailed
}
method terminate
{
##search from the top contextof the process down to intial_contextand find ensure blocks and execute them.
## if a different process calls 'terminate' on a process,
## the ensureblock is not executed in the context of the
## process being terminated, but in the context of terminatig process.
##
## 1) process termianted by another process
## p := [
## [ 1 to: 10000 by: 1 do: [:ex | System logNl: i asString] ] ensure: [System logNl: 'ensured....']
## ] newProcess.
## p resume.
## p terminate.
##
## 2) process terminated by itself
## p := [
## [ thisProcess terminate. ] ensure: [System logNl: 'ensured....']
## ] newProcess.
## p resume.
## p terminate.
## ----------------------------------------------------------------------------------------------------------
## the process must be frozen first. while unwinding is performed,
## the process must not be scheduled.
## ----------------------------------------------------------------------------------------------------------
##(Processor activeProcess ~~ self) ifTrue: [ self _suspend ].
(thisProcess ~~ self) ifTrue: [ self _suspend ].
self.current_context unwindTo: self.initial_context return: nil.
^self _terminate
}
method yield
{
<primitive: #_process_yield>
self primitiveFailed
}
method sp
{
^self.sp.
}
method initialContext
{
^self.initial_context
}
}
class Semaphore(Object)
{
dcl count waiting_head waiting_tail heapIndex fireTimeSec fireTimeNsec.
method(#class) forMutualExclusion
{
| sem |
sem := self new.
sem signal.
^sem
}
method initialize
{
self.count := 0.
self.heapIndex := -1.
self.fireTimeSec := 0.
self.fireTimeNsec := 0.
}
## ==================================================================
method signal
{
<primitive: #_semaphore_signal>
self primitiveFailed.
}
method wait
{
<primitive: #_semaphore_wait>
self primitiveFailed.
}
method waitWithTimeout: seconds
{
<primitive: #_semaphore_wait>
self primitiveFailed
}
method waitWithTimeout: seconds and: nanoSeconds
{
<primitive: #_semaphore_wait>
self primitiveFailed
}
method critical: aBlock
{
self wait.
^aBlock ensure: [ self signal ]
}
## ==================================================================
method heapIndex
{
^heapIndex
}
method heapIndex: anIndex
{
heapIndex := anIndex
}
method fireTime
{
^fireTimeSec
}
method fireTime: anInteger
{
self.fireTimeSec := anInteger.
}
method youngerThan: aSemaphore
{
^self.fireTimeSec < (aSemaphore fireTime)
}
}
class SemaphoreHeap(Object)
{
dcl arr size.
method initialize
{
self.size := 0.
self.arr := Array new: 100.
}
method size
{
^self.size
}
method at: anIndex
{
^self.arr at: anIndex.
}
method insert: aSemaphore
{
| index |
index := self.size.
(index >= (self.arr size)) ifTrue: [
| newarr newsize |
newsize := (self.arr size) * 2.
newarr := Array new: newsize.
newarr copy: self.arr.
self.arr := newarr.
].
self.arr at: index put: aSemaphore.
aSemaphore heapIndex: index.
self.size := self.size + 1.
^self siftUp: index
}
method popTop
{
| top |
top := self.arr at: 0.
self deleteAt: 0.
^top
}
method updateAt: anIndex with: aSemaphore
{
| item |
item := self.arr at: anIndex.
item heapIndex: -1.
self.arr at: anIndex put: aSemaphore.
aSemaphore heapIndex: anIndex.
^(aSemaphore youngerThan: item)
ifTrue: [ self siftUp: anIndex ]
ifFalse: [ self siftDown: anIndex ].
}
method deleteAt: anIndex
{
| item |
item := self.arr at: anIndex.
item heapIndex: -1.
self.size := self.size - 1.
(anIndex == self.size)
ifTrue: [
"the last item"
self.arr at: self.size put: nil.
]
ifFalse: [
| xitem |
xitem := self.arr at: self.size.
self.arr at: anIndex put: xitem.
xitem heapIndex: anIndex.
self.arr at: self.size put: nil.
(xitem youngerThan: item)
ifTrue: [self siftUp: anIndex ]
ifFalse: [self siftDown: anIndex ]
]
}
method parentIndex: anIndex
{
^(anIndex - 1) quo: 2
}
method leftChildIndex: anIndex
{
^(anIndex * 2) + 1.
}
method rightChildIndex: anIndex
{
^(anIndex * 2) + 2.
}
method siftUp: anIndex
{
| pindex cindex par item stop |
(anIndex <= 0) ifTrue: [ ^anIndex ].
pindex := anIndex.
item := self.arr at: anIndex.
stop := false.
[ stop ] whileFalse: [
cindex := pindex.
(cindex > 0)
ifTrue: [
pindex := self parentIndex: cindex.
par := self.arr at: pindex.
(item youngerThan: par)
ifTrue: [
## move the parent down
self.arr at: cindex put: par.
par heapIndex: cindex.
]
ifFalse: [ stop := true ].
]
ifFalse: [ stop := true ].
].
self.arr at: cindex put: item.
item heapIndex: cindex.
^cindex
}
method siftDown: anIndex
{
| base capa cindex item |
base := self.size quo: 2.
(anIndex >= base) ifTrue: [^anIndex].
cindex := anIndex.
item := self.arr at: cindex.
[ cindex < base ] whileTrue: [
| left right younger xitem |
left := self leftChildIndex: cindex.
right := self rightChildIndex: cindex.
((right < self.size) and: [(self.arr at: right) youngerThan: (self.arr at: left)])
ifTrue: [ younger := right ]
ifFalse: [ younger := left ].
xitem := self.arr at: younger.
(item youngerThan: xitem)
ifTrue: [
"break the loop"
base := anIndex
]
ifFalse: [
self.arr at: cindex put: xitem.
xitem heapIndex: cindex.
cindex := younger.
]
].
self.arr at: cindex put: item.
item heapIndex: cindex.
^cindex
}
}
class ProcessScheduler(Object)
{
dcl tally active runnable_head runnable_tail sem_heap.
method new
{
"instantiation is not allowed"
^nil. "TODO: raise an exception"
}
method activeProcess
{
^self.active.
}
method resume: process
{
<primitive: #_processor_schedule>
self primitiveFailed.
"The primitive does something like the following in principle:
(self.tally = 0)
ifTrue: [
self.head := process.
self.tail := process.
self.tally := 1.
]
ifFalse: [
process next: self.head.
self.head prev: process.
self.head := process.
self.tally := self.tally + 1.
].
"
}
"
method yield
{
<primitive: #_processor_yield>
self primitiveFailed
}
"
method signal: semaphore after: secs
{
<primitive: #_processor_add_timed_semaphore>
self primitiveFailed.
}
method signal: semaphore after: secs and: nanosecs
{
<primitive: #_processor_add_timed_semaphore>
self primitiveFailed.
}
method unsignal: semaphore
{
<primitive: #_processor_remove_semaphore>
self primitiveFailed.
}
"method signal: semaphore onInput: file
{
}"
"method signal: semaphore onOutput: file
{
}"
method return: object to: context
{
<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.
}
}

85
moo/kernel/Stdio.st Normal file
View File

@ -0,0 +1,85 @@
class(#byte) Stdio(Object) from 'stdio'
{
dcl(#class) in out err.
(*
* The following methods are generated by the module.
* method(#class) _newInstSize { <primitive: #stdio._newInstSize> }
* method open: name for: mode { <primitive: #stdio.open> }
* method close { <primitive: #stdio.close> }
*)
method(#class) new: size
{
## ignore the specified size
^(super new: (self _newInstSize))
}
method(#class) new
{
^(super new: (self _newInstSize))
}
method(#class) open: name for: mode
{
^(self new) open: name for: mode
}
(* ---------------------
method(#class) stdin
{
self.in isNil ifTrue: [ self.in := ^(super new) open: 0 for: 'r' ].
^self.in.
}
method(#class) stdout
{
self.out isNil ifTrue: [ self.out := ^(super new) open: 1 for: 'w' ].
^self.out.
}
method(#class) stderr
{
self.err isNil ifTrue: [ self.err := ^(super new) open: 2 for: 'w' ].
^self.err.
}
------------------------ *)
(*
method format: fmt with: ...
{
}
*)
method format (fmt)
{
| a b c |
'THIS IS FORMAT' dump.
fmt dump.
thisContext temporaryCount dump.
0 priorTo: (thisContext vargCount) do: [:k |
(thisContext vargAt: k) dump.
].
}
}
extend Stdio
{
method xxxx
{
self basicSize dump.
}
}
class(#byte) Stdio2(Stdio)
{
method(#class) new
{
##self prohibited
##raise exception. prohibited...
^(super new).
}
}

157
moo/kernel/generr.st Normal file
View File

@ -0,0 +1,157 @@
#include 'Moo.st'.
class MyObject(Object)
{
method(#class) main
{
| errmsgs synerrmsgs f |
errmsgs := #(
'no error'
'generic error'
'not implemented'
'subsystem error'
'internal error that should never have happened'
'insufficient system memory'
'insufficient object memory'
'invalid parameter or argument'
'data not found'
'existing/duplicate data'
'busy'
'access denied'
'operation not permitted'
'not a directory'
'interrupted'
'pipe error'
'resource temporarily unavailable'
'data too large'
'message sending error'
'range error'
'byte-code full'
'dictionary full'
'processor full'
'semaphore heap full'
'semaphore list full'
'divide by zero'
'I/O error'
'encoding conversion error'
).
synerrmsgs := #(
'no error'
'illegal character'
'comment not closed'
'string not closed'
'no character after $'
'no valid character after #'
'wrong character literal'
'colon expected'
'string expected'
'invalid radix'
'invalid numeric literal'
'byte too small or too large'
'wrong error literal'
'{ expected'
'} expected'
'( expected'
') expected'
'] expected'
'. expected'
' expected'
'| expected'
'> expected'
':= expected'
'identifier expected'
'integer expected'
'primitive: expected'
'wrong directive'
'undefined class'
'duplicate class'
'contradictory class definition'
'wrong class name'
'dcl not allowed'
'wrong method name'
'duplicate method name'
'duplicate argument name'
'duplicate temporary variable name'
'duplicate variable name'
'duplicate block argument name'
'cannot assign to argument'
'undeclared variable'
'unusable variable in compiled code'
'inaccessible variable'
'ambiguous variable'
'wrong expression primary'
'too many temporaries'
'too many arguments'
'too many block temporaries'
'too many block arguments'
'too large block'
'wrong primitive function number'
'wrong primitive function identifier'
'wrong module name'
'#include error'
'wrong namespace name'
'wrong pool dictionary name'
'duplicate pool dictionary name'
'literal expected'
).
f := Stdio open: 'generr.out' for: 'w'.
[ f isError ] ifTrue: [ System logNl: 'Cannot open generr.out'. thisProcess terminate. ].
self emitMessages: errmsgs named: 'errstr' on: f.
self emitMessages: synerrmsgs named: 'synerrstr' on: f.
f close.
}
method(#class) emitMessages: errmsgs named: name on: f
{
| c prefix |
prefix := name & '_'.
c := errmsgs size - 1.
0 to: c do: [:i |
self printString: (errmsgs at: i) prefix: prefix index: i on: f.
].
f puts: S'static moo_ooch_t* '.
f puts: name.
f puts: S'[] =\n{\n'.
0 to: c do: [:i |
((i rem: 8) = 0) ifTrue: [ f putc: C'\t' ].
f puts: prefix.
f puts: (i asString).
(i = c) ifFalse: [f puts: S',' ].
(((i + 1) rem: 8) = 0) ifTrue: [ f putc: C'\n' ] ifFalse: [ f putc: C' ' ].
].
(((c + 1) rem: 8) = 0) ifFalse: [ f putc: C'\n' ].
f puts: S'};\n'.
}
method(#class) printString: s prefix: prefix index: index on: f
{
| c |
c := s size - 1.
f puts: 'static moo_ooch_t '.
f puts: prefix.
f puts: index asString.
f puts: '[] = {'.
0 to: c do: [:i |
f putc: $'.
f putc: (s at: i).
f putc: $'.
(i = c) ifFalse: [f putc: $, ].
].
f puts: S',\'\\0\'};\n'.
}
}

68
moo/kernel/test-001.st Normal file
View File

@ -0,0 +1,68 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
^self xxxx.
}
method(#class) zzz
{
'zzzzzzzzzzzzzzzzzz' dump.
^self.
}
method(#class) yyy
{
^[123456789 dump. ^200].
}
method(#class) main
{
'START OF MAIN' dump.
['1111111' dump. '111111111' dump. '22222222222' dump.
'3333333' dump. '444444444' dump. '55555555555' dump] newProcess resume.
'EDN OF MAIN' dump.
}
}

87
moo/kernel/test-002.st Normal file
View File

@ -0,0 +1,87 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
^self xxxx.
}
method(#class) zzz
{
'zzzzzzzzzzzzzzzzzz' dump.
^self.
}
method(#class) yyy
{
^[123456789 dump. ^200].
}
method(#class) main2
{
'START OF MAIN2' dump.
##[thisContext dump. ^100] newProcess resume.
[ |k| thisContext dump. self zzz. "k := self yyy. k value." ['ok' dump. ^100] value] newProcess resume.
'1111' dump.
'1111' dump.
'1111' dump.
'1111' dump.
'1111' dump.
'EDN OF MAIN2' dump.
}
method(#class) main1
{
'START OF MAIN1' dump.
self main2.
'END OF MAIN1' dump.
}
method(#class) main
{
'START OF MAIN' dump.
self main1.
'EDN OF MAIN' dump.
}
}

56
moo/kernel/test-003.st Normal file
View File

@ -0,0 +1,56 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
^self xxxx.
}
method(#class) main
{
'START OF MAIN' dump.
'EDN OF MAIN' dump.
}
}

57
moo/kernel/test-004.st Normal file
View File

@ -0,0 +1,57 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
^self xxxx.
}
method(#class) main
{
'START OF MAIN' dump.
Processor activeProcess terminate.
'EDN OF MAIN' dump.
}
}

517
moo/kernel/test-005.st Normal file
View File

@ -0,0 +1,517 @@
#include 'Moo.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) t1 t2.
}
class MyObject(TestObject)
{
dcl(#class) C B A.
method getTrue
{
^true.
}
method getTrue: anInteger
{
^ anInteger
}
method getFalse
{
^false
}
method yyy: aBlock
{
| a |
a := aBlock value.
^a + 99.
##a := Moo.MyCOM.HashTable new.
}
method xxx: aBlock
{
| a |
a := self yyy: aBlock.
'KKKKKKKKKKKKKKKKKKKKKKKKKKKKK' dump.
^a.
}
method(#class) main2
{
| a b c sum |
## ##(10 add: 20) dump.
## (10 + 20) dump.
##
## a := 10 + 20 + 30.
## b := [:x :y | | t z | x := 20. b := 9. x := 10 + 20 ].
##
## (b value: 10 value: 20) dump.
##
## thisContext basicSize dump.
##
## (thisContext basicAt: (8 + 5)) dump.
##
## ^self.
a := self new.
##a yourself.
##b := a getTrue; getFalse.
##b := a getTrue; getFalse; getTrue: 20 + 10.
##b := a getTrue; getFalse; getTrue: 20 + 10; getTrue: 90 + 20.
##b := 3 + 5 getTrue: 20; getTrue: 8 + 1; getTrue: 20; yourself.
b := 3 + 5 inc getTrue: 20 + (30 getTrue: 20; yourself); yourself.
##b := [:q | q ] value: a getTrue.
b dump.
##^self.
## ############################################################
## A := 99.
[:x :y | R := y. ] value: 10 value: 6.
R := R + 1.
R dump.
sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
##sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1)) + (sum value: (n - 2))] ].
(sum value: R; value: 5) dump.
##sum := [ :n | sum value: 5 ].
##sum value: 5.
#[ 1 2 3] dump.
#[ 4 5 6] dump.
#(abc:def: 2 'string is good' 3 4 (5 6) (7 (8 9)) 10) dump.
#([] #[]) dump.
a := #(abc:def: -2 'string is good' 3 #[2 3 4] 4 (5 6) (7 (8 [4 56] 'hello' 9)) 10 -93952 self true false nil thisContext super).
a at: 3 put: 'hello world'; dump.
a := self new.
(a xxx: [888]) dump.
20 dump.
b := 0.
[ b < 9 ] whileTrue: [ b dump. b := b + 1 ].
S'hello \t\u78966\u8765\u3456\u2723\x20\123world\uD57C\uB85C\uC6B0' dump.
C'\n' dump.
#abc:def: dump.
##a := (11 < 10) ifTrue: [5] ifFalse: [20].
##a dump.
}
method(#class) main55
{
|a b c|
self main2.
## b := 0.
## [ b < 5 ] whileTrue: [ b dump. b := b + 1 ].
}
method(#class) getTen
{
^10
}
## ---------------------------------------------------------------------------
" this sample demonstrates what happens when a block context returns to the origin's caller
after the caller has already returned. "
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ |tmp| g1 := 50. g2 := 100. tmp := g1 + g2. tmp dump. ^tmp ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
self xxxx
}
method(#class) yyyy
{
|c1|
t1 := 1.
c1 :=self xxxx.
888 dump.
999 dump.
^c1.
}
method(#class) main66
{
self yyyy.
t2 := t2 value. "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
t2 dump.
}
method(#class) mainj
{
|k1|
t1 := 1.
self xxxx.
t2 := t2 value. "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
t2 dump.
}
## ----------------------------------------------------------------------
method(#class) main22
{
|a b c d e f g h i j k sum |
sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
(sum value: 5) dump.
'-------------------------' dump.
b := 0.
[ b < 2000 ] whileTrue: [ b dump. b := b + 1 ].
'-------------------------' dump.
b := 0.
[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
'-------------------------' dump.
a := #[4 5 6 7] at: 3.
(#[3 2 1] at: 3) dump.
## thisContext value. "the message value must be unresolvable as thisContext is a method context"
## [thisContext value] value.
'-------------------------' dump.
b := 0.
[ b := b + 1. b dump. thisContext value] value.
[self getTen] value dump.
}
method(#class) abc
{
<primitive: #snd_open>
}
method(#class) a: a b: b c: c
{
c dump.
}
method(#class) a: a b: b c: c d: d e: e f: f g: g h: h
{
h dump.
}
method(#class) a: a b: b c: c d: d e: e f: f g: g
{
g dump.
}
method(#class) getABlock
{
^ [ 'a block returned by getABlock' dump. "^ self"]
}
method(#class) main
{
"
| ffi |
ffi := FFI new: 'libc.so.6'.
## ffi call: #printf with: #((str '%d') (int 10) (long 20)).
ffi call: #printf withSig: 'i|sii' withArgs: #(S'hello world %d %d\n' 11123 9876543).
## ffi call: #puts withSig: 'i|s' withArgs: #('hello world').
ffi close.
"
## ---------------------------------------------------------------
## getABlock has returned.
## aBlock's home context is getABlock. getABlock has returned
## when 'aBlock value' is executed. so when aBlock is really
## executed, ^self is a double return attempt. should this be made
## illegal??
|aBlock|
aBlock := self getABlock.
aBlock value.
## ---------------------------------------------------------------
"
PROCESS TESTING
| p |
'000000000000000000' dump.
## p := [ | 'xxxxxxxxxxx' dump. 'yyyyyyyyyy' dump. ^10. ] newProcess.
p := [ :a :b :c :d | a dump. b dump. (c + d) dump. ^10. ] newProcessWith: #(abc def 10 20).
'999999999999999999' dump.
p resume.
'111111111111111111' dump.
'222222222222222222' dump.
'333333333333333333' dump.
'444444444444444444' dump.
"
(-2305843009213693952 - 1) dump.
(1 + 2) dump.
##(-2305843009213693952 * 2305843009213693952) dump.
## (((-2305843009213693952 - 10) * (-2305843009213693952 - 10) *(-2305843009213693952 - 10) * (-2305843009213693952 - 10) * 255) * ((-2305843009213693952 - 10) * (-2305843009213693952 - 10) *(-2305843009213693952 - 10) * (-2305843009213693952 - 10) * 255)) dump.
##((-2305843009213693952 - 10) * (-2305843009213693952 - 10) *(-2305843009213693952 - 10) * (-2305843009213693952 - 10) * 255) dump.
##(-16rFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF * 1) dump.
##((-2305843009213693952 * -1) - 1 + 2) dump.
((-2305843009213693952 * -2305843009213693952 * 2305843009213693952 * 2305843009213693952 * 2305843009213693952) - 1 + 2) dump.
(2r111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 * 128971234897128931) dump.
"(-10000 rem: 3) dump.
(-10000 quo: 3) dump.
(-10000 \\ 3) dump.
(-10000 // 3) dump."
(7 rem: -3) dump.
(7 quo: -3) dump.
(7 \\ -3) dump.
(7 // -3) dump.
##(777777777777777777777777777777777777777777777777777777777777777777777 rem: -8127348917239812731289371289731298) dump.
##(777777777777777777777777777777777777777777777777777777777777777777777 quo: -8127348917239812731289371289731298) dump.
##(270000000000000000000000000000000000000000000000000000000000000000000 rem: 50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(270000000000000000000000000000000000000000000000000000000000000000000 quo: 50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(270000000000000000000000000000000000000000000000000000000000000000000 \\ 50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(270000000000000000000000000000000000000000000000000000000000000000000 // 50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(0 rem: -50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(0 quo: -50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(0 \\ -50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(0 // -50000000000000000000000000000000000000000000000000000000000000000000) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 rem: -1) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 quo: -1) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 \\ -1) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 // -1) dump.
## (-27029038 // 2) asString dump.
## (-270290380000000000000000000000000000000000000000000000000000000000000000000000000000000000000 // 2) asString dump.
##(-16rAAAAAAAABBBBBBBBCCCCCCCCDDDDDDDDEEEEEEEEFFFFFFFF) asString dump.
## (16r2dd01fc06c265c8163ac729b49d890939826ce3dd quo: 16r3b9aca00) dump.
##(0 rem: -50) dump.
##(0 quo: -50) dump.
##(0 \\ -50) dump.
##(0 // -50) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 rem: 5) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 quo: 5) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 \\ 5) dump.
##(-270000000000000000000000000000000000000000000000000000000000000000000 // 5) dump.
##(-270 rem: 5) dump.
##(-270 quo: 5) dump.
##(-270 \\ 5) dump.
##(-270 // 5) dump.
##(16rFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF bitAnd: 16r1111111111111111111111111111111111111111) dump.
(2r1111111111111111111111111111111111111111111111111111111111111111 printStringRadix:2) dump.
"(16rF0FFFF bitOr: 16r111111) dump.
(16r11 bitOr: 16r20000000000000000000000000000000FFFFFFFFFFFFFFFF11111100000000000000000001) dump.
((16r11 bitOr: 16r20000000000000000000000000000000FFFFFFFFFFFFFFFF11111100000000000000000001) bitOr: 16r1100) dump.
((16r11 bitOr: $a) bitOr: 16r1100) dump.
(-20000000000000000000000000000000000000000 bitInvert printStringRadix: 2) dump.
((-2r101010 bitXor: 2r11101) printStringRadix: 2) dump.
((2r11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 bitXor: 2r11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111) printStringRadix: 2) dump.
((2r10101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101 bitAnd: 2r01010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010) printStringRadix: 2) dump.
"
(16rFFFFFFFFFFFFFFFF bitOr: 16rFFFFFFFFFFFFFFFFFFFFFFFF) dump.
(-16rFFFFFFFFFFFFFFFF bitOr: 16rFFFFFFFFFFFFFFFFFFFFFFFF) dump.
(16rFFFFFFFFFFFFFFFF bitOr: -16rFFFFFFFFFFFFFFFFFFFFFFFF) dump.
(-16rFFFFFFFFFFFFFFFF bitOr: -16rFFFFFFFFFFFFFFFFFFFFFFFF) dump.
((16rFFFFFFF bitXor: -16rFFFFFFF) printStringRadix: 16) dump.
((16r1234 bitXor: -16rFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF) printStringRadix: 16) dump.
((16r1234 bitXor: 2r1111111111111111111111111111111111111111111111111111111111111) printStringRadix: 16) dump.
((16r1234 bitXor: 2r100000000000000000000000000000000000000000000000000000000000000000000000000000) printStringRadix: 16) dump.
((-16r1234 bitXor: 2r100000000000000000000000000000000000000000000000000000000000000000000000000000) printStringRadix: 16) dump.
((16r1234 bitXor: -2r100000000000000000000000000000000000000000000000000000000000000000000000000000) printStringRadix: 16) dump.
((-16r1234 bitXor: -2r100000000000000000000000000000000000000000000000000000000000000000000000000000) printStringRadix: 16) dump.
((2r100000000000000000000000000000000000000000000000000000000000000000000000000000 bitInvert) printStringRadix: 16) dump.
((2r1111111 bitInvert) printStringRadix: 16) dump.
((2r11001110000000000000000000000000000000000000000000000000000000000000000000000 bitInvert) printStringRadix: 16) dump.
((2r1111 bitShift: 100) printStringRadix: 2) dump.
((123123124 bitShift: 100000) printStringRadix: 16) dump.
(2r110101010101010101010101010101111111111111111111111111111111111111111111111111111111100000000001111111 printStringRadix: 16) dump.
(16rFFFFFFFFFF1234567890AAAAAAAAAAAAAAAAAAAAAAAAA22222222222222222F printStringRadix: 32) dump.
(32r3VVVVVVVS938LJOI2LALALALALALALALALAL8H248H248H248HF printStringRadix: 16) dump.
## ((-2r110101010101010101010101010101111111111111111111111111111111111111111111111111111111100000000001111111 bitShift: 16r1FFFFFFFFFFFFFFFF) printStringRadix: 2) dump.
##((-2r11111111110000000000111110000 bitShift: -31) printStringRadix: 2) dump.
##((-536870911 bitShift: -536870912) printStringRadix: 2) dump.
((-2r1111 bitShift: -3) printStringRadix: 2) dump.
((-2r11111111111111111111111111111111111111111111111111111111111111111111110001 bitShift: -1) printStringRadix: 2) dump.
((-2r11111111111111111111111111111111111111111111111111111111111111111111110001 bitShift: -2) printStringRadix: 2) dump.
((-2r11111111111111111111111111111111111111111111111111111111111111111111110001 bitShift: -3) printStringRadix: 2) dump.
((-2r11111111111111111111111111111111111111111111111111111111111111111111110001 bitShift: -200) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -5) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -16rFFFFFFFFFFFFFFFF) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: 13) printStringRadix: 2) dump.
((2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: 13) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -0) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -1) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -73) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -74) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -75) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -76) printStringRadix: 2) dump.
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitShift: -77) printStringRadix: 2) dump.
(2305843009213693951 bitAt: 62) dump.
(-2305843009213693951 bitAt: 63) dump.
(2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 129) dump.
(2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 16rFFFFFFFFFFFFFFFF1) dump.
##self a: 1 b: 2 c: 3 d: 4 e: 5 f: 6 g: 7.
##self a: 1 b: 2 c: 3.
[1 + [100 + 200] value] value dump.
'====================' dump.
[
| a b |
'--------------' dump.
[a := 20. b := [ a + 20 ]. b value.] value dump.
a dump.
b dump.
] value.
'====================' dump.
([ :a :b | "a := 20." b := [ a + 20 ]. b value.] value: 99 value: 100) dump.
'====================' dump.
[ :a :b | a dump. b dump. a := 20. b := [ a + 20 ]. b value.] value dump. ## not sufficient arguments. it must fail
"[ :a :b | a dump. b dump. a := 20. b := [ a + 20 ]. b value.] on: Exception do: [:ex | 'Exception' dump]."
"
FFI isNil dump.
FFI notNil dump.
nil isNil dump.
nil notNil dump.
nil class dump.
nil class class class dump.
"
}
}
"
[ a := 20. b := [ a + 20 ]. b value. ] value
^ ^ ^ ^
p1 p3 p4 p2
--------------------------------------------------------------------------------
AC
--------------------------------------------------------------------------------
mc1<active>
mc1->sender := fake_initial_context.
mc1->home := nil.
mc1->origin := mc1.
mc1 p1 -> bc1 is created based on mc1 (mc1 blockCopy:)
bc1->caller := nil
bc1->origin := mc1.
bc1->home := mc1. (the active context is a method context. so just use it as a home).
bc1->source := nil.
mc1 p2 -> bc2 is shallow-copied of bc1. (bc1 value)
bc2->caller := mc1. (mc1 is the active context at p2 point)
bc2->origin := bc1->origin.
bc2->home := bc1->home.
bc2->source := bc1.
bc2 bc3 is created based on bc2. (bc2 blockCopy:)
bc3->caller := nil
bc3->origin := bc2->origin
bc3->home := bc2. (the active context is a block context).
bc3->source := nil.
bc2 bc4 is shallow-copied of bc3. (bc3 value)
bc4->caller := bc2. (bc2 is the active context at p2 point)
bc4->origin := bc3->origin
bc4->home := bc3->home
bc4->source = bc3.
bc4.
--------------------------------------------------------------------------------
'home' is set when the context is created by blockCopy.
'caller' is set when the context is activated.
all 'origin' fields point to mc1 as a result.
self represents the receiver. that is bc->origin->receiver which is mc1->receiver.
--------------------------------------------------------------------------------
method ifTrue: trueBlock
{
^trueBlock value.
}
method whileTrue: aBlock
{
(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
}
[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
"

105
moo/kernel/test-006.st Normal file
View File

@ -0,0 +1,105 @@
#include 'Moo.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) t1 t2.
}
class MyObject(TestObject)
{
dcl(#class) C B A.
method getTrue
{
^true.
}
method getTrue: anInteger
{
^ anInteger
}
method getFalse
{
^false
}
method a { ^ 10 }
method b { ^ 20 }
method c { ^ 30 }
method(#class) a: a b: b c: c
{
^ a + b + c.
}
method(#class) getBlock
{
| a |
a := 7777777.
"
^[1 + [^a]].
1234567 dump.
"
^[self a: a b: 3 c: ([[[^6] value] value ] value)].
}
method(#class) main
{
"
| k |
k := 30.
k := k + 10; + 20.
k dump.
(self a: 1 b: 2 c: 3) dump.
[self a: 1 b: 2 c: 3] value dump.
[self a: 1 b: 2 c: 3] value dump.
[self a: 9 b: 10 c: 11] value dump.
((k = 2) ifTrue: [11111] ifFalse: [2222])dump.
self getBlock value dump.
[10 + [^20]] value dump.
"
'START OF MAIN' dump.
[2 + 3 + 1 + [[[^6] value] value ] value] value dump.
## ^(self a: (self new a) b: ([:a :b | a + b] value: 10 value: 20) c: (self new c)) dump.
##self getBlock value dump.
'END OF MAIN' dump.
}
}

98
moo/kernel/test-007.st Normal file
View File

@ -0,0 +1,98 @@
#include 'Moo.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) t1 t2.
}
class MyObject(TestObject)
{
dcl(#class) C B A.
method getTrue
{
^true.
}
method getTrue: anInteger
{
^ anInteger
}
method getFalse
{
^false
}
method a { ^ 10 }
method b { ^ 20 }
method c { ^ 30 }
method(#class) a: a b: b c: c
{
^ a + b + c.
}
method(#class) main
{
| p p2 |
'START OF MAIN' dump.
##p := [ :a :b :c :d | a dump. b dump. (c + d) dump. ^10. ] newProcessWith: #(abc def 10 20).
p := [ :a :b :c :d | a dump. b dump. (c + d) dump. ] newProcessWith: #(abc def 10 20).
p2 := [ :a :b :c :d | a dump. b dump. a dump. b dump. (c + d) dump. ^10000 ] newProcessWith: #(
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
1000000000000000
299999999999999999999999999999999999999999
).
p resume.
p2 resume.
'MIDDLE OF MAIN' dump.
Processor activeProcess terminate.
##p terminate.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
## p resume.
'999999999999999999' dump.
'999999999999999999' dump.
'999999999999999999' dump.
'END OF MAIN' dump.
}
}

65
moo/kernel/test-008.st Normal file
View File

@ -0,0 +1,65 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2 t3.
method(#class) xxxx
{
| g1 g2 |
t1 dump.
t3 value.
t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
(t1 < 10) ifFalse: [ ^self ].
t1 := t1 + 1.
^self xxxx.
}
method(#class) main
{
t3 := ['1111' dump. ^20.].
t1 := 1.
self xxxx.
'END OF XXX' dump.
t2 := t2 value.
'END OF t2 value' dump.
t2 dump.
}
}

65
moo/kernel/test-009.st Normal file
View File

@ -0,0 +1,65 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
method(#class) main2
{
'START OF MAIN2' dump.
t1 value.
'END OF MAIN2' dump.
}
method(#class) main1
{
'START OF MAIN1' dump.
self main2.
t2 := [ 'BLOCK #2' dump. ^200].
'END OF MAIN1' dump.
}
method(#class) main
{
'START OF MAIN' dump.
t1 := ['BLOCK #1' dump. ^100].
self main1.
'END OF MAIN' dump.
}
}

239
moo/kernel/test-010.st Normal file
View File

@ -0,0 +1,239 @@
#include 'Moo.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) main111
{
| s3 |
s3 := Semaphore new.
Processor signal: s3 after: 1 and: 50.
s3 wait.
'END OF MAIN' dump.
}
method(#class) main987
{
|t1 t2 s1 s2 s3|
'START OF MAIN' dump.
s1 := Semaphore new.
s2 := Semaphore forMutualExclusion.
t1 := [
##1000 timesRepeat: ['BLOCK #1' dump].
s2 critical: [
10000 timesRepeat: ['BLOCK #1' dump ].
Exception signal: 'Raised Exception at process t1'.
]
] newProcess.
t2 := [
##1000 timesRepeat: ['BLOCK #2' dump].
s2 critical: [
10000 timesRepeat: ['BLOCK #2' dump. ]
].
s1 signal.
] newProcess.
t1 resume.
t2 resume.
s1 wait.
ABC.KKK dump.
'END OF MAIN' dump.
"
|s1|
s1 := Semaphore new.
s1 signal.
'XXXXXXXXXXXXXXXX' dump.
s1 wait.
"
}
method(#class) aaa_123
{
| v1 |
v1 := [
| k |
k := 99.
[
[
##[ Exception signal: 'simulated error' ] ensure: [('ensure 1 ' & (k asString)) dump ].
[ ^ 20 ] ensure: [ ('ensure 1 ' & (k asString)) dump. ].
] ensure: ['ensure 2' dump ].
] ensure: ['ensure 3' dump ].
] on: Exception do: [:ex |
('EXCETION - ' & ex messageText) dump.
## Exception signal: 'qqq'.
].
^v1
}
method(#class) main
{
| v1 |
'START OF MAIN' dump.
##[1 xxx] ifCurtailed: ['XXXXXXXX CURTAILED XXXXXXXXX' dump].
##['ENSURE TEST' dump] ensure: ['XXXXXXXXX ENSURE XXXXXXXXXXXXXx' dump].
##v1 := [ ['kkk' dump.] ensure: ['XXXXXXXXX ENSURE XXXXXXXXXXXXXx' dump. 30] ] on: Exception do: [:ex | 'EXCEPTION OUTSIDE ENSURE...' dump. ].
##v1 dump.
##[ Exception signal: 'simulated error' ] on: Exception do: [:ex | 'CAUGHT...' dump. Exception signal: 'jjjjjjj' ].
"[
[ Exception signal: 'simulated error' ] ensure: ['ensure 1' dump ].
] on: Exception do: [:ex | ('EXCETION - ' & ex messageText) dump. Exception signal: 'qqq'. ]."
"[1 xxx] ifCurtailed: ['XXXXXXXX CURTAILED XXXXXXXXX' dump. Exception signal: 'jjjj']."
" v1 := [
| k |
k := 99.
[
[
##[ Exception signal: 'simulated error' ] ensure: [('ensure 1 ' & (k asString)) dump ].
[ ^20 ] ensure: [('ensure 1 ' & (k asString)) dump ].
] ensure: ['ensure 2' dump ].
] ensure: ['ensure 3' dump ].
] on: Exception do: [:ex |
('EXCETION - ' & ex messageText) dump.
## Exception signal: 'qqq'.
].
"
v1 := self aaa_123.
'--------------------------------' dump.
v1 dump.
'--------------------------------' dump.
'END OF MAIN' dump.
}
method(#class) main22222
{
|t1 t2 s1 s2 s3|
'START OF MAIN' dump.
s1 := Semaphore new.
s2 := Semaphore new.
s3 := Semaphore new.
t1 := [
10 timesRepeat: ['BLOCK #1' dump. Processor sleepFor: 1.].
s1 signal
] newProcess.
t2 := [
5 timesRepeat: ['BLOCK #2' dump. "Processor sleepFor: 1." ].
'SIGNALLING S2...' dump. s2 signal.
] newProcess.
t1 resume.
t2 resume.
Processor signal: s3 after: 10.
'STARTED t1 and t2' dump.
s2 wait.
's2 WAITED....' dump.
s1 wait.
's1 WAITED....' dump.
'WAITING ON S3...' dump.
##Processor unsignal: s3.
s3 wait.
10 timesRepeat: ['WAITED t1 and t2' dump].
'END OF MAIN' dump.
}
method(#class) test_semaphore_heap
{
| sempq a |
sempq := SemaphoreHeap new.
'--------------------------' dump.
1 to: 200 by: 1 do: [ :i |
| sem |
sem := Semaphore new.
sem fireTime: (200 - i).
sempq insert: sem
].
'--------------------------' dump.
sempq deleteAt: 40.
sempq deleteAt: 50.
[sempq size > 0] whileTrue: [
| sem |
sem := sempq popTop.
sem fireTime dump.
]
}
}

228
moo/kernel/test-011.st Normal file
View File

@ -0,0 +1,228 @@
#include 'Moo.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.
}
class MyObject(TestObject)
{
method(#class) main2
{
| k q |
'BEGINNING OF main2' dump.
k := [ 'this is test-011' dump. q := Exception signal: 'main2 screwed...'. q dump. 8888 dump. ]
on: Exception do: [ :ex |
'Exception occurred' dump.
ex messageText dump.
'Getting back to....' dump.
"ex return: 9999."
ex pass.
'AFTER RETURN' dump.
].
'k=>>> ' dump.
k dump.
'END OF main2' dump.
}
method(#class) raise_exception
{
Exception signal: 'bad exceptinon'.
}
method(#class) test3
{
| k j g_ex |
j := 20.
k := [
'>>> TEST3 METHOD >>> ' dump.
j dump.
(j < 25) ifTrue: [ | t |
t := Exception signal: 'bad exceptinon'. ## when resumed, t should get Exception, the leftover in the stack...
t signal: 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. ## so it should be ok to signal again..
##t := self raise_exception. ## when resumed, t should get 'self'
##g_ex retry. # You should not do these as the following 3 lines make things very complicated.
##g_ex signal.
##g_ex pass.
'RESUMED???' dump.
t dump.
j dump.
].
'OOOOOOOOOOOOOOOOOOOOOOO' dump.
'JJJJJJJJJJJJJJ' dump.
] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. g_ex := ex. ex resume. ].
k dump.
'END OF TEST3' dump.
}
method(#class) test4_1
{
| k j |
j := 20.
k := [
'>>> TEST4_1 METHOD >>> ' dump.
j dump.
(j < 25) ifTrue: [ | t |
##t := Exception signal: 'bad exceptinon'. ## when resume, t should get Exception.
t := self raise_exception. ## when resumed, t should get 'self'
'RESUMED???' dump.
t dump.
j dump.
].
'OOOOOOOOOOOOOOOOOOOOOOO' dump.
'JJJJJJJJJJJJJJ' dump.
] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex pass. ].
k dump.
'END OF TEST4_1' dump.
}
method(#class) test4
{
'BEGINNING OF TEST4' dump.
[ self test4_1 ] on: Exception do: [:ex | 'Excepton in test4_1' dump. ex messageText dump. ex resume].
'END OF TEST4' dump.
}
method(#class) test5
{
| k j |
'BEGINNING OF TEST5' dump.
j := 20.
k := [
'>>> TEST5 BLOCK >>> ' dump.
j dump.
(j < 25) ifTrue: [ | t |
##t := Exception signal: 'bad exceptinon'. ## when resume, t should get Exception.
t := self raise_exception. ## when resumed, t should get 'self'
].
'OOOOOOOOOOOOOOOOOOOOOOO' dump.
'JJJJJJJJJJJJJJ' dump.
] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex retry. ].
k dump.
'END OF TEST5' dump.
}
method(#class) test11
{
## exception is raised in a new process. it can't be captured
## by an exception handler of a calling process.
## exception handling must not cross the process boundary.
'BEGINNING OF test11' dump.
[
|p |
p := [ 'TEST11 IN NEW PROCESS' dump. Exception signal: 'Exception raised in a new process of test11'. ] newProcess.
'JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ' dump.
p resume. ## resume the new process
] on: Exception do: [:ex | '---- EXCEPTION IN TEST11. THIS MUST NOT BE PRINTED----------' dump. ex messageText dump ].
'END OF test11' dump.
}
method(#class) test12
{
'BEGINNING OF test12' dump.
[
|p |
p := [
[ Exception signal: 'Exception in a new process of test12' ]
on: Exception do: [:ex |
('EXCEPTION CAUGHT...in test12 ==> ' & (ex messageText)) dump.
]
] newProcess.
'JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ' dump.
p resume.
] on: Exception do: [:ex | 'EXCEPTION ----------' dump. ex messageText dump ].
'END OF test12' dump.
}
method(#class) main
{
'>>>>> BEGINNING OF MAIN' dump.
[ self main2 ] on: Exception do: [ :ex |
'EXCEPTION CAUGHT IN MAIN....' dump.
ex messageText dump.
##ex pass.
'Returning back to where the exception has signalled in main2...' dump.
##ex resume.
ex resume: 'RESUMED WITH THIS STRING'.
].
'##############################' dump.
## self test3.
## self test4.
## self test5.
self test11.
## self test12.
## 100 timesRepeat: ['>>>>> END OF MAIN' dump].
"(Exception isKindOf: Apex) dump.
(Exception isMemberOf: Apex) dump.
(Exception isMemberOf: Class) dump.
(1 isMemberOf: SmallInteger) dump.
(1 isKindOf: Integer) dump.
(1 isKindOf: Class) dump.
(1 isKindOf: Apex) dump.
(Exception isKindOf: Class) dump.
(Exception isKindOf: Apex) dump.
(Exception isKindOf: Object) dump.
(Exception isKindOf: (Apex new)) dump.
(Exception isKindOf: (Object new)) dump."
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@' dump.
## the following line(return:to:) must cause primitive failure...
##[ Processor return: 10 to: 20. ] on: Exception do: [:ex | ex messageText dump].
##[ Processor return: 10 to: 20. ]
## on: PrimitiveFailureException do: [:ex | 'PRIMITIVE FAILURE CAUGHT HERE HERE HERE' dump]
## on: Exception do: [:ex | ex messageText dump].
'SLEEPING FOR 10 seconds ....' dump.
Processor sleepFor: 10.
'>>>>> END OF MAIN' dump.
}
}

103
moo/kernel/test-013.st Normal file
View File

@ -0,0 +1,103 @@
#include 'Moo.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: 20000 by: 1 do: [:i | System logNl: i asString. "Processor sleepFor: 1." ]
Processor activeProcess terminate.
] ensure: [ System logNl: '<<<PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP>>>' ].
] ensure: [ System logNl: '<<--------------------->>' ].
] newProcess.
System logNl: 'RESUMING v1'.
v1 resume.
Processor sleepFor: 1.
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'.
}
}

245
moo/kernel/test-014.st Normal file
View File

@ -0,0 +1,245 @@
#include 'Moo.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.
}
pooldic SRX.ABC
{
#JJJ := 1000.
}
class MyConsole(Console)
{
method box: origin corner: corner
{
| tmp |
self setCursor: origin.
self write: '+'.
(corner x - origin x - 1) timesRepeat: [self write: '-'].
self write: '+'.
tmp := Point new.
(origin y + 1) to: (corner y - 1) by: 1 do: [ :i |
tmp x: origin x y: i.
self setCursor: tmp.
self write: '|'.
tmp x: corner x.
self setCursor: tmp.
self write: '|'.
].
tmp x: origin x y: corner y.
self setCursor: tmp.
self write: '+'.
(corner x - origin x - 1) timesRepeat: [self write: '-'].
self write: '+'.
}
}
class MyObject(TestObject)
{
dcl(#pooldic) ABC SRX.ABC.
method(#class) main
{
| v1 v2 |
v2 := 'have fun'.
v2 at: 0 put: $H.
System logNl: ('START OF MAIN - ' & v2).
v1 := MyConsole output.
v1 clear.
v1 box: 0@0 corner: 80@20.
v1 write: S'hello, 월드 이거 좋지 않니\n'.
v1 write: S'하하하하하하하하 좋아좋아 可愛くってしょうがない(^o^) ほのかちゃん、しおりちゃん元気そうだね！ 久しぶりに見た。しおりちゃんどうしたのかな？좋아 하라하하\n'.
v1 close.
self main2.
System logNl: (9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
* 8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) asString.
System logNl: (9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
- 8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) asString.
System logNl: (8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888
- 9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999) asString.
System logNl:(820186817651640487320479808367534510238779540102526006236474836166734016865205999870833760242352512045225158774173869894826877890589130978987229877889333678492731896878236182891224254464936050871086340438798130266913122427332418216677813151305680453358955006355665628938266331979307689540884269372365762883678113227136498054422414501840232090872158915536978847443767922315217311444711397048331496139248250188991402851129033493732164230227458717486395514436574417275149404197774547389507462779807727615
* 765507696474864454832447821143032209556194237429024272487376513755618415740858933212778176226195677908876814855895611901838419364549855580388081219363378099926549770419687104031809304167273647479680584409544921582452247598843590335565958941218635089801691339265287920342381909847353843571491984747541378691432905678660731517460920201717549951480681654501180257614183394160869490681730637245109396396631700176391975994387097927483353281545628136320635813474136122790139443917922910896873631927820545774) asString.
System logNl:(-820186817651640487320479808367534510238779540102526006236474836166734016865205999870833760242352512045225158774173869894826877890589130978987229877889333678492731896878236182891224254464936050871086340438798130266913122427332418216677813151305680453358955006355665628938266331979307689540884269372365762883678113227136498054422414501840232090872158915536978847443767922315217311444711397048331496139248250188991402851129033493732164230227458717486395514436574417275149404197774547389507462779807727615
* 765507696474864454832447821143032209556194237429024272487376513755618415740858933212778176226195677908876814855895611901838419364549855580388081219363378099926549770419687104031809304167273647479680584409544921582452247598843590335565958941218635089801691339265287920342381909847353843571491984747541378691432905678660731517460920201717549951480681654501180257614183394160869490681730637245109396396631700176391975994387097927483353281545628136320635813474136122790139443917922910896873631927820545774) asString.
System logNl: S'\0\0\0END OF MAIN\0AB\0\0\0C\0\0\0'.
##v1 := Stdio2 open: '/tmp/1.txt' for: 'w+'.
v1 := Stdio2 new open: '/tmp/1.txt' for: 'w+'.
(v1 isError)
ifTrue: [
System logNl: ('Error in opening a file....' & v1 asString).
]
ifFalse: [
## v1 puts: 'hello'.
v1 puts ('hello', 'world', 'good', C'\n', C'\t', 'under my umbrella 123.', C'\n').
v1 close.
(*v1 format(10, 20) isNil ifFalse: [
'Beautiful life' dump.
].*)
].
nil isNil ifTrue: [ 'NIL NIL NIL' dump. ].
(Apex new) notNil ifTrue: [ 'APEX NIL NIL NIL' dump. ].
self varg_test (10, 20, 30, 40, 50) dump.
self varg_test2 (10, 20, 30, 40, 50) dump.
self varg_test3 (10, 20, 30, 40, 50) dump.
thisContext vargCount dump.
thisContext vargCount dump.
((2305843009213693951 bitAt: 61) = 0) ifFalse: [
System logNl: 'Test 1 failed'.
thisProcess terminate
].
((-2305843009213693951 bitAt: 62) = 1) ifFalse: [
System logNl: 'Test 2 failed'.
thisProcess terminate
].
((2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 120) = 0) ifFalse: [
System logNl: 'Test 3 failed'.
thisProcess terminate
].
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 16rFFFFFFFFFFFFFFFF0) = 1) ifFalse: [
System logNl: 'Test 4 failed'.
thisProcess terminate
].
0 priorTo: 200 do: [:i |
| k |
k := 1 bitShift: i.
## (k printStringRadix: 2) dump.
((k bitAt: i) = 1) ifFalse: [
System logNl: 'Test 5 failed'.
thisProcess terminate.
].
((k bitAt: i - 1) = 0) ifFalse: [
System logNl: 'Test 6 failed'.
thisProcess terminate.
].
].
2r100000000_10001111_01010000 dump.
16rFFFFFFFF_12345678 dump.
(v1 := self t001()) isError ifTrue: [('t001 Error 111....' & v1 asInteger asString) dump].
(v1 := self t001(10)) isError ifTrue: [('t001 Error 222....' & v1 asInteger asString) dump].
(v1 := self t001(20)) isError ifTrue: [('t001 Error 333....' & v1 asInteger asString) dump].
error(9999) dump.
error(9999) asInteger dump.
v2 := (16rFFFFFFFF_FFFFFFFF_FFFFFFFF_FFFFFFFF_FFFFFFFF_FFFFFFFF) basicAt: 1 put: 1; yourself.
v2 dump.
}
method(#class) varg_test()
{
0 to: (thisContext vargCount - 1) do: [:k |
(thisContext vargAt: k) dump.
].
^999
}
method(#class) varg_test2(a,b,c)
{
0 to: (thisContext vargCount - 1) do: [:k |
(thisContext vargAt: k) dump.
].
^a
}
method(#class) varg_test3(a,b,c,d,e,f)
{
0 to: (thisContext vargCount - 1) do: [:k |
(thisContext vargAt: k) dump.
].
## ^b * 100
^f
}
method(#class) t001(a)
{
a isNil ifTrue: [^error(10)].
(a = 20) ifTrue: [^error].
(a = 10) ifTrue: [^123 asError].
^a.
#! a := error(10).
#! [ a = error(10) ] ifTrue: [....].
#! self t001 (error:10).
#! self t001: (error:10)
}
}
extend MyObject
{
method(#class) main2
{
System logNl: KKK.
System logNl: SRX.ABC.JJJ.
System logNl: JJJ.
System logNl: -200 asString.
}
}