Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!ucbvax!decwrl!sun!pitstop!sundc!seismo!uunet!mcvax!ukc!dcl-cs!neil
From: neil@comp.lancs.ac.uk (Neil Haddley)
Newsgroups: comp.lang.smalltalk
Subject: Distributed(ish) Smalltalk
Message-ID: <721@dcl-csvax.comp.lancs.ac.uk>
Date: 14 Mar 89 00:04:56 GMT
Reply-To: neil@comp.lancs.ac.uk (Neil Haddley)
Organization: Department of Computing at Lancaster University, UK.
Lines: 1039

Distributed(ish) Smalltalk

The code enclosed below is a first attempt at providing a
Distribution layer ontop of ParcPlace Smalltalk VI2.2 VM1.1

A Readme file provides more details

------------------------- cut here ----------------------------
#!/bin/sh
#
# To create source use: sh <filename>
# 
sed 's/^X//' > Readme << '/'
XDistributed(ish) Smalltalk
X
XThe code which is presented here is the result of a small experi-
Xment performed as part of my Phd development work.
X
XIt builds on the sockets demo code which is packaged  with  Parc-
XPlace Smalltalk VI2.2 VM1.1 [/usr/smalltalk/sockets] to provide a
X(not very robust) way of sending messages between  two  Smalltalk
Ximages which share a common 'C' server.
X
XThe simple message passing supported is then packaged  up  in  an
Xeasy to use way. The most interesting result of this is the abil-
Xity to created running (View and Controller) Tools on one machine
Xwhich manipulate (Models) Objects on another.
X
XI can not stress enough that this is only a spin off  experiment,
Xbut it is interesting to see the loss of speed which results from
Xeven this rather fragile implementation.
X
XI have never seen a real Distributed Smalltalk system, although I
Xwould  be  very  interested  to see one, not withstanding I would
Xconclude from this experiment that any robust Distributed  System
Xbuilt ontop of an existing Smalltalk implementation might be very
Xslow ?
X
XThe Code is in two  Parts:  The  'C'  server  and  the  Smalltalk
XSource.  I  do assume that you have access to the existing server
Xcode packaged with ParcPlace Smalltalk VI2.2  VM1.1  as  I  don't
Xwant to upset ParcPlace by sending a copy of their code out here.
XAs it is server.c bears a remarkable similarity to myecho.c,  and
Xthe counter example is adapted and given here.
X
XTo create - compile 'C' code using makefile.
X	    open new image (st80).
X	    load in /usr/smalltalk/sockets/Socket.st
X	    and extra '.st' files using contents of 'loading'
X	    Then save resulting smalltalk image twice
X		(Dist1.im and Dist2.im etc say).
X
X
XTo run - start the server on a suitable machine.
X                  'snap' each of the images on separate machines.
X                  Create the interface object.
X                                "SystemInterfaceObject createSystemInterfaceObject".
X                             [during which the server address must be entered].
X
X                  Create a 'real object' - perferably from a class which
X                        inherits from DistributableObject.
X                  Then either:
X                        Place as an entry in 'Smalltalk' 
X			 (ie Smalltalk at: #name put: Object)
X                        in which case messages are sent in the form:
X                           InterfaceObject perform: message nonLocalId: #name.
X
X                   Or:
X                        Register object as distribted using:
X                                InterfaceObject distribute: Object as: #name.                          After which SystemInterfaceObject at: #name will return 
X                              either a real object, or a surrogate object
X		              which will relay all messages to the other image.
X        
XFinally two simple example tools are given. These are the Counter example
X(credit to ParcPlace) and the Dice example (credit to Manchester Uni).
X
X
XFirst create the interface object on each machine:
X 
XInterfaceObject createSystemInterfaceObject.
X 
XThen,
X 
XOn one machine enter:
X 
X| temp |
Xtemp _ Dice new.
XSystemInterfaceObject distribute: temp as: #MyDice.
XDiceView openOn: (SystemInterfaceObject at: #MyDice)
X 
Xor
X 
X| temp |
Xtemp _ CountHolder new: 0.
XSystemInterfaceObject distribute: temp as: #MyCounter.
XCounterView openOn: (SystemInterfaceObject at: #MyCounter)
X 
X 
XAnd then on the other enter:
X 
XDiceView openOn: (SystemInterfaceObject at: #MyDice)
X 
Xor
X 
XCounterView openOn: (SystemInterfaceObject at: #MyCounter)
X
XAlternative Examples: 
X
XSystemInterfaceObject perform: (Message selector: #cursorPoint) nonLocalId: #Sensor
X 
X(SystemInterfaceObject perform: (Message selector: #new) nonLocalId: #Dice) inspect
X
XAs one last point my apologies to everyone who sent messages asking for detail of the Designer's Notepad, part of which was put on the net almost a year ago. The first papers describing the results of this work are only just starting to be
Xpublished now.
X 
XNeil Haddley
/
sed 's/^X//' > loading << '/'
X"Globals"
X
XSmalltalk at: #SystemInterfaceObject put: nil.
X
X"Code"
X
X(FileStream oldFileNamed: '/usr/smalltalk/sockets/Socket.st') fileIn. 
X
X(FileStream oldFileNamed: 'Remote-Message.st') fileIn.
X
X(FileStream oldFileNamed: 'Distributable-Objects.st') fileIn.
X
X(FileStream oldFileNamed: 'Surrogate-Objects.st') fileIn.
X
X(FileStream oldFileNamed: 'Interface-Object.st') fileIn.
X
X(FileStream oldFileNamed: 'Games-Dice.st') fileIn.
X
X(FileStream oldFileNamed: 'Demo-Counter.st') fileIn. 
/
sed 's/^X//' > Remote-Message.st << '/'
XObject subclass: #Signal
X	instanceVariableNames: 'id '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Remote-Message'!
X
X
X!Signal methodsFor: 'accessing'!
X
Xid
X	^id! !
X
X!Signal methodsFor: 'modifying'!
X
Xid: aSymbol
X	id _ aSymbol! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XSignal class
X	instanceVariableNames: ''!
X
X
X!Signal class methodsFor: 'instance creation'!
X
Xid: aSymbol
X	^super new id: aSymbol! !
X
XObject subclass: #Reply
X	instanceVariableNames: 'value '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Remote-Message'!
X
X
X!Reply methodsFor: 'modifying'!
X
Xvalue: aValue
X	value _ aValue! !
X
X!Reply methodsFor: 'accessing'!
X
Xvalue
X	^value! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XReply class
X	instanceVariableNames: ''!
X
X
X!Reply class methodsFor: 'instance creation'!
X
Xvalue: aValue
X	^super new value: aValue! !
X
XObject subclass: #Request
X	instanceVariableNames: 'id message '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Remote-Message'!
X
X
X!Request methodsFor: 'accessing'!
X
Xid
X	^id!
X
Xmessage
X	^message! !
X
X!Request methodsFor: 'modifying'!
X
Xid: aSymbol
X	id _ aSymbol!
X
Xmessage: aMessage
X	message _ aMessage! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XRequest class
X	instanceVariableNames: ''!
X
X
X!Request class methodsFor: 'instance creation'!
X
Xid: aSymbol message: aMessage
X	^super new id: aSymbol; message: aMessage! !
/
sed 's/^X//' > Distributable-Objects.st << '/'
XModel subclass: #DistributableObject
X	instanceVariableNames: 'surrogateNames '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Distributable-Objects'!
X
X
X!DistributableObject methodsFor: 'private'!
X
XsetSurrogateNames
X	surrogateNames _ Set new.! !
X
X!DistributableObject methodsFor: 'modifying'!
X
XaddSurrogateName: aSymbol
X	surrogateNames add: aSymbol!
X
XremoveSurrogateName: aSymbol
X	surrogateNames remove: aSymbol! !
X
X!DistributableObject methodsFor: 'changing'!
X
Xchanged: anAspectSymbol with: aParameter 
X	surrogateNames do: [:id | SystemInterfaceObject signal: id].
X	^super changed: anAspectSymbol with: aParameter!
X
Xsignal
X	^super changed: nil with: nil! !
X
X!DistributableObject methodsFor: 'printing'!
X
XstoreOn: aStream
X	| temp result |
X	temp _ self dependents.
X	self breakDependents.
X	result _ super storeOn: aStream.
X	temp do: [:item | self addDependent: item].
X	^result! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XDistributableObject class
X	instanceVariableNames: ''!
X
X
X!DistributableObject class methodsFor: 'instance creation'!
X
Xnew
X	^super new setSurrogateNames! !
/
sed 's/^X//' > Surrogate-Objects.st << '/'
XObject subclass: #Surrogate
X	instanceVariableNames: 'nonLocalName '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Surrogate-Objects'!
X
X
X!Surrogate methodsFor: 'special'!
X
XdoesNotUnderstand: aMessage 
X	^SystemInterfaceObject perform: aMessage nonLocalId: nonLocalName! !
X
X!Surrogate methodsFor: 'private'!
X
XnonLocalName: aSymbol
X	nonLocalName _ aSymbol! !
X
X!Surrogate methodsFor: 'changing'!
X
Xchanged: anAspectSymbol with: aParameter 
X	SystemInterfaceObject signal: nonLocalName.
X	^super changed: anAspectSymbol with: aParameter!
X
Xsignal
X	^super changed: nil with: nil! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XSurrogate class
X	instanceVariableNames: ''!
X
X
X!Surrogate class methodsFor: 'instance creation'!
X
XnonLocalName: aSymbol
X	^super new nonLocalName: aSymbol! !
/
sed 's/^X//' > Interface-Object.st << '/'
XObject subclass: #InterfaceObject
X	instanceVariableNames: 'host service distributionTable interfaceProcess socket sharedQueue '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Interface-Object'!
X
X
X!InterfaceObject methodsFor: 'outgoing messages'!
X
Xperform: message nonLocalId: aSymbol 
X	^self
X		selector: (message selector)
X		withArguments: (message arguments)
X		nonLocalId: aSymbol!
X
Xselector: selector nonLocalId: aSymbol 
X	^self
X		selector: selector
X		withArguments: (Array new: 0)
X		nonLocalId: aSymbol!
X
Xselector: selector withArguments: anArray nonLocalId: aSymbol 
X	| message |
X	message _ Message selector: selector arguments: anArray.
X	"(distributionTable includesKey: aSymbol) ifFalse: [self error: 'surrogate connection broken']."
X	^self sendRequestFor: message nonLocalId: aSymbol!
X
XsendMessage: aMessage
X	| result message | 
X	Transcript cr; show: 'send outgoing message'.
X	aMessage class = Request ifTrue: [self transmit: aMessage. result _ sharedQueue next. ^result].
X	aMessage class = Reply ifTrue: [^self transmit: aMessage].
X	aMessage class = Signal ifTrue: [^self transmit: aMessage].!
X
XsendRequestFor: message nonLocalId: aSymbol 
X	| request |
X	request _ Request id: aSymbol message: message.
X	^self sendMessage: request!
X
Xsignal: anId 
X	| signal |
X	signal _ Signal id: anId.
X	self sendMessage: signal! !
X
X!InterfaceObject methodsFor: 'distribution'!
X
XcreateSurrogate: anId
X	| newSurrogate | 
X	newSurrogate _ Surrogate nonLocalName: anId.
X	distributionTable at: anId put: newSurrogate.
X	^nil!
X
Xdistribute: anObject as: anId 
X	distributionTable at: anId put: anObject.
X	(anObject isKindOf: DistributableObject)
X		ifTrue: [anObject addSurrogateName: anId].
X	SystemInterfaceObject
X		selector: #createSurrogate:
X		withArguments: (Array with: anId)
X		nonLocalId: #SystemInterfaceObject.
X	^nil!
X
XreLocalize1: anId 
X	| anObject |
X	anObject _ distributionTable at: anId.
X	(anObject isKindOf: DistributableObject)
X		ifTrue: [anObject removeSurrogateName: anId].
X	distributionTable removeKey: anId.
X	^nil!
X
XreLocalize: anId 
X	| anObject |
X	anObject _ distributionTable at: anId.
X	(anObject isKindOf: DistributableObject)
X		ifTrue: [anObject removeSurrogateName: anId].
X	distributionTable removeKey: anId.
X	SystemInterfaceObject
X		selector: #reLocalize1:
X		withArguments: (Array with: anId)
X		nonLocalId: #SystemInterfaceObject.
X	^nil! !
X
X!InterfaceObject methodsFor: 'incoming messages'!
X
XdealWith: aString
X	| message result |  
X	message _ Object readFrom: aString.
X	Transcript cr; show: 'deal with incoming message '; show: (message class printString).
X	message class = Request ifTrue: [self replyToRequest: message].
X	message class = Reply ifTrue: [result _ message value. sharedQueue nextPut: result].
X	message class = Signal ifTrue: [self sendSignal: message].!
X
XreplyToRequest: request 
X	| id message result reply sink |
X	id _ request id.
X	message _ request message.
X	sink _ distributionTable at: id ifAbsent: [Smalltalk at: id].
X	result _ sink perform: message selector withArguments: message arguments.
X	reply _ Reply value: result.
X	self sendMessage: reply!
X
XsendSignal: message 
X	
X	[(Delay forMilliseconds: 500) wait.
X	(distributionTable at: message id) signal] fork!
X
Xtransmit: aMessage
X	socket write: (aMessage storeString).! !
X
X!InterfaceObject methodsFor: 'private'!
X
Xconnect
X	socket _ Socket connectTo: service on: host.
X	socket == nil
X		ifTrue: [self error: 'Connection failed, please run the Server process.']
X		ifFalse: [Transcript cr; show: 'Connection made']!
X
Xhost: aString service: anotherString
X	host _ aString.
X	service _ anotherString!
X
Xinitialize
X	host _ ''.
X	service _ ''.
X	distributionTable _ Dictionary new.
X	interfaceProcess _ nil.
X	socket _ nil.
X	sharedQueue _ SharedQueue new!
X
XkissOfLife
X	| ok answer semaphore count |
X	ok _ true.
X	interfaceProcess _ [[ok]
X				whileTrue: 
X					[answer _ String new: 500.
X					semaphore _ Semaphore new.
X					socket waitForDataOn: semaphore.
X					count _ socket read: answer.
X					count > 0
X						ifTrue: [self dealWith: (answer copyFrom: 1 to: count)]
X						ifFalse: [count < 0
X								ifTrue: 
X									[Transcript cr; show: 'Connection broken'.
X									ok _ false]]]] newProcess.
X	interfaceProcess resume! !
X
X!InterfaceObject methodsFor: 'accessing'!
X
Xat: aSymbol 
X	^distributionTable at: aSymbol! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XInterfaceObject class
X	instanceVariableNames: ''!
X
X
X!InterfaceObject class methodsFor: 'instance creation'!
X
XcreateSystemInterfaceObject
X	"InterfaceObject createSystemInterfaceObject"
X
X	Smalltalk at: #SystemInterfaceObject put: nil.
X	Smalltalk at: #SystemInterfaceObject put: self new.
X	SystemInterfaceObject connect.
X	SystemInterfaceObject kissOfLife!
X
Xhost: aString service: anotherString
X	^super new initialize; host: aString service: anotherString!
X
Xnew
X	| aString anotherString |
X	aString _ FillInTheBlank request: 'Name of host? (blank for this one)'.
X	anotherString _ FillInTheBlank request: 'Name of the service socket' initialAnswer: '9876'.
X	anotherString isEmpty ifTrue: [^nil].
X	^self host: aString service: anotherString! !
/
sed 's/^X//' > Games-Dice.st << '/'
XView subclass: #DiceView
X	instanceVariableNames: 'cacheBox cachedForms '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Games-Dice'!
XDiceView comment:
X'I know how to display a Dice in a viewable manner.  I keep cached forms
Xfor speed.'!
X
X
X!DiceView methodsFor: 'initialize-release'!
X
Xinitialize
X	"Initialize the array for cached forms."
X
X	cachedForms _ Array new: 6.
X	super initialize! !
X
X!DiceView methodsFor: 'controller access'!
X
XdefaultControllerClass
X
X	^DiceController! !
X
X!DiceView methodsFor: 'displaying'!
X
XdisplayView
X	"Display the model.  Re-create the cached forms if the display
X	 box has changed."
X
X	(cacheBox isNil or: [cacheBox ~= self insetDisplayBox]) ifTrue: [
X		self makeForms.
X		cacheBox _ self insetDisplayBox copy].
X	(cachedForms at: self model value)
X		displayOn: Display
X		at: self insetDisplayBox topLeft!
X
Xupdate: aParameter
X	"Ignore aParameter, and recreate the display."
X
X	self display! !
X
X!DiceView methodsFor: 'private'!
X
XmakeForms
X	"Construct the cached forms used for displaying."
X
X	| box center tempForm |
X	box _ self insetDisplayBox.
X	tempForm _ Form dotOfSize: (box extent x min: box extent y) // 5.
X	1 to: 6 do: [:each |
X		cachedForms at: each put: (Form extent: box extent).
X		box _ (cachedForms at: each) boundingBox.
X		center _ box center.
X		(#(1 3 5) includes: each) ifTrue: [
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center].
X		(#(2 3 4 5 6) includes: each) ifTrue: [
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center - ((center - box topLeft) // 2).
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center + ((center - box topLeft) // 2)].
X		(#(4 5 6) includes: each) ifTrue: [
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center - ((center - box topRight) // 2).
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center + ((center - box topRight) // 2)].
X		(each = 6) ifTrue: [
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center - ((center - box leftCenter) // 2).
X			tempForm
X				displayOn: (cachedForms at: each)
X				at: center + ((center - box leftCenter) // 2)]]! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XDiceView class
X	instanceVariableNames: ''!
X
X
X!DiceView class methodsFor: 'instance creation'!
X
Xopen 
X	"Create a new instance on the receiver with a new model"
X	"DiceView open."
X
X	self openOn: Dice new!
X
XopenOn: aDice 
X	"Create a new instance on the receiver with the model aDice."
X	"DiceView openOn: Dice new."
X
X	| topView diceView |
X	topView _ StandardSystemView
X				model: nil
X				label: nil
X				minimumSize: 66 @ 66.
X	"topView cacheRefresh: false."
X	diceView _ self new model: aDice.
X	diceView insideColor: Form white.
X	diceView borderWidth: 1.
X	topView addSubView: diceView.
X	topView controller open! !
X
XDistributableObject subclass: #Dice
X	instanceVariableNames: 'value randomGenerator '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Games-Dice'!
XDice comment:
X'I represent a single Dice (strictly, a DIE).  I respond to the roll
Xmessage to generate a new random number.'!
X
X
X!Dice methodsFor: 'initialize-release'!
X
Xinitialize
X	"Initialize the random number generator, and set up the initial
X	 state of the receiver."
X
X	randomGenerator _ Random new.
X	self rollDice! !
X
X!Dice methodsFor: 'accessing'!
X
Xvalue
X	"Answer with the value represented by the receiver."
X
X	^value! !
X
X!Dice methodsFor: 'modifying'!
X
Xroll
X	"Update the dice value randomly several times, to give the impression
X	 of a real roll."
X
X	^self rollDice!
X
XrollDice
X	"Update the dice value randomly."
X
X	value _ (randomGenerator next * 6 + 1) truncated.
X	^value! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XDice class
X	instanceVariableNames: ''!
X
X
X!Dice class methodsFor: 'instance creation'!
X
Xnew
X	"Answer with a new instance of the receiver."
X
X	^super new initialize! !
X
XMouseMenuController subclass: #DiceController
X	instanceVariableNames: ''
X	classVariableNames: 'DiceYellowButtonMenu DiceYellowButtonMessages '
X	poolDictionaries: ''
X	category: 'Games-Dice'!
XDiceController comment:
X'I represent the controller for a DiceView.'!
X
X
X!DiceController methodsFor: 'initialize-release'!
X
Xinitialize
X	"Initialize the yellow button menu."
X
X	super initialize.
X	self
X		yellowButtonMenu: DiceYellowButtonMenu
X		yellowButtonMessages: DiceYellowButtonMessages! !
X
X!DiceController methodsFor: 'control defaults'!
X
XisControlActive
X	^(view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! !
X
X!DiceController methodsFor: 'menu messages'!
X
XredButtonActivity
X
X	self model roll.
X	self sensor waitNoButton!
X
XrollDice
X
X	self model roll.
X	model changed: model! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XDiceController class
X	instanceVariableNames: ''!
X
X
X!DiceController class methodsFor: 'class initialization'!
X
Xinitialize
X	"DiceController initialize."
X
X	DiceYellowButtonMenu _ PopUpMenu
X		labels: 'roll' withCRs.
X	DiceYellowButtonMessages _ #(rollDice).! !
X
XDiceController initialize!
/
sed 's/^X//' > Demo-Counter.st << '/'
XMouseMenuController subclass: #CounterController
X	instanceVariableNames: ''
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Demo-Counter'!
X
X
X!CounterController methodsFor: 'initialize-release'!
X
Xinitialize
X	
X	super initialize.
X	self yellowButtonMenu: (PopUpMenu
X			labels: 
X'Increment
XDecrement')
X		yellowButtonMessages: #(increment decrement)! !
X
X!CounterController methodsFor: 'control defaults'!
X
XisControlActive
X	"Inherits control from superclass MouseMenuController.
X	As the blue blutton menu is used for reframing views only, counters are to be activated
X	by pressing the other two buttons."
X
X	^super isControlActive & sensor blueButtonPressed not! !
X
X!CounterController methodsFor: 'menu messages'!
X
Xdecrement
X	"Subtract 1 from the value of the counter"
X
X	self model decrement!
X
Xincrement
X	"Add 1 to the value of the counter"
X
X	self model increment! !
X
XView subclass: #CounterView
X	instanceVariableNames: ''
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Demo-Counter'!
X
X
X!CounterView methodsFor: 'displaying'!
X
XdisplayView
X	"Display the value of the counter in the counter view."
X
X	| pos |
X
X	"Calculate the absolute display coordinates from the coordinates of the view box."
X	pos _ (self insetDisplayBox topLeft x +10) @ (self insetDisplayBox center y).
X
X	"Concatenating the components of the output string and display them."
X	('My value is: ', self model value printString) asText allBold asParagraph displayAt: pos.!
X
Xupdate: aParameter
X	self display! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XCounterView class
X	instanceVariableNames: ''!
X
X
X!CounterView class methodsFor: 'instance creation'!
X
Xopen
X	"Open a view for a new counter"
X	"CounterView open."
X
X	| counterView topView counter|
X
X	counter _ CountHolder new: 0.
X
X	counterView _ CounterView new
X		model: counter;
X		controller: CounterController new;
X		borderWidth: 2;
X		insideColor: Form white.
X
X	topView _ StandardSystemView new
X		label: 'Counter';
X		minimumSize: 120@120;
X		addSubView: counterView.
X
X	topView controller open!
X
XopenOn: aCountHolder
X	"Open a view for a new counter"
X	"CounterView open."
X
X	| counterView topView counter|
X
X	counter _ aCountHolder.
X
X	counterView _ CounterView new
X		model: counter;
X		controller: CounterController new;
X		borderWidth: 2;
X		insideColor: Form white.
X
X	topView _ StandardSystemView new
X		label: 'Counter';
X		minimumSize: 120@120;
X		addSubView: counterView.
X
X	topView controller open! !
X
XDistributableObject subclass: #CountHolder
X	instanceVariableNames: 'value '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Demo-Counter'!
X
X
X!CountHolder methodsFor: 'operations'!
X
Xdecrement
X	"Subtract 1 from the value of the counter"
X
X	value _ value - 1.
X	self changed!
X
Xincrement
X	"Add 1 to the value of the counter"
X
X	value _ value + 1.
X	self changed!
X
Xinitialize: aNumber 
X	"Initialize the state of the counter to aNumber"
X
X	value _ aNumber! !
X
X!CountHolder methodsFor: 'accessing'!
X
Xvalue
X	"return my current value"
X
X	^ value! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XCountHolder class
X	instanceVariableNames: ''!
X
X
X!CountHolder class methodsFor: 'instance creation'!
X
Xnew: aNumber 
X	"Create a new counter and initialize it with aNumber"
X
X	| newCounter |
X	newCounter _ super new.
X	newCounter initialize: aNumber.
X	^newCounter! !
/
sed 's/^X//' > makefile  << '/'
X# Makefile for the ParcPlace Systems Socket usage examples
X#
X# See commments in Socket.st and myecho.c
X
XCFLAGS = -O
X#CFLAGS = -g -DDEBUG
Xserver: server.c
X	cc $(CFLAGS)  -o server server.c
X
/
sed 's/^X//' > server.c << '/'
X/* 	server.c - was Myecho.c (comments below)
X *	now acts as a relay server between two running Smalltalk Images.
X *		Neil Haddley 3/1989
X */	
X
X/*	Myecho.c - Example of the use of Berkeley Unix Sockets with the
X *	Smalltalk-80 Programming System Version VI 2.2/VM 1.1
X *	Compile this file and open a socket to it with the Smalltalk example 
X *	in the file Socket.st
X *		ParcPlace Systems - 7/87
X */
X#include <stdio.h>
X#include <sys/file.h>
X#include <sys/types.h>
X#include <sys/socket.h>
X#include <netinet/in.h>
X#include <netdb.h>
X
X#define PORTNO_1 9876
X#define PORTNO_2 9877 /* arbitrary choixe of port no but not a service(ihope) */
X
Xmain (argc, argv)
X	char *argv[];
X	int argc;
X{
X	struct servent *sp;
X	struct sockaddr_in prog, client;
X	struct sockaddr_in prog2, client2;
X	char buf[BUFSIZ];
X	char line[BUFSIZ];
X	char a, *b = buf;
X	FILE *cfd;
X	int port;
X	int s, ns;
X	int s2, ns2;
X	int mask1,mask2,both;
X	int cnt;
X
X	cfd = fopen("/dev/console", "w");
X	port = PORTNO_1;
X
X/* Create Sockets */
X	if ((s=socket(AF_INET, SOCK_STREAM, 0)) == -1)
X        {
X		fprintf(cfd, "Error in socket\n");
X		perror("socket");
X		fflush(cfd);
X		exit(1);
X	}
X	if ((s2=socket(AF_INET, SOCK_STREAM, 0)) == -1)
X        {
X		fprintf(cfd, "Error in socket2 \n");
X		perror("socket");
X		fflush(cfd);
X		exit(1);
X	}
X
X/* Bind Socket 1 */
X	prog.sin_family = AF_INET;
X	prog.sin_addr.s_addr = INADDR_ANY;
X	prog.sin_port = PORTNO_1;
X
X	if (setsockopt(s, SOL_SOCKET, SO_REUSEADDR, 0, 0))
X		perror("setsockopt");
X
X	if (bind(s, &prog, sizeof(prog)) == -1){
X		fprintf(cfd, "Error in 'bind'\nsocket= %d, prog= %d, %d\n",
X				s, prog.sin_family, prog.sin_port);
X		perror("bind");
X		fflush(cfd);
X		shutdown(s, 2);
X		exit(2);
X	}
X
X/* Bind Socket 2  
X
X	prog2.sin_family = AF_INET;
X	prog2.sin_addr.s_addr = INADDR_ANY;
X	prog2.sin_port =PORTNO_2;
X
X	if (setsockopt(s2, SOL_SOCKET, SO_REUSEADDR, 0, 0))
X		perror("setsockopt");
X
X	if (bind(s2, &prog2, sizeof(prog2)) == -1){
X		fprintf(cfd, "Error in 'bind'\nsocket= %d, prog= %d, %d\n",
X				s, prog.sin_family, prog.sin_port);
X		perror("bind");
X		fflush(cfd);
X		shutdown(s2, 2);
X		exit(2);
X	}
X*/
X
X	for (;;){
X	/* Accept the conection from th the first socket */
X
X		if (listen(s, 1) == -1) perror("listen");
X		if ((ns = accept(s, client, sizeof(client))) == -1)
X			perror("accept");
X#ifdef DEBUG
X		printf("\nfirst Connection");
X#endif
X		if (listen(s, 1) == -1) perror("listen");
X		if ((ns2 = accept(s, client2, sizeof(client2))) == -1)
X			perror("accept");
X#ifdef DEBUG
X		printf("\nsecond Connection\n");
X#endif
X
X		mask1 = 1<<ns;
X		mask2 = 1<<ns2;
X		
X		for (;;)
X		  {
X		    both = mask1 | mask2;
X		    if (select(32,&both,0,0,0) > 0)
X			{
X			if (both& mask1)
X				{
X				if ((cnt = recv(ns, buf, sizeof(buf), 0)) == 0) 
X					{
X   				 	close(ns);
X				 	break;
X					}
X				else 
X			    		{
X 					buf[cnt] = 0;
X					bzero(line, BUFSIZ);
X					sprintf(line,"%s",buf);
X#ifdef DEBUG
X					printf("\n<- %s",buf);
X#endif
X					send(ns2, line, strlen(line), 0);
X			    		}
X				}
X
X			if (both& mask2)
X				{
X		  		if ((cnt = recv(ns2, buf, sizeof(buf), 0)) == 0)
X						{
X				 		close(ns2);
X				 		break;
X						}
X				else 
X			    		{
X 					buf[cnt] = 0;
X					bzero(line, BUFSIZ);
X#ifdef DEBUG
X					printf("\n-> %s",buf);
X#endif
X					sprintf(line,"%s",buf);
X					send(ns, line, strlen(line), 0);
X			    		}
X				}
X			}
X		   }
X	}
X}
/
-- 
EMAIL:	neil@comp.lancs.ac.uk		| Post: University of Lancaster,
UUCP:	...!mcvax!ukc!dcl-cs!neil	|	Department of Computing,
					|	Bailrigg, Lancaster, UK.