--- 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$'
! !
--- 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!
--- 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$'
! !
--- 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
--- 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$'
! !
--- 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"