"miscChanges.st Some changes, fixes and additions. I recommend viewing this file as a changes list. TITLE miscChanges.st AUTHOR Georg Gollmann (gollmann@edvz.tuwien.ac.at) VERSION 1.5 IMAGE VERSION 1.22 PREREQUISITES none DATE October 1, 1997"! "...Error handling... Minor cleanup of the error handling methods already present in the image. The methods ContextPart>failureCatcher: and BlockContext>ifFail: are inoperable and therefore removed. BlockContext>ifError: and BlockContext>value:ifError: have been commented, ifError: has been changed so both methods send two parameters to the error block. Also a misleading statement in the comment of Object>doesNotUnderstand is removed. Process>isErrorHandled becomes unused and is removed as well."! 'From Squeak 1.21 of July 17, 1997 on 19 September 1997 at 09:49:51'! !Object methodsFor: 'error handling'! error: aString "The default behavior for error: is the same as halt:. The code is replicated in order to avoid showing an extra level of message sending in the Debugger. This additional message is the one a subclass should override in order to change the error handling behavior." | handler | (handler _ Processor activeProcess errorHandler) notNil ifTrue: [handler value: aString value: self] ifFalse: [DebuggerView openContext: thisContext label: aString contents: thisContext shortStack] "nil error: 'error message'."! ! !Object methodsFor: 'error handling'! doesNotUnderstand: aMessage "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)." "Unless the receiver has an error handler defined for the active process, report to the user that the receiver does not understand the argument, aMessage, as a message." "Testing: (3 activeProcess)" | handler errorString | (Preferences autoAccessors and: [self tryToDefineVariableAccess: aMessage]) ifTrue: [^ aMessage sentTo: self]. errorString _ 'Message not understood: ', aMessage selector. (handler _ Processor activeProcess errorHandler) notNil ifTrue: [handler value: errorString value: self] ifFalse: [DebuggerView openContext: thisContext label: errorString contents: thisContext shortStack]. ^ aMessage sentTo: self! ! !BlockContext methodsFor: 'evaluating'! value: arg1 ifError: aBlock "Evaluate the block represented by the receiver. If an error occurs aBlock is evaluated with the error message and the receiver as parameters. The receiver should not contain an explicit return statement as this would leave an obsolete error handler hanging around." | lastHandler val activeProcess | activeProcess _ Processor activeProcess. lastHandler _ activeProcess errorHandler. activeProcess errorHandler: [:aString :aReceiver | activeProcess errorHandler: lastHandler. ^ aBlock value: aString value: aReceiver ]. val _ self value: arg1. activeProcess errorHandler: lastHandler. ^ val! ! !BlockContext methodsFor: 'evaluating'! ifError: aBlock "Evaluate the block represented by the receiver. If an error occurs aBlock is evaluated with the error message and the receiver as parameters. The receiver should not contain an explicit return statement as this would leave an obsolete error handler hanging around." | lastHandler val activeProcess | activeProcess _ Processor activeProcess. lastHandler _ activeProcess errorHandler. activeProcess errorHandler: [:aString :aReceiver | activeProcess errorHandler: lastHandler. ^ aBlock value: aString value: aReceiver ]. val _ self value. activeProcess errorHandler: lastHandler. ^ val! ! ContextPart removeSelector: #failureCatcher:! BlockContext removeSelector: #ifFail:! Process removeSelector: #isErrorHandled! !Set methodsFor: 'adding' stamp: 'go 10/1/97 09:33'! add: newObject "Add an element. User error instead of halt. go 10/1/97 09:33" | index | newObject == nil ifTrue: [self error: 'Sets cannot meaningfully contain nil as an element']. index _ self findElementOrNil: newObject. (array at: index) == nil ifTrue: [self atNewIndex: index put: newObject]. ^ newObject! ! "...Symbol... remove a redundant nil check in symbol lookup to gain a bit of speed."! !Symbol class methodsFor: 'instance creation'! intern: aString "Answer a unique Symbol whose characters are those of aString." | ascii table mainTable index sym numArgs | ascii _ (aString at: 1) asciiValue. aString size = 1 ifTrue: [ascii < 128 ifTrue: [^ SingleCharSymbols at: ascii + 1]]. table _ ((ascii >= "$a asciiValue" 97) and: [(ascii <= "$z asciiValue" 122) and: [(numArgs _ aString numArgs) >= 0]]) ifTrue: [ (mainTable _ SelectorTables at: (numArgs + 1 min: SelectorTables size)) at: (index _ ascii - "($a asciiValue - 1)" 96) ] ifFalse: [ (mainTable _ OtherTable) at: (index _ aString stringhash \\ OtherTable size + 1)]. 1 to: table size do: [:i | aString size = (table at: i) size ifTrue: [aString = (table at: i) ifTrue: [^ table at: i]] ]. sym _ (aString isMemberOf: Symbol) ifTrue: [aString] "putting old symbol in new table" ifFalse: [(Symbol new: aString size) string: aString]. "create a new one" mainTable at: index put: (table copyWith: sym). ^sym ! ! !Symbol class methodsFor: 'private'! hasInterned: aString ifTrue: symBlock "Answer with false if aString hasnt been interned (into a Symbol), otherwise supply the symbol to symBlock and return true." | table ascii numArgs | ascii _ (aString at: 1) asciiValue. aString size = 1 ifTrue: [ascii < 128 ifTrue: [symBlock value: (SingleCharSymbols at: ascii + 1). ^true]]. table _ ((ascii >= "$a asciiValue" 97) and: [(ascii <= "$z asciiValue" 122) and: [(numArgs _ aString numArgs) >= 0]]) ifTrue: [ (SelectorTables at: (numArgs + 1 min: SelectorTables size)) at: ascii - "($a asciiValue - 1)" 96 ] ifFalse: [ OtherTable at: aString stringhash \\ OtherTable size + 1]. 1 to: table size do: [:i | aString size = (table at: i) size ifTrue: [aString = (table at: i) ifTrue: [ symBlock value: (table at: i). ^true]] ]. ^false ! ! "...String... We can reduce code bloat a wee bit (one method and one message selector) by defining 'asString' for Object and removing 'stringRepresentation'. Also add some utilitiy methods."! !Object methodsFor: 'converting'! asString "Answer a string that represents the receiver." ^ self printString ! ! Object removeSelector: #stringRepresentation! String removeSelector: #stringRepresentation! !String methodsFor: 'converting'! substrings "Answer an array of the substrings that compose the receiver." | result aStream char | result _ WriteStream on: (Array new: 10). aStream _ WriteStream on: (String new: 16). 1 to: self size do: [:i | ((char _ self at: i) isSeparator) ifTrue: [ aStream isEmpty ifFalse: [ result nextPut: aStream contents. aStream reset ]] ifFalse: [ aStream nextPut: char ] ]. aStream isEmpty ifFalse: [result nextPut: aStream contents]. ^ result contents! ! !String methodsFor: 'comparing'! crc16 | crc | crc := 0. self do: [:c | crc := (crc bitXor: (c asciiValue bitShift: 8)) bitAnd: 16rFFFF. 1 to: 8 do: [ :dmy | "due to compiler optimization this is a bit faster than timesRepeat:" crc := (crc bitAnd: 16r8000) ~= 0 ifTrue: [ (crc bitShift: 1) bitXor: 16r1021 ] ifFalse: [ crc bitShift: 1 ] ]. ]. ^crc bitAnd: 16rFFFF! ! "...Networking... Utility methods for reading data. Provide Unix like listening behaviour."! !Socket methodsFor: 'sending-receiving'! readInto: aStringOrByteArray startingAt: aNumber "Read data into the given buffer starting at the given index and return the number of bytes received. Note the given buffer may be only partially filled by the received data." (self waitForDataUntil: Socket standardDeadline) ifFalse: [ self error: 'receive timeout']. ^ self primSocket: socketHandle receiveDataInto: aStringOrByteArray startingAt: aNumber count: aStringOrByteArray size - aNumber + 1 ! ! !Socket methodsFor: 'sending-receiving' stamp: 'go 9/29/97 15:44'! getData "Get some data" | buf bytesRead | (self waitForDataUntil: Socket standardDeadline) ifFalse: [ self error: 'getData timeout']. buf _ String new: 2000. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. ^ buf copyFrom: 1 to: bytesRead! ! !Socket methodsFor: 'queries' stamp: 'go 8/18/97 11:12'! peerName "Return the name of the host I'm connected to." ^NetNameResolver nameForAddress: (self primSocketRemoteAddress: socketHandle) timeout: 60! ! Object subclass: #ServerSocket instanceVariableNames: 'socket queue listener highwater ' classVariableNames: '' poolDictionaries: '' category: 'System-Network'! ServerSocket comment: 'This class is a workaround to get Unix like listening behaviour.'! !ServerSocket methodsFor: 'open/close' stamp: 'go 9/5/97 13:21'! bindTo: portNumber backlog: aNumber "Start listening. Accept only up to aNumber outstanding connections." highwater := Semaphore new. aNumber timesRepeat: [ highwater signal ]. queue := SharedQueue new: aNumber. listener := Process forContext: [[ (socket := Socket new) listenOn: portNumber. [ socket waitForConnectionUntil: Socket standardDeadline ] whileFalse: [ queue nextPut: nil. highwater wait ]. queue nextPut: socket. highwater wait. true ] whileTrue ] priority: Processor lowIOPriority. listener resume ! ! !ServerSocket methodsFor: 'open/close' stamp: 'go 9/5/97 12:49'! destroy "Stop listening." | sock | listener terminate. socket destroy. [ queue size > 0 ] whileTrue: [ (sock := queue next) notNil ifTrue: [ sock destroy ]]! ! !ServerSocket methodsFor: 'open/close' stamp: 'go 9/5/97 12:49'! listen "Return the next open socket or nil if no connection has been established during the timeout period." highwater signal. ^queue next! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ServerSocket class instanceVariableNames: ''! "...Date... Date reading enhancements."! !Date class methodsFor: 'instance creation'! newDay: day month: monthName year: year "Answer an instance of me which is the day'th day of the month named monthName in the year'th year. The year may be specified as the actual number of years since the beginning of the Roman calendar or the number of years since the beginning of the century." "Tolerate a month index instead of a month name." | monthIndex daysInMonth firstDayOfMonth | year < 100 ifTrue: [^self newDay: day month: monthName year: 1900 + year]. monthIndex _ monthName isInteger ifTrue: [ monthName ] ifFalse: [ self indexOfMonth: monthName ]. monthIndex = 2 ifTrue: [daysInMonth _ (DaysInMonth at: monthIndex) + (self leapYear: year)] ifFalse: [daysInMonth _ DaysInMonth at: monthIndex]. monthIndex > 2 ifTrue: [firstDayOfMonth _ (FirstDayOfMonth at: monthIndex) + (self leapYear: year)] ifFalse: [firstDayOfMonth _ FirstDayOfMonth at: monthIndex]. (day < 1 or: [day > daysInMonth]) ifTrue: [self error: 'illegal day in month'] ifFalse: [^self new day: day - 1 + firstDayOfMonth year: year]! ! !Date class methodsFor: 'instance creation'! fromString: aString "Answer an instance of created from a string with format DD.MM.YYYY." | fields | fields := aString findTokens: './'. ^self newDay: (fields at: 1) asNumber month: (fields at: 2) asNumber year: (fields at: 3) asNumber! ! "...Text constants... Some commonly needed text constants."! TextConstants at: #CrLf put: (String with: Character cr with: Character linefeed)! TextConstants at: #CrLfCrLf put: (TextConstants at: #CrLf), (TextConstants at: #CrLf)!