example network apps?Xu Wang xwang at objectshare.comFri Oct 29 17:53:30 UTC 1999
--------------4FDFC2E17E648A5C4F52E204 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit Here is one. -xwang Mark Morrissey wrote: > Does anyone have any example network programs in Squeak of which I could > get a copy? I haven't programmed in smalltalk in about 9 years, but since I > found that Squeak has network primitives, my old fascination with smalltalk > has been rekindled. > > I teach graduate level network protocols and programming courses and would > like my students to see example frameworks for network programming from as > many different environments as possible. So if someone has some example > programs that they would be willing to share with me, I would appreciate it. > > As a side note: under both WinNT and Solaris 2.7 (Squeak 2.5 and 2.6), I am > unable to get even the ping test to run. Am I missing something obvious? > > Thank you, > > --mark > --- > Mark Morrissey Director of Special Projects > markm at cse.ogi.edu The Oregon Graduate Institute > (503) 748-7053 Department of Computer Science and Engineering --------------4FDFC2E17E648A5C4F52E204 Content-Type: text/plain; charset=us-ascii; name="S2S.27Oct1006pm.cs" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="S2S.27Oct1006pm.cs" 'From Squeak2.6 of 11 October 1999 [latest update: #1559] on 27 October 1999 at 10:06:39 pm'! "Change Set: S2S Date: 25 October 1999 Author: Xu Wang S2S is a small object request broker designed specifically for Squeak. It let distributed objects send messages to each other easily and transparently. This change file requires Squeak 2.6 and it will redefine Process to add an instVar, please proceed to allow it. To get start, see ExampleObject class>>readMeFirst"! Model subclass: #ALSM instanceVariableNames: 'state ' classVariableNames: 'DoLog ErrorLogLevel InfoLogLevel LogLock StateLogLevel ' poolDictionaries: '' category: 'S2S-Core'! Object subclass: #AccessPoint instanceVariableNames: 'address ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! ALSM subclass: #ConnectionListener instanceVariableNames: 'accessPoint serverSocket listenerProcess connectionManager ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! ALSM subclass: #ConnectionManager instanceVariableNames: 'connections accessLock houseKeepProcess ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! Object subclass: #ExampleObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'S2S-Examples'! Object subclass: #ExternalObjRef instanceVariableNames: 'id accessPoint ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! ByteArray variableByteSubclass: #GIOPHeader instanceVariableNames: '' classVariableNames: 'MessageTypeNames ' poolDictionaries: '' category: 'S2S-Core'! Object subclass: #HomeSystem instanceVariableNames: '' classVariableNames: 'Default ' poolDictionaries: '' category: 'S2S-Core'! AccessPoint subclass: #IpAccessPoint instanceVariableNames: 'port ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! ConnectionManager subclass: #ObjectRequestBroker instanceVariableNames: 'exportTable proxyRegistry listener persistentObjects ' classVariableNames: 'DefaultPort ' poolDictionaries: '' category: 'S2S-Core'! Object subclass: #OrbContext instanceVariableNames: 'home principal request reply debuggingContext peerInfo replySemaphore replyType ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! Object subclass: #OrbControl instanceVariableNames: '' classVariableNames: 'RemoteSystems ' poolDictionaries: '' category: 'S2S-Core'! OrbControl class instanceVariableNames: 'Orb '! Object subclass: #OrbLocalTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'S2S-Test'! OrbControl subclass: #OrbLocalTestControl instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'S2S-Test'! OrbLocalTestControl class instanceVariableNames: 'ClientOrb '! Link subclass: #Process instanceVariableNames: 'suspendedContext priority myList errorHandler userContext ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! nil subclass: #Proxy instanceVariableNames: 'object ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! Proxy subclass: #PassModeWrapper instanceVariableNames: 'isPassedByValue ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! ReferenceStream subclass: #RemoteMessageStream instanceVariableNames: 'objectAdaptor ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! Proxy subclass: #RemoteObject instanceVariableNames: 'orb dependents ' classVariableNames: 'InspectProxy ' poolDictionaries: '' category: 'S2S-Core'! ALSM subclass: #TCPConnection instanceVariableNames: 'peerInfo useMark socket manager serverProcess writeLock ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! TCPConnection subclass: #RequestConnection instanceVariableNames: 'requestRegistry sessionObjects ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! RequestConnection subclass: #AdaptorConnection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! WeakValueDictionary subclass: #WeakObjectTable instanceVariableNames: 'accessLock nextId ' classVariableNames: '' poolDictionaries: '' category: 'S2S-Core'! !Object reorganize! ('accessing' addInstanceVarNamed:withValue: at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: in: readFromString: size yourself) ('testing' basicType haltIfNil ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isBehavior isCollection isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isPseudoContext isText isTransparent isWebBrowser knownName name notNil pointsTo: wantsSteps) ('comparing' = == closeTo: hash hashMappedBy: identityHash identityHashMappedBy: identityHashPrintString ~= ~~) ('copying' clone copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy shallowCopy veryDeepCopy veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('dependents access' addDependent: breakDependents canDiscardEdits dependents evaluate:wheneverChangeIn: hasUnacceptedEdits release removeDependent:) ('updating' changed changed: okToChange update: windowIsClosing) ('printing' fullPrintString isLiteral longPrintOn: longPrintString printOn: printString printStringLimitedTo: propertyList storeOn: storeString stringForReadout stringRepresentation) ('s2s' asPassedByRef asPassedByValue homeSystem isPassedByValue objectForMessageStream: remotePerform:withArguments: xxxClass xxxIsProxy xxxIsRemote xxxRemoteCopy xxxType) ('class membership' class isKindOf: isKindOf:orOf: isMemberOf: respondsTo:) ('message handling' perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass:) ('error handling' cannotInterpret: caseError confirm: confirm:orCancel: doesNotUnderstand: error: halt halt: handles: notify: notify:at: primitiveFailed shouldNotImplement subclassResponsibility tryToDefineVariableAccess:) ('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString basicInspect beep defaultBackgroundColor defaultLabelForInspector explore fullScreenSize hasContentsInExplorer inform: initialExtent inspect inspectWithLabel: modelSleep modelWakeUp mouseUpBalk: newTileMorphRepresentative notYetImplemented smartInspect windowActiveOnFirstClick windowReqNewLabel:) ('system primitives' asOop become: becomeForward: instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: nextInstance nextObject rootStubInImageSegment: someObject tryPrimitive:withArgs:) ('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: mustBeBoolean primitiveError: species storeAt:inTempFrame:) ('associating' ->) ('converting' adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: as: asOrderedCollection asString withoutListWrapper) ('casing' caseOf: caseOf:otherwise:) ('binding' bindingOf:) ('macpal' codeStrippedOut: contentsChanged currentEvent currentHand currentWorld flash ifKindOf:thenDo: instanceVariableValues playSoundNamed: scriptPerformer) ('flagging' flag: isThisEverCalled isThisEverCalled: logEntry logExecution logExit) ('translation support' asIf:var: asIf:var:asValue: asIf:var:put: asOop: asSmallIntegerObj asValue: cCode: cCode:inSmalltalk: cCoerce:to: export: inline: primitive:parameters:receiver: returnTypeC: sharedCodeNamed:inCase: var:declareC:) ('objects from disk' comeFullyUpOnReload: objectForDataStream: readDataFrom:size: rehash saveOnFile storeDataOn:) ('finalization' actAsExecutor executor finalize retryWithGC:until:) ('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: printOnStream: putOn: storeOnStream: writeOnFilterStream:) ! !Object methodsFor: 's2s'! asPassedByRef "Return aPassModeWrapper of receiver to make sure it will be passed by reference during a remote invocation" ^PassModeWrapper passedByRef: self! ! !Object methodsFor: 's2s'! asPassedByValue "Return aPassModeWrapper of receiver to make sure it will be passed by value during a remote invocation" ^PassModeWrapper passedByValue: self! ! !Object methodsFor: 's2s'! homeSystem "Return the home system of the object" ^Processor activeProcess homeSystem "Note: the homeSystem is always co-located with the initial context of a distributed thread if a user did not set otherwise."! ! !Object methodsFor: 's2s'! isPassedByValue ^false! ! !Object methodsFor: 's2s'! objectForMessageStream: refStrm "Return object to store on an external data stream" ^self! ! !Object methodsFor: 's2s' stamp: 'a 10/28/1999 04:56'! remotePerform: selector withArguments: args "Perform message from a remote sender" ^self perform: selector withArguments: args "^self interface perform: selector withArguments: args" "Developer's Notes: Subclasses could redefine this method to add some sort of capability checking by using orbContext peerInfo and orbContext principal. "! ! !Object methodsFor: 's2s'! xxxClass "This is my TRUE class!!" ^self class! ! !Object methodsFor: 's2s'! xxxIsProxy ^false! ! !Object methodsFor: 's2s'! xxxIsRemote ^false! ! !Object methodsFor: 's2s'! xxxRemoteCopy "Make a copy of the receiver at the remote location" ^self asPassedByValue! ! !Object methodsFor: 's2s'! xxxType ^self class name! ! !ALSM commentStamp: 'a 10/28/1999 00:28' prior: 0! ALSM - represents a generic communication protocol. It defines the common state control API: start - start the protocol stop - stop the protocol restart - stop and start the protocol. changeState: - change the protocol state and send updates to all the dependents. state - current protocol state. Subclasses may override the privateStart and privateStop to implement the protocol specific actions. Subclasses may also introduce more states then just the few defined in this class. The concept is superb, the implementation is horrible :-). ! !ALSM reorganize! ('initialize-release' initialize release) ('state-control' changeState: restart start state stop stop: stopRequest: systemDown systemUp) ('state-testing' isRunning) ('private' dataTimeNow privateStart privateStop) ('error-handling' doLog: doLog:level: error: logFile) ! !ALSM methodsFor: 'initialize-release'! initialize self changeState: #bone.! ! !ALSM methodsFor: 'initialize-release'! release self changeState: #dead.! ! !ALSM methodsFor: 'state-control' stamp: 'a 10/28/1999 02:44'! changeState: aSymbol "change the state of the receiver" self doLog: [self printString, ' changeState: ', aSymbol] level: self class stateLogLevel. state _ aSymbol. self changed.! ! !ALSM methodsFor: 'state-control'! restart self stop. self start.! ! !ALSM methodsFor: 'state-control'! start "Start the receiver and return true or false" | ok | state == #dead ifTrue:[self notify: 'Can''t start a dead protocol!!'. ^false]. state == #started ifTrue:[^true]. self changeState: #preStart. ok _ self privateStart. ok ifTrue:[self changeState: #started] ifFalse:[self changeState: #startFailed]. ^ok! ! !ALSM methodsFor: 'state-control'! state ^state! ! !ALSM methodsFor: 'state-control'! stop "Stop the receiver and return ture or false" | ok | state == #stopped ifTrue:[^true]. self changeState: #prepareStop. ok _ self privateStop. ok ifTrue:[self changeState: #stopped] ifFalse:[self changeState: #stopFailed]. ^ok! ! !ALSM methodsFor: 'state-control' stamp: 'a 10/28/1999 03:14'! stop: aString "Stop for a reason" self doLog: [aString] level: InfoLogLevel. self stop.! ! !ALSM methodsFor: 'state-control'! stopRequest: aString "A stop request with an advisory reason" ^self stop: aString! ! !ALSM methodsFor: 'state-control'! systemDown "Do whatever needed when image is down"! ! !ALSM methodsFor: 'state-control'! systemUp "Do whatever needed when image is up"! ! !ALSM methodsFor: 'state-testing'! isRunning ^state == #started! ! !ALSM methodsFor: 'private'! dataTimeNow ^Date today mmddyyyy, ' ', (Time now print24 copyFrom: 1 to: 8).! ! !ALSM methodsFor: 'private'! privateStart "Start the protocol, should return aBoolean" ^true! ! !ALSM methodsFor: 'private'! privateStop "Stop the protocol, should return aBoolean" ^true! ! !ALSM methodsFor: 'error-handling' stamp: 'a 10/28/1999 03:14'! doLog: theBlock self doLog: theBlock level: InfoLogLevel! ! !ALSM methodsFor: 'error-handling' stamp: 'a 10/28/1999 03:19'! doLog: theBlock level: aNumber "If DoLog, then value theBlock and it should return a string as log info" ((DoLog >= aNumber) and: [self logFile ~~ nil]) ifTrue:[ LogLock critical: [self logFile cr; show: self dataTimeNow; tab; show: theBlock value]]. ! ! !ALSM methodsFor: 'error-handling' stamp: 'a 10/28/1999 03:15'! error: aString self doLog: [aString] level: ErrorLogLevel. ^super error: aString.! ! !ALSM methodsFor: 'error-handling' stamp: 'a 10/28/1999 03:06'! logFile "Return a logFile which has transcriptStream protocol." ^self class logFile! ! !AccessPoint commentStamp: '<historical>' prior: 0! This class is an abstract class for an end point to reach an object. ! !AccessPoint methodsFor: 'accessing'! address ^address! ! !AccessPoint methodsFor: 'accessing'! address: addr address _ addr.! ! !AccessPoint methodsFor: 's2s'! isPassedByValue ^true! ! !Behavior methodsFor: 's2s'! asPassedByValue ^self error: 'Behavior should never passed by value'! ! !Behavior methodsFor: 's2s'! xxxRemoteCopy ^self! ! !ALSM class methodsFor: 'initialize-release' stamp: 'a 10/28/1999 22:19'! initialize StateLogLevel _ 9. InfoLogLevel _ 5. ErrorLogLevel _ 1. self logOff.! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 03:10'! errorLogLevel ^ErrorLogLevel! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 03:15'! infoLogLevel ^InfoLogLevel! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 03:07'! logFile ^Transcript! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 02:30'! logLevel: aNumber "All the log action with level smaller then aNumber will be valued" DoLog _ aNumber. DoLog > 0 ifTrue:[LogLock _ Semaphore forMutualExclusion] ifFalse:[LogLock _ nil].! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 02:25'! logOff "Turn off all the log" self logLevel: 0! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 03:17'! logOn "Turn on the log" self logLevel: self infoLogLevel.! ! !ALSM class methodsFor: 'log-contral' stamp: 'a 10/28/1999 03:11'! stateLogLevel ^StateLogLevel! ! !ALSM class methodsFor: 'system-contral'! shutDown self allInstances do: [:each | each systemDown]! ! !ALSM class methodsFor: 'system-contral'! startUp self allInstances do: [:each | each systemUp]! ! !Boolean methodsFor: 'orb'! isPassedByValue ^true! ! !Character reorganize! ('accessing' asciiValue digitValue) ('comparing' < = > hash) ('testing' isAlphaNumeric isDigit isLetter isLowercase isSafeForHTTP isSeparator isSpecial isUppercase isVowel tokenish) ('copying' copy deepCopy veryDeepCopyWith:) ('printing' hex isLiteral printOn: printOnStream: storeOn:) ('converting' asCharacter asIRCLowercase asInteger asLowercase asString asSymbol asUppercase to:) ('s2s' isPassedByValue) ! !Character methodsFor: 's2s'! isPassedByValue ^true! ! !Collection reorganize! ('accessing' anyOne capacity size) ('testing' includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isCollection isEmpty isEmptyOrNil isSequenceable occurrencesOf:) ('adding' add: addAll: addIfNotPresent:) ('removing' remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat:) ('enumerating' associationsDo: collect: collect:thenSelect: contains: count: detect: detect:ifNone: detectMax: detectMin: detectSum: do: do:separatedBy: do:without: inject:into: reject: select: select:thenCollect:) ('converting' adaptToCollection:andSend: adaptToNumber:andSend: adaptToPoint:andSend: adaptToString:andSend: asBag asCharacterSet asOrderedCollection asSet asSortedArray asSortedCollection asSortedCollection:) ('printing' printOn: storeOn:) ('private' emptyCheck errorEmptyCollection errorNoMatch errorNotFound errorNotKeyed fill:fromStack: maxSize toBraceStack:) ('arithmetic' * + - / // \\) ('math functions' abs average ceiling floor log max median min negated range reciprocal rounded sqrt squared sum truncated) ('filter streaming' contents flattenOnStream: write:) ('s2s' isPassedByValue) ! !Collection methodsFor: 's2s' stamp: 'a 10/28/1999 01:16'! isPassedByValue ^true "Developer's Notes: Collections should not be passed by value in theory, but in practice they are better off by passed-by-valeu becuase it is so often used with iterators in Smalltalk."! ! !ConnectionListener commentStamp: '<historical>' prior: 0! A connectionListener creates a server TCP socket and hold a listenning process to accept connection requests. When a socket is connected, connectionListener hand it over to the connectionManager. A connectionMananger must understand "newSocketConnection: aSocket" message. ! !ConnectionListener methodsFor: 'accessing'! accessPoint ^accessPoint! ! !ConnectionListener methodsFor: 'accessing'! connectionManager ^connectionManager! ! !ConnectionListener methodsFor: 'accessing' stamp: 'a 10/28/1999 22:12'! listenBacklog ^3! ! !ConnectionListener methodsFor: 'accessing'! listenerProcessPriority ^Processor highIOPriority! ! !ConnectionListener methodsFor: 'accessing'! serverPort ^accessPoint port! ! !ConnectionListener methodsFor: 'initialize-release'! port: aSmallInteger connectionManager: aConnManager accessPoint _ IpAccessPoint hostAddress: NetNameResolver localHostAddress port: aSmallInteger. connectionManager _ aConnManager.! ! !ConnectionListener methodsFor: 'private' stamp: 'a 10/28/1999 21:52'! listeningLoop "Wait for incomming connection request and handed to my connectionManager" | socket | serverSocket _ self setupServerSocket. serverSocket isValid ifFalse:[^self oldStyleListeningLoop]. [serverSocket isWaitingForConnection] whileTrue: [ socket _ serverSocket waitForAcceptUntil: (Socket deadlineSecs: 5). (socket notNil and:[socket isConnected]) ifTrue: [self connectionManager newSocketConnection: socket]]. self isRunning ifTrue:[self stop: 'Broken listenning socket']. ! ! !ConnectionListener methodsFor: 'private'! oldStyleListeningLoop "See ConnectionQueue>>oldStyleListenLoop." [true] whileTrue: [ serverSocket == nil ifTrue: [ "try to create a new socket for listening" serverSocket _ Socket createIfFail: [nil]]. serverSocket == nil ifTrue: [(Delay forMilliseconds: 100) wait] ifFalse: [ serverSocket isUnconnected ifTrue: [serverSocket listenOn: self serverPort]. serverSocket waitForConnectionUntil: (Socket deadlineSecs: 10). serverSocket isConnected ifTrue: [ self connectionManager newSocketConnection: serverSocket. serverSocket _ nil] ifFalse: [ serverSocket isWaitingForConnection ifFalse: [serverSocket destroy. serverSocket _ nil]]]. "broken serverSocket; start over" ]. ! ! !ConnectionListener methodsFor: 'private' stamp: 'a 10/28/1999 01:47'! privateStart "Start the listener process" listenerProcess _ [self listeningLoop] forkAt: self listenerProcessPriority. ^true ! ! !ConnectionListener methodsFor: 'private'! privateStop "Terminate the listener process and destroy the socket." listenerProcess ifNotNil: [ listenerProcess terminate. listenerProcess _ nil]. serverSocket ifNotNil: [ serverSocket closeAndDestroy. serverSocket _ nil]. connectionManager ifNotNil: [ connectionManager isRunning ifTrue:[connectionManager stop]]. ^true ! ! !ConnectionListener methodsFor: 'private'! setupServerSocket | socket | socket _ Socket newTCP. socket listenOn: self serverPort backlogSize: self listenBacklog. ^socket ! ! !ConnectionListener class methodsFor: 'instance creation'! port: aSmallInteger connectionManager: anObject ^super new port: aSmallInteger connectionManager: anObject! ! !ConnectionManager commentStamp: '<historical>' prior: 0! ConnectionManager manages communiction connections. ! !ConnectionManager methodsFor: 'private' stamp: 'a 10/28/1999 22:09'! connectionTimeoutLoop "Go though each connections, if a connection is unused since last marking then send it a stopRequest" [true] whileTrue: [ (Delay forSeconds: self connectionTimeout) wait. connections copy do: [:each | each mark > 1 ifTrue:[each stopRequest: 'connection timeout']]]! ! !ConnectionManager methodsFor: 'private'! privateStart super privateStart. connections _ Dictionary new. accessLock _ Semaphore forMutualExclusion. self needHouseKeepping ifTrue:[self startHouseKeepProcess]. ^true! ! !ConnectionManager methodsFor: 'private'! privateStop super privateStop. self stopAllConnections. self needHouseKeepping ifTrue:[self stopHouseKeepProcess]. ^true! ! !ConnectionManager methodsFor: 'private'! startHouseKeepProcess houseKeepProcess _ [self connectionTimeoutLoop] fork.! ! !ConnectionManager methodsFor: 'private'! stopHouseKeepProcess houseKeepProcess ifNotNil: [ houseKeepProcess terminate. houseKeepProcess _ nil].! ! !ConnectionManager methodsFor: 'connection-manage'! addConnection: aConnection self isRunning ifTrue:[accessLock critical: [ connections at: aConnection id put: aConnection ]]! ! !ConnectionManager methodsFor: 'connection-manage'! connectionAt: id ^accessLock critical: [ connections at: id ifAbsent: [] ]! ! !ConnectionManager methodsFor: 'connection-manage'! connectionTimeout "Aconnection may be stopped after being idle for 5 minutes. Value in seconds" ^300! ! !ConnectionManager methodsFor: 'connection-manage'! needHouseKeepping "Return ture if receiver need to start a house keeping process to timeout the idle connections, otherwise return false" ^false! ! !ConnectionManager methodsFor: 'connection-manage'! removeConnection: conn ^accessLock critical: [ connections removeKey: conn id ifAbsent: [] ] "^connections removeKey: connections id ifAbsent:[]"! ! !ConnectionManager methodsFor: 'connection-manage' stamp: 'a 10/28/1999 01:39'! stopAllConnections connections ifNotNil: [ connections copy do: [:each | each stop]]! ! !DataStream methodsFor: 'as yet unclassified'! getStoreObjectOf: anObject "Let anObject to decide what object should be put on the receiver" ^anObject objectForDataStream: self! ! !DataStream methodsFor: 'as yet unclassified'! nextPut: anObject "Write anObject to the receiver stream. Answer anObject. NOTE: If anObject is a reference type (one that we write cross-references to) but its externalized form (result of getStoreObjectOf:) isn't (e.g. CompiledMethod and ViewState), then we should remember its externalized form but not add to 'references'. Putting that object again should just put its external form again. That's more compact and avoids seeks when reading. But we just do the simple thing here, allowing backward-references for non-reference types like nil. So objectAt: has to compensate. Objects that externalize nicely won't contain the likes of ViewStates, so this shouldn't hurt much. : writeReference: -> errorWriteReference:." | typeID selector objectToStore | typeID _ self typeIDFor: anObject. (self tryToPutReference: anObject typeID: typeID) ifTrue: [^ anObject]. objectToStore _ self getStoreObjectOf: (self objectIfBlocked: anObject). objectToStore == anObject ifFalse: [typeID _ self typeIDFor: objectToStore]. byteStream nextPut: typeID. selector _ #(writeNil: writeTrue: writeFalse: writeInteger: writeStringOld: writeSymbol: writeByteArray: writeArray: writeInstance: errorWriteReference: writeBitmap: writeClass: writeUser: writeFloat: writeRectangle: == "dummy 16" writeString: writeBitmap:) at: typeID. self perform: selector with: objectToStore. ^ anObject! ! !Date reorganize! ('accessing' day leap monthIndex monthName weekday year) ('arithmetic' addDays: subtractDate: subtractDays:) ('comparing' < = hash) ('inquiries' dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:) ('converting' asSeconds) ('printing' mmddyy mmddyyyy printFormat: printOn: printOn:format: storeOn:) ('private' day:year: firstDayOfMonthIndex: weekdayIndex) ('s2s' isPassedByValue) ! !Date methodsFor: 's2s'! isPassedByValue ^true! ! !Delay reorganize! ('delaying' unschedule wait) ('private' activate adjustResumptionTimeOldBase:newBase: resumptionTime schedule setDelay:forSemaphore: signalWaitingProcess) ('s2s' stillWaiting) ! !Delay methodsFor: 's2s'! stillWaiting ^beingWaitedOn! ! !Dictionary methodsFor: 's2s'! isPassedByValue ^false! ! !ExampleObject commentStamp: '<historical>' prior: 0! This class is an example of using S2S ORB. Details in ExampleObject class readMeFirst ! ]style[(54 31 10)f1,f1LExampleObject class readMeFirst;,f1! !ExampleObject reorganize! ('private' sayings) ('example messages' doubleTheNumber echo: newFileNamed: oldFileNamed: saySomething systemInfo) ! !ExampleObject methodsFor: 'private' stamp: 'a 10/28/1999 05:59'! sayings ^#( 'Do "ALSM logOn" will let you see what ORB is doing on Transcript.' 'Remote browser is easy, but a good one is hard.' 'S2S is soooo coooool!!' 'You are doing ok.' 'Just let a server object return a fileStream, you could read or write the file remotely , and, slowly :-)' 'Pay a litter attention to what is passedByValue and what is passedByRef will save your a lot of trouble.' 'Don''t let people impose on you. Work Calmly and silently' 'Remote inspecting? Only a few lines away.' 'You could optimize your distrubuted methods by return nil instead of "self" if the return value is void.' 'What''s on the Web? Too many spiders.' 'HTML or XML? Thank you, I perfer SMALLTALK.' 'Can you make S2S faster? Sure!!' 'You make me laugh, you make me cry.' 'Distributed scriping? here you go!!' 'Got a wrong class? Try use xxxClass.' 'What is S2S anyway?' 'Documentation for S2S? No, you don''t need one.' 'Here is the challenge: code a distributed debugger.' 'Had fun, did you?' 'With little modification S2S can work over a shared memory or even a serial connection' 'Go get a life!!' 'Can''t wait to see some distributed morphs.' 'What I''m going to do next? Well, .... ' ) ! ! !ExampleObject methodsFor: 'example messages'! doubleTheNumber "This is boring" | n | n _ Number readFrom: (self homeSystem fillInTheBlack request: 'Give me aNumber:'). self homeSystem inform: (n printString, ' * 2 = ', (n * 2) printString). ^n*2 ! ! !ExampleObject methodsFor: 'example messages'! echo: obj "Just echo" ^obj! ! !ExampleObject methodsFor: 'example messages'! newFileNamed: aFilename "Return a new file. Make sure close it after use. Oh, this is dangerous!! Make sure your machine has a lots of space!!" ^FileStream newFileNamed: aFilename! ! !ExampleObject methodsFor: 'example messages'! oldFileNamed: aFilename "Return a old file. Make sure close it after use. Oh, this is dangerous!! Make sure your love letter is not on this machine!!" ^FileStream oldFileNamed: aFilename! ! !ExampleObject methodsFor: 'example messages'! saySomething "Want to get some hint? Here you go" self homeSystem inform: self sayings atRandom. ^nil ! ! !ExampleObject methodsFor: 'example messages'! systemInfo "The secretes is going out!!" | info | info _ Utilities vmStatisticsReportString. (self homeSystem newStringHolder contents: info) openLabel: 'VM Statistics on ', Smalltalk imageName. ^nil! ! !ExampleObject class methodsFor: 'examples'! clientSetup "Setup the client image and something you can try." "ExampleObject clientSetup" | serverHostName | "Start client Orb" OrbControl startOrbAtPort: 9900. "To make things easier, let's give server image a name," serverHostName _ FillInTheBlank request: 'Server Host Name: ' initialAnswer: OrbControl orbAccessPoint hostName. OrbControl addSystem: #server atHost: serverHostName port: 9999. "Open an example window" StringHolder new contents: ExampleObject clientExampleDos; openLabel: 'Client Examples'.! ! !ExampleObject class methodsFor: 'examples' stamp: 'a 10/28/1999 00:21'! readMeFirst " Only tree steps you need to do: 1) You need to make and start two images, say serverImage and clientImage. They can be on the same machine or different but networked machines. 2) In the serverImage, do: ExampleObject class serverSetup. 3) In the clientImage do: ExampleObject class clientSetup and follow the instructions in the client example popup window. No, you don't need a manual, and I hope you never will for this. If there is anything unexpected, drop me an email: xwang at s2s.stanford.edu. Enjoy!! "! ]style[(16 224 31 33 31 227)f1b,f1,f1LExampleObject class serverSetup;,f1,f1LExampleObject class clientSetup;,f1! ! !ExampleObject class methodsFor: 'examples' stamp: 'a 10/28/1999 01:40'! serverSetup "Setup the server image and export of an exampleObject" "ExampleObject serverSetup" "Start server Orb" OrbControl startOrbAtPort: 9999. "Export an exampleObject" OrbControl export: ExampleObject new as: #example. "Open a server info window" StringHolder new contents: ExampleObject serverDos; openLabel: 'Server Info'.! ! !ExampleObject class methodsFor: 'private' stamp: 'a 10/28/1999 00:23'! clientExampleDos ^ 'Now to try inspecting the result of following statements (one by one please): ''s2s://server/example'' asRemoteObject echo: (Array with: ''Hello!!'' with: 123.456). ''s2s://server/example'' asRemoteObject saySomething. ''s2s://server/example'' asRemoteObject doubleTheNumber. ''s2s://server/example'' asRemoteObject systemInfo. Nothing fancy here, but the examples are very up to the point and hope you got it already. Now it''s your turn to create more interesting examples :-). Hint: Just adding methods to ExampleObject in the server image, then send the messages from here. What? You want to stop Orb? Had enough don''t you? To stop the Orb: OrbControl stopOrb. To restart the Orb: OrbControl startOrb. To see if the Orb is running: OrbControl isOrbRunning To get an exported remote object: ''s2s://<hostname>:<port>/<nameOfExpportedObject>'' asRemoteObject ' ! ! !ExampleObject class methodsFor: 'private'! serverDos ^ 'Server is running on: ', OrbControl orbAccessPoint printString, ' Your exported example object is named #example. Now you can go to the client image and do the client setup. If you want to know what your server object can do, just inspect: ExampleObject new echo: (Array with: ''Hello!!'' with: 123.456). ExampleObject new saySomething. ExampleObject new doubleTheNumber. ExampleObject new systemInfo. Here is some other operations good to know: To see if the Orb is running: OrbControl isOrbRunning To stop the Orb: OrbControl stopOrb. To restart the Orb: OrbControl startOrb. To exported an object: OrbControl export: <anObject> byName: <aSymbol> To revoke exported object: OrbControl revokeExportNamed: <aSymbol> ' ! ! !ExternalObjRef commentStamp: '<historical>' prior: 0! An externlObjectReference has the location information about where an external object is. This class is used for implement pass by reference symantics and hard coded in RemoteMessageStream, so don't use it if you want to pass something means "external object reference" only. ! ]style[(170 19 90)f1,f1LRemoteMessageStream Comment;,f1! !ExternalObjRef reorganize! ('s2s' isPassedByValue) ('comparing' = hash) ('accessing' accessPoint accessPoint: id id:) ('printing' printOn:) ('initialize' id:accessPoint:) ! !ExternalObjRef methodsFor: 's2s'! isPassedByValue ^true! ! !ExternalObjRef methodsFor: 'comparing'! = anObject ^(self species == anObject species) and: [ (self accessPoint = anObject accessPoint) & (self id = anObject id)]! ! !ExternalObjRef methodsFor: 'comparing'! hash ^(self accessPoint hash) bitXor: self id hash! ! !ExternalObjRef methodsFor: 'accessing'! accessPoint ^accessPoint! ! !ExternalObjRef methodsFor: 'accessing'! accessPoint: ap accessPoint _ ap! ! !ExternalObjRef methodsFor: 'accessing'! id ^id! ! !ExternalObjRef methodsFor: 'accessing'! id: oid id _ oid.! ! !ExternalObjRef methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream space. accessPoint printOn: aStream. aStream nextPutAll: ' ID:'. self id printOn: aStream. ! ! !ExternalObjRef methodsFor: 'initialize'! id: oid accessPoint: ap id _ oid. accessPoint _ ap.! ! !ExternalObjRef class methodsFor: 'instance creation'! id: oid accessPoint: ap ^super new id: oid accessPoint: ap! ! !ExternalObjRef class methodsFor: 'instance creation'! id: oid hostName: aString port: aPort ^super new id: oid hostName: aString port: aPort! ! !GIOPHeader commentStamp: '<historical>' prior: 0! This class is GIOP Header see CORBA 3.0. Develper's Notes: Using GIOP Header allows us to add a full GIOP/IIOP protocol in the future.! !GIOPHeader methodsFor: 'testing' stamp: 'x 10/27/1999 21:41'! isValid ^self majorVersion = 1 and: [ self minorVersion = 2 and: [ self protocolTag = 'GIOP' ]]! ! !GIOPHeader methodsFor: 'accessing'! byteOrder ^(self byteAt: 7) bitAnd: 1! ! !GIOPHeader methodsFor: 'accessing'! byteOrder: oneOrZero "set the byte ordering of the message" self byteAt: 7 put: (oneOrZero == 1 ifTrue: [(self byteAt: 7) bitOr: 1] ifFalse: [(self byteAt: 7) bitAnd: 254])! ! !GIOPHeader methodsFor: 'accessing'! fragment "Return false if this is the last fragment" ^((self byteAt: 7) bitAnd: 2) == 1! ! !GIOPHeader methodsFor: 'accessing'! fragment: aBoolean "set the fragment flag" self byteAt: 7 put: (aBoolean ifTrue: [(self byteAt: 7) bitOr: 2] ifFalse: [(self byteAt: 7) bitAnd: 253])! ! !GIOPHeader methodsFor: 'accessing'! isBigEndian ^self byteOrder == 0 ! ! !GIOPHeader methodsFor: 'accessing'! majorVersion "return the major version number of the message" ^self byteAt: 5! ! !GIOPHeader methodsFor: 'accessing'! majorVersion: aByte "set the major version number of the message" self byteAt: 5 put: aByte! ! !GIOPHeader methodsFor: 'accessing'! messageSize "return the size of the message" ^self longAt: 9 bigEndian: self isBigEndian! ! !GIOPHeader methodsFor: 'accessing'! minorVersion "return the major version number of the message" ^self byteAt: 6! ! !GIOPHeader methodsFor: 'accessing'! minorVersion: aByte "set the minor version number of the message" self byteAt: 6 put: aByte! ! !GIOPHeader methodsFor: 'accessing'! msgSize ^self longAt: 9 bigEndian: self isBigEndian! ! !GIOPHeader methodsFor: 'accessing'! msgSize: anInt "set the size of the message" self longAt: 9 put: anInt bigEndian: self isBigEndian! ! !GIOPHeader methodsFor: 'accessing'! msgType "return the type of the message" ^self byteAt: 8! ! !GIOPHeader methodsFor: 'accessing'! msgType: anInt "set the type of the message" ^self byteAt: 8 put: anInt! ! !GIOPHeader methodsFor: 'accessing'! msgTypeName ^MessageTypeNames at: self msgType + 1.! ! !GIOPHeader methodsFor: 'accessing' stamp: 'x 10/27/1999 21:53'! protocolTag ^(self copyFrom: 1 to: 4) asString ! ! !GIOPHeader methodsFor: 'accessing'! protocolTag: aBytes self replaceFrom: 1 to: 4 with: aBytes startingAt: 1! ! !GIOPHeader methodsFor: 'initialize'! initialize "Initialize the receiver" self majorVersion: 1. self minorVersion: 2. self protocolTag: 'GIOP'. "We always use bigEndian" self byteOrder: 0. ! ! !GIOPHeader class methodsFor: 'class initialization'! initialize MessageTypeNames _ #( request reply cancelRequest locateRequest locateReply closeConnection messageError fragment ) ! ! !GIOPHeader class methodsFor: 'instance creation' stamp: 'x 10/27/1999 21:37'! for: aSymbol | type | type _ MessageTypeNames indexOf: aSymbol ifAbsent:[^self error: 'No such message type: ', aSymbol]. ^self new initialize; msgType: type - 1; yourself.! ! !GIOPHeader class methodsFor: 'instance creation'! new ^super new: self headerSize! ! !GIOPHeader class methodsFor: 'accessing'! headerSize ^12! ! !HomeSystem commentStamp: '<historical>' prior: 0! HomeSystem is a system agent factory which is associated with a distributed thread. ! !HomeSystem methodsFor: 'agents'! fillInTheBlack ^FillInTheBlank! ! !HomeSystem methodsFor: 'agents'! fillInTheBlackMorph ^FillInTheBlankMorph! ! !HomeSystem methodsFor: 'agents'! newStringHolder ^StringHolder new! ! !HomeSystem methodsFor: 'agents'! transcript ^Transcript! ! !HomeSystem methodsFor: 'agents'! utilities ^Utilities! ! !HomeSystem class methodsFor: 'instance creation'! default Default ifNil: [Default _ self new]. ^Default! ! !IpAccessPoint commentStamp: '<historical>' prior: 0! A ipAccessPoint is a internet address with a hostAddress and a portNumber.! !IpAccessPoint reorganize! ('initialize' hostAddress:port: hostName:port:) ('comparing' = hash) ('printing' printOn:) ('accessing' hostAddress hostAddressString hostName port) ! !IpAccessPoint methodsFor: 'initialize'! hostAddress: addr port: aPort address _ (addr class == String ifTrue:[NetNameResolver addressFromString: addr] ifFalse:[addr]). port _ aPort.! ! !IpAccessPoint methodsFor: 'initialize' stamp: 'a 10/28/1999 22:13'! hostName: aString port: aPort address _ NetNameResolver addressForName: aString. port _ aPort.! ! !IpAccessPoint methodsFor: 'comparing'! = anObject ^(self species == anObject species) and: [ (self address = anObject address) & (self port = anObject port)]! ! !IpAccessPoint methodsFor: 'comparing'! hash ^(self hostAddress hash) bitXor: self port hash! ! !IpAccessPoint methodsFor: 'printing'! printOn: aStream aStream nextPutAll: 'Host: '. aStream nextPutAll: self hostAddressString. aStream nextPutAll: ' Port: '. self port printOn: aStream.! ! !IpAccessPoint methodsFor: 'accessing'! hostAddress ^address! ! !IpAccessPoint methodsFor: 'accessing'! hostAddressString ^self hostAddress ifNil: ['localhost'] ifNotNil: [NetNameResolver stringFromAddress: self hostAddress]! ! !IpAccessPoint methodsFor: 'accessing'! hostName ^self hostAddress ifNil: ['localhost'] ifNotNil: [(NetNameResolver nameForAddress: self hostAddress timeout: 1) ifNil: [NetNameResolver stringFromAddress: self hostAddress]]! ! !IpAccessPoint methodsFor: 'accessing'! port ^port! ! !IpAccessPoint class methodsFor: 'instance creation'! hostAddress: addr port: aPort ^super new hostAddress: addr port: aPort! ! !IpAccessPoint class methodsFor: 'instance creation'! hostName: aString port: aPort ^super new hostName: aString port: aPort! ! !Number reorganize! ('arithmetic' * + - / // \\ abs negated quo: reciprocal rem:) ('mathematical functions' arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan) ('truncation and round off' ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated) ('testing' basicType even isDivisibleBy: isInf isInfinite isNaN isNumber isZero negative odd positive sign strictlyPositive) ('converting' @ adaptToCollection:andSend: adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: adaptToPoint:andSend: adaptToString:andSend: asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees) ('intervals' to: to:by: to:by:do: to:do:) ('printing' defaultLabelForInspector isOrAreStringWith: newTileMorphRepresentative printOn: printStringBase: storeOn: storeOn:base: storeStringBase: stringForReadout) ('comparing' closeTo:) ('filter streaming' byteEncode:) ('s2s' isPassedByValue) ! !Number methodsFor: 's2s'! isPassedByValue ^true! ! !ObjectRequestBroker commentStamp: '<historical>' prior: 0! This class is one implementation of an ORB. See CORBA - Common Object Request Broker Architecture at: http://www.omg.org. However, it is only follows the ARCHITECTURE not the standared. A standared ORB with IDL binding could be implemented with current framework, all you need is a GIOP marshaller and IDL-Smalltalk mapper. See Also OrbControl ! ]style[(102 18 214 10 1)f1,f1Rhttp://www.omg.org;,f1,f1LOrbControl Comment;,f1! !ObjectRequestBroker reorganize! ('initialize-release' initServerPort: initialize) ('accessing' accessPoint defaultName defaultServerPort isRunning listener) ('export-registry' export:as: isExported: isNameExported: nameOfExported: revokeAllExport revokeExport: revokeExportNamed:) ('private-export' exportAndGetRef: objectByRef:) ('proxy-registry' remoteObjectAt:name: remoteObjectAtHost:port:name: remoteOrbAt:) ('connection-manage' allObjectAdaptors allRequestConnetions findOrCreateConnectionTo: needHouseKeepping newSocketConnection:) ('private' findOrCreateRemoteObject: isLocal: privateStart privateStop) ('remote-messaging' sendOnewayRequest:to: sendRequest:to:timeout:) ('state-control' systemDown systemUp) ! !ObjectRequestBroker methodsFor: 'initialize-release'! initServerPort: aPort super initialize. listener _ ConnectionListener port: aPort connectionManager: self. persistentObjects _ Set new: 100. exportTable _WeakObjectTable new: 100.! ! !ObjectRequestBroker methodsFor: 'initialize-release'! initialize ^self initServerPort: self defaultServerPort ! ! !ObjectRequestBroker methodsFor: 'accessing'! accessPoint ^listener ifNil:[] ifNotNil: [listener accessPoint]! ! !ObjectRequestBroker methodsFor: 'accessing'! defaultName ^self class name! ! !ObjectRequestBroker methodsFor: 'accessing'! defaultServerPort ^DefaultPort! ! !ObjectRequestBroker methodsFor: 'accessing'! isRunning ^super isRunning & listener isRunning! ! !ObjectRequestBroker methodsFor: 'accessing'! listener ^listener! ! !ObjectRequestBroker methodsFor: 'export-registry' stamp: 'a 10/28/1999 01:40'! export: anObject as: aSymbol "Export anObject with name" ^aSymbol class == Symbol ifTrue: [persistentObjects add: anObject. exportTable at: aSymbol put: anObject] ifFalse:[self error: 'Export object name must be symbol'].! ! !ObjectRequestBroker methodsFor: 'export-registry'! isExported: anObject "Is anObject exported?" ^persistentObjects includes: anObject! ! !ObjectRequestBroker methodsFor: 'export-registry'! isNameExported: aSymbol "Is anObject exported under the name?" ^(exportTable at: aSymbol ifAbsent:[]) isNil not! ! !ObjectRequestBroker methodsFor: 'export-registry'! nameOfExported: anObject "Return the exproted id of anObject" ^(self isExported: anObject) ifTrue:[exportTable keyAtValue: anObject ifAbsent:[]] ifFalse:[]! ! !ObjectRequestBroker methodsFor: 'export-registry'! revokeAllExport persistentObjects _ Set new: 100.! ! !ObjectRequestBroker methodsFor: 'export-registry'! revokeExport: anObject ^persistentObjects remove: anObject ifAbsent: []! ! !ObjectRequestBroker methodsFor: 'export-registry'! revokeExportNamed: aSymbol | obj | ^aSymbol class == Symbol ifTrue: [obj _ exportTable removeKey: aSymbol ifAbsent:[^nil]. persistentObjects remove: obj ifAbsent:[]] ifFalse:[self error: 'Export object name must be symbol'].! ! !ObjectRequestBroker methodsFor: 'private-export'! exportAndGetRef: anObject "Internally export anObject and returns objRef" | oid | oid _ exportTable getKeyOf: anObject. ^ExternalObjRef id: oid accessPoint: self accessPoint. "This is used by out going passedByRef objects"! ! !ObjectRequestBroker methodsFor: 'private-export'! objectByRef: objRef "If objRef is a local object reference then return the local object, otherwise return a remote object proxy" ^(self isLocal: objRef) ifTrue:[exportTable at: objRef id ifAbsent: [ self error: 'Unknow object']] ifFalse:[self findOrCreateRemoteObject: objRef] "This is used by in coming passedByRef objects"! ! !ObjectRequestBroker methodsFor: 'proxy-registry'! remoteObjectAt: ap name: nm | objRef | objRef _ ExternalObjRef id: nm accessPoint: ap. ^self findOrCreateRemoteObject: objRef! ! !ObjectRequestBroker methodsFor: 'proxy-registry'! remoteObjectAtHost: aHostName port: p name: id | objRef pt nm | p ifNil: [pt _ self serverPort] ifNotNil: [pt _ p]. id ifNil: [nm _ self defaultName] ifNotNil: [nm _ id]. objRef _ ExternalObjRef id: nm accessPoint: (IpAccessPoint hostName: aHostName port: pt). ^self findOrCreateRemoteObject: objRef! ! !ObjectRequestBroker methodsFor: 'proxy-registry'! remoteOrbAt: ap | objRef | objRef _ ExternalObjRef id: self defaultName accessPoint: ap. ^self findOrCreateRemoteObject: objRef! ! !ObjectRequestBroker methodsFor: 'connection-manage'! allObjectAdaptors ^connections values select: [:each | each isKindOf: AdaptorConnection]! ! !ObjectRequestBroker methodsFor: 'connection-manage'! allRequestConnetions ^connections values select: [:each | each isKindOf: RequestConnection]! ! !ObjectRequestBroker methodsFor: 'connection-manage'! findOrCreateConnectionTo: objectRef | conn | "(self isLocal: objectRef) ifTrue:[^self error: 'Can''t connect to self']." conn _ self connectionAt: objectRef accessPoint. (conn == nil or: [conn isRunning not]) ifTrue:[conn _ RequestConnection forObjRef: objectRef manager: self. conn start]. ^conn isRunning ifTrue:[conn] ifFalse:[conn stop. self error: 'Can''t create connection to ', objectRef printString].! ! !ObjectRequestBroker methodsFor: 'connection-manage'! needHouseKeepping "Return ture if receiver need to start a house keeping process to timeout the idle connections, otherwise return false" ^true! ! !ObjectRequestBroker methodsFor: 'connection-manage' stamp: 'a 10/28/1999 01:50'! newSocketConnection: skt "Create an object adaptor on the connected skt" | conn | skt isConnected ifTrue:[ conn := AdaptorConnection socket: skt manager: self. conn start. self addConnection: conn].! ! !ObjectRequestBroker methodsFor: 'private'! findOrCreateRemoteObject: objRef | proxy | proxy _ proxyRegistry at: objRef ifAbsent: []. proxy ifNil:[proxy _ RemoteObject on: objRef orb: self. proxyRegistry at: objRef put: proxy]. ^proxy! ! !ObjectRequestBroker methodsFor: 'private'! isLocal: objRef ^objRef accessPoint = self accessPoint! ! !ObjectRequestBroker methodsFor: 'private' stamp: 'a 10/28/1999 22:50'! privateStart super privateStart. "This is pain on the ***!!" Socket initializeNetwork. "Always export self" self export: self as: self defaultName. proxyRegistry _ WeakObjectTable new: 100. ^self listener start. "Developer's Notes: A client only ORB need not start a listener. " ! ! !ObjectRequestBroker methodsFor: 'private'! privateStop super privateStop. ^self listener stop.! ! !ObjectRequestBroker methodsFor: 'remote-messaging'! sendOnewayRequest: msg to: objRef "Send the request 'msg' to the 'objRef'" | connection | ^(msg notNil & objRef notNil) ifTrue:[ connection _ self findOrCreateConnectionTo: objRef. connection sendOnewayRequest: msg to: objRef] ifFalse:[]. "Developer's Notes: Due to the nature of oneway call, the exceution sequence and result of oneway calls is not guarateed. " ! ! !ObjectRequestBroker methodsFor: 'remote-messaging'! sendRequest: msg to: objRef timeout: milliseconds "Send the request 'msg' to the 'objRef' and return the coming back result." | connection | ^(msg notNil & objRef notNil) ifTrue:[ connection _ self findOrCreateConnectionTo: objRef. connection sendRequest: msg to: objRef timeout: milliseconds.] ifFalse:[]. ! ! !ObjectRequestBroker methodsFor: 'state-control'! systemDown "Stop the receiver if it is running, and make state as start on system up" self isRunning ifTrue:[ self stop. self changeState: #StartOnSystemUp]! ! !ObjectRequestBroker methodsFor: 'state-control' stamp: 'a 10/28/1999 22:52'! systemUp "If receiver's previous life is running, then it should be restarted when system is up, otherwise stay down" state == #StartOnSystemUp ifTrue:[self start].! ! !ObjectRequestBroker class methodsFor: 'instance creation'! newAtPort: aNumber ^self new initServerPort: aNumber! ! !ObjectRequestBroker class methodsFor: 'initialize-release'! initialize "ObjectRequestBroker initialize" "ObjectRequestBroker initialize" DefaultPort := 9999. "Need to get the system up/down event. When system down, stop all my instances" Smalltalk addToShutDownList: self. Smalltalk addToStartUpList: self. Socket initializeNetwork.! ! !ObjectRequestBroker class methodsFor: 'initialize-release'! release Smalltalk removeFromShutDownList: self. Smalltalk removeFromStartUpList: self.! ! !OrbContext commentStamp: '<historical>' prior: 0! Objects of this class hold contexts info during an object request, i.e. HomeSystem, reply, replyType, etc.! ]style[(72 10 24)f1,f1LHomeSystem Comment;,f1! !OrbContext reorganize! ('s2s' isPassedByValue readDataFrom:size: storeDataOn:) ('accessing' clientInfo clientInfo: debuggingContext debuggingContext: homeSystem homeSystem: peerInfo peerInfo: principal principal: reply reply: replySemaphore replySemaphore: replyType replyType: request request:) ('initialize-release' initRemoteCallContext release) ! !OrbContext methodsFor: 's2s'! isPassedByValue ^true! ! !OrbContext methodsFor: 's2s' stamp: 'a 10/28/1999 04:57'! readDataFrom: aDataStream size: varsOnDisk "aDataStream beginReference: self." self homeSystem: aDataStream next. self principal: aDataStream next. ! ! !OrbContext methodsFor: 's2s' stamp: 'a 10/28/1999 04:57'! storeDataOn: aDataStream "Only homeSystem need to pass to the remote" aDataStream beginInstance: self class size: 2. aDataStream nextPut: self homeSystem. aDataStream nextPut: self principal.! ! !OrbContext methodsFor: 'accessing'! clientInfo ^clientInfo! ! !OrbContext methodsFor: 'accessing'! clientInfo: anObject "Set the clientInfo of the context" clientInfo _ anObject! ! !OrbContext methodsFor: 'accessing'! debuggingContext ^debuggingContext! ! !OrbContext methodsFor: 'accessing'! debuggingContext: ctx debuggingContext _ ctx! ! !OrbContext methodsFor: 'accessing'! homeSystem ^home ifNil: [home _ HomeSystem default]! ! !OrbContext methodsFor: 'accessing'! homeSystem: aHome "Set the home system of the context" home _ aHome! ! !OrbContext methodsFor: 'accessing'! peerInfo ^peerInfo! ! !OrbContext methodsFor: 'accessing'! peerInfo: anObject "Set the info of communication peer of the context" peerInfo _ anObject! ! !OrbContext methodsFor: 'accessing'! principal ^principal! ! !OrbContext methodsFor: 'accessing'! principal: anObj "Set the principal of this context" principal _ anObj! ! !OrbContext methodsFor: 'accessing'! reply ^reply! ! !OrbContext methodsFor: 'accessing'! reply: anObject reply _ anObject! ! !OrbContext methodsFor: 'accessing'! replySemaphore ^replySemaphore! ! !OrbContext methodsFor: 'accessing'! replySemaphore: anObject replySemaphore _ anObject! ! !OrbContext methodsFor: 'accessing'! replyType ^replyType! ! !OrbContext methodsFor: 'accessing'! replyType: anObject replyType _ anObject! ! !OrbContext methodsFor: 'accessing'! request ^request! ! !OrbContext methodsFor: 'accessing'! request: mStream request _ mStream! ! !OrbContext methodsFor: 'initialize-release'! initRemoteCallContext reply _ nil. replyType _ nil. replySemaphore _ nil. clientInfo _ nil. request _ nil. debuggingContext _ nil.! ! !OrbContext methodsFor: 'initialize-release'! release reply _ nil. replyType _ nil. replySemaphore _ nil. clientInfo _ nil. request _ nil. debuggingContext _ nil. home _ nil.! ! !OrbControl commentStamp: '<historical>' prior: 0! This class is used as a control object for a S2S ORB. It makes use of ORB a little bit easier for people who don't know much about the internals of ORBs. The ORB control API's are at the class side of this class. See ExampleObject for usage example.! ]style[(221 13 19)f1,f1LExampleObject Comment;,f1! !OrbControl class methodsFor: 'testing' stamp: 'a 10/28/1999 00:47'! isOrbRunning ^Orb ifNil: [false] ifNotNil: [ Orb isRunning ]! ! !OrbControl class methodsFor: 'exporting' stamp: 'a 10/28/1999 01:41'! export: obj as: aSymbol "Export a local object, make it accessible from remote by name" (self orb isNameExported: aSymbol) ifTrue:[^self inform: 'The name ', aSymbol, ' has been taken']. self orb export: obj as: aSymbol asSymbol. ^self urlFromName: aSymbol "Note: Althought it seams very handy to export everything by using this method, but it is only intended for ROOT objects, e.g. a naming service, a system service, etc." ! ! !OrbControl class methodsFor: 'exporting'! revokeExportNamed: aSymbol "Revoke an exported object," ^self orb revokeExportNamed: aSymbol asSymbol.! ! !OrbControl class methodsFor: 'initialize-release'! initialize "ORBControl initialize" RemoteSystems _ Dictionary new. self setupRemoteSystems.! ! !OrbControl class methodsFor: 'initialize-release'! setupRemoteSystems "Set up mappings for all known remote systems" " self addSystem: #test1 atHost: 'feng-isdn1.stanford.edu' port: 9999. self addSystem: #test2 atHost: 'feng-isdn1.stanford.edu' port: 9998. self addSystem: #test3 atHost: 'feng-isdn2.stanford.edu' port: 9999. self addSystem: #test4 atHost: 'feng-isdn2.stanford.edu' port: 9998. self addSystem: #test5 atHost: 'feng-isdn3.stanford.edu' port: 9999. self addSystem: #test6 atHost: 'feng-isdn3.stanford.edu' port: 9998. "! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:40'! defaultOrbPort ^9999 ! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:47'! releaseOrb Orb ifNotNil: [ Orb stop. Orb _ nil].! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:47'! setupOrbAtPort: aPort "Set up a orb listening at aPort" self releaseOrb. aPort ifNil:[Orb _ ObjectRequestBroker newAtPort: self defualtOrbPort] ifNotNil: [Orb _ ObjectRequestBroker newAtPort: aPort].! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:42'! startOrb self orb start.! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:42'! startOrbAtPort: aPort self setupOrbAtPort: aPort. ^self startOrb! ! !OrbControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:43'! stopOrb ^self orb stop! ! !OrbControl class methodsFor: 'remote systems'! addSystem: aSymbol atHost: host port: p "Add a remote system name mapping" | accessPoint | accessPoint _ IpAccessPoint hostName: host port: p. ^RemoteSystems at: aSymbol asSymbol put: accessPoint.! ! !OrbControl class methodsFor: 'remote systems'! removeSystem: aSymbol "Remove a remote system name mapping" ^RemoteSystems removeKey: aSymbol ifAbsent: []! ! !OrbControl class methodsFor: 'remote objects' stamp: 'a 10/28/1999 00:48'! objectFromUrl: aString "Try to create a proxy object from url string in the form of s2s://<host>:<port>/<objName> or s2s://<systemName>/<objName>" | buf scheme hostName port objName stream auth ap | buf _ aString withBlanksTrimmed. stream _ ReadStream on: buf from: 1 to: buf size. scheme _ stream upTo: $:. scheme = 's2s' ifFalse:[^self error: 'Unknown object url']. stream skip: 2. auth _ stream upTo: $/. ap _ RemoteSystems at: auth asSymbol ifAbsent:[ hostName _ auth copyUpTo: $:. hostName size = auth size ifTrue:[port _ self defaultOrbPort] ifFalse:[port _ (auth copyFrom: (hostName size + 2) to: auth size) asNumber]. IpAccessPoint hostName: hostName port: port]. objName _ stream upToEnd. (objName == nil or: [objName isEmpty]) ifTrue: [objName _ self orb defaultName] ifFalse: [objName _ objName asSymbol]. ^self orb remoteObjectAt: ap name: objName. "Note: this method need to be more robust then it is" "Note2: Once we have the naming service, S2S url need to be extended: Get the namingService object first and ask it to resolve the rest of the url path" "ORBControl objectFromUrl: 's2s://localhost:9999/TestObject'" "ORBControl objectFromUrl: 's2s://localhost/TestObject'" "ORBControl objectFromUrl: 's2s://localhost'" "ORBControl objectFromUrl: 's2s://test1/TestObject'" ! ! !OrbControl class methodsFor: 'remote objects'! urlFromName: aSymbol "Return the default url for an exported object" | stm | ^(self orb isNameExported: aSymbol) ifNil: [self homeSystem inform: 'The object is not exported'] ifNotNil: [ stm _ WriteStream on: (String new: 40). stm nextPutAll: 's2s://'; nextPutAll: self orb accessPoint hostName; nextPut: $:; nextPutAll: self orb accessPoint port printString; nextPut: $/; nextPutAll: aSymbol asString. stm contents] ! ! !OrbControl class methodsFor: 'remote objects'! urlFromObject: anObject "Return the default url for an exported object" | nm stm | ^(nm _ self orb nameOfExported: anObject) ifNil: [self homeSystem inform: 'The object is not exported'] ifNotNil: [ stm _ WriteStream on: (String new: 40). stm nextPutAll: 's2s://'; nextPutAll: self orb accessPoint hostName; nextPut: $:; nextPutAll: self orb accessPoint port printString; nextPut: $/; nextPutAll: nm asString. stm contents] ! ! !OrbControl class methodsFor: 'accessing' stamp: 'a 10/28/1999 06:02'! orb Orb ifNil: [self error: 'Orb have not been setup yet'] ifNotNil: [^Orb]! ! !OrbControl class methodsFor: 'accessing'! orbAccessPoint ^self orb accessPoint! ! !OrbLocalTest commentStamp: 'a 10/28/1999 05:34' prior: 0! This class is a local loop back tester of orb. It use OrbLocalTestControl to setup two local orbs to do the testing. See OrbLocalTest doTest Developer's Nodes: Distributed app dev and testing can be very time consuming due to it's nature. Currently this test class is very simply but it sets an example on how to test your distributed appliation in a single image as first step. However, you should put you bet on the real multi-image testing.! ]style[(54 19 49 19 314)f1,f1LOrbLocalTestControl Comment;,f1,f1LOrbLocalTest doTest;,f1! !OrbLocalTest reorganize! ('test-calls' echo: getStringHolderFromHome) ('orb-testing' doTest) ('accessing' refObject valueObject) ! !OrbLocalTest methodsFor: 'test-calls' stamp: 'a 10/28/1999 01:29'! echo: obj ^obj! ! !OrbLocalTest methodsFor: 'test-calls' stamp: 'a 10/28/1999 03:02'! getStringHolderFromHome ^self homeSystem newStringHolder! ! !OrbLocalTest methodsFor: 'orb-testing' stamp: 'x 10/27/1999 21:47'! doTest "OrbLocalTest new doTest" | remote result | [ OrbLocalTestControl setupTestOrb. OrbLocalTestControl startOrb. OrbLocalTestControl export: self as: #tester. remote _ OrbLocalTestControl remoteObjectByName: #tester. result _ remote echo: self refObject. result == self refObject ifFalse:[self inform: 'Pass by reference test is failed']. result _ remote echo: self valueObject. result = self valueObject ifFalse:[self inform: 'Pass by value test is failed']. (remote getStringHolderFromHome class == StringHolder) ifFalse: [self inform: 'HomeSystem test failed']. ] ensure: [ "Sometimes, ensure is NOT ENSURED in debuger return. Do the following by hand!!" OrbLocalTestControl releaseOrb]. self inform: 'Test finished' ! ! !OrbLocalTest methodsFor: 'accessing' stamp: 'a 10/28/1999 01:18'! refObject ^Object! ! !OrbLocalTest methodsFor: 'accessing' stamp: 'a 10/28/1999 01:19'! valueObject ^OrderedCollection with: 12345.6789 with: -99999999999999999999999 with: #Symbol with: 'String'! ! Smalltalk renameClassNamed: #OrbTestControl as: #OrbLocalTestControl! !OrbLocalTestControl commentStamp: 'x 10/28/1999 23:07' prior: 0! This class sets up two Orbs, serverOrb and clientOrb for local loop back testing. It will do a network layer loop back and can support most of communiation testing suites except platform dependent tests, i.e. socket implementation, endianess, etc.! !OrbLocalTestControl class methodsFor: 'accessing' stamp: 'a 10/28/1999 00:54'! clientOrb ^ClientOrb ifNil: [self error: 'ClientOrb have not been setup yet'] ifNotNil: [^ClientOrb]! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:44'! defaultClientOrbPort ^8800 ! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:52'! defaultServerOrbPort ^8888 ! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:46'! releaseOrb ClientOrb ifNotNil: [ ClientOrb stop. ClientOrb _ nil]. ^super releaseOrb.! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:52'! setupTestOrb self releaseOrb. super setupOrbAtPort: self defaultServerOrbPort. ClientOrb _ ObjectRequestBroker newAtPort: self defaultClientOrbPort.! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:53'! startOrb super startOrb. self clientOrb start.! ! !OrbLocalTestControl class methodsFor: 'orb control' stamp: 'a 10/28/1999 00:53'! stopOrb super stopOrb. self clientOrb stop.! ! !OrbLocalTestControl class methodsFor: 'remote objects' stamp: 'a 10/28/1999 00:56'! remoteObjectByName: aSymbol ^self clientOrb remoteObjectAt: self orb accessPoint name: aSymbol.! ! !Process reorganize! ('changing process state' resume suspend terminate) ('changing suspended state' install: popTo:) ('accessing' offList priority priority: suspendedContext suspendingList) ('printing' printOn:) ('private' suspendedContext:) ('error handling' errorHandler errorHandler:) ('s2s' homeSystem homeSystem: orbContext orbContext: userContext) ! !Process methodsFor: 's2s'! homeSystem ^self orbContext homeSystem! ! !Process methodsFor: 's2s'! homeSystem: aHomeSystem self orbContext homeSystem: aHomeSystem! ! !Process methodsFor: 's2s'! orbContext | ctx | ^self userContext at: #xxxOrbContext ifAbsent:[ ctx _ OrbContext new. self userContext at: #xxxOrbContext put: ctx. ctx]! ! !Process methodsFor: 's2s'! orbContext: anOrbContext " For private use only!!" self userContext at: #xxxOrbContext put: anOrbContext! ! !Process methodsFor: 's2s'! userContext ^userContext isNil ifTrue:[userContext _ IdentityDictionary new] ifFalse:[userContext]! ! !Proxy commentStamp: '<historical>' prior: 0! Proxy is a delegator of an other object! !Proxy reorganize! ('delegation' doesNotUnderstand:) ('local operation' == become: identityHash ifNil: ifNil:ifNotNil: ifNotNil: isInMemory isPassedByValue nextInstance objectForMessageStream: pointsTo: rehash xxxInstVarAt: xxxInstVarAt:put: xxxIsProxy xxxObject xxxObject: xxxType) ! !Proxy methodsFor: 'delegation'! doesNotUnderstand: aMessage ^ object perform: aMessage selector withArguments: aMessage arguments! ! !Proxy methodsFor: 'local operation'! == anObject "Primitive. Answer whether the receiver and the argument are the same object (have the same object pointer). Do not redefine the message == in any other class!! Essential. No Lookup. Do not override in any subclass. See Object documentation whatIsAPrimitive." "This is just a comment, since this message is never looked up" <primitive: 110> self primitiveFailed! ! !Proxy methodsFor: 'local operation'! become: otherObject "Primitive. Swap the object pointers of the receiver and the argument. All variables in the entire system that used to point to the receiver now point to the argument, and vice-versa. Fails if either object is a SmallInteger" (Array with: self) elementsExchangeIdentityWith: (Array with: otherObject)! ! !Proxy methodsFor: 'local operation'! identityHash "Answer a SmallInteger whose value is related to the receiver's identity. This method must not be overridden, except by SmallInteger. Primitive. Fails if the receiver is a SmallInteger. Essential. See Object documentation whatIsAPrimitive. Do not override." <primitive: 75> self primitiveFailed! ! !Proxy methodsFor: 'local operation'! ifNil: nilBlock "Know I'm not nil, so don't evaluate the block" ^ self! ! !Proxy methodsFor: 'local operation'! ifNil: nilBlock ifNotNil: ifNotNilBlock "Evaluate the block, unless I'm == nil (q.v.)" ^ ifNotNilBlock value! ! !Proxy methodsFor: 'local operation'! ifNotNil: aBlock "know its not nil, since we can't stand for a nil" ^ aBlock value! ! !Proxy methodsFor: 'local operation'! isInMemory ^ true! ! !Proxy methodsFor: 'local operation'! isPassedByValue ^true! ! !Proxy methodsFor: 'local operation'! nextInstance "Primitive. Answer the next instance after the receiver in the enumeration of all instances of this class. Fails if all instances have been enumerated. Essential. See Object documentation whatIsAPrimitive." <primitive: 78> ^nil! ! !Proxy methodsFor: 'local operation'! objectForMessageStream: aStream "Proxies are always local, only objRefs are passing out" ^object! ! !Proxy methodsFor: 'local operation'! pointsTo: anObject "This method returns true if self contains a pointer to anObject, and returns false otherwise" <primitive: 132> 1 to: self class instSize do: [:i | (self instVarAt: i) == anObject ifTrue: [^ true]]. 1 to: self basicSize do: [:i | (self basicAt: i) == anObject ifTrue: [^ true]]. ^ false! ! !Proxy methodsFor: 'local operation'! rehash "Do nothing. Here so sending this to a Set does not have to do a time consuming respondsTo:"! ! !Proxy methodsFor: 'local operation'! xxxInstVarAt: index "Primitive. Answer a fixed variable in an object. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Essential. See Object documentation whatIsAPrimitive." <primitive: 73> self primitiveFailed ! ! !Proxy methodsFor: 'local operation'! xxxInstVarAt: anInteger put: anObject "Primitive. Store a value into a fixed variable in the receiver. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Answer the value stored as the result. Using this message violates the principle that each object has sovereign control over the storing of values into its instance variables. Essential. See Object documentation whatIsAPrimitive." <primitive: 74> self primitiveFailed ! ! !Proxy methodsFor: 'local operation'! xxxIsProxy ^true! ! !Proxy methodsFor: 'local operation'! xxxObject ^object! ! !Proxy methodsFor: 'local operation'! xxxObject: anObject object _ anObject! ! !Proxy methodsFor: 'local operation'! xxxType ^self xxxClass name! ! !PassModeWrapper commentStamp: '<historical>' prior: 0! This class is used to override the default pass mode of an object during the remote message invocation. See Object asPassedByValue and Object asPassedByRef! ]style[(109 22 5 20)f1,f1LObject asPassedByValue;,f1,f1LObject asPassedByRef;! !PassModeWrapper methodsFor: 'initilize'! passedByRef: obj isPassedByValue _ false. object _ obj! ! !PassModeWrapper methodsFor: 'initilize'! passedByValue: obj isPassedByValue _ true. object _ obj! ! !PassModeWrapper methodsFor: 's2s'! isPassedByValue ^isPassedByValue! ! !Proxy class methodsFor: 'instance creation'! new ^self shouldNotImplement! ! !Proxy class methodsFor: 'instance creation'! on: anObject ^super new xxxObject: anObject ! ! !PassModeWrapper class methodsFor: 'instance creation'! passedByRef: obj ^super basicNew passedByRef: obj! ! !PassModeWrapper class methodsFor: 'instance creation'! passedByValue: obj ^super basicNew passedByValue: obj! ! !Random methodsFor: 'orb'! isPassedByValue ^false! ! !RemoteMessageStream commentStamp: '<historical>' prior: 0! This class is used for marshalling/unmarshalling remote messages. It's super class is a bit of complex for this task, but it works. It uses ExternalObjRef to implement pass by reference and use its super class to implement pass by value. Developer's Notes: DreamOn: If only all Smalltalk verdors could agree upon a common format of externalized objects and a semi auto class mapping protocol, we would have a SCORB, Smalltalk Common Object Request Broker. A dialect would perform at its full advatage while relies on others to do their the best. We can get off the dialect war once for all. This would put Smalltalk as THE most advanced Distributed Programming Language and System. DreamOff. ! ]style[(141 14 544)f1,f1LExternalObjRef Comment;,f1! !RemoteMessageStream methodsFor: 'accessing'! buffer ^byteStream originalContents! ! !RemoteMessageStream methodsFor: 'accessing'! getObjRefFor: anObject "First let anObject to decide what object should be put on the receiver, then exported it if it is not passed by value." ^self objectAdaptor exportAndGetRef: anObject ! ! !RemoteMessageStream methodsFor: 'accessing'! objectAdaptor ^objectAdaptor! ! !RemoteMessageStream methodsFor: 'accessing'! objectAdaptor: anOA objectAdaptor _ anOA! ! !RemoteMessageStream methodsFor: 'accessing'! reset super reset. byteStream binary.! ! !RemoteMessageStream methodsFor: 'accessing'! resetContents self reset. byteStream resetContents.! ! !RemoteMessageStream methodsFor: 'writing'! getStoreObjectOf: anObject "Ask anObject for the actual object it want to send out and ask how would it be sent out, by value or by ref." | obj | obj _ anObject objectForMessageStream: self. ^anObject isPassedByValue ifTrue:[obj] ifFalse:[self getObjRefFor: obj].! ! !RemoteMessageStream methodsFor: 'reading'! next "Get the next object on the receiver, if it is an objRef then translate it into either a local object or a remoteObject" | obj | obj _ super next. ^obj class == ExternalObjRef ifTrue:[self objectAdaptor objectByRef: obj] ifFalse:[obj]! ! !RemoteMessageStream class methodsFor: 'instance creation'! on: bytes objectAdaptor: aConn "For writing" ^(super on: (RWBinaryOrTextStream on: bytes)) objectAdaptor: aConn! ! !RemoteMessageStream class methodsFor: 'instance creation'! on: buf readLimit: size objectAdaptor: conn "For reading" ^(super on: (RWBinaryOrTextStream on: buf from: 1 to: size)) objectAdaptor: conn ! ! !RemoteObject commentStamp: '<historical>' prior: 0! RemoteObjects are proxies for objects in remote images.! !RemoteObject reorganize! ('delegation' doesNotUnderstand:) ('local operation' class inspect isKindOf: xxxInspect xxxIsKindOf: xxxIsRemote xxxORB xxxORB: xxxlocalCopy) ! !RemoteObject methodsFor: 'delegation'! doesNotUnderstand: aMessage ^orb ifNotNil:[ orb sendRequest: aMessage to: object timeout: 300 * 1000] ifNil:[ ^super doesNotUnderstand: aMessage]! ! !RemoteObject methodsFor: 'local operation'! class "Well, class message is intercepted by Squeak interpretor, so use class to get the receiver's class and use xxxClass to get remote object's class" "(RemoteObject on: #ABC) class" "(RemoteObject on: #ABC) xxxClass"! ! !RemoteObject methodsFor: 'local operation'! inspect "Create and schedule an Inspector in which the user can examine the remote object's variables." InspectProxy ifTrue:[self xxxInspect] ifFalse:[Inspector openOn: self withEvalPane: true] ! ! !RemoteObject methodsFor: 'local operation'! isKindOf: aClass "This is necessary for inspecting the proxy in the case of inspectId" ^InspectMySelf ifTrue:[self xxxIsKindOf: aClass] ifFalse:[super isKindOf: aClass] ! ! !RemoteObject methodsFor: 'local operation'! xxxInspect "Create and schedule an Inspector in which the user can examine the remote object's variables." Inspector openOn: (Array with: object with: orb) withEvalPane: true withLabel: 'A Proxy' ! ! !RemoteObject methodsFor: 'local operation'! xxxIsKindOf: aClass "This is necessary for inspecting the proxy in the case of inspectId" ^aClass == self class ! ! !RemoteObject methodsFor: 'local operation'! xxxIsRemote ^true! ! !RemoteObject methodsFor: 'local operation'! xxxORB ^orb! ! !RemoteObject methodsFor: 'local operation'! xxxORB: anORB orb _ anORB! ! !RemoteObject methodsFor: 'local operation'! xxxlocalCopy ^self xxxRemoteCopy! ! !RemoteObject class reorganize! ('instance creation' on:orb:) ('inspecting setting' inspectProxy inspectRemote) ('initialize-release' initialize) ! !RemoteObject class methodsFor: 'instance creation'! on: anObject orb: anORB ^(super on: anObject) xxxORB: anORB ! ! !RemoteObject class methodsFor: 'inspecting setting'! inspectProxy "Disallow remote inspecting" InspectProxy _ true.! ! !RemoteObject class methodsFor: 'inspecting setting'! inspectRemote "Allowing remote inspecting. Before you do this, make sure the inspector is happy with remote objects and remote classes. At least, change all usage of message class to xxxClass in inspector. Or change the interpretor." InspectProxy _ false. "What we need is an inspector and explore which is highly optimized for inspecting remote objects and still works well with local objects. Oneway to do it would be make a clean cut between inspector and inspectorWindow and make inspector always co-located with the inspected object while the inspectorWindow is always at the homeSytstem. The two need to communicate effectively with lot's of info caching and message compacting."! ! !RemoteObject class methodsFor: 'initialize-release'! initialize InspectProxy _ true.! ! !Socket class methodsFor: 'utilities'! deadlineMillisecs: msecs "Return a deadline time the given number of milliseconds from now." ^ Time millisecondClockValue + msecs ! ! !String methodsFor: 'converting' stamp: 'a 10/28/1999 04:48'! asRemoteObject "Create a remote object from receiver" ^OrbControl objectFromUrl: self! ! !SystemDictionary methodsFor: 'miscellaneous'! logError: errMsg inContext: aContext to: aFilename "Log the error message and a stack trace to the given file." | ff ctx | FileDirectory default deleteFileNamed: aFilename ifAbsent: []. (ff _ FileStream fileNamed: aFilename) ifNil: [^ self "avoid recursive errors"]. ff print: 'Client'. ff cr. Date today printOn: ff. ff space. Time now printOn: ff. ff cr. "Note: The following is an open-coded version of ContextPart>>stackOfSize: since this method may be called during a low space condition and we might run out of space for allocating the full stack." ctx _ aContext. [ctx == nil] whileFalse:[ ff print: ctx; cr. ctx _ ctx sender]. ff close.! ! !TCPConnection commentStamp: 'a 10/28/1999 00:19' prior: 0! This class represents TCPConnections. Developer's Notes: Connections are generic end points of communication channel it could be based on sockets as this class or shared memory, or wireless interface, etc. A connection has an id and handles i/o on transport. Sometime in the future, an abstract connection class may needed as the super class for all connection classes.! !TCPConnection methodsFor: 'accessing'! id "Use my peerInfo as my id" ^peerInfo! ! !TCPConnection methodsFor: 'accessing'! isRunning ^super isRunning & self isConnected! ! !TCPConnection methodsFor: 'accessing'! manager ^manager! ! !TCPConnection methodsFor: 'accessing'! mark "Increase the useMark by 1, mark receiver unused. This is used by a connection manager to keep track the idle time of receiver." ^useMark _ useMark + 1. ! ! !TCPConnection methodsFor: 'accessing'! resetMark "Set useMark back to 0, to indicate a use of receiver" useMark _ 0! ! !TCPConnection methodsFor: 'private-transport' stamp: 'a 10/28/1999 04:18'! createSocketFor: ipAccessPoint "Create a tcp socket for this connection" socket _ Socket new. socket connectTo: ipAccessPoint hostAddress port: ipAccessPoint port. (socket waitForConnectionUntil: (Socket deadlineSecs: 30)) ifFalse: [ self stop. ^self error: ipAccessPoint printString, ' is not responding']. ^socket ! ! !TCPConnection methodsFor: 'private-transport'! destroyTransport socket ifNotNil: [ socket closeAndDestroy: 2. socket _ nil].! ! !TCPConnection methodsFor: 'private-transport'! isConnected ^socket ~~ nil and: [socket isConnected]! ! !TCPConnection methodsFor: 'private-transport'! peerInfo ^peerInfo! ! !TCPConnection methodsFor: 'private-transport'! pullingInterval "Data pulling interval in milliseconds" ^100 "If the value is too small, then too much time is wasted on pulling, if it is too large, you got poor response."! ! !TCPConnection methodsFor: 'private-transport' stamp: 'a 10/28/1999 05:50'! readDataInto: buf count: size "Read the required count of bytes into buf, return 0 if not successful" | bytesRead | bytesRead := 0. [[self waitForData: self pullingInterval] whileTrue: [ bytesRead _ bytesRead + (socket primSocket: socket socketHandle receiveDataInto: buf startingAt: bytesRead + 1 count: (size - bytesRead)). bytesRead == size ifTrue:[ self resetMark. ^bytesRead]. ]] on: Error do: [:ex | self stop: ex description]. ! ! !TCPConnection methodsFor: 'private-transport'! sendData: buf ^writeLock critical: [ self resetMark. socket sendData: buf] ! ! !TCPConnection methodsFor: 'private-transport'! sendDataFrom: buf startIndex: index count: n | sent | ^writeLock critical: [ self resetMark. sent _ 0. [sent < n] whileTrue:[ sent _ sent + (socket sendSomeData: buf startIndex: index + sent count: (n-sent))]. sent] ! ! !TCPConnection methodsFor: 'private-transport'! waitForData: pullingInterval "Pull to see if data is available on the socket" [socket dataAvailable | socket isConnected] whileTrue:[ (socket waitForDataUntil: (Socket deadlineMillisecs: pullingInterval)) ifTrue:[^true]]. ^false "This is very expensive. Got to have the event driven socket read" "The socket.semaphore seams not wakeup by vm upon data arrival on WinNT. Got to try on other planforms"! ! !TCPConnection methodsFor: 'private'! handshake "Do connection handshake" " self sendAuthInfo. (self checkPeer: self getPeerAuthInfo) ifFalse: [self sendAuthFail. ^self stop: 'Authantication Fail']. self sendArk. " "This is to be transparently done by SSL"! ! !TCPConnection methodsFor: 'private'! privateStart super privateStart. writeLock _ Semaphore forMutualExclusion. self startServerProcess. self isConnected ifTrue: [manager addConnection: self]. ^self isConnected! ! !TCPConnection methodsFor: 'private' stamp: 'a 10/28/1999 21:58'! privateStop self doLog: ['Stop connection to ', self id printString]. manager ifNotNil: [ manager removeConnection: self]. serverProcess ifNotNil: [ serverProcess terminate. serverProcess _ nil]. self destroyTransport. ^super privateStop.! ! !TCPConnection methodsFor: 'private'! processIncomingData ^self subclassResponsibility! ! !TCPConnection methodsFor: 'private' stamp: 'a 10/28/1999 21:57'! serverLoop [self isConnected] whileTrue: [self processIncomingData]. self isRunning ifTrue:[self stop]! ! !TCPConnection methodsFor: 'private'! serverPriority ^Processor highIOPriority "^Processor userInterruptPriority"! ! !TCPConnection methodsFor: 'private'! startServerProcess serverProcess _ [self serverLoop] forkAt: self serverPriority.! ! !TCPConnection methodsFor: 'initialize-release' stamp: 'a 10/28/1999 21:53'! initManager: aConnectionManager super initialize. manager _ aConnectionManager. self resetMark. self handshake.! ! !RequestConnection commentStamp: '<historical>' prior: 0! This class implements Object Request Connection. Upon request, it establish a connection to a remote object adaptor and sends out the object request then wait for a reply if the request is not oneway request. See also: AdaptorConnection and ObjectRequestBroker.! ]style[(222 17 5 19 1)f1,f1LAdaptorConnection Comment;,f1,f1LObjectRequestBroker Comment;,f1! !RequestConnection methodsFor: 'request-managment'! newRequestId ^requestRegistry newObjectId! ! !RequestConnection methodsFor: 'request-managment'! registerRequest: aProcess id: pid requestRegistry at: pid put: aProcess.! ! !RequestConnection methodsFor: 'request-managment'! requestById: rid ^requestRegistry at: rid ifAbsent:[]! ! !RequestConnection methodsFor: 'request-managment'! requestRegistry ^requestRegistry! ! !RequestConnection methodsFor: 'request-managment'! terminateAllRequests requestRegistry ifNotNil: [ requestRegistry values do: [:each | each ifNotNil: [each terminate]]]. ! ! !RequestConnection methodsFor: 'request-managment'! unregisterRequestById: rid ^requestRegistry removeKey: rid ifAbsent:[]! ! !RequestConnection methodsFor: 'private'! fragmentOn: mStream ^self notYetImplemented "Developer's Notes: Get the request process which is blocked at the end of last fragment mStream, set the new mStream and signal dataIsArrived. " ! ! !RequestConnection methodsFor: 'private'! newMessageStream ^self newMessageStream: 200! ! !RequestConnection methodsFor: 'private'! newMessageStream: size ^RemoteMessageStream on: (String new: size) readLimit: size objectAdaptor: self! ! !RequestConnection methodsFor: 'private'! privateStart requestRegistry _ WeakObjectTable new. sessionObjects _ Set new. ^super privateStart.! ! !RequestConnection methodsFor: 'private'! privateStop self terminateAllRequests. requestRegistry _ nil. sessionObjects _ nil. ^super privateStop.! ! !RequestConnection methodsFor: 'private'! readMessageBody: size | mStream | ^size == 0 ifTrue:[] ifFalse:[ mStream _ self newMessageStream: size. self readDataInto: mStream buffer count: size. mStream].! ! !RequestConnection methodsFor: 'private'! readMessageHeader | buf | buf _ GIOPHeader new. self readDataInto: buf count: buf size. ^buf! ! !RequestConnection methodsFor: 'private' stamp: 'a 10/28/1999 03:59'! sendRequest: msg to: objRef oneway: aBoolean marshallOn: mStream "Send the request 'msg' to the 'objRef' and return the request." | rid proc header ctx | rid _ self newRequestId. proc _ Processor activeProcess. ctx _ proc orbContext. ctx initRemoteCallContext. aBoolean ifFalse:[ ctx replySemaphore: Semaphore new. self registerRequest: proc id: rid]. mStream nextPut: rid. mStream nextPut: aBoolean. mStream nextPut: proc orbContext. mStream nextPut: objRef. mStream nextPut: msg selector. mStream nextPut: msg arguments. header _ GIOPHeader for: #request. header msgSize: mStream size. self sendData: header. self sendDataFrom: mStream buffer startIndex: 1 count: mStream size. ^rid "Note: the marshalling has to be sync with ObjectAdaptorConnection>>doRequestOn: mStream peerInfo: info"! ! !RequestConnection methodsFor: 'private' stamp: 'a 10/28/1999 03:27'! waitForReplyId: rid until: aTimeout | replySemaphore ctx delay type mStream | "Setup the waiting semaphore and a timeout delay" ctx _ Processor activeProcess orbContext. replySemaphore _ ctx replySemaphore. delay _ Delay new setDelay: aTimeout forSemaphore: replySemaphore. "Block the calling thread" delay wait. "Being wakeup either by a reply message or by the timeout delay" self unregisterRequestById: rid. "If the delay is over, then it is a timeout error." delay stillWaiting ifFalse:[^self inform: 'Remote call timeout']. delay unschedule. "Otherwise, process the remote reply store in orbContext" self doLog: ['Sender wake up']. type _ ctx replyType. mStream _ ctx reply. type == #reply ifTrue:[^mStream next]. type == #messageError ifTrue:[^self inform: 'Remote ', mStream next]. type == #fragment ifTrue:[^self fragmentOn: mStream]. type == #locateReply ifTrue:["Not implemented yet"]. ^self inform: 'Remote call error' ! ! !RequestConnection methodsFor: 'private' stamp: 'a 10/28/1999 22:03'! wakeupRequestOn: mStream type: aSymbol "Set the reply stream, mStream to the orbContext of the waiting request process, and wake it up" | rid proc ctx | self doLog: ['Try wakeup sender']. rid _ mStream next. proc _ self requestById: rid. proc ifNotNil: [ ctx _ proc orbContext. ctx reply: mStream. ctx replyType: aSymbol. ctx replySemaphore signal]. Processor yield. ! ! !RequestConnection methodsFor: 'data-processing' stamp: 'x 10/27/1999 21:59'! processIncomingData | header | header _ self readMessageHeader. header isValid ifTrue: [self processMessage: header] ifFalse:[self isRunning ifTrue:[self stop: 'Get a invalid message header']] ! ! !RequestConnection methodsFor: 'data-processing' stamp: 'x 10/27/1999 21:58'! processMessage: header | mStream type | mStream _ self readMessageBody: header msgSize. type _ header msgTypeName. type = #closeConnection ifTrue:[^self stop: 'Request connection closed by peer']. self wakeupRequestOn: mStream type: type ! ! !RequestConnection methodsFor: 'remote-mssaging' stamp: 'a 10/28/1999 04:01'! sendOnewayRequest: msg to: objRef timeout: milliseconds "Send the oneway request 'msg' to the 'objRef' and return the request." self sendRequest: msg to: objRef oneway: true marshallOn: self newMessageStream. self doLog: ['Oneway request: ', msg selector printString]. ^nil! ! !RequestConnection methodsFor: 'remote-mssaging' stamp: 'a 10/28/1999 04:02'! sendRequest: msg to: objRef timeout: milliseconds "Send the request 'msg' to the 'objRef' and return the request." | rid result | rid _ self sendRequest: msg to: objRef oneway: false marshallOn: self newMessageStream. self doLog: ['Send Request: ', msg selector printString]. result _ self waitForReplyId: rid until: milliseconds. self doLog: ['Get Reply for: ', msg selector printString]. ^result ! ! !RequestConnection methodsFor: 'session-objects'! exportAndGetRef: anObject "Keep anObject persistent during the session" sessionObjects add: anObject. ^self manager exportAndGetRef: anObject.! ! !RequestConnection methodsFor: 'session-objects'! objectByRef: objRef ^self manager objectByRef: objRef ! ! !RequestConnection methodsFor: 'state-control'! stopRequest: aString "Stop if there are no pending requests" self requestRegistry isEmpty ifTrue:[ ^super stopRequest: aString]! ! !RequestConnection methodsFor: 'initialize-release' stamp: 'a 10/28/1999 22:01'! forObjRef: externalObjRef manager: aConnectionManager "initialize the receiver for a tcp client connection" self initManager: aConnectionManager. peerInfo := externalObjRef accessPoint. socket _ self createSocketFor: peerInfo. self doLog: ['aClientConnection is made to ', peerInfo printString].! ! !AdaptorConnection commentStamp: '<historical>' prior: 0! This class implements Basic Object Adaptor. It accepts object request coming from a connected requestConnection, activate a server object, forward the message to the server and returns the result. Current implementation of server activation is fork a process for each incoming request. See Also: RequestConnection and ObjectRequestBroker.! ]style[(300 17 5 19 1)f1,f1LRequestConnection Comment;,f1,f1LObjectRequestBroker Comment;,f1! !AdaptorConnection methodsFor: 'private'! cancelRequestOn: mStream | proc | proc _ self requestById: mStream next. proc ifNotNil: [proc terminate].! ! !AdaptorConnection methodsFor: 'private' stamp: 'a 10/28/1999 04:09'! doRequestOn: mStream peerInfo: info | requestId obj ctx selector args result oneway proc | [ requestId _ mStream next. oneway _ mStream next. ctx _ mStream next. obj _ mStream next. selector _ mStream next. args _ mStream next. ctx peerInfo: info. proc _ Processor activeProcess. proc orbContext: ctx. self registerRequest: proc id: requestId. self doLog: ['Get Request: ', selector printString]. result _ obj remotePerform: selector withArguments: args ] on: Error do: [:ex | self doLog: [ex description] level: ErrorLogLevel. oneway ifFalse: [^self replyException: ex requestId: requestId marshallOn: mStream] ]. oneway ifFalse:[self reply: result requestId: requestId marshallOn: mStream]. self unregisterRequestById: requestId. self doLog: ['Send Reply for ', selector printString].! ! !AdaptorConnection methodsFor: 'private'! reply: result requestId: requestId marshallOn: mStream | header | mStream resetContents. mStream nextPut: requestId. mStream nextPut: result. header _ GIOPHeader for: #reply. header msgSize: mStream size. self sendData: header. self sendDataFrom: mStream buffer startIndex: 1 count: mStream size.! ! !AdaptorConnection methodsFor: 'private' stamp: 'a 10/28/1999 04:01'! replyException: ex requestId: requestId marshallOn: mStream | header | mStream resetContents. requestId ifNil: [self doLog: ['Reply to unknown request (nil rid)'] level: ErrorLogLevel] ifNotNil: [ mStream nextPut: requestId. mStream nextPut: ex description. header _ GIOPHeader for: #messageError. header msgSize: mStream size. self sendData: header. self sendDataFrom: mStream buffer startIndex: 1 count: mStream size]. "Developer's Notes: The standard way to reply a user excution error is use a statue in the regular reply, not using messageError pacakage. Do it later. "! ! !AdaptorConnection methodsFor: 'private'! workerPriority "^Processor highIOPriority" ^Processor userInterruptPriority! ! !AdaptorConnection methodsFor: 'data-processing' stamp: 'x 10/27/1999 22:02'! processMessage: header | mStream type | mStream _ self readMessageBody: header msgSize. type _ header msgTypeName. type == #request ifTrue:[[self doRequestOn: mStream peerInfo: self peerInfo] forkAt: self workerPriority]. type == #cancelRequest ifTrue:[^self cancelRequestOn: mStream]. type == #closeConnection ifTrue:[^self stop: 'Adaptor connection clsoed by peer']. type == #fragment ifTrue:[^self fragmentOn: mStream]! ! !AdaptorConnection methodsFor: 'initialize-release' stamp: 'a 10/28/1999 22:02'! socket: aSocket manager: aConnectionManager self initManager: aConnectionManager. socket _ aSocket. peerInfo := IpAccessPoint hostAddress: socket remoteAddress port: socket remotePort. self doLog: ['ServerConnection is accepted from ', peerInfo printString].! ! !RequestConnection class methodsFor: 'instance creation' stamp: 'a 10/28/1999 21:56'! forObjRef: externalObjRef manager: aConnectionManager "Create a connection to externalObjRef" ^super new forObjRef: externalObjRef manager: aConnectionManager! ! !AdaptorConnection class methodsFor: 'instance creation' stamp: 'a 10/28/1999 21:56'! socket: aSocket manager: aConnectionManager "Handle a transport layer connection on aSocket" ^super new socket: aSocket manager: aConnectionManager! ! !Time reorganize! ('accessing' hours minutes seconds) ('arithmetic' addTime: subtractTime:) ('comparing' < = hash) ('printing' intervalString print24 print24:on: print24:showSeconds:on: printOn: storeOn:) ('converting' asSeconds) ('private' hours: hours:minutes:seconds:) ('s2s' isPassedByValue) ! !Time methodsFor: 's2s'! isPassedByValue ^true! ! !UndefinedObject reorganize! ('copying' clone copyRecordingIn: deepCopy shallowCopy veryDeepCopyWith:) ('printing' newTileMorphRepresentative printOn: storeOn:) ('testing' haltIfNil ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isEmptyOrNil isNil notNil) ('dependents access' addDependent: release suspend) ('class hierarchy' addSubclass: environment removeSubclass: subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclassDefinerClass subclasses subclassesDo: subclassesDoGently: typeOfClass) ('3ds parser support' from3DS:) ('s2s' isPassedByValue) ! !UndefinedObject methodsFor: 's2s'! isPassedByValue ^true! ! !WeakArray reorganize! ('s2s' isPassedByValue) ! !WeakArray methodsFor: 's2s'! isPassedByValue ^false! ! !WeakKeyDictionary reorganize! ('finalization' finalizeValues) ('accessing' at:put:) ('private' rehash) ('adding' add:) ('s2s' isPassedByValue) ! !WeakKeyDictionary methodsFor: 's2s'! isPassedByValue ^false! ! !WeakRegistry reorganize! ('finalization' finalizeValues) ('adding' add:) ('accessing' size species) ('initialize' initialize:) ('private' protected:) ('enumerating' do:) ('removing' remove:ifAbsent:) ('s2s' isPassedByValue) ! !WeakRegistry methodsFor: 's2s'! isPassedByValue ^false! ! !WeakValueDictionary reorganize! ('adding' add:) ('accessing' at:put:) ('s2s' isPassedByValue) ! !WeakValueDictionary methodsFor: 's2s'! isPassedByValue ^false! ! !WeakObjectTable commentStamp: '<historical>' prior: 0! This class implements quick mapping between exported objects and ids. It holds exported object weakly, that means user have to hold on to exported objects to keep it from GC. It also has a smallInteger sequence used as a simple object id generator. ! !WeakObjectTable reorganize! ('initialize' initialize) ('finalization' finalizeValues) ('private' protected:) ('accessing' at: at:ifAbsent: at:put: getKeyOf: isPassedByValue keyAtValue: newObjectId) ('removing' removeKey: removeKey:ifAbsent: removeValue:) ! !WeakObjectTable methodsFor: 'initialize'! initialize accessLock _ Semaphore forMutualExclusion. nextId _ 0.! ! !WeakObjectTable methodsFor: 'finalization'! finalizeValues "Some of the values may have gone away. Remove those entries." self protected:[ self associationsDo:[:assoc| assoc value isNil ifTrue:[super removeKey: assoc key ifAbsent:[]] ] ]. ! ! !WeakObjectTable methodsFor: 'private'! protected: aBlock "Execute aBlock protected by the accessLock" ^accessLock isNil ifTrue:[aBlock value] ifFalse:[accessLock critical: aBlock ifError:[:msg :rcvr| rcvr error: msg]]! ! !WeakObjectTable methodsFor: 'accessing'! at: anOOID anOOID ifNil: [^anOOID]. ^self protected: [ super at: anOOID ifAbsent: [] ]! ! !WeakObjectTable methodsFor: 'accessing'! at: anOOID ifAbsent: aBlock anOOID ifNil: [^aBlock value]. ^self protected: [ super at: anOOID ifAbsent: aBlock ]! ! !WeakObjectTable methodsFor: 'accessing'! at: id put: anObj self protected: [ super at: id put: anObj]. ^id! ! !WeakObjectTable methodsFor: 'accessing'! getKeyOf: anObject | key | ^self protected: [ super keyAtValue: anObject ifAbsent: [key _ self newObjectId. super at: key put: anObject. key]].! ! !WeakObjectTable methodsFor: 'accessing'! isPassedByValue "Don't pass by value!!" ^false! ! !WeakObjectTable methodsFor: 'accessing'! keyAtValue: anObject anObject ifNil: [^anObject]. ^self protected: [ super keyAtValue: anObject ifAbsent: [] ]! ! !WeakObjectTable methodsFor: 'accessing'! newObjectId ^nextId _ nextId + 1 \\ 1073741822 ! ! !WeakObjectTable methodsFor: 'removing'! removeKey: aKey aKey ifNil: [^aKey]. ^self protected: [ super removeKey: aKey].! ! !WeakObjectTable methodsFor: 'removing'! removeKey: aKey ifAbsent: aBlock aKey ifNil: [^aKey]. ^self protected: [ super removeKey: aKey ifAbsent: aBlock].! ! !WeakObjectTable methodsFor: 'removing'! removeValue: anObject anObject ifNil: [^nil]. self protected: [ super removeKey: (self keyAtValue: anObject ifAbsent:[^anObject]) ifAbsent: []]. ^anObject! ! !WeakObjectTable class methodsFor: 'instance creation'! new "WeakObjectTable new" ^self new: 20! ! !WeakObjectTable class methodsFor: 'instance creation'! new: n "WeakObjectTable new" | table | table := super new: n. table initialize. WeakArray addWeakDependent: table. ^table! ! ALSM initialize! ALSM class removeSelector: #userErrorLogLevel! ALSM class removeSelector: #systemErrorLogLevel! ALSM class removeSelector: #inforLogLevel! GIOPHeader removeSelector: #isValide! GIOPHeader initialize! ObjectRequestBroker removeSelector: #echo:! ObjectRequestBroker removeSelector: #export:byName:! ObjectRequestBroker initialize! OrbControl initialize! OrbControl class removeSelector: #export:byName:! OrbLocalTest removeSelector: #getHomeSystem! OrbLocalTestControl class removeSelector: #defaultOrbPort! RemoteObject initialize! TCPConnection removeSelector: #socket:manager:! TCPConnection removeSelector: #forObjRef:manager:! AdaptorConnection removeSelector: #processIncomingData! TCPConnection class removeSelector: #socket:manager:! TCPConnection class removeSelector: #forObjRef:manager:! TCPConnection class removeSelector: #id:socket:manager:! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." ! --------------4FDFC2E17E648A5C4F52E204--
More information about the Squeak-dev mailing list |