From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:30:29 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>ArgumentTransformer</name> <environment>Core</environment> <super>Core.EvaluableAction</super> <private>false</private> none block <imports></imports> <category>Opentalk</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Core.ArgumentTransformer
This class is intended to help with setting up broker event handlers (or any object event handlers for that matter). The existing event-API implemented in Object provides a lot of flexibility, however there isn't anything that would allow to transform an event with X arguments into a message with Y arguments. That's what this class is meant for. It's transformation block will receive all the event arguments and produces one output argument. If you need several output arguments, setup corresponding number of argument transformers. An example event handler can look like following: broker objectAdaptor when: #exportedObject:ooid:in: send: #show: to: Transcript with: (ArgumentTransformer withBlock: [ :args | 'Exported <1p> with ooid <2p>' expandMacrosWithArguments: args ]) Instance Variables: block <BlockClosure> one parameter block defining the argument transformation
</comment> <class> <name>EventProcessor</name> <environment>Protocols</environment> <super>Core.Object</super> <private>false</private> none accessProtect <imports></imports> <category>Opentalk</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.EventProcessor
This is the abstract event processor. It takes any message that it does not understand and treats it as an event, i.e. it runs it through the #process: method. Processing is protected by a recursion lock to serialize events coming in from multiple processes. Concrete subclasses should specify the processing by defining the #privateProcess: method. Instance Variables: accessProtect <RecursionLock> process serializer to protect event processing logic
</comment> <class> <name>EventConverter</name> <environment>Protocols</environment> <super>Protocols.EventProcessor</super> <private>false</private> none next converter <imports></imports> <category>Opentalk</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.EventConverter
I'm a generic event transformer. I'm supposed to take an event run it through my 'converter' and then pass it on to the 'next' processor in line. An example of my use is EventProcessor>>attachReceiver: which transforms an event Message into a MessageSend. Instance Variables: next <EventProcessor> next processor in the line converter <BlockClosure> converter block
</comment> <class> <name>EventPrinter</name> <environment>Protocols</environment> <super>Protocols.EventProcessor</super> <private>false</private> none label <imports></imports> <category>Opentalk</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.EventPrinter
This class provides for printing broker event messages to a Stream or to the Transcript. Instance Variables: accessProtect <Semaphore> mutex for event logging
</comment> <class> <name>PromiseExpiredError</name> <environment>Protocols</environment> <super>Core.Error</super> <private>false</private> none <imports></imports> <category>Opentalk-Core</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <class> <name>TimedPromise</name> <environment>Protocols</environment> <super>Kernel.Promise</super> <private>false</private> none delay <imports></imports> <category>IMAPSupport</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.TimedPromise
A TimedPromise represents the same value as a Promise does. An attempt to read the value of a TimedPromise will wait until the process has finished computing it or the specified timeout expires. If the process terminates with an exception, an attempt to read the value of the TimedPromise will raise the same exception. In case of the timeout the OsNeedRetryError will be raised. Instance Variables: delay <Delay> TimedPromise is using the delay semaphore to tells the consumers there is information available ms <Number> The number of milliseconds to create Delay
</comment> <class> <name>SharedRegistry</name> <environment>Protocols</environment> <super>Core.Object</super> <private>false</private> none elements lock <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.SharedRegistry
This is a keyed registry of objects suitable for use by multiple concurrent processes. It provides extended accessing methods that allow coupling actions with registry operations "atomically", i.e. within the same criticial region. Instance Variables: elements <Dictionary> registered elements lock <RecursionLock> access lock
</comment> <class> <name>MessageForwarder</name> <environment>Protocols</environment> <super></super> <private>false</private> none object <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.MessageForwarder
This class is a generic message forwarder. It's protocol is absolutely minimal, only #doesNotUnderstand: and couple of supporting methods prefixed with $_ to minimize the chance of clashes. Instance Variables: object <Object> undocumented
</comment> <class> <name>CachedReadStream</name> <environment>Protocols</environment> <super>Core.PeekableStream</super> <private>false</private> none stream cache <imports></imports> <category>XMK-Streams</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.CachedReadStream
This stream allows to skip back and forward relative to the current position of the underlying stream, without requiring the undelying stream to be capable of positioning or skipping. This is achieved by caching the input from the underlying stream in a fixed size buffer. Consequently maximum size of the skip back is limited by the size of the cache and obviously by the current position within the buffer. Skipping forward is unlimited but the cache has to follow along to the target position. Once a previously read element falls out of the bottom of the cache it is not accessible anymore. The underlying stream is moving only forward never back. The API is identical to other read streams with the exception of #skip: behavior being always predictable, regardless of the type of the underlying stream. This also motivates addition of message #previous, a counterpart of #next, however only time will show how useful will this capability be in practice. Another important difference is that this stream explicitly translates the EndOfStreamNotification into a hard IncompleteNextCountError. I believe that the whole deal with the notification and returning a nil as the result of #next at the end of the stream is a mistake, so this is an attempt to start moving away from this behavior. We'll see if I'll have to back down on this one. The name EndOfStream for the error would probably be better, however the IncompleteNextCountError has been used for a very similar purpose for a long time so I have doubts about introducing a new exception class for almost the same thing. The cache is implemented as a circular buffer used as a FIFO queue. It has a pointer to the current "top", i.e. pointing at the latest element read in from the stream, and a "position" pointer to the current position within the buffer. Consequently the position can back off from the top one full length of the buffer, but not more. Initially the buffer is empty and only fills up as elements are read from the stream. Once it fills up the "oldest" elements will start "falling out" of the bottom of the buffer as new elements are added at the top. The implementation also pays special attention to the block based APIs based on #next:into:startingAt:, translating that to as few block calls as possible. This allows taking advantage of block based copying primitives and can push through larger quantities of data more efficiently. This is clearly an optimization, but the difference is significant enough in most non-trivial applications. Instance Variables: stream <Stream> underlying stream cache <CircularBuffer> internal buffer for the stream
</comment> <class> <name>CachedWriteStream</name> <environment>Protocols</environment> <super>Protocols.CachedReadStream</super> <private>false</private> none <imports></imports> <category>XMK-Streams</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.CachedWriteStream
This stream allows to skip back and forward relative to the current position of the underlying stream, without requiring the underlying stream to be capable of positioning or skipping. This is achieved by caching the written elements in a fixed size buffer. Consequently maximum size of the skip back is limited by the size of the buffer and obviously by the current position within the buffer. Skipping forward is also limited by the top of the buffer, because that represents the absolute end of the write stream. Once a previously written element falls out of the bottom of the buffer it gets written into the underlying stream and is not accessible anymore. The underlying write stream is moving only forward never back. Since the stream is tracking the bottom of the buffer, not the top, it is possible to rewrite elements many times while they are in the buffer. The stream also provides reading capability within the confines of the buffer which can also be useful with some types of algorithms. Note however, that the reading and writing operations share the same position pointer. So a #next moves the position the same way as #nextPut:. So, for example (String new writeStream writeCache: 5) nextPutAll: 'abcdef'; skip: -4; next: 2; nextPutAll: 'EF'; contents yields result 'abcdEF'. Otherwise the API is identical to other write streams, however it is important to note that it is important to #flush or #close the stream in order to get the buffered elements written into the underlying stream. That applies equally to both internal and external streams. The implementation also pays special attention to the block based APIs based on #next:putAll:startingAt:, translating that to as few block calls as possible. This allows taking advantage of block based copying primitives and can push through larger quantities of data more efficiently. This is clearly an optimization, but the difference is significant enough in most non-trivial applications.
</comment> <class> <name>DecodedStreamConstructor</name> <environment>Protocols</environment> <super>Core.InternalEncodedStreamConstructor</super> <private>false</private> none <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <class> <name>ProtoObject</name> <environment>Protocols</environment> <super></super> <private>false</private> none <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.ProtoObject
This is a trimmed down version of Object with a reduced set of basic capabilities. The recognized set of selectors is chosen so that there's is only minimal probability of conflict with application domain selectors (we intentionally avoid things like #value, #size, #name, etc). Note however that in order to satisfy some of the more prevalent expectations of the environment we do define #=, #==, #hash and #class.
</comment> <class> <name>CircularBuffer</name> <environment>Protocols</environment> <super>Core.Object</super> <private>false</private> none cache top position full atTop <imports></imports> <category>ComputingStreams</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.CircularBuffer
Instance Variables: cache <SequenceableCollection> internal buffer for the cache top <Integer> index of the last occupied slot position <Integer> maintains current position, index of the last processed element full <Boolean> indicates that the cache has filled up and started wrapping around atTop <Boolean> indicates that the current position is "at the top", i.e. postion = top and is not backed up all the way
</comment> <class> <name>Struct</name> <environment>Protocols</environment> <super>Protocols.ProtoObject</super> <private>false</private> objects name lastIndex <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.Struct
Struct is aimed to replace the 'struct' construct from C-like languages. Member elements of Structs can be accessed using usual Smalltalk accessor convention. Alternatively Structs also support Dictionary like protocol #at:, #at:put:, etc. Note however that unlike Dictionary the order of elements is maintained. When a new element is added it is added at the end. Structs, like Dictionaries, grow automatically when necessary. Instance Variables: name <String> struct name; accessed as #structName lastIndex <Integer> index of the last element
</comment> <class> <name>IPMulticastRequest</name> <environment>Protocols</environment> <super>Core.UninterpretedBytes</super> <private>false</private> bytes <imports></imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.IPMulticastRequest
To use multicast, socket options must be set, and the argument required is a C structure. This class implements the argument structure for IP_ADD_MEMBERSHIP and IP_DROP_MEMBERSHIP. See netinet/in.h sturct ip_mreq { struct in_addr imr_multiaddr; /* IP multicast address of group */ struct in_addr imr_interface; '* local IP address of interface */ }
</comment> <class> <name>DecodedStream</name> <environment>Protocols</environment> <super>Core.EncodedStream</super> <private>false</private> none cache crPreceeding <imports> private OS.IOConstants.* </imports> <category>HTTP</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.DecodedStream
This is the inverse of EncodedStream. It expects character stream below which are decoded by this stream into bytes on read and bytes are encoded to characters on writing. Instance Variables: cache <ReadWriteStream> an internal cache for individual character encoding bytes crPreceeding <Boolean> indicates if previously written byte was 13 (CR)
</comment> <class> <name>B64StreamDecoder</name> <environment>Protocols</environment> <super>Core.StreamEncoder</super> <private>false</private> none quart offset leftover lineLength finishing defaultLineLength <imports> OS.IOConstants.* </imports> <category>Protocols-Common</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.B64StreamDecoder
This is a Base64 encoder intended for use with the DecodedStream, therefore it expects to convert bytes into characters of Base64 encoding as specified in RFC 2045. Example - Writing | stream input | input := ByteArray withAll: (1 to: 32). stream := DecodedStream on: String new writeStream encodedBy: B64StreamDecoder asEncoder. stream nextPutAll: input. stream close. stream encodedContents. Example - Reading | stream input | input := 'AQIDBAUGBwgJCgsMDQ4PEBESExQVFhcYGRobHB0eHyA='. stream := DecodedStream on: input readStream encodedBy: B64StreamDecoder asEncoder. stream contents. RFC 2045: Internet Message Bodies; chapter 6.8. Base64 Content-Transfer-Encoding The Base64 Content-Transfer-Encoding is designed to represent arbitrary sequences of octets in a form that need not be humanly readable. The encoding and decoding algorithms are simple, but the encoded data are consistently only about 33 percent larger than the unencoded data. This encoding is virtually identical to the one used in Privacy Enhanced Mail (PEM) applications, as defined in RFC 1421. A 65-character subset of US-ASCII is used, enabling 6 bits to be represented per printable character. (The extra 65th character, "=", is used to signify a special processing function.) NOTE: This subset has the important property that it is represented identically in all versions of ISO 646, including US-ASCII, and all characters in the subset are also represented identically in all versions of EBCDIC. Other popular encodings, such as the encoding used by the uuencode utility, Macintosh binhex 4.0 [RFC-1741], and the base85 encoding specified as part of Level 2 PostScript, do not share these properties, and thus do not fulfill the portability requirements a binary transport encoding for mail must meet. The encoding process represents 24-bit groups of input bits as output strings of 4 encoded characters. Proceeding from left to right, a 24-bit input group is formed by concatenating 3 8bit input groups. These 24 bits are then treated as 4 concatenated 6-bit groups, each of which is translated into a single digit in the base64 alphabet. When encoding a bit stream via the base64 encoding, the bit stream must be presumed to be ordered with the most-significant-bit first. That is, the first bit in the stream will be the high-order bit in the first 8bit byte, and the eighth bit will be the low-order bit in the first 8bit byte, and so on. Each 6-bit group is used as an index into an array of 64 printable characters. The character referenced by the index is placed in the output string. These characters, identified in Table 1, below, are selected so as to be universally representable, and the set excludes characters with particular significance to SMTP (e.g., ".", CR, LF) and to the multipart boundary delimiters defined in RFC 2046 (e.g., "-"). Table 1: The Base64 Alphabet 0 A 17 R 34 i 51 z 1 B 18 S 35 j 52 0 2 C 19 T 36 k 53 1 3 D 20 U 37 l 54 2 4 E 21 V 38 m 55 3 5 F 22 W 39 n 56 4 6 G 23 X 40 o 57 5 7 H 24 Y 41 p 58 6 8 I 25 Z 42 q 59 7 9 J 26 a 43 r 60 8 10 K 27 b 44 s 61 9 11 L 28 c 45 t 62 + 12 M 29 d 46 u 63 / 13 N 30 e 47 v 14 O 31 f 48 w (pad) = 15 P 32 g 49 x 16 Q 33 h 50 y The encoded output stream must be represented in lines of no more than 76 characters each. All line breaks or other characters not found in Table 1 must be ignored by decoding software. In base64 data, characters other than those in Table 1, line breaks, and other white space probably indicate a transmission error, about which a warning message or even a message rejection might be appropriate under some circumstances. Special processing is performed if fewer than 24 bits are available at the end of the data being encoded. A full encoding quantum is always completed at the end of a body. When fewer than 24 input bits are available in an input group, zero bits are added (on the right) to form an integral number of 6-bit groups. Padding at the end of the data is performed using the "=" character. Since all base64 input is an integral number of octets, only the following cases can arise: (1) the final quantum of encoding input is an integral multiple of 24 bits; here, the final unit of encoded output will be an integral multiple of 4 characters with no "=" padding, (2) the final quantum of encoding input is exactly 8 bits; here, the final unit of encoded output will be two characters followed by two "=" padding characters, or (3) the final quantum of encoding input is exactly 16 bits; here, the final unit of encoded output will be three characters followed by one "=" padding character. Because it is used only for padding at the end of the data, the occurrence of any "=" characters may be taken as evidence that the end of the data has been reached (without truncation in transit). No such assurance is possible, however, when the number of octets transmitted was a multiple of three and no "=" characters are present. Any characters outside of the base64 alphabet are to be ignored in base64-encoded data. Care must be taken to use the proper octets for line breaks if base64 encoding is applied directly to text material that has not been converted to canonical form. In particular, text line breaks must be converted into CRLF sequences prior to base64 encoding. The important thing to note is that this may be done directly by the encoder rather than in a prior canonicalization step in some implementations. NOTE: There is no need to worry about quoting potential boundary delimiters within base64-encoded bodies within multipart entities because no hyphen characters are used in the base64 encoding. Instance Variables: quart <Integer> zero based offset of the next character in current quartet {0,1,2,3} offset <Integer> zero based offset of the next character on current line leftover <Integer> whatever is left over from the previous octet lineLength <Integer> specifies the line length where to emit CR and wrap to the next line when encoding finishing <Boolean> flag indicating if we're reading final pad characters $= Class Instance Variables: defaultLineLength <Integer> specifies the default line length where to emit CR and wrap to the next line when encoding Shared Class Variables: LineLength <Integer> the line length where we should emit CR and wrap to the next line OctetMap <Dictionary key: Character value: Integer> maps characters to sextets SextetMap <String> maps sextets (indices) to characters Whitespace <Object> undocumented Zeros <Stream> an infinite stream of zeros
</comment> <class> <name>Base64StreamEncoder</name> <environment>Protocols</environment> <super>Core.StreamEncoder</super> <private>false</private> none index nibble nEncoded sextetMap octetMap <imports></imports> <category>Net-Clients</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.Base64StreamEncoder
Base64StreamEncoder is used to encode and decode base64 format Instance Variables: index <Number> octet index nEncoded <ArithmeticValue> number of encoded octets nibble <Integer> octet to encode or decode
</comment> <class> <name>EventCollector</name> <environment>Protocols</environment> <super>Protocols.EventPrinter</super> <private>false</private> none events baseClockValue <imports></imports> <category>Opentalk</category> <attributes> <package>Protocols-Common</package> </attributes> </class> <comment> Protocols.EventCollector
This class is for collecting broker event messages. Every event is recorded with millisecond clock value of its occurence (see #log:). The class also provides event printing services (see #toTranscript). Instance Variables: events <OrderedCollection> of (SmallInteger->Message) records of logged events baseClockValue <SmallInteger> allows to record 'starting' clock value, relative to which the event trace will be printed out
</comment> <name>Encoder</name> <environment>Protocols.Base64StreamEncoder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <initializer>nil</initializer> <attributes> <package>Protocols-Common</package> </attributes> <name>OctetMap</name> <environment>Protocols.B64StreamDecoder</environment> <private>false</private> <constant>false</constant> <category>all</category> <initializer>nil</initializer> <attributes> <package>Protocols-Common</package> </attributes> <name>SextetMap</name> <environment>Protocols.B64StreamDecoder</environment> <private>false</private> <constant>false</constant> <category>all</category> <initializer>nil</initializer> <attributes> <package>Protocols-Common</package> </attributes> <name>Zeros</name> <environment>Protocols.B64StreamDecoder</environment> <private>false</private> <constant>false</constant> <category>all</category> <initializer>nil</initializer> <attributes> <package>Protocols-Common</package> </attributes> <name>Whitespace</name> <environment>Protocols.B64StreamDecoder</environment> <private>false</private> <constant>false</constant> <category>all</category> <initializer>nil</initializer> <attributes> <package>Protocols-Common</package> </attributes> <methods> Core.ArgumentTransformer <category>event evaluating</category>
evaluate ^self evaluateWithArguments: nil
evaluateWithArguments: evaluationArguments ^block isNil ifTrue: [evaluationArguments] ifFalse: [block value: evaluationArguments]
</methods> <methods> Core.ArgumentTransformer <category>accessing</category>
setBlock: aBlock block := aBlock
</methods> <methods> Core.ArgumentTransformer class <category>instance creation</category>
withBlock: aBlock ^self new setBlock: aBlock
</methods> <methods> Protocols.EventProcessor <category>converting</category>
attachReceiver: anObject ^Protocols.EventConverter on: self using: [ :msg | MessageSend receiver: anObject selector: msg selector arguments: msg arguments ]
</methods> <methods> Protocols.EventProcessor <category>services</category>
process: anEvent accessProtect critical: [ self privateProcess: anEvent ]
</methods> <methods> Protocols.EventProcessor <category>private</category>
doesNotUnderstand: aMessage "Let's consider any message that is not understood an event action." self process: aMessage
privateProcess: aMessage self subclassResponsibility
</methods> <methods> Protocols.EventProcessor <category>initialize/release</category>
initialize accessProtect := RecursionLock new.
</methods> <methods> Protocols.EventProcessor class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Protocols.EventConverter <category>private</category>
privateProcess: anEvent next process: (converter value: anEvent)
</methods> <methods> Protocols.EventConverter <category>initialize/release</category>
on: anEventProcessor using: aConverter next := anEventProcessor. converter := aConverter
</methods> <methods> Protocols.EventConverter class <category>instance creation</category>
on: anEventProcessor using: aConverter ^self new on: anEventProcessor using: aConverter
</methods> <methods> Protocols.EventPrinter <category>private</category>
eventEmphasis ^#bold "^#color -> ColorValue navy"
parameterEmphasis ^nil
printEvent: aMessage on: aStream label notNil ifTrue: [ aStream nextPutAll: label; nextPutAll: '>>' ]. (aMessage isKindOf: MessageSend) ifTrue: [self printSend: aMessage on: aStream] ifFalse: [self printMessage: aMessage on: aStream]
printMessage: aMessage on: aStream | originalEmphasis | originalEmphasis := aStream emphasis. aMessage selector isKeyword ifTrue: [ aMessage selector keywords with: aMessage arguments do: [ :keyword :argument | aStream emphasis: self eventEmphasis; space; nextPutAll: keyword; emphasis: self parameterEmphasis; space. argument _isRemote ifTrue: [argument _printOn: aStream] ifFalse: [argument printOn: aStream]]] ifFalse: [ aStream emphasis: self eventEmphasis; space; nextPutAll: aMessage selector; emphasis: self parameterEmphasis; space. aMessage arguments do: [ :argument | argument _isRemote ifTrue: [argument _printOn: aStream] ifFalse: [argument printOn: aStream]]]. aStream emphasis: originalEmphasis
printSend: aMessageSend on: aStream | receiver | (receiver := aMessageSend receiver) _isRemote ifTrue: [receiver _printOn: aStream] ifFalse: [receiver printOn: aStream]. aStream space. self printMessage: aMessageSend on: aStream
privateProcess: anEvent self transcriptTextStreamDo: [ :ts | self printEvent: anEvent on: ts ]
transcriptTextStreamDo: aBlock | ts | ts := TextStream on: (String new: 20). ts nextPutAllText: Transcript value; cr. aBlock value: ts. Transcript value: ts contents; changed: #update
</methods> <methods> Protocols.EventPrinter <category>services</category>
log: anEvent self process: anEvent
</methods> <methods> Protocols.EventPrinter <category>accessing</category>
label: aString label := aString
</methods> <methods> Protocols.EventPrinter class <category>instance creation</category>
new: aString ^self new label: aString
</methods> <methods> Protocols.PromiseExpiredError class <category>testing</category>
mayResume ^true
</methods> <methods> Protocols.TimedPromise <category>accessing-parent</category>
signalTimeout ^PromiseExpiredError new messageText: (#errPromiseExpiredError << #dialogs >> 'Promise expiration error'); parameter: self; raiseSignal
value | hasResult | delay wait. "Wait for data arrival or alarm expiry." hasResult := delay inProgress. delay disable. sync signal. "To allow multiple reads of the result" ^exception == nil ifTrue: [hasResult ifTrue: [ value] ifFalse: [self signalTimeout. "If resumed, start over" sync wait. "Undo the signal above" self value]] ifFalse: [exception clearForReraise; searchFrom: thisContext; raise]
</methods> <methods> Protocols.TimedPromise <category>initialization</category>
initialize: msec delay := Delay forMilliseconds: msec. sync := delay delaySemaphore.
</methods> <methods> Protocols.TimedPromise class <category>instance creation</category>
forMilliseconds: anInteger ^self new initialize: anInteger
</methods> <methods> Protocols.SharedRegistry <category>accessing</category>
at: key ifAbsent: absent "Find and return the element at key. If it is not present, run the absent block. " ^lock critical: [ elements at: key ifAbsent: absent ]
at: key ifAbsent: absent ifPresent: present "Find an object at key. Run the present block with it if it is present, otherwise run the absent block. Return the resulting value. " ^lock critical: [ | element found | found := true. element := elements at: key ifAbsent: [ found := false ]. found ifTrue: [ present value: element ] ifFalse: [ absent value ] ]
at: key ifAbsentPut: absent "Find an object at key or, if there isn't one, register a result of absent block at that key instead. " ^lock critical: [ elements at: key ifAbsentPut: absent ]
at: key ifAbsentPut: absent do: block "Find an object at key or if there isn't one register a result of absent block at that key instead. Then run block with either of them. " ^lock critical: [ | element | element := elements at: key ifAbsentPut: absent. block value: element. element ]
at: key put: object "Add an object to the registry. " ^lock critical: [ elements at: key put: object ]
at: key put: object do: block "Add an object to the registry and execute block " lock critical: [ elements at: key put: object. block value ]. ^object
includesKey: key ^lock critical: [ elements includesKey: key ]
removeKey: key ifAbsent: absent "Find an object at key and remove it. Run the the absent block if the key is absent. " ^lock critical: [ elements removeKey: key ifAbsent: absent ]
removeKey: key ifAbsent: absent ifPresent: present "Find an object at key and remove it. Run the present block with the element if it is present, otherwise run the absent block.. " ^lock critical: [ | element found | found := true. element := elements removeKey: key ifAbsent: [ found := false ]. found ifTrue: [ present value: element ] ifFalse: [ absent value ] ]
size ^elements size
</methods> <methods> Protocols.SharedRegistry <category>initialize-release</category>
initialize elements := Dictionary new. lock := RecursionLock new.
</methods> <methods> Protocols.SharedRegistry <category>enumerating</category>
do: block lock critical: [ "We have to copy because block might be adding/removing elements" elements values do: block ]
</methods> <methods> Protocols.SharedRegistry class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Protocols.MessageForwarder <category>accessing</category>
_object ^object
</methods> <methods> Protocols.MessageForwarder <category>testing</category>
_isForwarder ^true
</methods> <methods> Protocols.MessageForwarder <category>private</category>
_forwardMessage: aMessage ^object perform: aMessage selector withArguments: aMessage arguments
</methods> <methods> Protocols.MessageForwarder <category>initialize-release</category>
_initializeWith: anObject object := anObject
</methods> <methods> Protocols.MessageForwarder <category>error handling</category>
doesNotUnderstand: aMessage ^self _forwardMessage: aMessage
</methods> <methods> Protocols.MessageForwarder class <category>instance creation</category>
with: anObject ^self new _initializeWith: anObject
</methods> <methods> Protocols.CachedReadStream <category>private</category>
contentsSpecies ^stream contentsSpecies
pullNext ^[ stream next ] on: EndOfStreamNotification do: [ :ex | "resignal the notification as hard error" ex resignalAs: ( IncompleteNextCountError new messageText: ex messageText; parameter: 0 "this is supposed to be the size of bytes read"; yourself ) ]
skipBack: step | size | size := cache skipBack: step. size = step ifFalse: [ self steppingUnderTheBottom: size ]
skipForward: step | size left | size := cache skipForward: step. size = step ifTrue: [ ^self ]. left := step - size. "pull the rest from the stream" left > cache size ifTrue: [ stream skip: left - cache size. left := cache size ]. cache next: left putAll: stream. ^self
steppingUnderTheBottom: size ^IncompleteNextCountError new messageText: 'Cannot skip back past the buffer limits!'; parameter: size; raise
</methods> <methods> Protocols.CachedReadStream <category>accessing</category>
next ^cache nextIfNone: [ cache nextPut: self pullNext ]
next: total into: target startingAt: start | cached newTotal newStart | "read what is in the buffer" cached := cache next: total into: target startingAt: start. cached = total ifTrue: [ ^target ]. "pull the rest from the stream" newTotal := total - cached. newStart := start + cached. stream next: newTotal into: target startingAt: newStart. "update the buffer from the end of the target" cache next: (newTotal min: cache size) putAll: target startingAt: (start + total - cache size max: newStart). ^target
previous ^cache previousIfNone: [ self steppingUnderTheBottom: 0 ]
skip: step step < 0 ifTrue: [ self skipBack: step negated ] ifFalse: [ self skipForward: step ]
</methods> <methods> Protocols.CachedReadStream <category>testing</category>
atEnd ^cache atEnd and: [ stream atEnd ]
isReadable "Answer whether the stream implements #next." ^true
isWritable "Answer whether the stream implements #nextPut:." ^true
</methods> <methods> Protocols.CachedReadStream <category>status</category>
close cache clear. stream close
</methods> <methods> Protocols.CachedReadStream <category>initialize-release</category>
initializeFor: next size: size stream := next. cache := CircularBuffer cache: (self contentsSpecies new: size)
</methods> <methods> Protocols.CachedReadStream class <category>instance creation</category>
wrap: stream cache: size ^self basicNew initializeFor: stream size: size
</methods> <methods> Protocols.CachedWriteStream <category>testing</category>
atEnd ^cache atEnd
isWritable "Answer whether the stream implements #nextPut:." ^true
</methods> <methods> Protocols.CachedWriteStream <category>status</category>
close self commit. stream close
commit self flush. stream commit
</methods> <methods> Protocols.CachedWriteStream <category>accessing</category>
contents self flush. ^stream contents
flush "Flush everything that was written so far (regardless of the current position) and empty the buffer. Note that this necessarily sets the position to the end of written data (to the top), because once flushed there's no access to previously written elements." cache reset. cache next: cache size into: stream. stream flush. cache clear
next ^cache nextIfNone: [ self steppingOverTheTop: 0 ]
next: total into: target startingAt: start "Only allow reading within the cache. Raise IncompleteNextCountError if reading past the top of the buffer." | size | size := cache next: total into: target startingAt: start. ^total = size ifTrue: [ target ] ifFalse: [ self steppingOverTheTop: size ]
next: total putAll: source startingAt: start | size left next | size := cache headroom min: total. cache next: size putAll: source startingAt: start. size = total ifTrue: [^source]. left := total - size. next := start + size. cache reset. "flush how much is necessary, possibly all" cache next: left into: stream. cache setToEnd. left > cache size ifTrue: [ size := left - cache size. stream next: size putAll: source startingAt: next. next := next + size. left := cache size ]. cache next: left putAll: source startingAt: next. ^source
nextPut: anObject ^cache nextPut: anObject ifReplacingDo: [ :outgoing | stream nextPut: outgoing ].
</methods> <methods> Protocols.CachedWriteStream <category>private</category>
skipForward: step | size | size := cache skipForward: step. size = step ifFalse: [ self steppingOverTheTop: size ]
steppingOverTheTop: size ^IncompleteNextCountError new messageText: 'Cannot step forward past the write buffer limit!'; parameter: size; raise
</methods> <methods> Protocols.DecodedStreamConstructor <category>initialize</category>
addEncodingTo: aStream ^DecodedStream on: aStream encodedBy: (self findEncoding: encoding) initializeForMemory
</methods> <methods> Protocols.ProtoObject <category>system primitives</category>
become: otherObject " Swap the state of the receiver with that of anObject." self primBecome: otherObject
beImmutable "Set the receiver to be immutable" self isImmutable: true. ^self
beMutable "Set the receiver to be mutable" self isImmutable: false. ^self
instVarAt: index "Answer with 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." <primitive: 73> "Access beyond fixed variables." ^self basicAt: index - self class instSize
instVarAt: anInteger put: anObject "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, or if the receiver is immutable. Answer with 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.)." <primitive: 74> self isImmutable ifTrue: [^self noModificationErrorFor: #instVarAt:put: index: anInteger value: anObject]. "Access beyond fixed fields" ^self basicAt: anInteger - self class instSize put: anObject
isImmutable: aBoolean "Set the receiver's immutability. Answer if the receiver was previously immutable. Fail if the argument is not a boolean or if the receiver is immediate and the argument is false." <primitive: 1064 errorCode: error> ^self primitiveFailed
primBecome: otherObject "Swap the instance data and appropriate header information of the receiver and the argument, otherObject. In other words, transform the receiver into the argument and vice-versa. Fail if either object is an immediate or a MethodContext or a BlockContext or if there is insufficient memory to perform the become, or if either object is immutable. Answer with the argument which is now the semantic equivalent of the object that formerly denoted the receiver." <primitive: 72 errorCode: errCode> ^(errCode ~~ nil and: [errCode name = #'no modification']) ifTrue: [self noModificationErrorFor: #primBecome: index: nil value: otherObject] ifFalse: [self handleFailedBecome: otherObject]
</methods> <methods> Protocols.ProtoObject <category>user interface</category>
inspect "Create and schedule an Inspector in which the user can examine the receiver's variables." Tools.Trippy.Inspector useSimpleInspector ifTrue: [self inspectorClass openOn: self] ifFalse: [Tools.Trippy.Inspector openOn: self]
inspectorActions "Answer a collection of Action instances listing the common actions a user might want to perform on an object. They are added to the inspector's Object menu." ^#()
inspectorClass ^Inspector
inspectorClasses "Answer a sequence of inspector classes that can represent the receiver in an inspector. The first page in the array is the one used by default in a new inspector." ^Array with: Tools.Trippy.BasicInspector
inspectorCollaborators "Answer a collection of Collaborator instances listing the important other objects a person looking at this one might want to see. For example, collaborators of a view would be its model and the controller. Collaborators are added to the inspector's Go menu." ^#()
inspectorExtraAttributes "Subclasses may reimplement this to answer a sequence of DerivedAttribute or TextAttribute instances that should show up in the inspector in addition to named instance variables and indexed variables. See implementors for an example." ^#()
inspectorHierarchies "Answer a collection of instances of Hierarchy describing the hierarchies this object is a member of." ^#()
</methods> <methods> Protocols.ProtoObject <category>message handling</category>
perform: aSymbol "Send the receiver the unary message indicated by the argument. The argument is the selector of the message. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if the looked-up method does not expect zero arguments." <primitive: 511> ^self perform: aSymbol withArguments: (Array new: 0)
perform: aSymbol with: anObject "Send the receiver the keyword or binary message indicated by the arguments. The first argument is the selector of the message. The other argument is the argument of the message to be sent. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if the looked-up method does not expect one argument." <primitive: 512> ^self perform: aSymbol withArguments: (Array with: anObject)
perform: aSymbol with: firstObject with: secondObject "Send the receiver the keyword message indicated by the arguments. The first argument is the selector of the message. The other arguments are the arguments of the message to be sent. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if the looked-up method does not expect two arguments." <primitive: 513> ^self perform: aSymbol withArguments: (Array with: firstObject with: secondObject)
perform: aSymbol with: firstObject with: secondObject with: thirdObject "Send the receiver the keyword message indicated by the arguments. The first argument is the selector of the message. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if the looked-up method does not expect three arguments." <primitive: 514> ^self perform: aSymbol withArguments: (Array with: firstObject with: secondObject with: thirdObject)
perform: selector withArguments: anArray "Send the receiver the message indicated by the arguments. The argument selector is the selector of the message. The arguments of the message are the elements of anArray. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if anArray is not an Array with the same number of elements as the number of arguments expected by the looked-up method." <primitive: 510> ^self primitiveFailed
performMethod: method "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The method must be expecting no arguments." ^self performMethod: method arguments: #()
performMethod: method arguments: args "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other argument is the list of arguments of the method. The number of arguments expected by the method must match the size of the Array." ^method valueWithReceiver: self arguments: args
performMethod: method with: arg1 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other argument is the argument of the method. The method must be expecting one argument." ^self performMethod: method arguments: (Array with: arg1)
performMethod: method with: arg1 with: arg2 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other arguments are the arguments of the method. The method must be expecting two arguments." ^self performMethod: method arguments: (Array with: arg1 with: arg2)
performMethod: method with: arg1 with: arg2 with: arg3 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other arguments are the arguments of the method. The method must be expecting three arguments." ^self performMethod: method arguments: (Array with: arg1 with: arg2 with: arg3)
</methods> <methods> Protocols.ProtoObject <category>accessing</category>
basicAt: index "Answer the value of an indexable field in the receiver. Fail if the argument index is not an Integer or is out of bounds. Do not override this message in any subclass." <primitive: 60> index isInteger ifTrue: [^self subscriptBoundsErrorFor: #basicAt: index: index]. index respondsToArithmetic ifTrue: [^self basicAt: index asSmallInteger] ifFalse: [^self nonIntegerIndexError: index]
basicAt: index put: value "Store the second argument value in the indexable field of the receiver indicated by index. Fail if the index is not an Integer or is out of bounds. Or fail if the value is not of the right type for this kind of collection. Answer the value that was stored. Do not override in a subclass." <primitive: 61> index isInteger ifTrue: [(index >= 1 and: [index <= self basicSize]) ifTrue: [self isImmutable ifTrue: [^self noModificationErrorFor: #basicAt:put: index: index value: value] ifFalse: [^self improperStoreError]] ifFalse: [^self subscriptBoundsErrorFor: #basicAt:put: index: index value: value]]. index respondsToArithmetic ifTrue: [^self basicAt: index asSmallInteger put: value] ifFalse: [^self nonIntegerIndexError: index]
basicSize "Answer the number of indexable fields in the receiver. This value is the same as the largest legal subscript. Do not override in any subclass." <primitive: 62> "The number of indexable fields of fixed-length objects is 0" ^0
</methods> <methods> Protocols.ProtoObject <category>comparing</category>
= anObject "Answer whether the receiver and the argument represent the same object. If = is redefined in any subclass, consider also redefining the message hash." ^self == anObject
== anObject "Answer true if the receiver and the argument are the same object (have the same object pointer) and false otherwise. Do not redefine the message == in any other class! No Lookup." <primitive: 110> self primitiveFailed
hash "Answer a SmallInteger that is equal to the hash value of any object that is equal to (=) the receiver. When two objects are not =, their hash values may or may not be the same. The hash value may change based on the receiver's contents." "If hash is redefined in a subclass, it may also be necessary to redefine the = method to maintain the semantics described above. Primitive 75 fails for immediate objects, so immediate subclasses such as SmallInteger must override this method." <primitive: 75> self primitiveFailed
identityHash "Answer a SmallInteger that is equal to the identityHash of any object that is == to the receiver. When two objects are not ==, their identityHash values may or may not be the same. The identityHash value does not change across the life of the object." "If identityHash is redefined in a subclass, the new implementation must answer the same identityHash when two objects are ==. Changing the == method has no effect on the execution machinery -- in effect, you cannot redefine == to echo a changed implementation of identityHash. Primitive 75 fails for immediate objects, so immediate subclasses such as SmallInteger must override this method." <primitive: 75> self primitiveFailed
~= anObject "Answer whether the receiver and the argument do not represent the same object." ^self = anObject == false
~~ anObject "Answer true if the receiver and the argument are not the same object (have the same object pointer) and false otherwise." <primitive: 109> ^(self == anObject) not
</methods> <methods> Protocols.ProtoObject <category>error handling</category>
doesNotUnderstand: aMessage ^MessageNotUnderstood new parameter: aMessage; messageText: [| selectorString | selectorString := [aMessage selector printString] on: Error do: [:ex | ex return: (#errSelectorNotPrintable << #dialogs >> '** unprintable selector **') expandMacros asString]. (#errNotUnderstood << #dialogs >> 'Message not understood: <1s>') expandMacrosWith: selectorString]; raiseSignal.
handleFailedBecome: otherObject "Called if the primBecome: primitive fails. This primitive can fail for one of the following reasons: 1. Either object is immutable (which includes immediate objects) 2. Either object is a MethodContext 3. Either object is a BlockContext 4. If there is insufficient memory to perform the become. In the first three cases, raise an error. In the latter case, attempt to make space and try again." | recClass argClass bytesInOop om overheadBytes recBytes argBytes | (self isImmutable or: [otherObject isImmutable]) ifTrue: [^Error raiseSignal: (#cannotBecomeObject << #dialogs >> 'cannot use become: on immutable objects')]. ((recClass := self class) == MethodContext or: [(argClass := otherObject class) == MethodContext]) ifTrue: [^Error raiseSignal: (#cannotBecomeMethod << #dialogs >> 'cannot use become: on a MethodContext')]. (recClass == BlockContext or: [argClass == BlockContext]) ifTrue: [^Error raiseSignal: (#cannotBecomeBlock << #dialogs >> 'cannot use become: on a BlockContext')]. om := ObjectMemory current. bytesInOop := om bytesPerOOP. overheadBytes := om bytesPerOTE + bytesInOop. "Includes size-overflow field" recBytes := recClass isBits ifTrue: [self basicSize] ifFalse: [(self basicSize + recClass instSize) * bytesInOop]. argBytes := argClass isBits ifTrue: [otherObject basicSize] ifFalse: [(otherObject basicSize + argClass instSize) * bytesInOop]. ObjectMemory makeSpaceFor: overheadBytes + recBytes + overheadBytes + argBytes. ^self becomeNoRetry: otherObject
improperStoreError "Create an error notification that an improper store was attempted." Error raiseSignal: (#errImproperIndex << #dialogs >> 'Improper store into indexable object')
mustBeBoolean "Catches attempts to test truth of non-Booleans. This message is sent from the VM." SystemNotification raiseRequestWith: thisContext errorString: (#nonBoolReceiver << #dialogs >> 'NonBoolean receiver--proceed for truth.'). ^true
noModificationErrorFor: selector index: index value: value ^(NoModificationError receiver: self selector: selector index: index value: value) raiseRequest
nonIntegerIndexError: index "Raise a signal indicating that an improper object was used as an index." ^Object nonIntegerIndexSignal raiseWith: index
primitiveFailed "Announce that a primitive has failed and there is no appropriate Smalltalk code to run." Error raiseSignal: (#errPrimitiveFailed << #dialogs >> 'a primitive has failed')
subscriptBoundsErrorFor: selector index: index "Raise a signal indicating that an improper index was used as an index in a send of selector with index." ^(SubscriptOutOfBoundsError receiver: self selector: selector index: index value: nil) raiseRequest
subscriptBoundsErrorFor: selector index: index value: aValue "Raise a signal indicating that an improper index was used as an index in a send of selector with index and aValue." ^(SubscriptOutOfBoundsError receiver: self selector: selector index: index value: aValue) raiseRequest
</methods> <methods> Protocols.ProtoObject <category>controlling</category>
ifNil: aBlock "Return the receiver if it is not nil, or evaluate the block and return the result if the receiver is nil." ^self
ifNil: nilBlock ifNotNil: notNilBlock "If the receiver is not nil, answer the evaluation of aBlock (with the receiver as its argument if it takes one), otherwise answer nil. UndefinedObject redefines this to answer the evaluation of nilBlock, and hence since here the receiver is not nil answer the evaluation of notNilBlock." ^0 == notNilBlock numArgs ifTrue: [notNilBlock value] ifFalse: [notNilBlock value: self]
ifNotNil: aBlock "If the receiver is not nil, answer the evaluation of aBlock (with the receiver as its argument if it takes one), otherwise answer nil. Since the receiver is not nil, answer aBlock's evaluation. Passing the receiver to aBlock is handy for idioms such as self toolBarSpec ifNotNil: [:spec | ...]. UndefinedObject reimplements this to not evaluate aBlock." ^0 == aBlock numArgs ifTrue: [aBlock value] ifFalse: [aBlock value: self]
ifNotNil: notNilBlock ifNil: nilBlock "If the receiver is not nil, answer the evaluation of notNilBlock (with the receiver as its argument if it takes one), otherwise answer the evaluation of nilBlock. UndefinedObject redefines this to answer the evaluation of nilBlock, and hence since here the receiver is not nil answer the evaluation of notNilBlock." ^0 == notNilBlock numArgs ifTrue: [notNilBlock value] ifFalse: [notNilBlock value: self]
</methods> <methods> Protocols.ProtoObject <category>testing</category>
isBehavior "Answer whether the object can be the 'class' of another object" ^false
isImmediate "Answer true if this object has immediate representation." "Currently, SmallInteger and Character are represented as immediate (or zero-sized storage) objects." ^self class hasImmediateInstances
isImmutable "Answer if the receiver is immutable. This is always true of immediates. Cannot fail." <primitive: 1063> ^false
isNil "Coerce nil to true and everything else to false. UndefinedObject overrides with ^true" ^false
isVariableBinding ^false
notNil "Coerce nil to false and everything else to true. UndefinedObject overrides with ^false" ^true
_isForwarder ^false
</methods> <methods> Protocols.ProtoObject <category>class membership</category>
changeClassTo: aClass "Change the class of the receiver to aClass." aClass adoptInstance: self. ^self
changeClassToThatOf: anObject "Change the class of the receiver to the class of anObject. Fail if either the receiver or anObject is immutable (which includes immediates), or if none of the following cases holds: 1. The receiver and anObject are both byte-type. 2. The receiver is any pointer-type object, anObject is a non-indexable pointer-type object, and the storage sizes (i.e. the number of named instance variables plus the number of indexed instance variables, if any) of the two objects are the same. 3. The receiver is any pointer-type object, anObject is an indexable pointer-type object, and the storage size of the receiver is at least as large as the number of named instance variables of anObject. Compare with the adoptInstance: primitive." <primitive: 535 errorCode: errCode> ^(errCode ~~ nil and: [errCode name = #'no modification']) ifTrue: [self noModificationErrorFor: #changeClassToThatOf: index: nil value: anObject] ifFalse: [self primitiveFailed]
class "Answer the object which is the receiver's class." <primitive: 111> self primitiveFailed
isKindOf: aClass "Answer a Boolean as to whether the class, aClass, is a superclass or class of the receiver." ^self class includesBehavior: aClass
respondsTo: aSymbol "Answer a Boolean as to whether the method dictionary of the receiver's class contains aSymbol as a message selector." ^self class canUnderstand: aSymbol
</methods> <methods> Protocols.ProtoObject <category>private</category>
becomeNoRetry: otherObject "Swap the instance data and appropriate header information of the receiver and the argument, otherObject. In other words, transform the receiver into the argument and vice-versa. Fail if either object is an immediate or a MethodContext or a BlockContext or if there is insufficient memory to perform the become. Answer with the argument which is now the semantic equivalent of the object that formerly denoted the receiver." <primitive: 72 errorCode: errCode> ^(errCode ~~ nil and: [errCode name = #'no modification']) ifTrue: [self noModificationErrorFor: #becomeNoRetry: index: nil value: otherObject] ifFalse: [self primitiveFailed]
</methods> <methods> Protocols.ProtoObject <category>printing</category>
basicPrintOn: aStream "Append to the argument aStream a sequence of characters that describes the receiver." | title | title := self class printString. aStream nextPutAll: ((title at: 1) isVowel ifTrue: ['an '] ifFalse: ['a ']). aStream nextPutAll: title
basicPrintString "Answer a String whose characters are a description of the receiver." | aStream | aStream := WriteStream on: (String new: 16). self basicPrintOn: aStream. ^aStream contents
printOn: aStream "Append to the argument aStream a sequence of characters that describes the receiver." | title | title := self class printString. aStream nextPutAll: ((title at: 1) isVowel ifTrue: ['an '] ifFalse: ['a ']). aStream nextPutAll: title
printString "Answer a String whose characters are a description of the receiver." | aStream | aStream := WriteStream on: (String new: 16). self printOn: aStream. ^aStream contents
</methods> <methods> Protocols.CircularBuffer <category>accessing</category>
headroom | headroom | headroom := top - position \\ cache size. (headroom isZero and: [ atTop not ]) ifTrue: [ headroom := cache size ]. ^full ifTrue: [ headroom ] ifFalse: [ cache size = top ifTrue: [ cache size ] ifFalse: [ cache size - top + headroom ] ]
next: total "Return a collection of up to total available elements. total <Integer> number of elements to return ^<SequenceableCollection> resulting elements " | result size | result := cache species new: total. size := self next: total into: result startingAt: 1. ^size = total ifTrue: [ result ] ifFalse: [ result copyFrom: 1 to: size ]
next: total into: target "Put up to @total available elements into @target stream. Return number of elements actually transferred. total <Integer> desired number of elements to write target <Stream> a writable stream to write elements into ^<Integer> number of actually written elements " | size size1 size2 | atTop ifTrue: [^0]. size1 := 0. position >= top ifTrue: [ (size1 := cache size - position min: total) isZero ifFalse: [ target next: size1 putAll: cache startingAt: position + 1. position := position + size1. total = size1 ifTrue: [ ^size1 ] ]. position := 0 ]. size2 := top - position min: total - size1. size := size1 + size2. target next: size2 putAll: cache startingAt: position + 1. position := position + size2. atTop := position = top. ^size
next: total into: target startingAt: start "Put up to @total available elements into @target starting at index @start. Return number of elements actually transferred. total <Integer> number of bytes to put into target target <SequenceableCollection> the target collection start <Integer> the initial index where to start writing ^<Integer> the actual number of elements transferred " | size size1 size2 | atTop ifTrue: [^0]. size1 := 0. position >= top ifTrue: [ (size1 := cache size - position min: total) isZero ifFalse: [ target replaceFrom: start to: start + size1 - 1 with: cache startingAt: position + 1. position := position + size1. total = size1 ifTrue: [ ^size1 ] ]. position := 0 ]. size2 := top - position min: total - size1. size := size1 + size2. target replaceFrom: start + size1 to: start + size - 1 with: cache startingAt: position + 1. position := position + size2. atTop := position = top. ^size
next: total putAll: source "Write up to total elements from source stream into the buffer. Elements will fill up any available headeroom plus up to a buffer size worth of additional elements, but not more. Return number of elements actually read. total <Integer> number of bytes to get from the source target <Stream> the source stream ^<Integer> the actual number of elements transferred " | left size | total isZero ifTrue: [^0]. size := self fillUpNext: total putAll: source. left := total - size. left isZero ifTrue: [ ^total ]. "Now we should be at the top" (size := cache size - position min: left) isZero ifFalse: [ source next: size into: cache startingAt: position + 1. left := left - size. left isZero ifTrue: [ top := position := position + size. position = cache size ifTrue: [ full := true ]. ^total ]. full := true ]. size := position min: left. source next: size into: cache startingAt: 1. left := left - size. top := position := size. top = cache size ifTrue: [ full := true ]. ^total - left
next: total putAll: source startingAt: start "Write up to total elements from source starting at index start into the buffer. Elements will fill up any available headeroom plus up to a buffer size worth of additional elements, but not more. Return number of elements actually written. total <Integer> number of bytes to get from the source source <SequenceableCollection> the source collection start <Integer> the initial index where to start reading ^<Integer> the actual number of elements transferred " | left next size | total isZero ifTrue: [^0]. size := self fillUpNext: total putAll: source startingAt: start. left := total - size. left isZero ifTrue: [ ^total ]. next := start + size. "Now we should be at the top" (size := cache size - position min: left) isZero ifFalse: [ cache replaceFrom: position + 1 to: position + size with: source startingAt: next. left := left - size. left isZero ifTrue: [ top := position := position + size. position = cache size ifTrue: [ full := true ]. ^total ]. full := true. next := next + size ]. size := position min: left. cache replaceFrom: 1 to: size with: source startingAt: next. left := left - size. top := position := size. top = cache size ifTrue: [ full := true ]. ^total - left
nextIfNone: aBlock "Return next element from the buffer. If there isn't one evaluate aBlock and return result of that. " ^atTop ifTrue: aBlock ifFalse: [ position := position \\ cache size + 1. atTop := position = top. cache at: position ]
nextPut: anObject "Put anObject into the buffer. Ignore replaced elements. " ^self nextPut: anObject ifReplacingDo: [ :replaced | ].
nextPut: anObject ifReplacingDo: aBlock "Put anObject into the buffer. If there's an old element being replaced, evaluate aBlock with it. " position := position \\ cache size + 1. atTop ifTrue: [ top := position. full ifTrue: [ aBlock value: (cache at: top) ]. top = cache size ifTrue: [ full := true ] ] ifFalse: [ atTop := position = top ]. ^cache at: position put: anObject
nextPutAll: source "Write elements from the source collection into the buffer. Elements will fill up any available headeroom plus up to a buffer size worth of additional elements, but not more. Return number of elements actually written. source <SequenceableCollection> the source collection ^<Integer> the actual number of elements transferred " ^self next: source size putAll: source startingAt: 1
previousIfNone: aBlock | previous | ((full not and: [ position = cache size ]) or: [ top = position and: [ atTop not ] ]) ifTrue: [ ^aBlock value ]. previous := cache at: position. (position := position - 1) isZero ifTrue: [ position := cache size ]. atTop := false. ^previous
size ^cache size
unread | unread | ^(unread := top - position \\ self size) isZero ifTrue: [ atTop ifTrue: [ 0 ] ifFalse: [ self size ] ] ifFalse: [ unread ]
</methods> <methods> Protocols.CircularBuffer <category>testing</category>
atBottom ^full ifTrue: [ position = top and: [ atTop not ] ] ifFalse: [ position = cache size ]
atEnd ^self atTop
atTop ^atTop
</methods> <methods> Protocols.CircularBuffer <category>skipping</category>
reset full ifTrue: [ position := top. atTop := false ] ifFalse: [ position := cache size. atTop := position = top ]
setToEnd position := top. atTop := true.
skip: step ^self skipForward: step
skipBack: step | size left | step < 0 ifTrue: [ ^self skipForward: step negated ]. step isZero ifTrue: [^0]. self atBottom ifTrue: [^0]. atTop := false. size := 0. position <= top ifTrue: [ size := position min: step. position := position - size. position isZero ifTrue: [ position := cache size ]. step = size ifTrue: [ ^step ] ]. left := step - size. full ifTrue: [ size := position - top min: left. position := position - size. left := left - size ]. ^step - left
skipForward: step | size left | step < 0 ifTrue: [ ^self skipBack: step negated ]. (step isZero or: [ atTop ]) ifTrue: [^0]. size := 0. position >= top ifTrue: [ size := cache size - position min: step. position := position + size. step = size ifTrue: [ ^step ]. position := 0 ]. left := step - size. size := top - position min: left. position := position + size. atTop := position = top. left := left - size. ^step - left
</methods> <methods> Protocols.CircularBuffer <category>printing</category>
printDetailsOn: aStream | stream show back forward | show := 5. "how many elements around current position to show" stream := (cache species new: 2*show) writeStream. back := self skipBack: show. forward := (self next: show + back into: stream) - show. self skipBack: forward. "Here we rely on pretty printing capability of internal streams, so that we don't need to reimplement it" stream := stream printString readStream. stream skipThrough: $[. aStream nextPutAll: '[ '; nextPutAll: (stream through: $[); nextPut: $-; print: self unread; nextPut: $]; nextPutAll: (stream through: $]; upTo: $]); nextPut: $]
printOn: aStream aStream print: self class; space. self printDetailsOn: aStream.
</methods> <methods> Protocols.CircularBuffer <category>private</category>
clear "Reset the buffer to an empty state, throwing away any contents" full := false. top := position := cache size. atTop := true
fillUpNext: total putAll: source | left size | (total isZero or: [ atTop ]) ifTrue: [^0]. left := total. position < top ifFalse: [ (size := cache size - position min: left) isZero ifFalse: [ source next: size into: cache startingAt: position + 1. position := position + size. atTop := position = top. left := left - size. left isZero ifTrue: [ ^total ] ]. position := 0 ]. size := top - position min: left. source next: size into: cache startingAt: position + 1. position := position + size. atTop := position = top. left := left - size. ^total - left
fillUpNext: total putAll: source startingAt: start | left next size | (total isZero or: [ atTop ]) ifTrue: [^0]. left := total. next := start. position < top ifFalse: [ (size := cache size - position min: left) isZero ifFalse: [ cache replaceFrom: position + 1 to: position + size with: source startingAt: next. position := position + size. atTop := position = top. left := left - size. left isZero ifTrue: [ ^total ]. next := next + size ]. position := 0 ]. size := top - position min: left. cache replaceFrom: position + 1 to: position + size with: source startingAt: next. position := position + size. atTop := position = top. left := left - size. ^total - left
</methods> <methods> Protocols.CircularBuffer <category>initialize-release</category>
cache: aCollection cache := aCollection. self clear.
</methods> <methods> Protocols.CircularBuffer class <category>instance creation</category>
cache: aCollection ^self new cache: aCollection
</methods> <methods> Protocols.Struct <category>accessing-dictionary</category>
add: anAssociation ( self associationAt: anAssociation key ifAbsent: [ ^self addLast: anAssociation ] ) value: anAssociation value. ^anAssociation
associationAt: key ^self associationAt: key ifAbsent: [self keyNotFoundErrorFor: #associationAt: index: key]
associationAt: key ifAbsent: aBlock 1 to: lastIndex do: [ :i || asc | asc := self basicAt: i. asc key = key ifTrue: [^asc] ]. ^aBlock value
associations | coll | coll := OrderedCollection new. 1 to: lastIndex do: [ :i | coll add: (self basicAt: i) ]. ^coll
associationsDo: aBlock "Evaluate aBlock for each of the receiver's key/value associations." 1 to: lastIndex do: [ :i | aBlock value: (self basicAt: i) ].
associationsDo: aBlock separatedBy: separatorBlock "Evaluate aBlock for each of the receiver's key/value associations. Between each pair of elements, but not before the first or after the last, evaluate the separatorBlock." | first | first := true. 1 to: lastIndex do: [ :i | first ifTrue: [ first := false ] ifFalse: [ separatorBlock value ]. aBlock value: (self basicAt: i) ].
do: aBlock self associationsDo: [ :asc | aBlock value: asc value ]
do: elementBlock separatedBy: separatorBlock "Evaluate elementBlock for each element in the collection. Between each pair of elements, but not before the first or after the last, evaluate the separatorBlock." | first | first := true. self do: [:elmnt | first ifTrue: [first := false] ifFalse: [separatorBlock value]. elementBlock value: elmnt]
includesKey: key "Answer whether the receiver has a key equal to the argument, key." ^(self associationAt: key ifAbsent: [nil]) notNil
keysAndValuesDo: aBlock self associationsDo: [ :asc | aBlock value: asc key value: asc value ].
removeKey: key ^self removeKey: key ifAbsent: [self keyNotFoundErrorFor: #removeKey: index: key]
removeKey: key ifAbsent: aBlock 1 to: lastIndex do: [ :i || asc | asc := self basicAt: i. asc key = key ifTrue: [ i + 1 to: lastIndex do: [ :j | self basicAt: j - 1 put: (self basicAt: j) ]. self basicAt: lastIndex put: nil. lastIndex := lastIndex - 1. ^asc value ] ]. ^aBlock value
</methods> <methods> Protocols.Struct <category>copying</category>
copy ^self shallowCopy postCopy
copyEmpty: aSize "Answer a copy of the receiver that contains no elements. This method should be redefined in subclasses that add instance variables, so that the state of those variables is preserved" ^self class new: aSize
postCopy 1 to: lastIndex do: [ :i | self basicAt: i put: (self basicAt: i) copy ]
shallowCopy "Answer a copy of the receiver which shares the receiver's instance variables." <primitive: 532> | class newObject index | class := self class. newObject := class basicNew: (index := self basicSize). 1 to: index do: [ :i | newObject basicAt: i put: (self basicAt: i) ]. 1 to: class instSize do: [ :i | newObject instVarAt: i put: (self instVarAt: i) ]. ^newObject
</methods> <methods> Protocols.Struct <category>accessing</category>
at: key ^self at: key ifAbsent: [ self keyNotFoundError: key ]
at: key ifAbsent: aBlock ^(self associationAt: key ifAbsent: [ ^aBlock value ] ) value
at: key ifAbsentPut: aBlock ^self associationAt: key ifAbsent: [ | value | value := aBlock value. self addLast: key -> value. value ]
at: key put: value (self associationAt: key ifAbsent: [ self addLast: key -> value ]) value: value. ^value
structName ^name
structName: aString name := aString
structSize ^lastIndex
yourself "Answer self."
</methods> <methods> Protocols.Struct <category>comparing</category>
= anObject "... must handle different orderings of the associations consequent upon the DER's constraints governing transmission order." ^( self class == anObject class ) and: [ ( self structName = anObject structName ) and: [ self contentsEquals: anObject ] ]
contentsEquals: aStruct "Anwer true if the receiver and aStruct contain the same key/values in the same order." self structSize == aStruct structSize ifFalse: [ ^false ]. 1 to: lastIndex do: [ :i | (self basicAt: i) = (aStruct basicAt: i) ifFalse: [^false] ]. ^true
hash | h | h := self structName hash. 1 to: self basicSize do: [ :i | (self basicAt: i) ifNotNil: [ :asc | h := (h bitXor: asc key hash) bitXor: asc value hash] ]. ^h
</methods> <methods> Protocols.Struct <category>error handling</category>
keyNotFoundError: key "Raise a signal indicating that the key was not found." ^(KeyNotFoundError receiver: self selector: nil index: key) raiseRequest
keyNotFoundErrorFor: selector index: key "Raise a signal indicating that the key was not found." ^(KeyNotFoundError receiver: self selector: selector index: key) raiseRequest
</methods> <methods> Protocols.Struct <category>private</category>
addLast: anAssociation anAssociation key == nil ifTrue: [ ^self subscriptBoundsErrorFor: #addLast: index: nil value: anAssociation value]. lastIndex = self basicSize ifTrue: [self makeRoomAtLast]. lastIndex := lastIndex + 1. self basicAt: lastIndex put: anAssociation. ^anAssociation
changeCapacityTo: newCapacity | newSelf | newSelf := self copyEmpty: newCapacity. self associationsDo: [:each | newSelf noCheckAddLast: each]. self become: newSelf
doesNotUnderstand: aMessage | selector numArgs | selector := aMessage selector. (numArgs := aMessage arguments size) isZero ifTrue: [ ^self at: selector ifAbsent: [ super doesNotUnderstand: aMessage ] ]. (numArgs > 1 or: [ selector last ~= $: ]) ifTrue: [ ^super doesNotUnderstand: aMessage ]. self at: (selector copyFrom: 1 to: selector size - 1) asSymbol put: aMessage arguments first
growSize "Answer an amount by which the receiver should grow to make room for more elements." ^5
increaseCapacity "Increase the number of elements of the collection." self changeCapacityTo: self basicSize + self growSize.
makeRoomAtLast ^self increaseCapacity
noCheckAddLast: anAssociation lastIndex := lastIndex + 1. self basicAt: lastIndex put: anAssociation
</methods> <methods> Protocols.Struct <category>initialize-release</category>
initialize lastIndex := 0
</methods> <methods> Protocols.Struct <category>testing</category>
isEmpty ^lastIndex = 0
isString ^false
isStruct ^true
notEmpty ^self isEmpty not
</methods> <methods> Protocols.Struct <category>printing</category>
printNameOn: aStream ( name notNil ) ifTrue: [ name printOn: aStream. aStream space ]
printOn: aStream self printNameOn: aStream. aStream nextPut: ${. self associationsDo: [ :asc | asc key isString ifTrue: [ aStream nextPutAll: asc key] ifFalse: [ aStream print: asc key ]. aStream nextPutAll: ' '; print: asc value ] separatedBy: [ aStream nextPutAll: ', ' ]. aStream nextPut: $}.
</methods> <methods> Protocols.Struct class <category>instance creation</category>
name: aString ^self new structName: aString; yourself
new ^self new: 5
new: anInteger ^(super new: anInteger) initialize
</methods> <methods> Protocols.IPMulticastRequest <category>accessing</category>
address "IP multicast address of group" ^( ByteArray new: 4 ) replaceBytesFrom: 1 to: 4 with: self startingAt: 1
address: aByteArray "Sets the IP multicast address of the group." ( self inMulticast: aByteArray ) ifFalse:[ self error: (#NotAnIPMulticastAddress << #opentalk >> 'Not an IP multicast address.') ]. ^self replaceBytesFrom: 1 to: 4 with: aByteArray startingAt: 1
interface "local IP address of interface" ^( ByteArray new: 4 ) replaceBytesFrom: 1 to: 4 with: self startingAt: 5
interface: aByteArray "local IP address of interface" ^self replaceBytesFrom: 5 to: 8 with: aByteArray startingAt: 1
</methods> <methods> Protocols.IPMulticastRequest <category>testing</category>
inMulticast: aByteArray "Is aByteArray a multicast address?" ^self class inMulticast: aByteArray
</methods> <methods> Protocols.IPMulticastRequest class <category>testing</category>
inMulticast: aByteArray "Is aByteArray a multicast address? IP Address: #[224 0 0 0] - #[239 255 255 255]" | byte | byte := aByteArray byteAt: 1. ^( byte bitAnd: 16rF0 ) = 16rE0 "self new inMulticast: #[239 255 255 255]"
</methods> <methods> Protocols.IPMulticastRequest class <category>instance creation</category>
interface: aByteArray address: addrByteArray ^( self new ) interface: aByteArray; address: addrByteArray; yourself
new "sturct ip_mreq { struct in_addr imr_multiaddr; /* IP multicast address of group */ struct in_addr imr_interface; '* local IP address of interface */ }" ^self new: 8
toAddress: addrByteArray ^( self new ) address: addrByteArray; yourself
</methods> <methods> Protocols.DecodedStream <category>accessing</category>
close self finish. stream close
contents "Answer with a copy of the receiver's readable information. Assuming that the size of encoded file in byte is always equal or bigger than the number of Unicode characters." | str c | str := (self contentsSpecies new: (stream size)) writeStream. [self atEnd] whileFalse: [c := self next. c == nil ifFalse: [str nextPut: c]]. ^str contents
finish self flush. cache position isZero ifFalse: [ self error: 'Incomplete encoding for the last character!' ]. super finish
flush self decodeAndPushCharacters. super flush
next "Answer the next object in the Stream represented by the receiver." binary ifFalse: [^stream next]. [ cache atEnd and: [ stream atEnd not ] ] whileTrue: [ self pullAndEncodeCharacter. cache reset ]. ^cache next
nextPut: anObject binary ifFalse: [^stream nextPut: anObject]. cache nextPut: anObject. cache position > 10 ifTrue: [ "If we accumulated a few bytes, let's try to push some characters through" self decodeAndPushCharacters ]. ^anObject
peek "Answer what would be returned with a self next, without changing position. If the receiver is at the end, answer nil." | next | binary ifFalse: [^stream peek]. self atEnd ifTrue: [^nil]. next := self next. cache skip: -1. ^next
peekFor: anObject "Answer false and do not move the position if self next ~= anObject or if the receiver is at the end. Answer true and increment position if self next = anObject." | next | binary ifFalse: [^stream peekFor: anObject ]. self atEnd ifTrue: [^false]. next := self next. "peek for matching element" anObject = next ifTrue: [^true]. "gobble it if found" cache skip: -1. ^false
skip: anInteger "Skip anInteger of elements." | step | binary ifFalse: [^stream skip: anInteger]. anInteger < 0 ifFalse: [ anInteger timesRepeat: [self next isNil ifTrue: [^self]]. ^self]. "skip back" step := anInteger. [ cache position < step negated ] whileTrue: [ step := step + cache position. stream skip: -2. self pullAndEncodeCharacter ]. cache skip: step. ^self
</methods> <methods> Protocols.DecodedStream <category>private</category>
contentsSpecies ^binary ifTrue: [ByteArray] ifFalse: [stream contentsSpecies]
decodeAndPushCharacters | position leftover | cache reset. leftover := #[]. [ position := cache position. cache atEnd ] whileFalse: [ (encoder nextFrom: cache) ifNil: [ "we don't have entire encoding of the last character yet, let's capture the leftover" cache position: position. leftover := cache upToEnd ] ifNotNil: [ :c | c == LF ifTrue: [ (crPreceeding and: [ lineEndConvention = LineEndCRLF ]) ifFalse: [ stream nextPut: ( lineEndConvention == LineEndLF ifTrue: [ CR ] ifFalse: [ LF ]) ] ] ifFalse: [ stream nextPut: c ]. crPreceeding := c == CR ] ]. cache on: cache collection. "reinitialize stream" cache nextPutAll: leftover
pullAndEncodeCharacter cache := cache on: cache collection. "reinitialize the stream" stream next ifNotNil: [ :char | char == CR ifTrue: [ lineEndConvention == LineEndLF ifTrue: [ encoder nextPut: LF on: cache ] ifFalse: [ encoder nextPut: CR on: cache ]. lineEndConvention == LineEndCRLF ifTrue: [ encoder nextPut: LF on: cache ] ] ifFalse: [ encoder nextPut: char on: cache ] ]
</methods> <methods> Protocols.DecodedStream <category>initialize</category>
on: aStream encodedBy: aStreamEncoder super on: aStream encodedBy: aStreamEncoder. binary := true. cache := ReadWriteStream on: (ByteArray new: 10). crPreceeding := false.
</methods> <methods> Protocols.DecodedStream <category>testing</category>
atEnd binary ifFalse: [ ^stream atEnd ]. [ cache atEnd and: [ stream atEnd not ] ] whileTrue: [ self pullAndEncodeCharacter. cache reset ]. ^cache atEnd
</methods> <methods> Protocols.DecodedStream <category>positioning</category>
position: anInteger cache on: cache collection. "reinitialize stream" crPreceeding := false. ^super position: anInteger
reset cache on: cache collection. "reinitialize stream" crPreceeding := false. ^super reset
</methods> <methods> Protocols.B64StreamDecoder <category>printing</category>
encoding ^#base64
printOn: aStream aStream nextPutAll: 'B64'; nextPut: $[. leftover printOn: aStream base: 16 digitsToPad: 2 highDigit: 2. aStream nextPut: $@; print: quart; nextPut: $]
</methods> <methods> Protocols.B64StreamDecoder <category>private</category>
advance offset := offset + 1. quart := (quart + 1) \\ 4.
nextPartFor: sextet | mask shift | mask := #(2r11111100 2r11110000 2r11000000). shift := #(-2 -4 -6). ^(leftover bitAnd: (mask at: sextet)) bitShift: (shift at: sextet)
nextPartOf: sextet | shift | quart = 0 ifTrue: [^0]. shift := #(2 4 6). ^(sextet bitShift: (shift at: quart)) bitAnd: 16rFF
previousPartFor: sextet | mask shift | mask := #(2r00000011 2r00001111 2r00111111). shift := #(4 2 0). ^(leftover bitAnd: (mask at: sextet)) bitShift: (shift at: sextet)
previousPartOf: sextet | shift | shift := #(-4 -2 0). ^leftover bitOr: (sextet bitShift: (shift at: quart))
privateNextFrom: aStream | next | next := 0. quart = 0 ifFalse: [ next := self previousPartFor: quart ]. self advance. quart = 0 ifFalse: [ leftover := aStream next. next := next bitOr: (self nextPartFor: quart) ]. ^next
privateNextPut: sextet on: aStream quart = 0 ifFalse: [ leftover := self previousPartOf: sextet. aStream nextPut: leftover ]. self advance. leftover := self nextPartOf: sextet
</methods> <methods> Protocols.B64StreamDecoder <category>accessing</category>
lineLength ^lineLength ifNil: [ self class defaultLineLength ]
lineLength: length " <Integer> specifies the line length where to emit CR and wrap to the next line when encoding " lineLength := length
nextFrom: aStream offset < self lineLength ifFalse: [ offset := 0. ^CR ]. ^SextetMap at: (self privateNextFrom: aStream) + 1
nextPut: c on: aStream c = $= ifTrue: [ finishing := true ]. (Whitespace includes: c) ifTrue: [^c]. finishing ifTrue: [ (c = $= and: [ quart > 1 ]) ifTrue: [ self advance. ^c ] ifFalse: [ self error: 'Reading past the end of Base 64 encoding!' ] ]. (OctetMap at: c ifAbsent: [ nil ]) ifNil: [self noEncodingFor: c] ifNotNil: [ :code | self privateNextPut: code on: aStream]. ^c
prepareToClose: aStream "If there are some conventions about the state of the file at closing, prepare those conventions." quart = 0 ifFalse: [ "flush the last nibble" aStream nextPut: ( self nextFrom: Zeros) ]. "at this point quart is one of 0,2,3" quart = 0 ifFalse: [ 4 - quart timesRepeat: [ aStream nextPut: $= ] ]
reset quart := 0. offset := 0. leftover := 0. finishing := false.
</methods> <methods> Protocols.B64StreamDecoder class <category>zeros</category>
next "This method is here to have the receiver emulate an efficient infinite stream of zeros." ^0
</methods> <methods> Protocols.B64StreamDecoder class <category>accessing</category>
defaultLineLength ^defaultLineLength ifNil: [ self defaultLineLengthValue ]
defaultLineLength: length " length <Integer> specifies the default line length where to emit CR and wrap to the next line when encoding " defaultLineLength := length
defaultLineLengthValue ^76
streamEncodingType ^nil "Don't register this encoder"
</methods> <methods> Protocols.B64StreamDecoder class <category>class initialization</category>
initialize SextetMap := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'. OctetMap := IdentityDictionary new. 1 to: SextetMap size do: [ :idx | OctetMap at: ( SextetMap at: idx) put: (idx -1)]. "the class is also used to emulate an efficient, infinite stream of zeros. See the class method #next" Zeros := self. Whitespace := Array with: CR with: LF with: Character tab with: Character space.
</methods> <methods> Protocols.B64StreamDecoder class <category>instance creation</category>
new: symbol ^symbol = #base64 ifTrue: [ self asEncoder ] ifFalse: [ super new: symbol ]
</methods> <methods> Protocols.Base64StreamEncoder <category>manipulating sextets</category>
fillNibbleFrom: aStream | nSextets code enc | enc := self class octetMap. nibble := 0. nSextets := 0. 1 to: 4 do: [ :idx | aStream atEnd ifTrue: [ ^nSextets ]. code := aStream next. (code isNil or: [ code == self padChar ]) ifTrue: [ ^nSextets ]. nibble := nibble bitOr: ((enc at: code ) bitShift: (self shiftValueAt: idx)). nSextets := nSextets + 1. ]. ^nSextets
nextPutNibble: ival on: aStream | nchars code dec | dec := self class sextetMap. nchars := self charsToEncode. 1 to: nchars do: [ :idx | code := ((ival bitAnd: (self sextetMaskAt: idx)) bitShift: (self shiftValueAt: idx) negated) bitAnd: 16r3f. aStream nextPut: ( dec at: (code + 1)). ]. self charsToPad timesRepeat: [ aStream nextPut: self padChar ]. self reset
octetsToDecodeFromSextets: nSextets " Depending on how many characters was read from source stream, answer " " how many octets can be decoded from these characters (nSextets is zero-based) " ^#(0 0 1 2 3 ) at: nSextets + 1
sextetMaskAt: idx ^#( 2r111111000000000000000000 2r000000111111000000000000 2r000000000000111111000000 2r000000000000000000111111 ) at: idx.
shiftValueAt: idx ^#( 18 12 6 0 ) at: idx.
</methods> <methods> Protocols.Base64StreamEncoder <category>private</category>
charsToEncode ^#(1 2 3 4) at: index + 1.
charsToPad ^#(0 2 1 0) at: index + 1.
index ^index
nibble ^nibble
padChar ^$= asInteger
privateNextPut: int on: aStream | length | length := int digitLength. length = 1 ifTrue: [ self nextPutOctet: int on: aStream] ifFalse: [ 1 to: length do: [ :idx | self nextPackOctet: (int digitAt: idx) ] ]
reset index := 0. nEncoded := 0. nibble := 0.
</methods> <methods> Protocols.Base64StreamEncoder <category>initialization</category>
initialize super initialize. self reset
</methods> <methods> Protocols.Base64StreamEncoder <category>packing/unpacking octets</category>
getNibbleFrom: aStream | nSextets | nSextets := self fillNibbleFrom: aStream. nEncoded := self octetsToDecodeFromSextets: nSextets. index := 3.
nEncoded " Answer number of encoded octets " ^nEncoded
nextPackOctet: octet nibble := (nibble bitShift: 8) bitOr: octet.
nextPutOctet: octet on: aStream self nextPackOctet: octet. index := index + 1. index = 3 ifTrue: [ self nextPutNibble: nibble on: aStream ]
nextUnpackOctet "Decode the next byte(s) in the stream and answer the character." | octet | nEncoded = 0 ifTrue: [ ^nil ]. octet := nibble digitAt: index. index := index - 1. nEncoded := nEncoded - 1. ^octet
</methods> <methods> Protocols.Base64StreamEncoder <category>accessing</category>
characterSize: char "Return the size in bytes of <char>." ^1
encoder: anEncoder encoder := anEncoder
nextFrom: aStream "Decode the next byte(s) in the stream and answer the code." nEncoded = 0 ifTrue: [ self getNibbleFrom: aStream ]. ^self nextUnpackOctet.
nextPut: c on: aStream | code | ((code := self encoder encode: c) > 255 or: [ c < 0 ]) ifTrue: [self noEncodingFor: c] ifFalse: [ self privateNextPut: code on: aStream]
prepareToClose: aStream "If there are some conventions about the state of the file at closing, prepare those conventions." index > 0 ifTrue: [ index to: 2 do: [ :idx | self nextPackOctet: 0 ]. self nextPutNibble: self nibble on: aStream. ]
</methods> <methods> Protocols.Base64StreamEncoder class <category>accesing</category>
octetMap ^octetMap
sextetMap ^sextetMap
streamEncodingType ^#BASE64
</methods> <methods> Protocols.Base64StreamEncoder class <category>testing</category>
test1 "self test1" | stream | " Encoding string as base64 " stream := (ByteArray new withEncoding: #BASE64) writeStream. stream nextPutAll: 'Aladdin:open sesame'. stream close. " Should be 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' " ^(stream encodedContents withEncoding: #ASCII) readStream contents
test2 "self test2" | stream input output char | " Decoding base64-encoded string " input := 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' asByteArray readStream. stream := EncodedStream on: input encodedBy: Base64StreamEncoder asEncoder. output := (ByteArray new: 64) writeStream. [ (char := stream next) notNil ] whileTrue: [ output nextPut: char ]. ^(output contents withEncoding: #ASCII) readStream contents " should be 'Aladdin:open sesame'. "
test3 " self test3 " | output stream input unistr base64str stream1 result char unistr1 stream2 | " Test encoding/decoding Unicode strings as base64. We take regular string 'Aladdin:open sesame', encode it as Unicode bytes (byte array) and then encode Unicode bytes as base64. Then the process is reverted: base64-encoded string is decoded back into Unicode byte array which is then decoded back into the original string " output := (ByteArray new: 64) writeStream. stream := EncodedStream on: output encodedBy: UnicodeStreamEncoder asEncoder. " Default string->Unicode encoder " stream nextPutAll: 'Aladdin:open sesame'. stream close. " This is needed to flush byte buffer " unistr := output contents. " Unicode bytes " output := (ByteArray new: 64) writeStream. stream := EncodedStream on: output encodedBy: ((Base64StreamEncoder asEncoder) encoder: UnicodeCharacterEncoder new; yourself). " Unicode bytes->base64 encoder " stream nextPutAll: unistr. stream close. " This is needed to flush byte buffer " base64str := output contents. " base64-encoded string " input := base64str readStream. stream1 := EncodedStream on: input encodedBy: " Base64->Unicode decoder " ((Base64StreamEncoder asEncoder) encoder: UnicodeCharacterEncoder new; yourself). result := (ByteArray new: 64) writeStream. [ (char := stream1 next) notNil ] whileTrue: [ result nextPut: char ]. " Convert from base64 to Unicode " unistr1 := result contents. " should be 'Aladdin:open sesame' in Unicode as byte array " stream2 := EncodedStream on: unistr1 readStream encodedBy: UnicodeStreamEncoder asEncoder. " Unicode->default string decoder " ^stream2 upToEnd. " should be 'Aladdin:open sesame'. "
</methods> <methods> Protocols.Base64StreamEncoder class <category>class initialization</category>
initialize "Initialize class variables" self initializeMaps. self flushEncoderDirectory.
initializeMaps | stream | stream := ((ByteArray new: 64) withEncoding: #ASCII) writeStream. stream nextPutAll: self sextetMapCharacters. sextetMap := stream encodedContents. octetMap := IdentityDictionary new. 1 to: sextetMap size do: [ :idx | octetMap at: ( sextetMap at: idx) put: (idx -1)].
</methods> <methods> Protocols.Base64StreamEncoder class <category>private</category>
characterSet ^'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
defaultCharacterEncoder ^String defaultPlatformClass encoder
sextetMapCharacters ^'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
</methods> <methods> Protocols.EventCollector <category>deprecated</category>
dumpToTranscript self clearToTranscript
</methods> <methods> Protocols.EventCollector <category>private</category>
clockEmphasis ^Array with: #color -> ColorValue darkMagenta
printEventsOn: aStream | originalEmphasis | originalEmphasis := aStream emphasis. events do: [ :rec | aStream cr; emphasis: self clockEmphasis. self printTime: ( baseClockValue isNil ifTrue: [rec key] ifFalse: [rec key - baseClockValue]) on: aStream. aStream tab. self printEvent: rec value on: aStream ]. aStream emphasis: originalEmphasis.
printTime: milliseconds on: aStream | tm | tm := (Time aTime: milliseconds // 1000) last. tm hours printOn: aStream paddedWith: $0 to: 2 base: 10. aStream nextPut: $:. tm minutes printOn: aStream paddedWith: $0 to: 2 base: 10. aStream nextPut: $:. tm seconds printOn: aStream paddedWith: $0 to: 2 base: 10. aStream nextPut: $.. (milliseconds \\ 1000) printOn: aStream paddedWith: $0 to: 3 base: 10
privateProcess: anEvent events add: (Time millisecondClockValue -> anEvent)
</methods> <methods> Protocols.EventCollector <category>services</category>
clear events := OrderedCollection new: events size
clearToTranscript self toTranscript; clear
resetClock baseClockValue := Time millisecondClockValue
toTranscript self transcriptTextStreamDo: [ :ts | self printEventsOn: ts ] "Transcript flush"
</methods> <methods> Protocols.EventCollector <category>initialize/release</category>
initialize: eventsSize events := OrderedCollection new: eventsSize
release events := nil. super release
</methods> <methods> Protocols.EventCollector <category>accessing</category>
events ^events
</methods> <methods> Protocols.EventCollector class <category>instance creation</category>
new ^self new: 50
new: eventsSize ^super new initialize: eventsSize
</methods> <methods> Core.StreamEncoder <category>accessing</category>
bigEndian: aBoolean "Doesn't apply by default."
</methods> <methods> Core.Exception <category>accessing</category>
clearForReraise "This is to get the exception instance ready for transport to the client side and reraise it in the calling thread. The method 'copyForReraise' doesn't seem to be good enough to support user defined exception parameters. Moreover, it seems to make sense to make the exception nonresumable, when raised in the client thread." messageText := self description. initialContext := nil. firstUnwindContext := nil. handlerContext := nil. proceedBlock := nil. isResumable := false. signal := nil. searchContext := nil
</methods> <methods> Core.UnicodeStreamEncoder <category>accessing</category>
bigEndian: aBoolean orderHiLow := aBoolean
</methods> <methods> OS.MacOSXSocketAccessor class <category>opentalk</category>
otReuseAddress: aBoolean for: aSocket aSocket soReuseport: aBoolean
</methods> <methods> OS.SocketAccessor class <category>opentalk</category>
otReuseAddress: aBoolean for: aSocket aSocket soReuseaddr: aBoolean
</methods> <methods> OS.SocketAccessor class <category>constants-socket options</category>
SO_REUSEPORT "Socket option constant allowing local port reuse." ^self defaultClass _soReuseport
</methods> <methods> OS.SocketAccessor class <category>private-socket options</category>
_soReuseport "Socket option constant allowing local port reuse." ^16r200
</methods> <methods> OS.SocketAccessor <category>opentalk</category>
otReuseAddress: aBoolean self defaultClass otReuseAddress: aBoolean for: self
</methods> <methods> OS.SocketAccessor <category>options</category>
soReuseport: aBoolean "... allows or prohibits the use of the same port for multiple broadcast groups or adaptors. But note that not all casting implementations support this." ^self setOptionsLevel: SocketAccessor SOL_SOCKET name: SocketAccessor SO_REUSEPORT value: (aBoolean ifTrue: [1] ifFalse: [0])
</methods> <methods> Kernel.BlockClosure <category>scheduling</category>
timedPromiseFor: aMillisecondClockDuration "Answer a TimedPromise that represents the result of evaluating the receiver. See class Promise for more information." | prom | prom := Protocols.TimedPromise forMilliseconds: aMillisecondClockDuration. ( self promiseBlock: prom ) fork. ^prom
timedPromiseFor: aMillisecondClockDuration at: aPriority "Answer a TimedPromise that represents the result of evaluating the receiver at the given priority See class Promise for more information." | prom | prom := Protocols.TimedPromise forMilliseconds: aMillisecondClockDuration. ( self promiseBlock: prom ) forkAt: aPriority. ^prom
</methods> <methods> Core.EncodedStream <category>status</category>
finish encoder prepareToClose: stream. stream finish
</methods> <methods> Core.UTF16StreamEncoder <category>accessing</category>
bigEndian: aBoolean bigEndian := aBoolean
</methods> <methods> Core.Stream <category>status</category>
finish
</methods> <methods> Core.Stream <category>computed streaming</category>
readCache: size "Create a cached stream wrapping the receiver. size <Integer> desired size of the cache, in number of cached elements " ^Protocols.CachedReadStream wrap: self cache: size
writeCache: size "Create a cached stream wrapping the receiver. size <Integer> desired size of the cache, in number of cached elements " ^Protocols.CachedWriteStream wrap: self cache: size
</methods> <methods> Core.Object <category>testing</category>
_isForwarder ^false
</methods> <methods> Core.CharacterArray <category>converting</category>
withEncoding: encoding ^Protocols.DecodedStreamConstructor on: self encoding: encoding
</methods> <initialize> Protocols.B64StreamDecoder </initialize> <initialize> Protocols.Base64StreamEncoder </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>StreamEncoder</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none encoder errorPolicy skipRecord <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>UnicodeStreamEncoder</name> <environment>Core</environment> <super>Core.StreamEncoder</super> <private>false</private> none beginning orderHiLow writeBOM <imports></imports> <category>Internationalization</category> <attributes> <package>Internationalization</package> </attributes> </class> <class> <name>EvaluableAction</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>System-Dependency Events</category> <attributes> <package>System-Dependency Events</package> </attributes> </class> <class> <name>Stream</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports> private IOConstants.* </imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>Exception</name> <environment>Core</environment> <super>Core.GenericException</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>Error</name> <environment>Core</environment> <super>Core.Exception</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>Promise</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none sync value hasValue exception <imports></imports> <category>Kernel-Processes</category> <attributes> <package>Kernel-Processes</package> </attributes> </class> <class> <name>SocketAccessor</name> <environment>OS</environment> <super>OS.BlockableIOAccessor</super> <private>false</private> none concreteClass <imports></imports> <category>OS-Sockets</category> <attributes> <package>OS-Sockets</package> </attributes> </class> <class> <name>UninterpretedBytes</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> bytes <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>UTF16StreamEncoder</name> <environment>Core</environment> <super>Core.StreamEncoder</super> <private>false</private> none bigEndian <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>PeekableStream</name> <environment>Core</environment> <super>Core.Stream</super> <private>false</private> none <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>BlockClosure</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none method outerContext copiedValues <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>EncodedStream</name> <environment>Core</environment> <super>Core.PeekableStream</super> <private>false</private> none binary stream encoder policy lineEndConvention lineEndCharacter skipSize <imports> private OS.IOConstants.* </imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>InternalEncodedStreamConstructor</name> <environment>Core</environment> <super>Core.EncodedStreamConstructor</super> <private>false</private> none <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class>