diff --git a/moo/kernel/Apex.moo b/moo/kernel/Apex.moo index 066ba01..601b088 100644 --- a/moo/kernel/Apex.moo +++ b/moo/kernel/Apex.moo @@ -23,7 +23,7 @@ class(#limited) Error(Apex) } } -(* +/* pooldic Error.Code { ENOERR := #\E0. @@ -40,9 +40,9 @@ pooldic Error.Code ELIMIT := #\E9999. ## add more items... -} *) +} */ -(*pooldic Error.Code2 +/*pooldic Error.Code2 { >> CAN I SUPPORT this kind of redefnition? as of now, it's not accepted because >> Error.Code2.EGENERIC is not a literal. Should i treate pooldic members as a constant @@ -50,7 +50,7 @@ pooldic Error.Code >> the definition here won't see the change... what is the best way to tackle this issue? EGENERIC := Error.Code2.EGENERIC. -}*) +}*/ extend Apex { @@ -73,7 +73,7 @@ extend Apex method(#class,#primitive) basicNew. method(#class,#primitive) basicNew: size. - (* the following definition is almost equivalent to the simpler definition + /* the following definition is almost equivalent to the simpler definition * method(#class,#primitive) basicNew: size. * found above. * in the following defintion, the primitiveFailed method is executed @@ -84,7 +84,7 @@ extend Apex { self primitiveFailed(thisContext method) - }*) + }*/ method(#class) new { @@ -104,7 +104,7 @@ extend Apex method initialize { - (* a subclass may override this method *) + /* a subclass may override this method */ ^self. } @@ -126,27 +126,27 @@ extend Apex method(#dual,#primitive) basicFillFrom: sindex with: value count: count. method(#dual,#primitive) basicShiftFrom: sindex to: dindex count: count. - (* ------------------------------------------------------------------ + /* ------------------------------------------------------------------ * FINALIZATION SUPPORT - * ------------------------------------------------------------------ *) + * ------------------------------------------------------------------ */ method(#dual,#primitive) addToBeFinalized. method(#dual,#primitive) removeToBeFinalized. - (* ------------------------------------------------------------------ + /* ------------------------------------------------------------------ * HASHING - * ------------------------------------------------------------------ *) + * ------------------------------------------------------------------ */ method(#dual,#primitive) hash. - (* + /* method(#dual) hash { self subclassResponsibility: #hash - }*) + }*/ - (* ------------------------------------------------------------------ + /* ------------------------------------------------------------------ * IDENTITY TEST - * ------------------------------------------------------------------ *) + * ------------------------------------------------------------------ */ ## check if the receiver is identical to anObject. ## this doesn't compare the contents @@ -158,9 +158,9 @@ extend Apex ^(self == anObject) not. } - (* ------------------------------------------------------------------ + /* ------------------------------------------------------------------ * EQUALITY TEST - * ------------------------------------------------------------------ *) + * ------------------------------------------------------------------ */ method(#dual) = anObject { self primitiveFailed. } method ~= anObject { - (* for a symbol, equality check is the same as the identity check *) + /* for a symbol, equality check is the same as the identity check */ ^(self == anObject) not. } @@ -353,7 +353,7 @@ class(#byte) ByteArray(Array) self primitiveFailed(thisContext method). - (* + /* ### TODO: implement this in moo also.. | firstByte | firstByte := self at: 0. @@ -363,7 +363,7 @@ class(#byte) ByteArray(Array) elsif (firstByte bitAnd:2r11110000) == 2r11100000) { 4 } elsif (firstByte bitAnd:2r11111000) == 2r11110000) { 5 } elsif (firstByte bitAnd:2r11111100) == 2r11111000) { 6 }. - *) + */ } } @@ -718,7 +718,7 @@ class OrderedCollection(SequenceableCollection) self.buffer at: self.lastIndex put: nil. } - (* + /* method findIndex: obj { | i | @@ -731,7 +731,7 @@ class OrderedCollection(SequenceableCollection) }. ^Error.Code.ENOENT. - } *) + } */ } @@ -780,7 +780,7 @@ class Set(Collection) { | newbuc newsz ass index i | - (* expand the bucket *) + /* expand the bucket */ newsz := bs + 16. ## TODO: make this sizing operation configurable. newbuc := Array new: newsz. i := 0. @@ -846,12 +846,12 @@ class Set(Collection) y := (y + 1) rem: bs. ass := self.bucket at: y. - if (ass isNil) { (* done. the slot at the current index is nil *) break }. + if (ass isNil) { /* done. the slot at the current index is nil */ break }. - (* get the natural hash index *) + /* get the natural hash index */ z := (ass key hash) rem: bs. - (* move an element if necessary *) + /* move an element if necessary */ if (((y > x) and ((z <= x) or (z > y))) or ((y < x) and ((z <= x) and (z > y)))) { self.bucket at: x put: (self.bucket at: y). @@ -864,7 +864,7 @@ class Set(Collection) self.bucket at: x put: nil. self.tally := self.tally - 1. - (* return the affected association *) + /* return the affected association */ ^v } @@ -988,8 +988,8 @@ class AssociativeCollection(Collection) { | newbuc newsz ass index i | - (* expand the bucket *) - newsz := bs + 128. (* TODO: keep this growth policy in sync with VM(dic.c) *) + /* expand the bucket */ + newsz := bs + 128. /* TODO: keep this growth policy in sync with VM(dic.c) */ newbuc := Array new: newsz. i := 0. while (i < bs) @@ -1019,7 +1019,7 @@ class AssociativeCollection(Collection) { if (key = ass key) { - (* found *) + /* found */ if (upsert) { ass value: value }. ^ass }. @@ -1134,12 +1134,12 @@ class AssociativeCollection(Collection) y := (y + 1) rem: bs. ass := self.bucket at: y. - if (ass isNil) { (* done. the slot at the current index is nil *) break }. + if (ass isNil) { /* done. the slot at the current index is nil */ break }. - (* get the natural hash index *) + /* get the natural hash index */ z := (ass key hash) rem: bs. - (* move an element if necessary *) + /* move an element if necessary */ if (((y > x) and ((z <= x) or (z > y))) or ((y < x) and ((z <= x) and (z > y)))) { self.bucket at: x put: (self.bucket at: y). @@ -1174,19 +1174,19 @@ class AssociativeCollection(Collection) method removeAllKeys { - (* remove all items from a dictionary *) + /* 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. +/* TODO: ... keys is an array of keys. method removeAllKeys: keys { self notImplemented: #removeAllKeys: } -*) +*/ method remove: assoc { @@ -1282,10 +1282,10 @@ class SymbolTable(AssociativeCollection) class Dictionary(AssociativeCollection) { - (* [NOTE] + /* [NOTE] * VM require Dictionary to implement new: and __put_assoc * for the dictionary expression notation - %{ } - *) + */ ## TODO: implement Dictionary as a Hashed List/Table or Red-Black Tree ## Do not inherit Set upon reimplementation @@ -1295,14 +1295,14 @@ class Dictionary(AssociativeCollection) ^super new: (capacity + 10). } - (* put_assoc: is called internally by VM to add an association + /* put_assoc: is called internally by VM to add an association * to a dictionary with the dictionary/association expression notation * like this: * * %{ 1 -> 20, #moo -> 999 } * * it must return self for the way VM works. - *) + */ method __put_assoc: assoc { | hv ass bs index ntally key | @@ -1312,22 +1312,22 @@ class Dictionary(AssociativeCollection) hv := key hash. index := hv rem: bs. - (* as long as 'assoc' supports the message 'key' and 'value' + /* as long as 'assoc' supports the message 'key' and 'value' * this dictionary should work. there is no explicit check - * on this protocol of key and value. *) + * on this protocol of key and value. */ while ((ass := self.bucket at: index) notNil) { if (key = ass key) { - (* found *) + /* found */ self.bucket at: index put: assoc. ^self. ## it must return self for the instructions generated by the compiler. }. index := (index + 1) rem: bs. }. - (* not found *) + /* not found */ ntally := self.tally + 1. if (ntally >= bs) { @@ -1340,15 +1340,15 @@ class Dictionary(AssociativeCollection) self.tally := ntally. self.bucket at: index put: assoc. - (* it must return self for the instructions generated by the compiler. - * otherwise, VM will break. *) + /* it must return self for the instructions generated by the compiler. + * otherwise, VM will break. */ ^self. } } -(* Namespace is marked with #limited. If a compiler is writeen in moo itself, it must +/* Namespace is marked with #limited. If a compiler is writeen in moo itself, it must * call a primitive to instantiate a new namespace rather than sending the new message - * to Namespace *) + * to Namespace */ class(#limited) Namespace(AssociativeCollection) { var name, nsup. @@ -1356,10 +1356,10 @@ class(#limited) Namespace(AssociativeCollection) method name { ^self.name } ## method name: name { self.name := name } - (* nsup points to either the class associated with this namespace or directly + /* nsup points to either the class associated with this namespace or directly * the upper namespace placed above this namespace. when it points to a class, * you should inspect the nsup field of the class to reach the actual upper - * namespace *) + * namespace */ method nsup { ^self.nsup } ## method nsup: nsup { self.nsup := nsup } @@ -1452,7 +1452,7 @@ class LinkedList(Collection) { if (pos isNil) { - (* add link at the back *) + /* add link at the back */ if (self.tally == 0) { self.first := link. @@ -1469,7 +1469,7 @@ class LinkedList(Collection) } else { - (* insert the link before pos *) + /* insert the link before pos */ link next: pos. link prev: pos prev. if (pos prev notNil) { pos prev next: link } diff --git a/moo/kernel/Console.moo b/moo/kernel/Console.moo index 0f9e7e8..0498a56 100644 --- a/moo/kernel/Console.moo +++ b/moo/kernel/Console.moo @@ -55,14 +55,14 @@ class Console(Object) from 'con' method(#primitive) _setcursor(x, y). method(#primitive) _write(msg). -(* +/* method finalize { if (still open) { self _close. } } -*) +*/ ## method(#class) input diff --git a/moo/kernel/Context.moo b/moo/kernel/Context.moo index 389a4bb..586d946 100644 --- a/moo/kernel/Context.moo +++ b/moo/kernel/Context.moo @@ -17,7 +17,7 @@ class(#pointer) Context(Apex) ^self.ntmprs } -(* --------------------------------- +/* --------------------------------- method varargCount { method context, @@ -39,7 +39,7 @@ block context... ^self.home varargAt: index } ----------------------------------- *) +---------------------------------- */ } class(#pointer,#final,#limited) MethodContext(Context) @@ -161,7 +161,7 @@ class(#pointer,#final,#limited) BlockContext(Context) method ifFalse: aBlock { ##^(self value) ifFalse: aBlock. - ^if (self value) { (* nothing *) } else { aBlock value }. + ^if (self value) { /* nothing */ } else { aBlock value }. } method ifTrue: trueBlock ifFalse: falseBlock @@ -172,15 +172,15 @@ class(#pointer,#final,#limited) BlockContext(Context) method whileTrue: aBlock { - (* -------------------------------------------------- + /* -------------------------------------------------- * Naive recursive implementation * -------------------------------------------------- (self value) ifFalse: [^nil]. aBlock value. self whileTrue: aBlock. - * -------------------------------------------------- *) + * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Non-recursive implementation * -------------------------------------------------- | pc sp | @@ -197,22 +197,22 @@ class(#pointer,#final,#limited) BlockContext(Context) thisContext goto: pc. * -------------------------------------------------- *( - (* -------------------------------------------------- + /* -------------------------------------------------- * Imperative implementation - == true or ~~ false? match the VM implementation - * -------------------------------------------------- *) + * -------------------------------------------------- */ while ((self value) ~~ false) { aBlock value }. } method whileTrue { - (* -------------------------------------------------- + /* -------------------------------------------------- * Naive recursive implementation * -------------------------------------------------- (self value) ifFalse: [^nil]. self whileTrue. * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Non-recursive implementation * -------------------------------------------------- | pc | @@ -221,23 +221,23 @@ class(#pointer,#final,#limited) BlockContext(Context) thisContext goto: pc. * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Imperative implementation - * -------------------------------------------------- *) + * -------------------------------------------------- */ while ((self value) ~~ false) { }. } method whileFalse: aBlock { - (* -------------------------------------------------- + /* -------------------------------------------------- * Naive recursive implementation * -------------------------------------------------- (self value) ifTrue: [^nil]. aBlock value. self whileFalse: aBlock. - * -------------------------------------------------- *) + * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Non-recursive implementation * -------------------------------------------------- * The assignment to 'pc' uses the POP_INTO_TEMPVAR_1. @@ -257,31 +257,31 @@ class(#pointer,#final,#limited) BlockContext(Context) (self value) ifTrue: [ ^nil ]. ## ^self aBlock value. thisContext goto: pc. - * -------------------------------------------------- *) + * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Imperative implementation - * -------------------------------------------------- *) + * -------------------------------------------------- */ while ((self value) == false) { aBlock value }. } method whileFalse { - (* -------------------------------------------------- + /* -------------------------------------------------- * Naive recursive implementation * -------------------------------------------------- (self value) ifTrue: [^nil]. self whileFalse. - * -------------------------------------------------- *) + * -------------------------------------------------- */ - (* -------------------------------------------------- + /* -------------------------------------------------- * Non-recursive implementation * -------------------------------------------------- | pc | pc := thisContext pcplus1. (self value) ifTrue: [ ^nil ]. ## ^self thisContext goto: pc. - * -------------------------------------------------- *) + * -------------------------------------------------- */ while ((self value) == false) { }. } @@ -324,7 +324,7 @@ class(#pointer) CompiledMethod(Object) method preambleCode { - (* TODO: make this a primtive for performance *) + /* TODO: make this a primtive for performance */ ^(self.preamble bitShift: -4) bitAnd: 16r1F. } diff --git a/moo/kernel/Except.moo b/moo/kernel/Except.moo index 81864c0..d3663f8 100644 --- a/moo/kernel/Except.moo +++ b/moo/kernel/Except.moo @@ -9,7 +9,7 @@ class Exception(Apex) var signalContext, handlerContext. var(#get) messageText. -(* +/* TODO: can i convert 'thisProcess primError' to a relevant exception? var(#class) primExceptTable. @@ -17,7 +17,7 @@ TODO: can i convert 'thisProcess primError' to a relevant exception? { ^self.primExceptTable at: no } -*) +*/ method(#class) signal { @@ -182,8 +182,8 @@ extend Context eb := ctx ensureBlock. if (eb notNil) { - (* position of the temporary variable in the ensureBlock that indicates - * if the block has been evaluated *) + /* position of the temporary variable in the ensureBlock that indicates + * if the block has been evaluated */ pending_pos := ctx basicSize - 1. if (ctx basicAt: pending_pos) { @@ -246,21 +246,21 @@ extend MethodContext method findExceptionHandlerFor: exception_class { - (* find an exception handler block for a given 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 *) + * basicAt: 9 must be the do: argument */ | size exc i | if (self isExceptionContext) { - (* NOTE: the following loop scans all parameters to the on:do: method. + /* 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. *) + * those must be skipped from scanning. */ size := self basicSize. ##8 priorTo: size by: 2 do: [ :i | @@ -285,7 +285,7 @@ extend MethodContext method handleException: exception { - (* ----------------------------------------------------------------- + /* ----------------------------------------------------------------- * <> * called by Exception>>signal. * this method only exists in the MethodContext and UndefinedObject. @@ -293,12 +293,12 @@ extend MethodContext * 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 'exception_active' in MethodContext>>on:do. - * for this code to work, it must be the last temporary variable in the method. *) + /* position of the temporary variable 'exception_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). @@ -312,13 +312,13 @@ extend MethodContext 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 @@ -326,11 +326,11 @@ extend MethodContext ##(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. System return: retval to: self.sender. } @@ -344,14 +344,14 @@ extend BlockContext | exception_active | -(* ------------------------------- +/* ------------------------------- 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. } @@ -380,9 +380,9 @@ thisContext isExceptionContext dump. pending := true. retval := self value. - (* the temporary variable 'pending' may get changed + /* the temporary variable 'pending' may get changed * during evaluation for exception handling. - * it gets chagned in Context>>unwindTo:return: *) + * it gets chagned in Context>>unwindTo:return: */ if (pending) { pending := false. aBlock value }. ^retval } @@ -476,7 +476,7 @@ extend Apex { | a b msg ec ex | - (* since method is an argument, the caller can call this method + /* since method is an argument, the caller can call this method * from a context chain where the method context actually doesn't exist. * when a primitive method is defined using the #primitive method, * the VM invokes this primtiveFailed method without creating @@ -488,16 +488,16 @@ extend Apex * on the other handle, in the latter definition, the context * for the method is activated first before primitiveFailed is * invoked. in the context chain, the method for xxx is found. - *) + */ - (*System logNl: 'Arguments: '. + /*System logNl: 'Arguments: '. a := 0. b := thisContext vargCount. while (a < b) { System logNl: (thisContext vargAt: a) asString. a := a + 1. - }.*) + }.*/ ec := thisProcess primError. msg := thisProcess primErrorMessage. @@ -509,7 +509,7 @@ extend Apex ### elsif (ec == Error.Code.EPERM) { self messageProhibited: method name } ### elsif (ec == Error.Code.ENOIMPL) { self subclassResponsibility: method name }. - (PrimitiveFailureException (* in: method *) withErrorCode: ec) signal: msg. + (PrimitiveFailureException /* in: method */ withErrorCode: ec) signal: msg. } method(#dual) doesNotUnderstand: message_name diff --git a/moo/kernel/FFI.moo b/moo/kernel/FFI.moo index 283bc36..e04c0f1 100644 --- a/moo/kernel/FFI.moo +++ b/moo/kernel/FFI.moo @@ -4,7 +4,7 @@ class _FFI(Object) from 'ffi' method(#primitive) close. method(#primitive) getsym(name). - (* TODO: make call variadic? method(#primitive,#variadic) call (func, sig). *) + /* TODO: make call variadic? method(#primitive,#variadic) call (func, sig). */ method(#primitive) call(func, sig, args). } @@ -48,12 +48,12 @@ class FFI(Object) { | f rc | - (* f := self.funcs at: name ifAbsent: [ + /* f := self.funcs at: name ifAbsent: [ f := self.ffi getsym(name). if (f isError) { FFIException signal: ('Unable to find %s' strfmt(name)) }. self.funcs at: name put: f. f. ## need this as at:put: returns an association - ]. *) + ]. */ f := self.funcs at: name ifAbsent: [ nil ]. if (f isNil) diff --git a/moo/kernel/Fcgi.moo b/moo/kernel/Fcgi.moo index ca4e319..327195a 100644 --- a/moo/kernel/Fcgi.moo +++ b/moo/kernel/Fcgi.moo @@ -1,11 +1,11 @@ ###include 'Moo.moo'. #include 'Socket.moo'. -(* ------------------------------------------- +/* ------------------------------------------- - ----------------------------------------------- *) + ----------------------------------------------- */ class Fcgi(Object) { @@ -220,7 +220,7 @@ class Fcgi.ParamRecord(Fcgi.Record) if (aString notNil) { ### TODO: implement this... -(* +/* (aString subStrings: %(char)) do: [:each | equal := each indexOf: $=. equal = 0 @@ -229,7 +229,7 @@ class Fcgi.ParamRecord(Fcgi.Record) tempFields at: (each first: equal - 1) put: (each allButFirst: equal)] - ] *) + ] */ }. ^tempFields @@ -239,10 +239,10 @@ class Fcgi.ParamRecord(Fcgi.Record) { | buffer stream | buffer := aStream next: header contentLength. -(* TODO: +/* TODO: stream := ReadStream on: buffer. [stream atEnd] whileFalse: [self readNameValueFrom: stream] -*) +*/ } method readNameValueFrom: aStream @@ -396,11 +396,11 @@ class FcgiSocket(SyncSocket) | buf k i hdr | self timeout: 10. - (*while (true) + /*while (true) { req := self readRequest. - }. *) + }. */ buf := ByteArray new: 128. 'IM RUNNING SERVICE...............' dump. @@ -416,14 +416,14 @@ class FcgiSocket(SyncSocket) ## unsigned char paddingLength; ## unsigned char reserved; ## } FCGI_Header; -(* +/* ver := self.bs next. type := self.bs next. reqid := (self.bs next bitShift: 8) bitAnd: (self.bs next). ## can i implement nextUint16?? clen := (self.bs next bitShift: 8) bitAnd: (self.bs next). plen := self.bs next. self.bs next. ## eat up the reserved byte. -*) +*/ ## typedef struct { ## unsigned char roleB1; @@ -440,12 +440,12 @@ class FcgiSocket(SyncSocket) ## unsigned char reserved[3]; ## } FCGI_EndRequestBody; -(* +/* if (type == Fcgi.Type.BEGIN_REQUEST) { - } *) + } */ -(* +/* i := 0. while (i < 3) { @@ -459,7 +459,7 @@ class FcgiSocket(SyncSocket) self.bs nextPut: k from: buf startingAt: 10. }. self.bs flush. -*) +*/ self close. } @@ -764,7 +764,7 @@ oc := Fcgi.ParamRecord new. (oc parseToFields: 'a=b&d=f' separatedBy: $&) dump. thisProcess terminate. -(* +/* [ addr := SocketAddress fromString: '1.2.3.4:5555'. ##addr := SocketAddress fromString: '127.0.0.1:22'. @@ -772,7 +772,7 @@ fcgi := SyncSocket family: (addr family) type: Socket.Type.STREAM. fcgi timeout: 5. fcgi connect: addr. ] on: Exception do: [:ex | ]. -*) +*/ [ self another_proc: 5000 ] fork. [ self another_proc: 5100 ] fork. diff --git a/moo/kernel/Http.moo b/moo/kernel/Http.moo index ff166d5..6850873 100644 --- a/moo/kernel/Http.moo +++ b/moo/kernel/Http.moo @@ -117,22 +117,22 @@ class HttpSocket(SyncSocket) | buf k i | self timeout: 10. - (*while (true) + /*while (true) { req := self readRequest. - }. *) + }. */ buf := ByteArray new: 128. 'IM RUNNING SERVICE...............' dump. - (* + /* self readBytesInto: buf. buf dump. self readBytesInto: buf. buf dump. - *) + */ i := 0. while (i < 3) @@ -443,7 +443,7 @@ class MyObject(Object) { | httpd addr | -(* +/* [ addr := SocketAddress fromString: '1.2.3.4:5555'. ##addr := SocketAddress fromString: '127.0.0.1:22'. @@ -451,7 +451,7 @@ httpd := SyncSocket family: (addr family) type: Socket.Type.STREAM. httpd timeout: 5. httpd connect: addr. ] on: Exception do: [:ex | ]. -*) +*/ [ self another_proc: 5000 ] fork. [ self another_proc: 5100 ] fork. diff --git a/moo/kernel/Magnitu.moo b/moo/kernel/Magnitu.moo index 37c8011..3eab22c 100644 --- a/moo/kernel/Magnitu.moo +++ b/moo/kernel/Magnitu.moo @@ -245,8 +245,8 @@ class(#limited) Number(Magnitude) method bitShift: aNumber { - (* positive number for left shift. - * negative number for right shift *) + /* positive number for left shift. + * negative number for right shift */ self primitiveFailed. @@ -267,7 +267,7 @@ class(#limited) Number(Magnitude) { | i | i := self. - (* + /* (step > 0) ifTrue: [ [ i <= end ] whileTrue: [ @@ -281,7 +281,7 @@ class(#limited) Number(Magnitude) i := i - step. ]. ]. - *) + */ if (step > 0) { while (i <= end) @@ -309,7 +309,7 @@ class(#limited) Number(Magnitude) { | i | i := self. - (* + /* (step > 0) ifTrue: [ [ i < end ] whileTrue: [ @@ -323,7 +323,7 @@ class(#limited) Number(Magnitude) i := i - step. ]. ]. - *) + */ if (step > 0) { while (i < end) @@ -349,16 +349,16 @@ class(#limited) Number(Magnitude) method abs { - (*self < 0 ifTrue: [^self negated]. - ^self.*) + /*self < 0 ifTrue: [^self negated]. + ^self.*/ ^if (self < 0) { self negated } else { self } } method sign { - (* self < 0 ifTrue: [^-1]. + /* self < 0 ifTrue: [^-1]. self > 0 ifTrue: [^1]. - ^0.*) + ^0.*/ ^if (self < 0) { -1 } elsif (self > 0) { 1 } else { 0 } } } diff --git a/moo/kernel/Mill.moo b/moo/kernel/Mill.moo index 21bcca9..bcdce8a 100644 --- a/moo/kernel/Mill.moo +++ b/moo/kernel/Mill.moo @@ -43,10 +43,10 @@ class MyObject(Object) { | d a ffi | - (*k := Mill new. + /*k := Mill new. k register: #abc call: [ Dictionary new ]. a := k make: #abc. - ##a dump.*) + ##a dump.*/ d := Dictionary new. d at: #abc put: 20. @@ -55,9 +55,9 @@ class MyObject(Object) d at: #moo put: 'good?'. d at: #moo put: 'not good?'. - (* (d at: #abc) dump. - (* (d at: #dddd) dump. *) - (*d do: [:v | v dump].*) + /* (d at: #abc) dump. + /* (d at: #dddd) dump. */ + /*d do: [:v | v dump].*/ d keysAndValuesDo: [:k :v| System logNl: (k asString) & ' => ' & (v asString) ]. @@ -72,17 +72,17 @@ class MyObject(Object) (d at: #jjjj) dump. (d at: #jjjja) dump. - (* + /* System keysAndValuesDo: [:k :v| System logNl: (k asString) & ' => ' & (v asString) ]. - *) + */ ##System keysDo: [:k| System logNl: (k asString)] - (*[ + /*[ [Exception hash dump] ensure: ['xxxx' dump]. - ] on: Exception do: [:ex | ('Exception caught - ' & ex asString) dump ].*) + ] on: Exception do: [:ex | ('Exception caught - ' & ex asString) dump ].*/ ffi := FFI new: '/lib64/libc.so.6'. if (ffi isError) @@ -160,12 +160,12 @@ class MyObject(Object) ] ]) dump. - (* + /* a := 5. while (true) { System logNl: a asString. a := a + 100000000000000. - }.*) + }.*/ a := if(false) { 10 } elsif (false) { 20 } elsif (false) { 30} else { 40}. @@ -228,24 +228,24 @@ class MyObject(Object) #'a b c' ). - (* Dictionary ??? + /* Dictionary ??? a := %{ key -> value , key -> value , key -> value , key -> value ),. - *) + */ a do: [ :v | v dump]. -(* +/* ## how to handle return inside 'if' like the following??? ## what happens to the stack? a := if ((k := 20) == 10) {99} else { 100}. k dump. a dump. -*) +*/ '---------- END ------------' dump. ##System sleepForSecs: 20. } @@ -260,7 +260,7 @@ class MyObject(Object) a := 100. ## PROBLEM: the following double loop will exhaust the stack - (* + /* while (true) { ##111 dump. @@ -272,7 +272,7 @@ class MyObject(Object) ##[:j :q | (j + q) dump] value: 10 value: 20. ##if (false) {} else { break }. }. - }.*) + }.*/ a := %{ @@ -285,8 +285,8 @@ class MyObject(Object) 'ccc' -> 890 }. - (*a removeKey: 'bbb'. - a remove: :(#bbb).*) + /*a removeKey: 'bbb'. + a remove: :(#bbb).*/ ##1 to: 100 do: [ :i | a at: i put: (i * 2) ]. a keysAndValuesDo: [:k :v | @@ -296,7 +296,7 @@ class MyObject(Object) ]. (a associationAt: (#aaa -> nil)) dump. - (* + /* while (true) { while (true) @@ -304,12 +304,12 @@ class MyObject(Object) [:j :q | (j + q) dump] value: (if (true) { 20 }) value: (if (true) { break }). (1 + (if (false) {} else { break })) dump. } - }*) + }*/ - (* basicAt: 12 to access the nsdic field. use a proper method once it's defined in Class *) + /* basicAt: 12 to access the nsdic field. use a proper method once it's defined in Class */ ## (System nsdic) keysAndValuesDo: [:k :v | ## k dump. ## v dump. @@ -344,7 +344,7 @@ a free. System sleepForSecs: 2. } - (* + /* #method(#class) main { | event | @@ -359,12 +359,12 @@ a free. event := GUI waitForEvent. GUI dispatchEvent: event. } - }*) + }*/ } -(* +/* pooldic XXD { #abc := #(1 2 3). #def := %( 1, 3, 4 ). ## syntax error - literal expected where %( is } -*) +*/ diff --git a/moo/kernel/Moo.moo b/moo/kernel/Moo.moo index 03a135d..ec89090 100644 --- a/moo/kernel/Moo.moo +++ b/moo/kernel/Moo.moo @@ -9,7 +9,7 @@ #include 'Process.moo'. #include 'Stream.moo'. -(* -------------------------------------------------------------------------- *) +/* -------------------------------------------------------------------------- */ #include 'FFI.moo'. #include 'Stdio.moo'. ## #include 'Console.moo'. diff --git a/moo/kernel/Process.moo b/moo/kernel/Process.moo index 58edd63..85efced 100644 --- a/moo/kernel/Process.moo +++ b/moo/kernel/Process.moo @@ -156,11 +156,11 @@ class Mutex(Semaphore) ^s. } -(* +/* TODO: how to prohibit wait and signal??? method(#prohibited) wait. method(#prohibited) signal. -*) +*/ method lock { ^super wait } method unlock { ^super signal } @@ -186,16 +186,16 @@ class SemaphoreGroup(Object) sem_io_count := 0, sem_count := 0. -(* TODO: good idea to a shortcut way to prohibit a certain method in the heirarchy chain? +/* TODO: good idea to a shortcut way to prohibit a certain method in the heirarchy chain? method(#class,#prohibited) new. method(#class,#prohibited) new: size. method(#class,#abstract) xxx. => method(#class) xxx { self subclassResponsibility: #xxxx } -*) +*/ -(* +/* method(#class) new { self messageProhibited: #new } method(#class) new: size { self messageProhibited: #new: } -*) +*/ method(#primitive) addSemaphore: sem. method(#primitive) removeSemaphore: sem. diff --git a/moo/kernel/Socket.moo b/moo/kernel/Socket.moo index 8bd43c0..99d9459 100644 --- a/moo/kernel/Socket.moo +++ b/moo/kernel/Socket.moo @@ -20,10 +20,10 @@ class(#byte) IPAddress(Object) class(#byte(4)) IP4Address(IPAddress) { - (*method(#class) new + /*method(#class) new { ^self basicNew: 4. - }*) + }*/ method(#class) fromString: str { @@ -76,10 +76,10 @@ class(#byte(4)) IP4Address(IPAddress) while (true). ^self. -(* +/* (@label@) Exception signal: ('invalid IPv4 address ' & str). -*) +*/ } method fromString: str @@ -93,10 +93,10 @@ class(#byte(4)) IP4Address(IPAddress) class(#byte(16)) IP6Address(IP4Address) { - (*method(#class) new + /*method(#class) new { ^self basicNew: 16. - }*) + }*/ ##method(#class) fromString: str ##{ @@ -304,7 +304,7 @@ class SyncSocket(Socket) method(#class) new { self messageProhibited: #new } method(#class) new: size { self messageProhibited: #new: } -(* +/* method(#class) __with_handle: handle { ###self addToBeFinalized. @@ -319,7 +319,7 @@ class SyncSocket(Socket) ##^(self new) open(family, type, 0) ^(super new) open(family, type, 0) } -*) +*/ method initialize { @@ -437,7 +437,7 @@ class AsyncSocket(Socket) var pending_bytes, pending_offset, pending_length. var outreadysem, outdonesem, inreadysem. - (* ------------------- + /* ------------------- socket call-back methods socketClosing socketClosed @@ -445,7 +445,7 @@ class AsyncSocket(Socket) socketDataOut socketAccepted:from: socketConnected: - -------------------- *) + -------------------- */ method initialize { @@ -489,13 +489,13 @@ class AsyncSocket(Socket) } -(* +/* method finalize { 'SOCKET FINALIZED...............' dump. self close. } -*) +*/ method close { @@ -619,7 +619,7 @@ class AsyncClientSocket(AsyncSocket) self onSocketConnected: (soerr == 0). if (soerr == 0) { self beWatched }. }. - (* HOW TO HANDLE TIMEOUT? *) + /* HOW TO HANDLE TIMEOUT? */ ]. } @@ -726,7 +726,7 @@ class AsyncServerSocket(AsyncSocket) } } -(* +/* class ListenerSocket(Socket) { var inreadysem. @@ -806,4 +806,4 @@ class ListenerSocket(Socket) } } -*) +*/ diff --git a/moo/kernel/Stdio.moo b/moo/kernel/Stdio.moo index 19487a2..31c4906 100644 --- a/moo/kernel/Stdio.moo +++ b/moo/kernel/Stdio.moo @@ -14,7 +14,7 @@ class Stdio(Object) from 'stdio' ^(self new) open(name, mode) } -(* --------------------- +/* --------------------- method(#class) stdin { self.in isNil ifTrue: [ self.in := ^(super new) open: 0 for: 'r' ]. @@ -32,14 +32,14 @@ class Stdio(Object) from 'stdio' self.err isNil ifTrue: [ self.err := ^(super new) open: 2 for: 'w' ]. ^self.err. } ------------------------- *) +------------------------ */ - (* + /* method format: fmt with: ... { } - *) + */ method(#variadic) format (fmt) { diff --git a/moo/kernel/Stream.moo b/moo/kernel/Stream.moo index 66c8fbc..8c0cff1 100644 --- a/moo/kernel/Stream.moo +++ b/moo/kernel/Stream.moo @@ -125,17 +125,17 @@ class ExternalStream(ReadWriteStream) { } -(* +/* ## mimic java's interface... interface ByteStreamable { readBytesInto: writeBytesFrom: } -*) +*/ ### TODO: specify interface inside [] -(* +/* difficulty: how to ensure that the class implements the defined interface? 1) check when a new instance is created. @@ -186,7 +186,7 @@ extension String: StringConvertible { 4) other methods??? Let me think about it.. -*) +*/ class ByteStreamAdapter(Object) ### [ByteStreamable, ByteXXX] { @@ -383,7 +383,7 @@ class ByteStream(ByteStreamAdapter) } } -(* +/* class TextStream(ByteStream) { method initialize @@ -400,5 +400,5 @@ class TextStream(ByteStream) { if (self.seq at: 0) bitAnd: } -}*) +}*/ diff --git a/moo/kernel/System.moo b/moo/kernel/System.moo index c9f3666..43f4c8d 100644 --- a/moo/kernel/System.moo +++ b/moo/kernel/System.moo @@ -146,13 +146,13 @@ class System(Apex) ## method(#class,#variadic,#primitive) log(level,msg1). -(* +/* TODO: how to pass all variadic arguments to another variadic methods??? method(#class,#variadic) logInfo (msg1) { ^self log (System.Log.INFO,msg1) } -*) +*/ method(#class) atLevel: level log: message { @@ -214,7 +214,7 @@ TODO: how to pass all variadic arguments to another variadic methods??? ^self atLevel: System.Log.INFO logNl: message and: message2. } - (* nsdic access *) + /* nsdic access */ method(#class) at: key { ^self nsdic at: key @@ -225,7 +225,7 @@ TODO: how to pass all variadic arguments to another variadic methods??? ^self nsdic at: key put: value } - (* raw memory allocation *) + /* raw memory allocation */ method(#class,#primitive) malloc (size). method(#class,#primitive) calloc (size). method(#class,#primitive) free (rawptr). @@ -234,7 +234,7 @@ TODO: how to pass all variadic arguments to another variadic methods??? method(#class,#primitive) calloc: size. method(#class,#primitive) free: rawptr. - (* raw memory access *) + /* raw memory access */ method(#class,#primitive) getInt8 (rawptr, offset). ## method(#class,#primitive) getInt16 (rawptr, offset). method(#class,#primitive) getInt32 (rawptr, offset). diff --git a/moo/kernel/X11.moo b/moo/kernel/X11.moo index 22638b7..1a3ffff 100644 --- a/moo/kernel/X11.moo +++ b/moo/kernel/X11.moo @@ -84,7 +84,7 @@ method(#dual,#liberal) def(x, z) { ^nil } } } -(* +/* TODO: TODO: compiler enhancement class X11(Object) { @@ -97,7 +97,7 @@ TODO: TODO: compiler enhancement } ----> should i support soemthign like ::X11.Rectangle and X11.Rectangle? ::X11.Rectangle alwasy from the top??? -----> or .X11.Rectangle -> to start search from the current name space??? -*) +*/ method(#primitive,#liberal) _open_display(name). method(#primitive) _close_display. @@ -595,7 +595,7 @@ extend X11 self.shell_container := self.Composite new. self.window_registrar := System.Dictionary new: 100. - (* + /* self.llevent_blocks := System.Dictionary new. self.llevent_blocks @@ -610,7 +610,7 @@ extend X11 at: self.LLEventType.DESTROY_NOTIFY put: #__handle_destroy_notify:on:; at: self.LLEventType.CONFIGURE_NOTIFY put: #__handle_configure_notify:on:; at: self.LLEventType.CLIENT_MESSAGE put: #__handle_client_message:on:. - *) + */ self.llevent_blocks := %{ self.LLEventType.KEY_PRESS -> #__handle_key_event:on:, self.LLEventType.KEY_RELEASE -> #__handle_key_event:on:, diff --git a/moo/kernel/test-002.moo b/moo/kernel/test-002.moo index a34cf5d..3b6f423 100644 --- a/moo/kernel/test-002.moo +++ b/moo/kernel/test-002.moo @@ -82,7 +82,7 @@ class MyObject(Object) ^%( v, p ) ## v must be 2000, p must be 6000 } -(* +/* method(#class) test_sem_sig { | s | @@ -101,7 +101,7 @@ class MyObject(Object) sg add: s3 withAction: []. sg wait. } -*) +*/ method(#class) main { @@ -129,7 +129,7 @@ class MyObject(Object) } -(* +/* s1 := TcpSocket new. s1 onEvent: #connected do: [ @@ -156,4 +156,4 @@ s1 endSend s1 beginAccept: [callback] s1 endAccept -> returns the actual socket -*) +*/ diff --git a/moo/kernel/test-005.moo b/moo/kernel/test-005.moo index 49253b0..f16c773 100644 --- a/moo/kernel/test-005.moo +++ b/moo/kernel/test-005.moo @@ -224,10 +224,10 @@ class MyObject(TestObject) [self getTen] value dump. } - (*method(#class) abc + /*method(#class) abc { - }*) + }*/ method(#class) a: a b: b c: c { @@ -275,7 +275,7 @@ class MyObject(TestObject) self test_ffi. -(* ----------------------------- +/* ----------------------------- PROCESS TESTING | p | '000000000000000000' dump. @@ -288,7 +288,7 @@ PROCESS TESTING '222222222222222222' dump. '333333333333333333' dump. '444444444444444444' dump. ----------------------------- *) +---------------------------- */ @@ -306,10 +306,10 @@ PROCESS TESTING (2r111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 * 128971234897128931) dump. -(* (-10000 rem: 3) dump. +/* (-10000 rem: 3) dump. (-10000 mod: 3) dump. (-10000 div: 3) dump. -(-10000 mdiv: 3) dump. *) +(-10000 mdiv: 3) dump. */ (7 rem: -3) dump. (7 mod: -3) dump. @@ -359,7 +359,7 @@ PROCESS TESTING (2r1111111111111111111111111111111111111111111111111111111111111111 printStringRadix:2) dump. -(* ----------------------- +/* ----------------------- (16rF0FFFF bitOr: 16r111111) dump. @@ -373,7 +373,7 @@ PROCESS TESTING ((2r10101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101 bitAnd: 2r01010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010) printStringRadix: 2) dump. ---------------------- *) +--------------------- */ (16rFFFFFFFFFFFFFFFF bitOr: 16rFFFFFFFFFFFFFFFFFFFFFFFF) dump. (-16rFFFFFFFFFFFFFFFF bitOr: 16rFFFFFFFFFFFFFFFFFFFFFFFF) dump. @@ -445,25 +445,25 @@ PROCESS TESTING b dump. ] value. '====================' dump. -([ :a :b | (*a := 20.*) b := [ a + 20 ]. b value.] value: 99 value: 100) 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 @@ -522,4 +522,4 @@ method whileTrue: aBlock [ b < 10 ] whileTrue: [ b dump. b := b + 1 ]. -========== *) +========== */ diff --git a/moo/kernel/test-010.moo b/moo/kernel/test-010.moo index b917f87..3c88b08 100644 --- a/moo/kernel/test-010.moo +++ b/moo/kernel/test-010.moo @@ -149,7 +149,7 @@ class MyObject(TestObject) ##[1 xxx] ifCurtailed: ['XXXXXXXX CURTAILED XXXXXXXXX' dump. Exception signal: 'jjjj']. - (* + /* v1 := [ | k | k := 99. @@ -163,7 +163,7 @@ class MyObject(TestObject) ('EXCETION - ' & ex messageText) dump. ## Exception signal: 'qqq'. ]. - *) + */ v1 := self aaa_123. '--------------------------------' dump. diff --git a/moo/kernel/test-011.moo b/moo/kernel/test-011.moo index 342a35f..8005137 100644 --- a/moo/kernel/test-011.moo +++ b/moo/kernel/test-011.moo @@ -198,7 +198,7 @@ class MyObject(TestObject) ## 100 timesRepeat: ['>>>>> END OF MAIN' dump]. -(* +/* (Exception isKindOf: Apex) dump. (Exception isMemberOf: Apex) dump. (Exception isMemberOf: Class) dump. @@ -211,7 +211,7 @@ class MyObject(TestObject) (Exception isKindOf: Object) dump. (Exception isKindOf: (Apex new)) dump. (Exception isKindOf: (Object new)) dump. -*) +*/ '@@@@@@@@@@@@@@@@@@@@@@@@@@@@' dump. diff --git a/moo/kernel/test-012.moo b/moo/kernel/test-012.moo index d778798..4256bbb 100644 --- a/moo/kernel/test-012.moo +++ b/moo/kernel/test-012.moo @@ -88,11 +88,11 @@ class MyObject(TestObject) ##[ 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']. *) + [1 xxx] ifCurtailed: ['XXXXXXXX CURTAILED XXXXXXXXX' dump. Exception signal: 'jjjj']. */ v1 := [ [ diff --git a/moo/kernel/test-014.moo b/moo/kernel/test-014.moo index f649e92..2c6923f 100644 --- a/moo/kernel/test-014.moo +++ b/moo/kernel/test-014.moo @@ -132,9 +132,9 @@ class MyObject(TestObject) v1 puts ('hello', 'world', 'good', C'\n', C'\t', 'under my umbrella 123.', C'\n'). v1 close. - (*v1 format(10, 20) isNil ifFalse: [ + /*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. ]. diff --git a/moo/lib/comp.c b/moo/lib/comp.c index 0cef937..bff286e 100644 --- a/moo/lib/comp.c +++ b/moo/lib/comp.c @@ -1114,9 +1114,9 @@ static int skip_comment (moo_t* moo) if (c == '"') GET_CHAR (moo); /* keep the next character in lxc */ return 1; /* double-quoted comment */ } - else if (c == '(') + else if (c == '/') { - /* handle (* ... *) */ + /* handle block comment encoded in /x x/ where x is * */ lc = moo->c->lxc; GET_CHAR_TO (moo, c); if (c != '*') goto not_comment; @@ -1133,7 +1133,7 @@ static int skip_comment (moo_t* moo) if (c == MOO_OOCI_EOF) goto unterminated; if (c == '*') goto check_rparen; /* got another * after * */ - if (c == ')') + if (c == '/') { GET_CHAR (moo); /* keep the first meaningful character in lxc */ break; @@ -1142,7 +1142,7 @@ static int skip_comment (moo_t* moo) } while (1); - return 1; /* multi-line comment enclosed in (* and *) */ + return 1; /* multi-line comment enclosed in /x and x/ where x is * */ } else if (c == '#') {