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

changed some directives from symbols to plain words including class, method, pooldic, dcl.

Browse Source 
introduced stix_pfrc_t as a return code type from a primitive function
This commit is contained in:
hyunghwan.chung
2017-01-06 09:53:40 +00:00
parent af9c144a1c
commit 7779229b52
32 changed files with 1099 additions and 1337 deletions
Download Patch File Download Diff File Expand all files Collapse all files

227
stix/kernel/Apex.st
View File

@ -1,16 +1,16 @@
#class Apex(nil)
class Apex(nil)
{
#dcl(#class) sysdic.
dcl(#class) sysdic.
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) dump
method(#class) dump
{
<primitive: #_dump>
}
#method dump
method dump
{
<primitive: #_dump>
}
@ -18,12 +18,12 @@
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) yourself
method(#class) yourself
{
^self.
}
#method yourself
method yourself
{
^self.
}
@ -31,31 +31,31 @@
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) basicNew
method(#class) basicNew
{
<primitive: #_basic_new>
self primitiveFailed.
}
#method(#class) basicNew: anInteger
method(#class) basicNew: anInteger
{
<primitive: #_basic_new_with_size>
self primitiveFailed.
}
#method(#class) ngcNew
method(#class) ngcNew
{
<primitive: #_ngc_new>
self primitiveFailed.
}
#method(#class) ngcNew: anInteger
method(#class) ngcNew: anInteger
{
<primitive: #_ngc_new_with_size>
self primitiveFailed.
}
#method(#class) new
method(#class) new
{
| x |
x := self basicNew.
@ -63,7 +63,7 @@
^x.
}
#method(#class) new: anInteger
method(#class) new: anInteger
{
| x |
## TODO: check if the class is a fixed class.
@ -73,20 +73,20 @@
^x.
}
#method initialize
method initialize
{
"a subclass may override this method."
^self.
}
#method ngcDispose
method ngcDispose
{
<primitive: #_ngc_dispose>
self primitiveFailed.
}
## -------------------------------------------------------
## -------------------------------------------------------
#method shallowCopy
method shallowCopy
{
<primitive: #_shallow_copy>
self primitiveFailed.
@ -95,12 +95,12 @@
## -------------------------------------------------------
## -------------------------------------------------------
#method class
method class
{
<primitive: #_class>
}
#method(#class) class
method(#class) class
{
<primitive: #_class>
^Class
@ -109,123 +109,152 @@
## -------------------------------------------------------
## -------------------------------------------------------
#method basicSize
method basicSize
{
<primitive: #_basic_size>
self primitiveFailed.
}
#method(#class) basicSize
method(#class) basicSize
{
<primitive: #_basic_size>
self primitiveFailed.
}
#method basicAt: index
method basicAt: index
{
<primitive: #_basic_at>
self index: index outOfRange: (self basicSize).
}
#method basicAt: index put: anObject
method basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self index: index outOfRange: (self basicSize).
}
#method(#class) basicAt: index
method(#class) basicAt: index
{
<primitive: #_basic_at>
self index: index outOfRange: (self basicSize).
}
#method(#class) basicAt: index put: anObject
method(#class) basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self index: index outOfRange: (self basicSize).
}
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) hash
(* ------------------------------------------------------------------
* HASHING
* ------------------------------------------------------------------ *)
method hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
#method hash
method(#class) hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
## -------------------------------------------------------
## -------------------------------------------------------
(* ------------------------------------------------------------------
* IDENTITY TEST
* ------------------------------------------------------------------ *)
#method == anObject
method == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
self primitiveFailed.
}
#method ~~ anObject
method ~~ anObject
{
<primitive: #_not_identical>
^(self == anObject) not.
}
#method(#class) == anObject
method(#class) == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
self primitiveFailed.
}
#method(#class) ~~ anObject
method(#class) ~~ anObject
{
<primitive: #_not_identical>
^(self == anObject) not.
}
## TODO: add = and ~= for equality check.
(* ------------------------------------------------------------------
* 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
* ------------------------------------------------------------------ *)
## -------------------------------------------------------
## COMMON QUERIES
## -------------------------------------------------------
#method isNil
method isNil
{
"^self == nil."
^false
}
#method notNil
method notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
#method(#class) isNil
method(#class) isNil
{
"^self == nil."
^false
}
#method(#class) notNil
method(#class) notNil
{
"^(self == nil) not"
"^self ~= nil."
^true.
}
#method isError
method isError
{
^false
}
#method(#class) isError
method(#class) isError
{
^false
}
@ -233,7 +262,7 @@
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) inheritsFrom: aClass
method(#class) inheritsFrom: aClass
{
| c |
c := self superclass.
@ -244,7 +273,7 @@
^false
}
#method(#class) isMemberOf: aClass
method(#class) isMemberOf: aClass
{
(* a class object is an instance of Class
* but Class inherits from Apex. On the other hand,
@ -253,109 +282,103 @@
^aClass == Class
}
#method(#class) isKindOf: aClass
method(#class) isKindOf: aClass
{
^(self isMemberOf: aClass) or: [self inheritsFrom: aClass].
}
#method isMemberOf: aClass
method isMemberOf: aClass
{
^self class == aClass
}
#method isKindOf: aClass
method isKindOf: aClass
{
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
}
## -------------------------------------------------------
## -------------------------------------------------------
"
#method(#class) respondsTo: selectorSymbol
(* -----------------
method(#class) respondsTo: selectorSymbol
{
TODO: find selectorSymbol in the class method dictionary...
}
#method respondsTo: selectorSymbol
method respondsTo: selectorSymbol
{
TODO: find selectorSymbol in the method dictionary...
}
"
------------ *)
## -------------------------------------------------------
method exceptionizeError: trueOrFalse
{
<primitive: #_exceptionize_error>
self class cannotExceptionizeError
}
## method(#class) primitiveFailed
## {
## this method will be added after Exception class has been defined.
## }
#method primitiveFailed
(* ------------------------------------------------------------------
* COMMON ERROR/EXCEPTION HANDLERS
* ------------------------------------------------------------------ *)
method primitiveFailed
{
self class primitiveFailed.
}
#method doesNotUnderstand: messageSymbol
method doesNotUnderstand: messageSymbol
{
self class doesNotUnderstand: messageSymbol
}
#method(#class) error: msgText
method index: index outOfRange: ubound
{
self class index: index outOfRange: ubound.
}
method cannotInstantiate
{
self class cannotInstantiate
}
method subclassResponsibility: message_name
{
self class subclassResponsibility: message_name
}
method cannotExceptionizeError
{
self class cannotExceptionizeError
}
method(#class) error: msgText
{
## TODO: implement this
## Error signal: msgText.
msgText dump.
}
#method error: aString
method error: aString
{
self class error: aString.
}
#method index: index outOfRange: ubound
{
self class index: index outOfRange: ubound.
}
#method cannotInstantiate
{
self class cannotInstantiate
}
#method subclassResponsibility: message_name
{
self class subclassResponsibility: message_name
}
#method cannotExceptionizeError
{
self class cannotExceptionizeError
}
#method exceptionizeError: trueOrFalse
{
<primitive: #_exceptionize_error>
self class cannotExceptionizeError
}
}
#class Object(Apex)
class Object(Apex)
{
}
#class UndefinedObject(Apex)
class UndefinedObject(Apex)
{
#method isNil
method isNil
{
^true
}
#method notNil
method notNil
{
^false.
}
#method handleException: exception
method handleException: exception
{
('### EXCEPTION NOT HANDLED #### ' & exception class name & ' - ' & exception messageText) dump.
## TODO: debug the current process???? "
@ -365,7 +388,7 @@
}
#pooldic ErrorCode
pooldic ErrorCode
{
(* migrate it into Error class *)
#NONE := error(0).
@ -373,7 +396,7 @@
#NOENT := error(2).
}
#class Error(Apex)
class Error(Apex)
{
(* ----------------------------
TODO: support constant declaration...
@ -385,22 +408,22 @@
}
-------------------------------- *)
#method isError
method isError
{
^true
}
#method asInteger
method asInteger
{
<primitive: #_error_as_integer>
}
#method asCharacter
method asCharacter
{
<primitive: #_error_as_character>
}
#method asString
method asString
{
<primitive: #_error_as_string>
}

42
stix/kernel/Boolean.st
View File

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

27
stix/kernel/Class.st
View File

@ -2,45 +2,42 @@
## the Class object should be a variable-pointer object because
## it needs to accomodate class instance variables.
##
#class(#pointer) Class(Apex)
class(#pointer) Class(Apex)
{
#dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
#method(#class) basicNew
method(#class) basicNew
{
## you must not instantiate a new class this way.
self cannotInstantiate.
}
#method(#class) initialize
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
(* 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
method superclass
{
^self.superclass
}
#method specNumInstVars
method specNumInstVars
{
## shift right by 7 bits.
## see stix-prv.h for details.
^self.spec bitShift: -7
}
"#method inheritsFrom: aSuperclass
(*method inheritsFrom: aSuperclass
{
| c |
c := self superclass.
@ -49,5 +46,5 @@
c := c superclass.
].
^false
}"
}*)
}

117
stix/kernel/Collect.st
View File

@ -1,57 +1,52 @@
#class Collection(Object)
class Collection(Object)
{
}
## -------------------------------------------------------------------------------
#class(#pointer) Array(Collection)
class(#pointer) Array(Collection)
{
#method size
method size
{
^self basicSize.
^self basicSize
}
#method ubound
{
^(self basicSize - 1).
}
#method at: anInteger
method at: anInteger
{
^self basicAt: anInteger.
}
#method at: anInteger put: aValue
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
#method first
method first
{
^self at: 0.
}
#method last
method last
{
^self at: (self ubound).
^self at: (self basicSize - 1).
}
#method do: aBlock
method do: aBlock
{
0 to: (self ubound) do: [:i | aBlock value: (self at: i)].
0 priorTo: (self basicSize) do: [:i | aBlock value: (self at: i)].
}
#method copy: anArray
method copy: anArray
{
0 to: (anArray ubound) do: [:i | self at: i put: (anArray at: i) ].
0 priorTo: (anArray basicSize) do: [:i | self at: i put: (anArray at: i) ].
}
}
## -------------------------------------------------------------------------------
#class(#character) String(Array)
class(#character) String(Array)
{
#method & string
method & string
{
(* TOOD: make this a primitive for performance. *)
@ -70,7 +65,7 @@
^newstr
}
#method asString
method asString
{
^self
}
@ -78,9 +73,9 @@
## -------------------------------------------------------------------------------
#class(#character) Symbol(String)
class(#character) Symbol(String)
{
#method asString
method asString
{
(* TODO: make this a primitive for performance *)
@ -96,14 +91,14 @@
## -------------------------------------------------------------------------------
#class(#byte) ByteArray(Collection)
class(#byte) ByteArray(Collection)
{
#method at: anInteger
method at: anInteger
{
^self basicAt: anInteger.
}
#method at: anInteger put: aValue
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
@ -111,22 +106,22 @@
## -------------------------------------------------------------------------------
#class Set(Collection)
class Set(Collection)
{
#dcl tally bucket.
dcl tally bucket.
#method initialize
method initialize
{
self.tally := 0.
self.bucket := Array new: 100.
}
#method size
method size
{
^self.tally
}
#method at: key
method at: key
{
| ass |
ass := self __find: key or_upsert: false with: nil.
@ -134,7 +129,7 @@
^ErrorCode.NOENT
}
#method at: key ifAbsent: error_block
method at: key ifAbsent: error_block
{
| ass |
ass := self __find: key or_upsert: false with: nil.
@ -142,13 +137,13 @@
^error_block value.
}
#method at: key put: value
method at: key put: value
{
self __find: key or_upsert: true with: value.
^value
}
#method __find: key or_upsert: upsert with: value
method __find: key or_upsert: upsert with: value
{
| hv ass bs index ntally |
@ -158,7 +153,7 @@
[(ass := self.bucket at: index) notNil]
whileTrue: [
[key == ass key] ifTrue: [
[key == ass key] ifTrue: [ (* TODO: change it to equality??? *)
(* found *)
upsert ifTrue: [ass value: value].
^ass
@ -181,7 +176,7 @@
^ass
}
#method do: block
method do: block
{
| bs |
@ -192,7 +187,7 @@
].
}
#method keysAndValuesDo: block
method keysAndValuesDo: block
{
| bs |
@ -204,15 +199,15 @@
}
}
#class SymbolSet(Set)
class SymbolSet(Set)
{
}
#class Dictionary(Set)
class Dictionary(Set)
{
}
#pooldic Log
pooldic Log
{
## -----------------------------------------------------------
## defines log levels
@ -226,7 +221,7 @@
#FATAL := 16.
}
#class SystemDictionary(Dictionary)
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
@ -234,27 +229,27 @@
## System logNl: 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'.
##
#dcl(#pooldic) Log.
dcl(#pooldic) Log.
#method atLevel: level log: message
method atLevel: level log: message
{
<primitive: #_log>
## do nothing upon logging failure
}
#method atLevel: level log: message and: message2
method atLevel: level log: message and: message2
{
<primitive: #_log>
## do nothing upon logging failure
}
#method atLevel: level log: message and: message2 and: message3
method atLevel: level log: message and: message2 and: message3
{
<primitive: #_log>
## do nothing upon logging failure
}
#method atLevel: level logNl: message
method atLevel: level logNl: message
{
## the #_log primitive accepts an array.
## so the following lines should work also.
@ -267,58 +262,64 @@
^self atLevel: level log: message and: S'\n'.
}
#method atLevel: level logNl: message and: message2
method atLevel: level logNl: message and: message2
{
^self atLevel: level log: message and: message2 and: S'\n'.
}
#method log: message
method log: message
{
^self atLevel: Log.INFO log: message.
}
#method log: message and: message2
method log: message and: message2
{
^self atLevel: Log.INFO log: message and: message2.
}
#method logNl: message
method logNl: message
{
^self atLevel: Log.INFO logNl: message.
}
#method logNl: message and: message2
method logNl: message and: message2
{
^self atLevel: Log.INFO logNl: message and: message2.
}
method at: key
{
(key class = Symbol) ifTrue: [InvalidArgumentException signal: 'argument is not a symbol'].
^super at: key.
}
}
#class Namespace(Set)
class Namespace(Set)
{
}
#class PoolDictionary(Set)
class PoolDictionary(Set)
{
}
#class MethodDictionary(Dictionary)
class MethodDictionary(Dictionary)
{
}
#extend Apex
extend Apex
{
## -------------------------------------------------------
## Association has been defined now. let's add association
## creating methods
## -------------------------------------------------------
#method(#class) -> object
method(#class) -> object
{
^Association new key: self value: object
}
#method -> object
method -> object
{
^Association new key: self value: object
}

68
stix/kernel/Console.st
View File

@ -1,46 +1,46 @@
#class Point(Object)
class Point(Object)
{
#dcl x y.
dcl x y.
#method(#class) new
method(#class) new
{
^self basicNew x: 0 y: 0.
}
#method(#class) x: x y: y
method(#class) x: x y: y
{
^self basicNew x: x y: y.
}
#method x
method x
{
^self.x
}
#method y
method y
{
^self.y
}
#method x: x
method x: x
{
self.x := x
}
#method y: y
method y: y
{
self.y := y
}
#method x: x y: y
method x: x y: y
{
self.x := x.
self.y := y
}
}
#extend SmallInteger
extend SmallInteger
{
#method @ y
method @ y
{
^Point x: self y: y
}
@ -49,11 +49,11 @@
#class Console(Object)
class Console(Object)
{
#dcl handle.
dcl handle.
"
#method finalize
method finalize
{
handle notNil ifTrue: [
self _close: handle.
@ -62,12 +62,12 @@
"
## #method(#class) input
## method(#class) input
## {
## ^self new _open: filename mode: mode
## }
#method(#class) output
method(#class) output
{
| c |
@ -76,73 +76,73 @@
^c
}
## #method(#class) error
## method(#class) error
## {
## }
#method handle: v
method handle: v
{
self.handle := v.
}
#method close
method close
{
self _close: self.handle.
self.handle := nil.
}
#method write: text
method write: text
{
^self _writeOn: self.handle text: text.
}
#method clear
method clear
{
^self _clear: self.handle
}
#method setCursor: point
method setCursor: point
{
^self _setCursor: self.handle point: point.
}
"
#method _open: filename mode: mode
method _open: filename mode: mode
{
self.handle := self __open: filename mode: mode.
^self.
}
#method __open: filename mode: mode
method __open: filename mode: mode
{
<primitive: #console.open>
##StdioException signal: ('cannot open ' & filename).
}
"
#method _open
method _open
{
<primitive: #console.open>
}
#method _close: handle
method _close: handle
{
<primitive: #console.close>
self primitiveFailed.
}
#method _clear: handle
method _clear: handle
{
<primitive: #console.clear>
self primitiveFailed.
}
#method _writeOn: handle text: text
method _writeOn: handle text: text
{
<primitive: #console.write>
self primitiveFailed.
}
#method _setCursor: handle point: point
method _setCursor: handle point: point
{
<primitive: #console.setcursor>
self primitiveFailed.
@ -151,19 +151,19 @@
"
#method(#class) open
method(#class) open
{
<primitive: #console.open>
self primitiveFailed.
}
#method close
method close
{
<primitive: #console.close>
self primitiveFailed.
}
#method setCursorTo: point
method setCursorTo: point
{
<primitive: #console.setcursor>
self primitiveFailed.
@ -195,9 +195,9 @@ Stix define: 'console_write'
---> produces a method like this internally...
#class Console
class Console
{
#method write: aString upto: length
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.
}

115
stix/kernel/Context.st
View File

@ -1,24 +1,24 @@
#class(#pointer) Context(Apex)
class(#pointer) Context(Apex)
{
#dcl sender ip sp ntmprs.
dcl sender ip sp ntmprs.
#method sender
method sender
{
^self.sender
}
#method isDead
method isDead
{
^self.ip < 0
}
#method temporaryCount
method temporaryCount
{
^self.ntmprs
}
(* ---------------------------------
#method varargCount
method varargCount
{
method context,
@ -30,7 +30,7 @@ for a block context, it must access homeContext first and call varargCount
^self.home varargCount...
}
#method varargAt: index
method varargAt: index
{
method context
^do calculation...
@ -42,91 +42,91 @@ block context...
---------------------------------- *)
}
#class(#pointer) MethodContext(Context)
class(#pointer) MethodContext(Context)
{
#dcl method receiver home origin.
dcl method receiver home origin.
#method pc
method pc
{
^self.ip
}
#method pcplus1
method pcplus1
{
^self.ip + 1
}
#method goto: anInteger
method goto: anInteger
{
<primitive: #_context_goto>
self primitiveFailed. ## TODO: need to make this a hard failure?
}
#method pc: anInteger
method pc: anInteger
{
self.ip := anInteger.
}
#method sp
method sp
{
^self.sp.
}
#method sp: new_sp
method sp: new_sp
{
self.sp := new_sp
}
#method pc: new_pc sp: new_sp
method pc: new_pc sp: new_sp
{
self.ip := new_pc.
self.sp := new_sp.
}
#method method
method method
{
^self.method
}
#method vargCount
method vargCount
{
^self basicSize - self class specNumInstVars - self.ntmprs
}
#method vargAt: index
method vargAt: index
{
^self basicAt: (index + self class specNumInstVars + self.ntmprs)
}
}
#class(#pointer) BlockContext(Context)
class(#pointer) BlockContext(Context)
{
#dcl nargs source home origin.
dcl nargs source home origin.
#method vargCount
method vargCount
{
^self.home vargCount
}
#method vargAt: index
method vargAt: index
{
^self.home vargAt: index
}
#method fork
method fork
{
"crate a new process in the runnable state"
^self newProcess resume.
}
#method newProcess
method newProcess
{
"create a new process in the suspended state"
<primitive: #_block_new_process>
self primitiveFailed.
}
#method newProcessWith: anArray
method newProcessWith: anArray
{
"create a new process in the suspended state passing the elements
of anArray as block arguments"
@ -134,53 +134,53 @@ block context...
self primitiveFailed.
}
#method value
method value
{
<primitive: #_block_value>
self primitiveFailed.
}
#method value: a
method value: a
{
<primitive: #_block_value>
self primitiveFailed.
}
#method value: a value: b
method value: a value: b
{
<primitive: #_block_value>
self primitiveFailed.
}
#method value: a value: b value: c
method value: a value: b value: c
{
<primitive: #_block_value>
self primitiveFailed.
}
#method value: a value: b value: c value: d
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
method value: a value: b value: c value: d value: e
{
<primitive: #_block_value>
self primitiveFailed.
}
#method ifTrue: aBlock
method ifTrue: aBlock
{
^(self value) ifTrue: aBlock.
}
#method ifFalse: aBlock
method ifFalse: aBlock
{
^(self value) ifFalse: aBlock.
}
#method ifTrue: trueBlock ifFalse: falseBlock
method ifTrue: trueBlock ifFalse: falseBlock
{
^(self value) ifTrue: trueBlock ifFalse: falseBlock
}
#method whileTrue: aBlock
method whileTrue: aBlock
{
## --------------------------------------------------
## Naive implementation
@ -208,7 +208,7 @@ block context...
## --------------------------------------------------
}
#method whileTrue
method whileTrue
{
## (self value) ifFalse: [^nil].
## self whileTrue.
@ -223,7 +223,7 @@ block context...
## --------------------------------------------------
}
#method whileFalse: aBlock
method whileFalse: aBlock
{
## --------------------------------------------------
## Naive implementation
@ -256,7 +256,7 @@ block context...
## --------------------------------------------------
}
#method whileFalse
method whileFalse
{
## (self value) ifTrue: [^nil].
## self whileFalse.
@ -271,28 +271,55 @@ block context...
## --------------------------------------------------
}
#method pc
method pc
{
^self.ip
}
#method pc: anInteger
method pc: anInteger
{
self.ip := anInteger.
}
#method sp
method sp
{
^self.sp
}
#method sp: anInteger
method sp: anInteger
{
self.sp := anInteger.
}
#method restart
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
{
^(self.preamble bitAnd: 16rFF) bitShift: -2.
}
method owner
{
^self.owner
}
method name
{
^self.name
}
}

94
stix/kernel/Except.st
View File

@ -4,42 +4,42 @@
## TODO: is it better to inherit from Object???
## or treat Exception specially like UndefinedObject or Class???
##
#class Exception(Apex)
class Exception(Apex)
{
#dcl signalContext handlerContext messageText.
dcl signalContext handlerContext messageText.
#method(#class) signal
method(#class) signal
{
^self new signal
}
#method(#class) signal: text
method(#class) signal: text
{
^self new signal: text
}
#method handlerContext: context
method handlerContext: context
{
self.handlerContext := context.
}
#method messageText
method messageText
{
^self.messageText
}
#method asString
method asString
{
^(self class name) & ' - ' & self.messageText.
}
#method __signal
method __signal
{
self.signalContext := thisContext.
((thisContext sender) findExceptionContext) handleException: self.
}
#method signal
method signal
{
| exctx exblk retval actpos |
@ -74,26 +74,26 @@
thisProcess terminate.
}
#method signal: text
method signal: text
{
self.messageText := text.
^self signal.
}
#method pass
method pass
{
## pass the exception to the outer context
((self.handlerContext sender) findExceptionContext) handleException: self.
}
#method return: value
method return: value
{
(self.handlerContext notNil) ifTrue: [
Processor return: value to: self.handlerContext.
].
}
#method retry
method retry
{
## TODO: verify if return:to: causes unnecessary stack growth.
(self.handlerContext notNil) ifTrue: [
@ -102,7 +102,7 @@
].
}
#method resume: value
method resume: value
{
## TODO: verify if return:to: causes unnecessary stack growth.
## is this correct???
@ -115,31 +115,31 @@
].
}
#method resume
method resume
{
^self resume: nil.
}
}
##============================================================================
#extend Context
extend Context
{
#method isExceptionContext
method isExceptionContext
{
^false
}
#method isEnsureContext
method isEnsureContext
{
^false
}
#method ensureBlock
method ensureBlock
{
^nil
}
#method findExceptionContext
method findExceptionContext
{
| ctx |
ctx := self.
@ -150,7 +150,7 @@
^nil
}
#method unwindTo: context return: retval
method unwindTo: context return: retval
{
## -------------------------------------------------------------------
## <<private>>
@ -183,21 +183,21 @@
}
##============================================================================
#extend MethodContext
extend MethodContext
{
#method isExceptionContext
method isExceptionContext
{
## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM.
^self.method preambleCode == 10.
}
#method isEnsureContext
method isEnsureContext
{
## 10 - STIX_METHOD_PREAMBLE_ENSURE in VM.
^self.method preambleCode == 11
}
#method ensureBlock
method ensureBlock
{
## TODO: change 8 to a constant when stix is enhanced to support constant definition
@ -213,7 +213,7 @@
}
#method findExceptionHandlerFor: exception_class
method findExceptionHandlerFor: exception_class
{
(* find an exception handler block for a given exception class.
*
@ -242,7 +242,7 @@
^nil.
}
#method handleException: exception
method handleException: exception
{
(* -----------------------------------------------------------------
* <<private>>
@ -295,9 +295,9 @@
}
##============================================================================
#extend BlockContext
extend BlockContext
{
#method on: anException do: anExceptionBlock
method on: anException do: anExceptionBlock
{
| exception_active |
<exception>
@ -314,7 +314,7 @@ thisContext isExceptionContext dump.
^self value.
}
#method on: exc1 do: blk1 on: exc2 do: blk2
method on: exc1 do: blk1 on: exc2 do: blk2
{
| exception_active |
<exception>
@ -322,7 +322,7 @@ thisContext isExceptionContext dump.
^self value.
}
#method ensure: aBlock
method ensure: aBlock
{
| retval done |
<ensure>
@ -339,7 +339,7 @@ thisContext isExceptionContext dump.
^retval
}
#method ifCurtailed: aBlock
method ifCurtailed: aBlock
{
| v ok |
@ -351,33 +351,37 @@ thisContext isExceptionContext dump.
##============================================================================
#class InstantiationFailureException(Exception)
class InstantiationFailureException(Exception)
{
}
#class NoSuchMessageException(Exception)
class NoSuchMessageException(Exception)
{
}
#class PrimitiveFailureException(Exception)
class PrimitiveFailureException(Exception)
{
}
#class IndexOutOfRangeException(Exception)
class IndexOutOfRangeException(Exception)
{
}
#class SubclassResponsibilityException(Exception)
class SubclassResponsibilityException(Exception)
{
}
#class ErrorExceptionizationFailureException(Exception)
class InvalidArgumentException(Exception)
{
}
#extend Apex
class ErrorExceptionizationFailureException(Exception)
{
#method(#class) primitiveFailed
}
extend Apex
{
method(#class) primitiveFailed
{
## TODO: implement this
## experimental backtrace...
@ -393,29 +397,29 @@ ctx := thisContext.
PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
}
#method(#class) cannotInstantiate
method(#class) cannotInstantiate
{
## TOOD: accept a class
InstantiationFailureException signal: 'Cannot instantiate'.
}
#method(#class) doesNotUnderstand: message_name
method(#class) doesNotUnderstand: message_name
{
## TODO: implement this properly
NoSuchMessageException signal: (message_name & ' not understood by ' & (self name)).
}
#method(#class) index: index outOfRange: ubound
method(#class) index: index outOfRange: ubound
{
IndexOutOfRangeException signal: 'Out of range'.
}
#method(#class) subclassResponsibility: message_name
method(#class) subclassResponsibility: message_name
{
SubclassResponsibilityException signal: ('Subclass must implment ' & message_name).
}
#method(#class) cannotExceptionizeError
method(#class) cannotExceptionizeError
{
## todo: accept the object
ErrorExceptionizationFailureException signal: 'Cannot exceptionize an error'

112
stix/kernel/Process.st
View File

@ -1,35 +1,35 @@
#class(#pointer) Process(Object)
class(#pointer) Process(Object)
{
#dcl initial_context current_context state sp prev next sem.
dcl initial_context current_context state sp prev next sem.
#method new
method new
{
"instantiation is not allowed"
^nil. "TODO: raise an exception"
}
#method prev
method prev
{
^self.prev.
}
#method next
method next
{
^self.next.
}
#method next: process
method next: process
{
self.next := process.
}
#method prev: process
method prev: process
{
self.prev := process.
}
#method resume
method resume
{
<primitive: #_process_resume>
self primitiveFailed
@ -37,19 +37,19 @@
##^Processor resume: self.
}
#method _terminate
method _terminate
{
<primitive: #_process_terminate>
self primitiveFailed
}
#method _suspend
method _suspend
{
<primitive: #_process_suspend>
self primitiveFailed
}
#method terminate
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,
@ -80,28 +80,28 @@
^self _terminate
}
#method yield
method yield
{
<primitive: #_process_yield>
self primitiveFailed
}
#method sp
method sp
{
^self.sp.
}
#method initialContext
method initialContext
{
^self.initial_context
}
}
#class Semaphore(Object)
class Semaphore(Object)
{
#dcl count waiting_head waiting_tail heapIndex fireTimeSec fireTimeNsec.
dcl count waiting_head waiting_tail heapIndex fireTimeSec fireTimeNsec.
#method(#class) forMutualExclusion
method(#class) forMutualExclusion
{
| sem |
sem := self new.
@ -109,7 +109,7 @@
^sem
}
#method initialize
method initialize
{
self.count := 0.
self.heapIndex := -1.
@ -119,31 +119,31 @@
## ==================================================================
#method signal
method signal
{
<primitive: #_semaphore_signal>
self primitiveFailed.
}
#method wait
method wait
{
<primitive: #_semaphore_wait>
self primitiveFailed.
}
#method waitWithTimeout: seconds
method waitWithTimeout: seconds
{
<primitive: #_semaphore_wait>
self primitiveFailed
}
#method waitWithTimeout: seconds and: nanoSeconds
method waitWithTimeout: seconds and: nanoSeconds
{
<primitive: #_semaphore_wait>
self primitiveFailed
}
#method critical: aBlock
method critical: aBlock
{
self wait.
^aBlock ensure: [ self signal ]
@ -151,53 +151,53 @@
## ==================================================================
#method heapIndex
method heapIndex
{
^heapIndex
}
#method heapIndex: anIndex
method heapIndex: anIndex
{
heapIndex := anIndex
}
#method fireTime
method fireTime
{
^fireTimeSec
}
#method fireTime: anInteger
method fireTime: anInteger
{
self.fireTimeSec := anInteger.
}
#method youngerThan: aSemaphore
method youngerThan: aSemaphore
{
^self.fireTimeSec < (aSemaphore fireTime)
}
}
#class SemaphoreHeap(Object)
class SemaphoreHeap(Object)
{
#dcl arr size.
dcl arr size.
#method initialize
method initialize
{
self.size := 0.
self.arr := Array new: 100.
}
#method size
method size
{
^self.size
}
#method at: anIndex
method at: anIndex
{
^self.arr at: anIndex.
}
#method insert: aSemaphore
method insert: aSemaphore
{
| index |
@ -217,7 +217,7 @@
^self siftUp: index
}
#method popTop
method popTop
{
| top |
@ -226,7 +226,7 @@
^top
}
#method updateAt: anIndex with: aSemaphore
method updateAt: anIndex with: aSemaphore
{
| item |
@ -241,7 +241,7 @@
ifFalse: [ self siftDown: anIndex ].
}
#method deleteAt: anIndex
method deleteAt: anIndex
{
| item |
@ -268,22 +268,22 @@
]
}
#method parentIndex: anIndex
method parentIndex: anIndex
{
^(anIndex - 1) quo: 2
}
#method leftChildIndex: anIndex
method leftChildIndex: anIndex
{
^(anIndex * 2) + 1.
}
#method rightChildIndex: anIndex
method rightChildIndex: anIndex
{
^(anIndex * 2) + 2.
}
#method siftUp: anIndex
method siftUp: anIndex
{
| pindex cindex par item stop |
@ -319,7 +319,7 @@
^cindex
}
#method siftDown: anIndex
method siftDown: anIndex
{
| base capa cindex item |
@ -359,22 +359,22 @@
}
}
#class ProcessScheduler(Object)
class ProcessScheduler(Object)
{
#dcl tally active runnable_head runnable_tail sem_heap.
dcl tally active runnable_head runnable_tail sem_heap.
#method new
method new
{
"instantiation is not allowed"
^nil. "TODO: raise an exception"
}
#method activeProcess
method activeProcess
{
^self.active.
}
#method resume: process
method resume: process
{
<primitive: #_processor_schedule>
self primitiveFailed.
@ -396,45 +396,45 @@
}
"
#method yield
method yield
{
<primitive: #_processor_yield>
self primitiveFailed
}
"
#method signal: semaphore after: secs
method signal: semaphore after: secs
{
<primitive: #_processor_add_timed_semaphore>
self primitiveFailed.
}
#method signal: semaphore after: secs and: nanosecs
method signal: semaphore after: secs and: nanosecs
{
<primitive: #_processor_add_timed_semaphore>
self primitiveFailed.
}
#method unsignal: semaphore
method unsignal: semaphore
{
<primitive: #_processor_remove_semaphore>
self primitiveFailed.
}
"#method signal: semaphore onInput: file
"method signal: semaphore onInput: file
{
}"
"#method signal: semaphore onOutput: file
"method signal: semaphore onOutput: file
{
}"
#method return: object to: context
method return: object to: context
{
<primitive: #_processor_return_to>
self primitiveFailed.
}
#method sleepFor: secs
method sleepFor: secs
{
## -----------------------------------------------------
## put the calling process to sleep for given seconds.
@ -445,7 +445,7 @@
s wait.
}
#method sleepFor: secs and: nanosecs
method sleepFor: secs and: nanosecs
{
## -----------------------------------------------------
## put the calling process to sleep for given seconds.

39
stix/kernel/Stdio.st
View File

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

352
stix/kernel/Stix.st
View File

@ -1,343 +1,23 @@
#include 'Apex.st'.
#include 'Class.st'.
#include 'Boolean.st'.
#########################################################################################
#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 key
{
^self.key
}
#method value
{
^self.value
}
}
#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.
}
}
#########################################################################################
#include 'Collect.st'.
#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
{
^(self.preamble bitAnd: 16rFF) bitShift: -2.
}
#method owner
{
^self.owner
}
#method name
{
^self.name
}
}
#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
class FFI(Object)
{
dcl name handle funcs.
method(#class) new: aString
{
^self new open: aString.
}
#method open: aString
method open: aString
{
self.funcs := Dictionary new.
self.name := aString.
@ -353,13 +33,13 @@
^self.
}
#method close
method close
{
self privateClose: self.handle.
self.handle := nil.
}
#method call: aFunctionName withSig: aString withArgs: anArray
method call: aFunctionName withSig: aString withArgs: anArray
{
| f |
@ -375,23 +55,23 @@ f isNil ifTrue: [ self error: 'No such function' ].
^self privateCall: f withSig: aString withArgs: anArray
}
#method privateOpen: aString
method privateOpen: aString
{
<primitive: #_ffi_open>
^nil. ## TODO: Error signal: 'can not open'
}
#method privateClose: aHandle
method privateClose: aHandle
{
<primitive: #_ffi_close>
}
#method privateCall: aSymbol withSig: aString withArgs: anArray
method privateCall: aSymbol withSig: aString withArgs: anArray
{
<primitive: #_ffi_call>
}
#method privateGetSymbol: aString in: aHandle
method privateGetSymbol: aString in: aHandle
{
<primitive: #_ffi_getsym>
^nil.

11
stix/kernel/generr.st
View File

@ -1,8 +1,8 @@
#include 'Stix.st'.
#class MyObject(Object)
class MyObject(Object)
{
#method(#class) main
method(#class) main
{
| errmsgs synerrmsgs f |
@ -72,7 +72,8 @@
'undefined class'
'duplicate class'
'contradictory class definition'
'#dcl not allowed'
'wrong class name'
'dcl not allowed'
'wrong method name'
'duplicate method name'
'duplicate argument name'
@ -109,7 +110,7 @@
f close.
}
#method(#class) emitMessages: errmsgs named: name on: f
method(#class) emitMessages: errmsgs named: name on: f
{
| c prefix |
prefix := name & '_'.
@ -134,7 +135,7 @@
f puts: S'};\n'.
}
#method(#class) printString: s prefix: prefix index: index on: f
method(#class) printString: s prefix: prefix index: index on: f
{
| c |
c := s size - 1.

24
stix/kernel/test-001.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -47,17 +47,17 @@
^self xxxx.
}
#method(#class) zzz
method(#class) zzz
{
'zzzzzzzzzzzzzzzzzz' dump.
^self.
}
#method(#class) yyy
method(#class) yyy
{
^[123456789 dump. ^200].
}
#method(#class) main
method(#class) main
{
'START OF MAIN' dump.
['1111111' dump. '111111111' dump. '22222222222' dump.

28
stix/kernel/test-002.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -47,17 +47,17 @@
^self xxxx.
}
#method(#class) zzz
method(#class) zzz
{
'zzzzzzzzzzzzzzzzzz' dump.
^self.
}
#method(#class) yyy
method(#class) yyy
{
^[123456789 dump. ^200].
}
#method(#class) main2
method(#class) main2
{
'START OF MAIN2' dump.
##[thisContext dump. ^100] newProcess resume.
@ -70,14 +70,14 @@
'EDN OF MAIN2' dump.
}
#method(#class) main1
method(#class) main1
{
'START OF MAIN1' dump.
self main2.
'END OF MAIN1' dump.
}
#method(#class) main
method(#class) main
{
'START OF MAIN' dump.
self main1.

20
stix/kernel/test-003.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -47,7 +47,7 @@
^self xxxx.
}
#method(#class) main
method(#class) main
{
'START OF MAIN' dump.
'EDN OF MAIN' dump.

20
stix/kernel/test-004.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -47,7 +47,7 @@
^self xxxx.
}
#method(#class) main
method(#class) main
{
'START OF MAIN' dump.
Processor activeProcess terminate.

60
stix/kernel/test-005.st
View File

@ -9,50 +9,50 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) t1 t2.
dcl(#class) Q R.
dcl(#classinst) t1 t2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#dcl(#class) C B A.
dcl(#class) C B A.
#method getTrue
method getTrue
{
^true.
}
#method getTrue: anInteger
method getTrue: anInteger
{
^ anInteger
}
#method getFalse
method getFalse
{
^false
}
#method yyy: aBlock
method yyy: aBlock
{
| a |
a := aBlock value.
@ -62,14 +62,14 @@
##a := Stix.MyCOM.HashTable new.
}
#method xxx: aBlock
method xxx: aBlock
{
| a |
a := self yyy: aBlock.
'KKKKKKKKKKKKKKKKKKKKKKKKKKKKK' dump.
^a.
}
#method(#class) main2
method(#class) main2
{
| a b c sum |
@ -139,7 +139,7 @@
##a dump.
}
#method(#class) main55
method(#class) main55
{
|a b c|
@ -148,7 +148,7 @@
## [ b < 5 ] whileTrue: [ b dump. b := b + 1 ].
}
#method(#class) getTen
method(#class) getTen
{
^10
}
@ -158,7 +158,7 @@
" this sample demonstrates what happens when a block context returns to the origin's caller
after the caller has already returned. "
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -168,7 +168,7 @@
t1 := t1 + 1.
self xxxx
}
#method(#class) yyyy
method(#class) yyyy
{
|c1|
t1 := 1.
@ -177,14 +177,14 @@
999 dump.
^c1.
}
#method(#class) main66
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
method(#class) mainj
{
|k1|
t1 := 1.
@ -195,7 +195,7 @@
}
## ----------------------------------------------------------------------
#method(#class) main22
method(#class) main22
{
|a b c d e f g h i j k sum |
@ -224,31 +224,31 @@
[self getTen] value dump.
}
#method(#class) abc
method(#class) abc
{
<primitive: #snd_open>
}
#method(#class) a: a b: b c: c
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
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
method(#class) a: a b: b c: c d: d e: e f: f g: g
{
g dump.
}
#method(#class) getABlock
method(#class) getABlock
{
^ [ 'a block returned by getABlock' dump. "^ self"]
}
#method(#class) main
method(#class) main
{
"
| ffi |
@ -502,12 +502,12 @@ self represents the receiver. that is bc->origin->receiver which is mc1->receive
--------------------------------------------------------------------------------
#method ifTrue: trueBlock
method ifTrue: trueBlock
{
^trueBlock value.
}
#method whileTrue: aBlock
method whileTrue: aBlock
{
(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
}

36
stix/kernel/test-006.st
View File

@ -9,59 +9,59 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) t1 t2.
dcl(#class) Q R.
dcl(#classinst) t1 t2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#dcl(#class) C B A.
dcl(#class) C B A.
#method getTrue
method getTrue
{
^true.
}
#method getTrue: anInteger
method getTrue: anInteger
{
^ anInteger
}
#method getFalse
method getFalse
{
^false
}
#method a { ^ 10 }
#method b { ^ 20 }
#method c { ^ 30 }
method a { ^ 10 }
method b { ^ 20 }
method c { ^ 30 }
#method(#class) a: a b: b c: c
method(#class) a: a b: b c: c
{
^ a + b + c.
}
#method(#class) getBlock
method(#class) getBlock
{
| a |
a := 7777777.
@ -73,7 +73,7 @@
^[self a: a b: 3 c: ([[[^6] value] value ] value)].
}
#method(#class) main
method(#class) main
{
"
| k |

34
stix/kernel/test-007.st
View File

@ -9,59 +9,59 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) t1 t2.
dcl(#class) Q R.
dcl(#classinst) t1 t2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#dcl(#class) C B A.
dcl(#class) C B A.
#method getTrue
method getTrue
{
^true.
}
#method getTrue: anInteger
method getTrue: anInteger
{
^ anInteger
}
#method getFalse
method getFalse
{
^false
}
#method a { ^ 10 }
#method b { ^ 20 }
#method c { ^ 30 }
method a { ^ 10 }
method b { ^ 20 }
method c { ^ 30 }
#method(#class) a: a b: b c: c
method(#class) a: a b: b c: c
{
^ a + b + c.
}
#method(#class) main
method(#class) main
{
| p p2 |
'START OF MAIN' dump.

20
stix/kernel/test-008.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2 t3.
#method(#class) xxxx
method(#class) xxxx
{
| g1 g2 |
t1 dump.
@ -48,7 +48,7 @@
^self xxxx.
}
#method(#class) main
method(#class) main
{
t3 := ['1111' dump. ^20.].
t1 := 1.

22
stix/kernel/test-009.st
View File

@ -9,43 +9,43 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#declare(#classinst) t1 t2.
#method(#class) main2
method(#class) main2
{
'START OF MAIN2' dump.
t1 value.
'END OF MAIN2' dump.
}
#method(#class) main1
method(#class) main1
{
'START OF MAIN1' dump.
self main2.
@ -54,7 +54,7 @@
}
#method(#class) main
method(#class) main
{
'START OF MAIN' dump.
t1 := ['BLOCK #1' dump. ^100].

40
stix/kernel/test-010.st
View File

@ -9,55 +9,55 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test999
method test999
{
^self.Q
}
}
#class B.TestObject(Object)
class B.TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test000
method test000
{
^self.Q
}
}
#pooldic ABC
pooldic ABC
{
#KKK := 20.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#method(#class) main111
method(#class) main111
{
| s3 |
s3 := Semaphore new.
@ -67,7 +67,7 @@
}
#method(#class) main987
method(#class) main987
{
|t1 t2 s1 s2 s3|
@ -112,7 +112,7 @@
}
#method(#class) aaa_123
method(#class) aaa_123
{
| v1 |
v1 := [
@ -130,7 +130,7 @@
].
^v1
}
#method(#class) main
method(#class) main
{
| v1 |
'START OF MAIN' dump.
@ -171,7 +171,7 @@
'END OF MAIN' dump.
}
#method(#class) main22222
method(#class) main22222
{
|t1 t2 s1 s2 s3|
@ -211,7 +211,7 @@
'END OF MAIN' dump.
}
#method(#class) test_semaphore_heap
method(#class) test_semaphore_heap
{
| sempq a |
sempq := SemaphoreHeap new.

34
stix/kernel/test-011.st
View File

@ -9,35 +9,35 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#method(#class) main2
method(#class) main2
{
| k q |
'BEGINNING OF main2' dump.
@ -56,12 +56,12 @@
'END OF main2' dump.
}
#method(#class) raise_exception
method(#class) raise_exception
{
Exception signal: 'bad exceptinon'.
}
#method(#class) test3
method(#class) test3
{
| k j g_ex |
j := 20.
@ -90,7 +90,7 @@
'END OF TEST3' dump.
}
#method(#class) test4_1
method(#class) test4_1
{
| k j |
j := 20.
@ -113,7 +113,7 @@
'END OF TEST4_1' dump.
}
#method(#class) test4
method(#class) test4
{
'BEGINNING OF TEST4' dump.
[ self test4_1 ] on: Exception do: [:ex | 'Excepton in test4_1' dump. ex messageText dump. ex resume].
@ -121,7 +121,7 @@
}
#method(#class) test5
method(#class) test5
{
| k j |
'BEGINNING OF TEST5' dump.
@ -142,7 +142,7 @@
'END OF TEST5' dump.
}
#method(#class) test11
method(#class) test11
{
## exception is raised in a new process. it can't be captured
## by an exception handler of a calling process.
@ -157,7 +157,7 @@
'END OF test11' dump.
}
#method(#class) test12
method(#class) test12
{
'BEGINNING OF test12' dump.
[
@ -174,7 +174,7 @@
'END OF test12' dump.
}
#method(#class) main
method(#class) main
{
'>>>>> BEGINNING OF MAIN' dump.

30
stix/kernel/test-013.st
View File

@ -9,55 +9,55 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test999
method test999
{
^self.Q
}
}
#class B.TestObject(Object)
class B.TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test000
method test000
{
^self.Q
}
}
#pooldic ABC
pooldic ABC
{
#KKK := 20.
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#method(#class) main
method(#class) main
{
| v1 v2 |
System logNl: 'START OF MAIN'.

53
stix/kernel/test-014.st
View File

@ -9,58 +9,58 @@
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
extend Apex
{
}
#extend SmallInteger
extend SmallInteger
{
#method getTrue: anInteger
method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
method inc
{
^self + 1.
}
}
#class TestObject(Object)
class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test999
method test999
{
^self.Q
}
}
#class B.TestObject(Object)
class B.TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) a1 a2.
dcl(#class) Q R.
dcl(#classinst) a1 a2.
#method test000
method test000
{
^self.Q
}
}
#pooldic ABC
pooldic ABC
{
#KKK := 20.
}
#pooldic SRX.ABC
pooldic SRX.ABC
{
#JJJ := 1000.
}
#class MyConsole(Console)
class MyConsole(Console)
{
#method box: origin corner: corner
method box: origin corner: corner
{
| tmp |
self setCursor: origin.
@ -88,11 +88,11 @@
}
}
#class MyObject(TestObject)
class MyObject(TestObject)
{
#dcl(#pooldic) ABC SRX.ABC.
dcl(#pooldic) ABC SRX.ABC.
#method(#class) main
method(#class) main
{
| v1 v2 |
@ -190,23 +190,26 @@
(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()
method(#class) varg_test()
{
0 to: (thisContext vargCount - 1) do: [:k |
(thisContext vargAt: k) dump.
].
^999
}
#method(#class) varg_test2(a,b,c)
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)
method(#class) varg_test3(a,b,c,d,e,f)
{
0 to: (thisContext vargCount - 1) do: [:k |
(thisContext vargAt: k) dump.
@ -215,7 +218,7 @@
^f
}
#method(#class) t001(a)
method(#class) t001(a)
{
a isNil ifTrue: [^error(10)].
(a = 20) ifTrue: [^error].
@ -230,9 +233,9 @@
}
}
#extend MyObject
extend MyObject
{
#method(#class) main2
method(#class) main2
{
System logNl: KKK.
System logNl: SRX.ABC.JJJ.