neil@comp.lancs.ac.uk (Neil Haddley) (03/14/89)
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.