# HG changeset patch # User Merge Script # Date 1437799151 -7200 # Node ID 358b275dced957140db26dee9ab295c78d961377 # Parent 27ffa826691be61f0be6e26ac2d1cb82be5dbe2a# Parent 3529a684d3fbc1f72105f9c8c7408d7fd3fc3147 Merge diff -r 27ffa826691b -r 358b275dced9 AbstractOperatingSystem.st --- a/AbstractOperatingSystem.st Fri Jul 24 08:09:56 2015 +0100 +++ b/AbstractOperatingSystem.st Sat Jul 25 06:39:11 2015 +0200 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 1988 by Claus Gittinger All Rights Reserved @@ -1339,244 +1337,244 @@ terminateLock := Semaphore forMutualExclusion. ((externalInStream := anInStream) notNil and:[externalInStream isExternalStream not]) ifTrue:[ - pIn := NonPositionableExternalStream makePipe. - inStreamToClose := externalInStream := pIn at:1. - shuffledInStream := pIn at:2. - anInStream isBinary ifTrue:[ - shuffledInStream binary - ]. - lineWise ifFalse:[ - shuffledInStream blocking:false. - ]. - - "/ start a reader process, shuffling data from the given - "/ inStream to the pipe (which is connected to the commands input) - inputShufflerProcess := - [ - [ - [anInStream atEnd] whileFalse:[ - self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise. - shuffledInStream flush - ] - ] ensure:[ - shuffledInStream close - ] - ] newProcess - name:'cmd input shuffler'; + pIn := NonPositionableExternalStream makePipe. + inStreamToClose := externalInStream := pIn at:1. + shuffledInStream := pIn at:2. + anInStream isBinary ifTrue:[ + shuffledInStream binary + ]. + lineWise ifFalse:[ + shuffledInStream blocking:false. + ]. + + "/ start a reader process, shuffling data from the given + "/ inStream to the pipe (which is connected to the commands input) + inputShufflerProcess := + [ + [ + [anInStream atEnd] whileFalse:[ + self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise. + shuffledInStream flush + ] + ] ensure:[ + shuffledInStream close + ] + ] newProcess + name:'cmd input shuffler'; "/ beSystemProcess; - resume. + resume. ]. ((externalOutStream := anOutStream) notNil and:[externalOutStream isExternalStream not]) ifTrue:[ - pOut := NonPositionableExternalStream makePipe. - shuffledOutStream := (pOut at:1). - anOutStream isBinary ifTrue:[ - shuffledOutStream binary - ]. - outStreamToClose := externalOutStream := pOut at:2. - outputShufflerProcess := - [ - WriteError handle:[:ex | - "/ ignored - ] do:[ - self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock. - ]. - ] newProcess - priority:(Processor userSchedulingPriority + 1); - name:'cmd output shuffler'; + pOut := NonPositionableExternalStream makePipe. + shuffledOutStream := (pOut at:1). + anOutStream isBinary ifTrue:[ + shuffledOutStream binary + ]. + outStreamToClose := externalOutStream := pOut at:2. + outputShufflerProcess := + [ + WriteError handle:[:ex | + "/ ignored + ] do:[ + self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock. + ]. + ] newProcess + priority:(Processor userSchedulingPriority "+ 1"); + name:'cmd output shuffler'; "/ beSystemProcess; - resume. + resume. ]. (externalErrStream := anErrStream) notNil ifTrue:[ - anErrStream == anOutStream ifTrue:[ - externalErrStream := externalOutStream - ] ifFalse:[ - anErrStream isExternalStream ifFalse:[ - pErr := NonPositionableExternalStream makePipe. - shuffledErrStream := (pErr at:1). - anErrStream isBinary ifTrue:[ - shuffledErrStream binary - ]. - errStreamToClose := externalErrStream := pErr at:2. - errorShufflerProcess := - [ - self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock. - ] newProcess - priority:(Processor userSchedulingPriority + 2); - name:'cmd err-output shuffler'; + anErrStream == anOutStream ifTrue:[ + externalErrStream := externalOutStream + ] ifFalse:[ + anErrStream isExternalStream ifFalse:[ + pErr := NonPositionableExternalStream makePipe. + shuffledErrStream := (pErr at:1). + anErrStream isBinary ifTrue:[ + shuffledErrStream binary + ]. + errStreamToClose := externalErrStream := pErr at:2. + errorShufflerProcess := + [ + self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock. + ] newProcess + priority:(Processor userSchedulingPriority + 1); + name:'cmd err-output shuffler'; "/ beSystemProcess; - resume. - ] - ] + resume. + ] + ] ]. ((externalAuxStream := anAuxStream) notNil and:[externalAuxStream isExternalStream not]) ifTrue:[ - pAux := NonPositionableExternalStream makePipe. - auxStreamToClose := externalAuxStream := pAux at:1. - shuffledAuxStream := pAux at:2. - shuffledAuxStream blocking:false. - anAuxStream isBinary ifTrue:[ - shuffledAuxStream binary - ]. - - "/ start a reader process, shuffling data from the given - "/ auxStream to the pipe (which is connected to the commands aux) - auxShufflerProcess := - [ - [ - [anAuxStream atEnd] whileFalse:[ - self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false. - shuffledAuxStream flush - ] - ] ensure:[ - shuffledAuxStream close - ] - ] newProcess - name:'cmd aux shuffler'; + pAux := NonPositionableExternalStream makePipe. + auxStreamToClose := externalAuxStream := pAux at:1. + shuffledAuxStream := pAux at:2. + shuffledAuxStream blocking:false. + anAuxStream isBinary ifTrue:[ + shuffledAuxStream binary + ]. + + "/ start a reader process, shuffling data from the given + "/ auxStream to the pipe (which is connected to the commands aux) + auxShufflerProcess := + [ + [ + [anAuxStream atEnd] whileFalse:[ + self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false. + shuffledAuxStream flush + ] + ] ensure:[ + shuffledAuxStream close + ] + ] newProcess + name:'cmd aux shuffler'; "/ beSystemProcess; - resume. + resume. ]. stopShufflers := [:shuffleRest | - inputShufflerProcess notNil ifTrue:[ - terminateLock critical:[inputShufflerProcess terminate]. - inputShufflerProcess waitUntilTerminated - ]. - auxShufflerProcess notNil ifTrue:[ - terminateLock critical:[auxShufflerProcess terminate]. - auxShufflerProcess waitUntilTerminated - ]. - outputShufflerProcess notNil ifTrue:[ - terminateLock critical:[outputShufflerProcess terminate]. - outputShufflerProcess waitUntilTerminated. - shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ]. - shuffledOutStream close. - ]. - errorShufflerProcess notNil ifTrue:[ - terminateLock critical:[errorShufflerProcess terminate]. - errorShufflerProcess waitUntilTerminated. - shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ]. - shuffledErrStream close. - ]. - ]. + inputShufflerProcess notNil ifTrue:[ + terminateLock critical:[inputShufflerProcess terminate]. + inputShufflerProcess waitUntilTerminated + ]. + auxShufflerProcess notNil ifTrue:[ + terminateLock critical:[auxShufflerProcess terminate]. + auxShufflerProcess waitUntilTerminated + ]. + outputShufflerProcess notNil ifTrue:[ + terminateLock critical:[outputShufflerProcess terminate]. + outputShufflerProcess waitUntilTerminated. + shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ]. + shuffledOutStream close. + ]. + errorShufflerProcess notNil ifTrue:[ + terminateLock critical:[errorShufflerProcess terminate]. + errorShufflerProcess waitUntilTerminated. + shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ]. + shuffledErrStream close. + ]. + ]. closeStreams := [ - inStreamToClose notNil ifTrue:[ - inStreamToClose close - ]. - errStreamToClose notNil ifTrue:[ - errStreamToClose close - ]. - outStreamToClose notNil ifTrue:[ - outStreamToClose close - ]. - auxStreamToClose notNil ifTrue:[ - auxStreamToClose close - ]. - nullStream notNil ifTrue:[ - nullStream close - ]. - ]. + inStreamToClose notNil ifTrue:[ + inStreamToClose close + ]. + errStreamToClose notNil ifTrue:[ + errStreamToClose close + ]. + outStreamToClose notNil ifTrue:[ + outStreamToClose close + ]. + auxStreamToClose notNil ifTrue:[ + auxStreamToClose close + ]. + nullStream notNil ifTrue:[ + nullStream close + ]. + ]. sema := Semaphore new name:'OS command wait'. [ - externalInStream isNil ifTrue:[ - externalInStream := nullStream := Filename nullDevice readWriteStream. - ]. - externalOutStream isNil ifTrue:[ - nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream]. - externalOutStream := nullStream. - ]. - externalErrStream isNil ifTrue:[ - externalErrStream := externalOutStream - ]. - - pid := Processor - monitor:[ - self - startProcess:aCommandStringOrArray - inputFrom:externalInStream - outputTo:externalOutStream - errorTo:externalErrStream - auxFrom:externalAuxStream - environment:environmentDictionary - inDirectory:dirOrNil - ] - action:[:status | - status stillAlive ifFalse:[ - exitStatus := status. - sema signal. - self closePid:pid - ] - ]. - - pid isNil ifTrue:[ - exitStatus := self osProcessStatusClass processCreationFailure - ] ifFalse:[ - sema wait. - ]. + externalInStream isNil ifTrue:[ + externalInStream := nullStream := Filename nullDevice readWriteStream. + ]. + externalOutStream isNil ifTrue:[ + nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream]. + externalOutStream := nullStream. + ]. + externalErrStream isNil ifTrue:[ + externalErrStream := externalOutStream + ]. + + pid := Processor + monitor:[ + self + startProcess:aCommandStringOrArray + inputFrom:externalInStream + outputTo:externalOutStream + errorTo:externalErrStream + auxFrom:externalAuxStream + environment:environmentDictionary + inDirectory:dirOrNil + ] + action:[:status | + status stillAlive ifFalse:[ + exitStatus := status. + sema signal. + self closePid:pid + ] + ]. + + pid isNil ifTrue:[ + exitStatus := self osProcessStatusClass processCreationFailure + ] ifFalse:[ + sema wait. + ]. ] ifCurtailed:[ - closeStreams value. - pid notNil ifTrue:[ - "/ terminate the os-command (and all of its forked commands) - self terminateProcessGroup:pid. - self terminateProcess:pid. - self closePid:pid. - ]. - stopShufflers value:false. + closeStreams value. + pid notNil ifTrue:[ + "/ terminate the os-command (and all of its forked commands) + self terminateProcessGroup:pid. + self terminateProcess:pid. + self closePid:pid. + ]. + stopShufflers value:false. ]. closeStreams value. stopShufflers value:true. (exitStatus isNil or:[exitStatus success]) ifFalse:[ - ^ aBlock value:exitStatus + ^ aBlock value:exitStatus ]. ^ true " - |outStream errStream| - - outStream := '' writeStream. - - OperatingSystem executeCommand:'ls -l' - inputFrom:'abc' readStream - outputTo:outStream - errorTo:nil - inDirectory:nil - lineWise:true - onError:[:exitStatus | ^ false]. - outStream contents - " - - " - |outStream errStream| - - outStream := #[] writeStream. - - OperatingSystem executeCommand:'cat' - inputFrom:(ByteArray new:5000000) readStream - outputTo:outStream - errorTo:nil - inDirectory:nil - lineWise:false - onError:[:exitStatus | ^ false]. - outStream size - " - - " - |outStream errStream| - - outStream := '' writeStream. - - OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd' - inputFrom:'bla' readStream - outputTo:outStream - errorTo:nil - inDirectory:nil - lineWise:true - onError:[:exitStatus | false]. - outStream contents + |outStream errStream| + + outStream := '' writeStream. + + OperatingSystem executeCommand:'ls -l' + inputFrom:'abc' readStream + outputTo:outStream + errorTo:nil + inDirectory:nil + lineWise:true + onError:[:exitStatus | ^ false]. + outStream contents + " + + " + |outStream errStream| + + outStream := #[] writeStream. + + OperatingSystem executeCommand:'cat' + inputFrom:(ByteArray new:5000000) readStream + outputTo:outStream + errorTo:nil + inDirectory:nil + lineWise:false + onError:[:exitStatus | ^ false]. + outStream size + " + + " + |outStream errStream| + + outStream := '' writeStream. + + OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd' + inputFrom:'bla' readStream + outputTo:outStream + errorTo:nil + inDirectory:nil + lineWise:true + onError:[:exitStatus | false]. + outStream contents " "Modified: / 11-02-2007 / 20:54:39 / cg" @@ -7743,11 +7741,11 @@ !AbstractOperatingSystem class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $' + ^ '$Header$' ! ! diff -r 27ffa826691b -r 358b275dced9 AutoDeletedFilename.st --- a/AutoDeletedFilename.st Fri Jul 24 08:09:56 2015 +0100 +++ b/AutoDeletedFilename.st Sat Jul 25 06:39:11 2015 +0200 @@ -1,3 +1,5 @@ +"{ Encoding: utf8 }" + " COPYRIGHT (c) 2007 by eXept Software AG All Rights Reserved @@ -11,9 +13,11 @@ " "{ Package: 'stx:libbasic' }" +"{ NameSpace: Smalltalk }" + Filename subclass:#AutoDeletedFilename instanceVariableNames:'' - classVariableNames:'' + classVariableNames:'Lobby' poolDictionaries:'' category:'System-Support' ! @@ -90,6 +94,35 @@ " ! ! +!AutoDeletedFilename class methodsFor:'initialization'! + +initialize + Lobby isNil ifTrue:[ + Lobby := Registry new. + ]. + Smalltalk addDependent:self. "inform me when smalltalk exits" +! ! + +!AutoDeletedFilename class methodsFor:'change and update'! + +update:anAspect with:aParameter from:changedObject + "when Smalltalk exits, remove all auto deleted files" + + anAspect == #aboutToQuit ifTrue:[ + |currentFilename| + "do it with timeout in case of a non-responding remote file server" + ([ + Lobby do:[:each| + currentFilename := each. + each basicFinalize + ]. + ] valueWithTimeout:1 minutes) isNil ifTrue:[ + 'AutoDeletedFilename: timed out while removing: ' errorPrint. currentFilename errorPrintCR. + ]. + ]. + super update:anAspect with:aParameter from:changedObject +! ! + !AutoDeletedFilename methodsFor:'accessing'! keep @@ -118,26 +151,37 @@ !AutoDeletedFilename methodsFor:'finalization'! +basicFinalize + |linkInfo| + + linkInfo := self linkInfo. + linkInfo notNil ifTrue:[ + linkInfo isDirectory ifTrue:[ + super recursiveRemove + ] ifFalse:[ + super removeFile. + ]. + ]. +! + executor ^ self class basicNew nameString:nameString ! +finalizationLobby + "answer the registry used for finalization. + we have our own Lobby." + + ^ Lobby +! + finalize - |linkInfo| - "/ do this in a forked process to avoid blocking "/ in case of an autodeleted remote file of a broken connection [ "/ with timeout to avoid waiting forever [ - linkInfo := self linkInfo. - linkInfo notNil ifTrue:[ - linkInfo isDirectory ifTrue:[ - super recursiveRemove - ] ifFalse:[ - super removeFile. - ]. - ]. + self basicFinalize. ] valueWithTimeout:1 minutes. ] fork. ! ! @@ -175,6 +219,12 @@ !AutoDeletedFilename class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/AutoDeletedFilename.st,v 1.12 2014-06-07 15:08:38 cg Exp $' + ^ '$Header$' +! + +version_CVS + ^ '$Header$' ! ! + +AutoDeletedFilename initialize! diff -r 27ffa826691b -r 358b275dced9 ExternalStream.st --- a/ExternalStream.st Fri Jul 24 08:09:56 2015 +0100 +++ b/ExternalStream.st Sat Jul 25 06:39:11 2015 +0200 @@ -1495,6 +1495,15 @@ !ExternalStream class methodsFor:'initialization'! +closeFiles + "close all files. + To be called on exit of Smalltalk." + + Lobby do:[:eachFileStream | + eachFileStream close + ]. +! + initDefaultEOLMode OperatingSystem isUNIXlike ifTrue:[ "/ unix EOL conventions @@ -1575,8 +1584,8 @@ "reopen all files (if possible) after a snapShot load. This is invoked via the #earlyRestart change notification." - Lobby do:[:aFileStream | - aFileStream reOpen + Lobby do:[:eachFileStream | + eachFileStream reOpen ]. ! @@ -6547,11 +6556,11 @@ !ExternalStream class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.420 2015-05-18 15:24:22 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.420 2015-05-18 15:24:22 cg Exp $' + ^ '$Header$' ! ! diff -r 27ffa826691b -r 358b275dced9 Filename.st --- a/Filename.st Fri Jul 24 08:09:56 2015 +0100 +++ b/Filename.st Sat Jul 25 06:39:11 2015 +0200 @@ -3372,9 +3372,12 @@ osName := self osNameForFile. (ok := OperatingSystem removeFile:osName) ifFalse:[ linkInfo := self linkInfo. - (linkInfo notNil and:[linkInfo isDirectory]) ifTrue:[ + linkInfo isNil ifTrue:[ + "file does not exist - no error" + ^ self. + ] ifFalse:[linkInfo isDirectory ifTrue:[ ok := OperatingSystem removeDirectory:osName - ]. + ]]. ok ifFalse:[ self exists ifTrue:[ self removeError:self diff -r 27ffa826691b -r 358b275dced9 PipeStream.st --- a/PipeStream.st Fri Jul 24 08:09:56 2015 +0100 +++ b/PipeStream.st Sat Jul 25 06:39:11 2015 +0200 @@ -1,3 +1,5 @@ +"{ Encoding: utf8 }" + " COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved @@ -218,7 +220,7 @@ |p| p := PipeStream bidirectionalFor:'cat -u'. - p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr. + p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr. Transcript showCR:p nextLine. p close " @@ -423,22 +425,37 @@ outputFromCommand:aCommand "open a pipe reading from aCommand and return the complete output as a string. - If the command cannot be executed, return nil" + If the command cannot be executed, return nil. + The command's current directory will be the smalltalk current directory." + + ^ self outputFromCommand:aCommand inDirectory:nil + + " + PipeStream outputFromCommand:'ls -l' + " +! + +outputFromCommand:aCommand inDirectory:aDirectoryOrNil + "open a pipe reading from aCommand and return the complete output as a string. + If the command cannot be executed, return nil. + The current directory of the command will be aDirectoryOrNil or the smalltalk's current directory (if nil)" |p cmdOutput| - p := self readingFrom:aCommand. + p := self readingFrom:aCommand inDirectory:aDirectoryOrNil. p isNil ifTrue:[^ nil]. [ - cmdOutput := p contentsAsString. + cmdOutput := p contentsAsString. ] ensure:[ - p close. + p close. ]. ^ cmdOutput " - PipeStream outputFromCommand:'ls -l' + PipeStream outputFromCommand:'ls -l' inDirectory:nil + PipeStream outputFromCommand:'ls -l' inDirectory:'/' + PipeStream outputFromCommand:'ls -l' inDirectory:'/etc' " ! ! @@ -820,11 +837,11 @@ !PipeStream class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.119 2015-02-10 13:27:32 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.119 2015-02-10 13:27:32 cg Exp $' + ^ '$Header$' ! ! diff -r 27ffa826691b -r 358b275dced9 UninterpretedBytes.st --- a/UninterpretedBytes.st Fri Jul 24 08:09:56 2015 +0100 +++ b/UninterpretedBytes.st Sat Jul 25 06:39:11 2015 +0200 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 1993 by Claus Gittinger All Rights Reserved @@ -196,12 +194,15 @@ fromPackedString:aString "ST-80 compatibility: decode a byteArray from a packed string in which 6bits are encoded per character. The argument, aString must be a multiple - of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like - the radix-encoding used in good old PDP11 times ;-) + of 4 in size (since 24 is the lcm of 6 and 8). + Every 6 bit packet is encoded as a character in 32..95. + Characters below 32 are ignored (so line breaks can be inserted at any place). + An addition final byte defines how many bytes of the last triple are valid. + This is somewhat like the radix-encoding used in good old PDP11 times ;-) ST-80 uses this encoding for Images ... This is a base64 encoding, very similar (but not equal) to the algorithm used in RFC1421. PS: It took a while to figure that one out ... - I don't like it ;-)" + PPS: I don't like it ;-)" |index "{ Class: SmallInteger }" dstIndex "{ Class: SmallInteger }" @@ -221,47 +222,47 @@ last := aString last codePoint. last > 96 ifTrue:[ - stop := stop - 3 + (last - 96) + stop := stop - 3 + (last - 96) ]. bytes := self new:stop. index := 1. dstIndex := 1. [dstIndex <= stop] whileTrue:[ - "/ take 4 characters ... - "/ allow a line break before each group of 4 - sixBits := (aString at:index) codePoint. - [sixBits < 32] whileTrue:[ - index := index + 1. - sixBits := (aString at:index) codePoint. - ]. - sixBits := sixBits bitAnd:16r3F. - n := sixBits. - - "/ self assert:(aString at:index+1) codePoint >= 32. - sixBits := (aString at:index+1) codePoint bitAnd:16r3F. - n := (n bitShift:6) + sixBits. - - "/ self assert:(aString at:index+2) codePoint >= 32. - sixBits := (aString at:index+2) codePoint bitAnd:16r3F. - n := (n bitShift:6) + sixBits. - - "/ self assert:(aString at:index+3) codePoint >= 32. - sixBits := (aString at:index+3) codePoint bitAnd:16r3F. - n := (n bitShift:6) + sixBits. - - index := index + 4. - - "/ now have 24 bits in n - - bytes at:dstIndex put:(n bitShift:-16). - - dstIndex < stop ifTrue:[ - bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF). - dstIndex+2 <= stop ifTrue:[ - bytes at:dstIndex+2 put:(n bitAnd:16rFF). - ] - ]. - dstIndex := dstIndex + 3. + "/ take 4 characters ... + "/ allow a line break before each group of 4 + sixBits := (aString at:index) codePoint. + [sixBits < 32] whileTrue:[ + index := index + 1. + sixBits := (aString at:index) codePoint. + ]. + sixBits := sixBits bitAnd:16r3F. + n := sixBits. + + "/ self assert:(aString at:index+1) codePoint >= 32. + sixBits := (aString at:index+1) codePoint bitAnd:16r3F. + n := (n bitShift:6) + sixBits. + + "/ self assert:(aString at:index+2) codePoint >= 32. + sixBits := (aString at:index+2) codePoint bitAnd:16r3F. + n := (n bitShift:6) + sixBits. + + "/ self assert:(aString at:index+3) codePoint >= 32. + sixBits := (aString at:index+3) codePoint bitAnd:16r3F. + n := (n bitShift:6) + sixBits. + + index := index + 4. + + "/ now have 24 bits in n + + bytes at:dstIndex put:(n bitShift:-16). + + dstIndex < stop ifTrue:[ + bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF). + dstIndex+2 <= stop ifTrue:[ + bytes at:dstIndex+2 put:(n bitAnd:16rFF). + ] + ]. + dstIndex := dstIndex + 3. ]. ^ bytes @@ -271,6 +272,23 @@ ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString) ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString) ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString) + ByteArray fromPackedString:((ByteArray new:256) asPackedString) + ByteArray fromPackedString:((ByteArray new:128) asPackedString) + ByteArray fromPackedString:((ByteArray new:129) asPackedString) + ByteArray fromPackedString:((ByteArray new:130) asPackedString) + ByteArray fromPackedString:((ByteArray new:131) asPackedString) + ByteArray fromPackedString:((ByteArray new:132) asPackedString) + ByteArray fromPackedString:((ByteArray new:64) asPackedString) + + 0 to:256 do:[:l | + |orig copy| + + 0 to:255 do:[:fill | + orig := ByteArray new:l withAll:fill. + copy := ByteArray fromPackedString:(orig asPackedString). + self assert:(orig = copy). + ] + ] " "Modified: / 6.3.1997 / 15:28:52 / cg"