--- a/.cvsignore Fri Dec 09 22:31:28 2016 +0000
+++ b/.cvsignore Mon Feb 13 21:29:46 2017 +0000
@@ -14,6 +14,7 @@
*.S
*.sc
*.xc
+*.res
.listOfSTfiles
.dependencies
*.exp
@@ -31,3 +32,7 @@
objtcc
objmingw
*.@@@
+.DS_Store
+*.sav
+*.bad
+*.fixed
--- a/.hgtags Fri Dec 09 22:31:28 2016 +0000
+++ b/.hgtags Mon Feb 13 21:29:46 2017 +0000
@@ -4,6 +4,7 @@
246ccdafca3ce8d2ca3f22ab44981b5ecb2c1e5f expecco_2_6_2
2a14d6e5479c98cd9e1d82719908e486297376d9 expecco_1_7_0rc8
2b282d2c832ad46d6fac4f37363cbabf1a72d76f stable
+2b9580d3cabc5ef33f9b7d1d7dfa66008b6b6432 expecco_2_11_0
2c07a05644f14ed0851f9b676504d8246800dfa8 expeccoNET_1_6_8_0
2c1c439ddab3d63d3ce82d0a0b8b29aee2a7df3e expecco_1_3_4
2e7fc0e4df9bba4892506790d0041601b9d0aa9b expecco_2_8_0
@@ -18,7 +19,6 @@
4306fb61b9f8004278974861ad3d1fb0cc9a9529 expecco_1_6_0rc5
43bb5d8495e0048a1ba8f299b56d6411394dc6d1 expecco_1_7_0rc1
484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_0
-484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_0_a
484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_0_win75_lx36
484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_1
508e9e5d9254027c7f4aed4fe7734dab793e5230 expecco_ALM_1_9_7
@@ -52,11 +52,13 @@
8be26a61d6804a7ce85608ac51de8ab7211b840a expecco_2_5_0
8d10113a89a936d0e702cabc9df87f694ffd4595 rel3_6_1
983d045c17f5f23c4d5b7e3644ec8921f68c11d8 rel2_10_8_5
+9f46467ddc070630b9562e44535b66d8a22eb4a5 expecco_ALM_1_10_0
a5aa551f9b6ba0f59b7050cdf26a247f473b5e3c expeccoNET_1_7_0_0
a7ae2d96849615e5d3a46f24faf788506428db65 dtm2_1
a811aef4aaf57908662de58120b05de02f38dd01 expecco_ALM_1_9_5
a811aef4aaf57908662de58120b05de02f38dd01 expecco_ALM_1_9_6
aa0aadd112add654df30c7777082b54ce4bae4af expeccoALM_1_9_0_1
+aa7155bed06ee1e5409a06e00e3237b7f52a0965 expecco_2_10_0
aa93e348e5d3c964977d1571451e24069a17f88a expeccoNET_1_5_0rc1
aa93e348e5d3c964977d1571451e24069a17f88a expecco_1_8_2rc1
aebca3972774d3331f0bcedbaef81aec29ff2026 expecco_1_7_0rc5
--- a/AbstractOperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
+++ b/AbstractOperatingSystem.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -188,6 +186,12 @@
!AbstractOperatingSystem class methodsFor:'initialization'!
getConcreteClass
+ "called at early startup to determine the kind of OS we are running on,
+ and assigning a concrete subclass of me (remember: I am abstract) to the
+ global 'OperatingSystem'.
+ Programs should never refer to any of my concrete classes directly, as
+ they may not (will not) be present when ST/X is executed under anther OS."
+
|osType|
osType := self getSystemType.
@@ -619,22 +623,22 @@
"open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
+ open
+ edit
+ explore
mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf'.
If nil is passed in, the file's suffix is used to guess the mime type.
"
self
- openApplicationForDocument:aFilenameOrString
- operation:operationSymbol
- mimeType:mimeTypeStringArgOrNil
- inDirectory:nil
- ifNone:[
- "/ last resort: use a fileBrowser
- UserPreferences fileBrowserClass openOn:aFilenameOrString
- ].
+ openApplicationForDocument:aFilenameOrString
+ operation:operationSymbol
+ mimeType:mimeTypeStringArgOrNil
+ inDirectory:nil
+ ifNone:[
+ "/ last resort: use a fileBrowser
+ UserPreferences fileBrowserClass openOn:aFilenameOrString
+ ].
"
self openApplicationForDocument: Filename currentDirectory operation:#open
@@ -652,26 +656,26 @@
"open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
+ open
+ edit
+ explore
mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf';
if nil is passed in, the file's suffix is used to guess it.
"
- ^ self
- openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
- inDirectory:nil ifNone:exceptionBlock
-!
-
-openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
+ ^ self
+ openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
+ inDirectory:nil ifNone:exceptionBlock
+!
+
+openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
inDirectory:directoryStringOrFilenameOrNil
"open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
+ open
+ edit
+ explore
mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf';
if nil is passed in, the file's suffix is used to guess it.
"
@@ -681,28 +685,28 @@
mimeTypeString := mimeTypeStringArgOrNil.
MIMETypes notNil ifTrue:[
- mimeTypeString isNil ifTrue:[
- mimeTypeString := MIMETypes mimeTypeForFilename:aFilenameOrString.
- ].
- mimeTypeString notNil ifTrue:[
- openCommand := MIMETypes defaultCommandTemplateToOpenMimeType:mimeTypeString.
- ].
- ].
+ mimeTypeString isNil ifTrue:[
+ mimeTypeString := MIMETypes mimeTypeForFilename:aFilenameOrString.
+ ].
+ mimeTypeString notNil ifTrue:[
+ openCommand := MIMETypes defaultCommandTemplateToOpenMimeType:mimeTypeString.
+ ].
+ ].
openCommand notEmptyOrNil ifTrue:[
- (openCommand includesSubString:'%1') ifTrue:[
- openCommand := openCommand bindWith:aFilenameOrString asString.
- ] ifFalse:[
- openCommand := openCommand, ' "', aFilenameOrString asString, '"'.
- ].
-
- (self
- startProcess:openCommand
- inputFrom:nil outputTo:nil
- errorTo:nil auxFrom:nil
- environment:nil inDirectory:directoryStringOrFilenameOrNil) notNil
- ifTrue:[
- ^ self.
- ].
+ (openCommand includesSubString:'%1') ifTrue:[
+ openCommand := openCommand bindWith:aFilenameOrString asString.
+ ] ifFalse:[
+ openCommand := openCommand, ' "', aFilenameOrString asString, '"'.
+ ].
+
+ (self
+ startProcess:openCommand
+ inputFrom:nil outputTo:nil
+ errorTo:nil auxFrom:nil
+ environment:nil inDirectory:directoryStringOrFilenameOrNil) notNil
+ ifTrue:[
+ ^ self.
+ ].
].
ExecutionError raiseErrorString:'execution of command failed: ', openCommand.
@@ -717,25 +721,25 @@
"Modified: / 05-02-2011 / 16:13:42 / cg"
!
-openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
+openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
inDirectory:directoryStringOrFilenameOrNil ifNone:exceptionBlock
"open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
+ open
+ edit
+ explore
mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf';
if nil is passed in, the file's suffix is used to guess it.
"
[
- ^ self
- openApplicationForDocument:aFilenameOrString
- operation:operationSymbol mimeType:mimeTypeStringArgOrNil
- inDirectory:directoryStringOrFilenameOrNil.
+ ^ self
+ openApplicationForDocument:aFilenameOrString
+ operation:operationSymbol mimeType:mimeTypeStringArgOrNil
+ inDirectory:directoryStringOrFilenameOrNil.
] on:ExecutionError do:[:ex|
- exceptionBlock value.
+ exceptionBlock value.
].
! !
@@ -903,18 +907,8 @@
!AbstractOperatingSystem class methodsFor:'executing OS commands-implementation'!
-exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork newPgrp:newGrp inDirectory:aDirectory
- "execute an OS command"
-
- ^ self
- exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork
- newPgrp:newGrp inDirectory:aDirectory showWindow:false
-
- "Created: / 12.11.1998 / 14:46:15 / cg"
-!
-
-exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork
- newPgrp:newGrp inDirectory:aDirectory showWindow:showWindowBooleanOrNil
+exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork
+ newPgrp:newGrp inDirectory:aDirectory showWindow:showWindowBooleanOrNil
"execute an OS command"
^ self subclassResponsibility
@@ -941,243 +935,206 @@
!
startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment inDirectory:dir
+ errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
+ environment:anEvironmentDictionary inDirectory:dir newPgrp:newPgrp showWindow:showWindowBooleanOrNil
"start executing the OS command as specified by the argument, aCommandString
as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- "raise an error: must be redefined in concrete subclass(es)"
-
- ^ self
- startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil
- environment:environment inDirectory:dir
- showWindow:nil
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
- inDirectory:dir newPgrp:newPgrp showWindow:showWindowBooleanOrNil
-
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- "raise an error: must be redefined in concrete subclass(es)"
-
- ^ self subclassResponsibility
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
- inDirectory:dir showWindow:showWindowBooleanOrNil
-
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
The command gets stdIn, stdOut and stdErr assigned from the arguments;
each may be nil.
Return the processId if successful, nil otherwise.
Use #monitorPid:action: for synchronization and exec status return,
or #killProcess: to stop it."
- "raise an error: must be redefined in concrete subclass(es)"
-
- ^ self
- startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
- inDirectory:dir newPgrp:true showWindow:showWindowBooleanOrNil
-
- "Modified: / 08-11-2016 / 21:24:27 / cg"
-! !
-
-!AbstractOperatingSystem class methodsFor:'executing OS commands-private'!
-
-shuffleAllFrom:anInStream to:anOutStream lineWise:lineWise lockWith:aLock
-
- lineWise ifFalse:[
- ^ anInStream copyToEndInto:anOutStream.
+ |nullStream in out err shellAndArgs pid auxFd|
+
+ aCommandString isNil ifTrue:[^ nil].
+
+ (in := anExternalInStream) isNil ifTrue:[
+ nullStream := Filename nullDevice readWriteStream.
+ in := nullStream.
+ ].
+ (out := anExternalOutStream) isNil ifTrue:[
+ nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
+ out := nullStream.
+ ].
+ (err := anExternalErrStream) isNil ifTrue:[
+ err := out
+ ].
+ anAuxiliaryStream notNil ifTrue:[
+ auxFd := anAuxiliaryStream fileHandle.
].
- [anInStream isOpen and:[anInStream atEnd not]] whileTrue:[
- aLock critical:[
- self
- shuffleFrom:anInStream
- to:anOutStream
- lineWise:lineWise
- ]
- ]
-!
-
-shuffleFrom:anInStream to:anOutStream lineWise:lineWise
- "copy data from anInStream to anOutStream.
- Caller makes sure, than anInStream does not block.
- anOutstream should have been set to non-blocking-mode"
-
- lineWise ifTrue:[
- |data|
-
- data := anInStream nextLine.
- data notNil ifTrue:[
- anOutStream nextPutLine:data
- ] .
- ] ifFalse:[
- anInStream copyToEndInto:anOutStream.
+
+ shellAndArgs := self commandAndArgsForOSCommand:aCommandString.
+
+ pid := self
+ exec:(shellAndArgs at:1)
+ withArguments:(shellAndArgs at:2)
+ environment:anEvironmentDictionary
+ fileDescriptors:(Array with:in fileHandle
+ with:out fileHandle
+ with:err fileHandle
+ with:auxFd)
+ fork:true
+ newPgrp:newPgrp
+ inDirectory:dir
+ showWindow:(showWindowBooleanOrNil ? (shellAndArgs at:3)).
+
+ nullStream notNil ifTrue:[
+ nullStream close.
].
-!
-
-shuffleRestFrom:anInStream to:anOutStream lineWise:lineWise
- [anInStream atEnd] whileFalse:[
- self
- shuffleFrom:anInStream
- to:anOutStream
- lineWise:lineWise.
- ].
-!
-
-startProcess:aCommandString
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual.
- Return the processId if successful, nil otherwise.
- Use #waitForProcess: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- ^ self
- startProcess:aCommandString
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- inDirectory:nil
-
- "
- |pid|
-
- pid := OperatingSystem startProcess:'sleep 2; echo 1; sleep 2; echo 2'.
- (Delay forSeconds:3) wait.
- OperatingSystem killProcess:pid.
- "
- "
- |pid|
-
- pid := OperatingSystem startProcess:'dir/l'.
- (Delay forSeconds:1) wait.
- OperatingSystem killProcess:pid.
- "
- "
- |pid|
-
- pid := OperatingSystem
- startProcess:'dir/l'
- inputFrom:nil
- outputTo:Stdout
- errorTo:nil
- inDirectory:nil.
- (Delay forSeconds:2) wait.
- OperatingSystem killProcess:pid.
- "
+
+ ^ pid
+
+ "blocking at current prio (i.e. only higher prio threads execute):
+
+ OperatingSystem executeCommand:'ls -l > out'.
+ OperatingSystem executeCommand:#('/bin/ls' '-l') outputTo:Transcript.
+ "
+
+ "non-blocking (lower prio threads continue):
+
+ |in out err pid sema|
+
+ in := 'out' asFilename readStream.
+ out := 'out2' asFilename writeStream.
+ err := 'err' asFilename writeStream.
+
+ sema := Semaphore new.
+ pid := OperatingSystem startProcess:'sleep 10; grep drw' inputFrom:in outputTo:out errorTo:err.
+
+ The following will no longer work. monitorPid has disappeared
+
+ pid notNil ifTrue:[
+ Processor monitorPid:pid action:[:osStatus | sema signal ].
+ ].
+ in close.
+ out close.
+ err close.
+ sema wait.
+ Transcript showCR:'finished'
+ "
+
+ "
+ |pid sema|
+
+ sema := Semaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem startProcess:'(sleep 2; ls -l) > out 2>err'
+ ]
+ action:[:osStatus | sema signal ].
+
+ sema wait.
+ Transcript showCR:'finished'
+ "
+
+ "
+ |pid sema|
+
+ sema := Semaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem startProcess:'(sleep 1; echo 1; sleep 9; ls -l) > out 2>err'
+ ]
+ action:[:osStatus | sema signal ].
+
+ Delay waitForSeconds:2.
+ OperatingSystem terminateProcess:pid.
+ Transcript showCR:'terminated'
+ "
+
+ "======================== WINDOWS: ==================================================================="
+
+ "blocking at current prio (i.e. only higher prio threads execute):
+
+ OperatingSystem executeCommand:'dir > out'.
+ OperatingSystem executeCommand:'tree /A' outputTo:Transcript.
+ OperatingSystem executeCommand:#('c:\windows\system32\tree.com' '/A' '/F') outputTo:Transcript.
+ OperatingSystem executeCommand:#('c:\windows\system32\where.exe' '/T' '*.dll') outputTo:Transcript.
+ "
+
+ "non-blocking (lower prio threads continue):
+
+ |in out err pid sema|
+
+ in := 'out' asFilename readStream.
+ out := 'out2' asFilename writeStream.
+ err := 'err' asFilename writeStream.
+
+ sema := Semaphore new.
+ pid := OperatingSystem startProcess:'sleep 10; grep drw' inputFrom:in outputTo:out errorTo:err.
+
+ The following will no longer work. monitorPid has disappeared
+
+ pid notNil ifTrue:[
+ Processor monitorPid:pid action:[:OSstatus | sema signal ].
+ ].
+ in close.
+ out close.
+ err close.
+ sema wait.
+ Transcript showCR:'finished'
+ "
+
+ "
+ |pid sema|
+
+ sema := Semaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem startProcess:'dir > out 2>err'
+ ]
+ action:[:osStatus | sema signal ].
+
+ sema wait.
+ Transcript showCR:'finished'
+ "
+
+"<<END
+ |pid sema|
+
+ sema := Semaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem startProcess:'(echo 1 & stx --eval "Delay waitForSeconds:100" & dir) >out' withCRs
+ ]
+ action:[:osStatus | sema signal ].
+
+ Delay waitForSeconds:5.
+ OperatingSystem terminateProcessGroup:pid.
+ Transcript showCR:'terminated'
+END"
+
+"<<END
+ |pid sema|
+
+ sema := Semaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem startProcess:{ 'C:\Users\cg\work\stx\projects\smalltalk\stx.com' . '--eval' . '"Delay waitForSeconds:100"' }
+ ]
+ action:[:osStatus | sema signal ].
+
+ Delay waitForSeconds:5.
+ OperatingSystem terminateProcess:pid.
+ Transcript showCR:'terminated'
+END"
+
"Modified: / 21.3.1997 / 10:04:35 / dq"
- "Modified: / 10.11.1998 / 21:03:50 / cg"
-!
-
-startProcess:aCommandString inDirectory:aDirectory
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual.
- Return the processId if successful, nil otherwise.
- Use #waitForProcess: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- ^ self
- startProcess:aCommandString
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- inDirectory:aDirectory
- "
- |pid|
-
- pid := OperatingSystem startProcess:'sleep 2; echo 1; sleep 2; echo 2'.
- (Delay forSeconds:3) wait.
- OperatingSystem killProcess:pid.
- "
-
- "Modified: / 21.3.1997 / 10:04:35 / dq"
- "Modified: / 28.1.1998 / 14:13:33 / md"
- "Modified: / 10.11.1998 / 20:59:33 / cg"
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- ^ self
- startProcess:aCommandString
- inputFrom:anExternalInStream
- outputTo:anExternalOutStream
- errorTo:anExternalErrStream
- auxFrom:nil
- inDirectory:nil
-
- "Modified: / 10.11.1998 / 20:59:05 / cg"
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream inDirectory:dir
-
- ^ self
- startProcess:aCommandString
- inputFrom:anExternalInStream
- outputTo:anExternalOutStream
- errorTo:anExternalErrStream
- auxFrom:anAuxiliaryStream
- environment:nil
- inDirectory:dir
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream inDirectory:dir
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- The commandString is passed to a shell for execution - see the description of
- 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- ^ self
- startProcess:aCommandString
- inputFrom:anExternalInStream
- outputTo:anExternalOutStream
- errorTo:anExternalErrStream
- auxFrom:nil
- inDirectory:dir
+ "Modified: / 15.7.1997 / 16:03:51 / stefan"
+ "Modified: / 5.6.1998 / 19:03:51 / cg"
+ "Created: / 12.11.1998 / 14:39:20 / cg"
! !
!AbstractOperatingSystem class methodsFor:'executing OS commands-public'!
@@ -1339,16 +1296,16 @@
Return true if successful, false otherwise."
^ self
- executeCommand:aCommandString
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- environment:nil
- inDirectory:aDirectory
- lineWise:false
- showWindow:showWindow
- onError:[:exitStatus| false]
+ executeCommand:aCommandString
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ auxFrom:nil
+ environment:nil
+ inDirectory:aDirectory
+ lineWise:false
+ showWindow:showWindow
+ onError:[:exitStatus| false]
"Created: / 18-10-2016 / 15:55:29 / cg"
!
@@ -1455,270 +1412,36 @@
avoid blocking on pipes.
Special for windows:
- you can control (have to - sigh) if a window should be shown for the command or not.
- This is the OS's H_SHOWWINDOW argument.
- If you pass nil as showWindow-argument, the OS's default is used for the particular
- command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
- executables will not.
- However, some command-line executables show a window, even if they should not.
- (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
- a shell command opens a cmd-window, whereas in windows7 it did not)
- In this case, pass an explicit false argument to suppress it.
- This argument is ignored on Unix systems.
- See examples below."
-
- |pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
- shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
- inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
- inStreamToClose outStreamToClose errStreamToClose auxStreamToClose nullStream terminateLock
- closeStreams|
-
- 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';
-"/ beSystemProcess;
- 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';
-"/ beSystemProcess;
- 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 + 1);
- name:'cmd err-output shuffler';
-"/ beSystemProcess;
- 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';
-"/ beSystemProcess;
- 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.
- ].
- ].
-
- 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
- ].
- ].
-
-
- 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
- newPgrp:newPgrp
- showWindow:showWindowBooleanOrNil
- ]
- 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.
- stopShufflers value:true.
- (exitStatus isNil or:[exitStatus success]) ifFalse:[
- ^ 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
- "
-
- "Modified: / 11-02-2007 / 20:54:39 / cg"
+ you can control (have to - sigh) if a window should be shown for the command or not.
+ This is the OS's H_SHOWWINDOW argument.
+ If you pass nil as showWindow-argument, the OS's default is used for the particular
+ command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+ executables will not.
+ However, some command-line executables show a window, even if they should not.
+ (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+ a shell command opens a cmd-window, whereas in windows7 it did not)
+ In this case, pass an explicit false argument to suppress it.
+ This argument is ignored on Unix systems.
+ See examples below."
+
+ |osProcess|
+
+ osProcess := OSProcess new
+ command:aCommandStringOrArray;
+ inStream:anInStream;
+ outStream:anOutStream;
+ errorStream:anErrStream;
+ auxStream:anAuxStream;
+ environment:environmentDictionary;
+ directory:dirOrNil;
+ lineWise:lineWise;
+ showWindow:showWindowBooleanOrNil.
+
+ osProcess execute ifFalse:[
+ aBlock value:osProcess exitStatus.
+ ^ false.
+ ].
+ ^ true.
!
executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
@@ -1745,53 +1468,53 @@
avoid blocking on pipes"
^ self
- executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
- errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
- inDirectory:dirOrNil lineWise:lineWise showWindow:false onError:aBlock
-
- "
- |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
+ executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+ errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+ inDirectory:dirOrNil lineWise:lineWise showWindow:false onError:aBlock
+
+ "
+ |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"
@@ -1821,66 +1544,66 @@
avoid blocking on pipes.
Special for windows:
- you can control (have to - sigh) if a window should be shown for the command or not.
- This is the OS's H_SHOWWINDOW argument.
- If you pass nil as showWindow-argument, the OS's default is used for the particular
- command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
- executables will not.
- However, some command-line executables show a window, even if they should not.
- (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
- a shell command opens a cmd-window, whereas in windows7 it did not)
- In this case, pass an explicit false argument to suppress it.
- This argument is ignored on Unix systems.
- See examples below."
+ you can control (have to - sigh) if a window should be shown for the command or not.
+ This is the OS's H_SHOWWINDOW argument.
+ If you pass nil as showWindow-argument, the OS's default is used for the particular
+ command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+ executables will not.
+ However, some command-line executables show a window, even if they should not.
+ (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+ a shell command opens a cmd-window, whereas in windows7 it did not)
+ In this case, pass an explicit false argument to suppress it.
+ This argument is ignored on Unix systems.
+ See examples below."
^ self
- executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
- errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
- inDirectory:dirOrNil lineWise:lineWise newPgrp:true showWindow:showWindowBooleanOrNil onError:aBlock
-
- "
- |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
+ executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+ errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+ inDirectory:dirOrNil lineWise:lineWise newPgrp:true showWindow:showWindowBooleanOrNil onError:aBlock
+
+ "
+ |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: / 08-11-2016 / 21:33:00 / cg"
@@ -1901,16 +1624,16 @@
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream auxFrom:anAuxStream inDirectory:dirOrNil lineWise:lineWise showWindow:showWindow onError:aBlock
^ self
- executeCommand:aCommandString
- inputFrom:anInStream
- outputTo:anOutStream
- errorTo:anErrStream
- auxFrom:anAuxStream
- environment:nil
- inDirectory:dirOrNil
- lineWise:lineWise
- showWindow:showWindow
- onError:aBlock
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:anAuxStream
+ environment:nil
+ inDirectory:dirOrNil
+ lineWise:lineWise
+ showWindow:showWindow
+ onError:aBlock
!
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream environment:env onError:aBlock
@@ -1992,59 +1715,59 @@
(containing the exit status) as argument."
^ self
- executeCommand:aCommandString
- inputFrom:anInStream
- outputTo:anOutStream
- errorTo:anErrStream
- auxFrom:nil
- environment:env
- inDirectory:nil
- lineWise:false
- showWindow:showWindow
- onError:aBlock
-
- "
- OperatingSystem
- executeCommand:'dir'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
-
- OperatingSystem
- executeCommand:'foo'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls /fooBar'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:env
+ inDirectory:nil
+ lineWise:false
+ showWindow:showWindow
+ onError:aBlock
+
+ "
+ OperatingSystem
+ executeCommand:'dir'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+
+ OperatingSystem
+ executeCommand:'foo'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls /fooBar'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
"
"Modified: / 10.11.1998 / 20:51:39 / cg"
@@ -2123,16 +1846,16 @@
error resp. - i.e. usually, i/o will be from/to the terminal"
^ self
- executeCommand:aCommandString
- inputFrom:anInStream
- outputTo:anOutStream
- errorTo:anErrStream
- auxFrom:nil
- environment:nil
- inDirectory:dirOrNil
- lineWise:lineWise
- showWindow:showWindow
- onError:aBlock
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:nil
+ inDirectory:dirOrNil
+ lineWise:lineWise
+ showWindow:showWindow
+ onError:aBlock
!
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream inDirectory:dirOrNil onError:aBlock
@@ -2217,59 +1940,59 @@
(containing the exit status) as argument."
^ self
- executeCommand:aCommandString
- inputFrom:anInStream
- outputTo:anOutStream
- errorTo:anErrStream
- auxFrom:nil
- environment:nil
- inDirectory:dir
- lineWise:false
- showWindow:showWindow
- onError:aBlock
-
- "
- OperatingSystem
- executeCommand:'dir'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
-
- OperatingSystem
- executeCommand:'foo'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls /fooBar'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:nil
+ inDirectory:dir
+ lineWise:false
+ showWindow:showWindow
+ onError:aBlock
+
+ "
+ OperatingSystem
+ executeCommand:'dir'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+
+ OperatingSystem
+ executeCommand:'foo'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls /fooBar'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
"
"Modified: / 10.11.1998 / 20:51:39 / cg"
@@ -2354,59 +2077,59 @@
(containing the exit status) as argument."
^ self
- executeCommand:aCommandString
- inputFrom:anInStream
- outputTo:anOutStream
- errorTo:anErrStream
- auxFrom:nil
- environment:nil
- inDirectory:nil
- lineWise:false
- showWindow:showWindow
- onError:aBlock
-
- "
- OperatingSystem
- executeCommand:'dir'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
-
- OperatingSystem
- executeCommand:'foo'
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- onError:[:status | Transcript flash]
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
- "
- "
- |outStr errStr|
-
- outStr := '' writeStream.
- errStr := '' writeStream.
- OperatingSystem
- executeCommand:'ls /fooBar'
- inputFrom:nil
- outputTo:outStr
- errorTo:errStr
- onError:[:status | Transcript flash].
- Transcript show:'out:'; showCR:outStr contents.
- Transcript show:'err:'; showCR:errStr contents.
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:nil
+ inDirectory:nil
+ lineWise:false
+ showWindow:showWindow
+ onError:aBlock
+
+ "
+ OperatingSystem
+ executeCommand:'dir'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+
+ OperatingSystem
+ executeCommand:'foo'
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ onError:[:status | Transcript flash]
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls /fooBar'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
"
"Modified: / 10.11.1998 / 20:51:39 / cg"
@@ -2554,30 +2277,30 @@
hardwiring any 'cd ..' command strings into your applictions.
Special for windows:
- you can control (have to - sigh) if a window should be shown for the command or not.
- This is the OS's H_SHOWWINDOW argument.
- If you pass nil as showWindow-argument, the OS's default is used for the particular
- command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
- executables will not.
- However, some command-line executables show a window, even if they should not.
- (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
- a shell command opens a cmd-window, whereas in windows7 it did not)
- In this case, pass an explicit false argument to suppress it.
- This argument is ignored on Unix systems.
- See examples below."
+ you can control (have to - sigh) if a window should be shown for the command or not.
+ This is the OS's H_SHOWWINDOW argument.
+ If you pass nil as showWindow-argument, the OS's default is used for the particular
+ command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+ executables will not.
+ However, some command-line executables show a window, even if they should not.
+ (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+ a shell command opens a cmd-window, whereas in windows7 it did not)
+ In this case, pass an explicit false argument to suppress it.
+ This argument is ignored on Unix systems.
+ See examples below."
^ self
- executeCommand:aCommandString
- inputFrom:nil
- outputTo:outStreamOrNil
- errorTo:errStreamOrNil
- auxFrom:nil
- environment:nil
- inDirectory:aDirectory
- lineWise:false
- newPgrp:true
- showWindow:showWindowBooleanOrNil
- onError:[:status| false]
+ executeCommand:aCommandString
+ inputFrom:nil
+ outputTo:outStreamOrNil
+ errorTo:errStreamOrNil
+ auxFrom:nil
+ environment:nil
+ inDirectory:aDirectory
+ lineWise:false
+ newPgrp:true
+ showWindow:showWindowBooleanOrNil
+ onError:[:status| false]
"
OperatingSystem executeCommand:'tdump date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'.
@@ -2623,36 +2346,36 @@
If aCommandString is a String, the commandString is passed to a shell for execution
- see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
If aCommandString is an Array, the first element is the command to be executed,
- and the other elements are the arguments to the command.
+ and the other elements are the arguments to the command.
No shell is invoked in this case.
This blocks the current thread until the command has finished.
Return true if successful, false otherwise.
Special for windows:
- you can control (have to - sigh) if a window should be shown for the command or not.
- This is the OS's H_SHOWWINDOW argument.
- If you pass nil as showWindow-argument, the OS's default is used for the particular
- command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
- executables will not.
- However, some command-line executables show a window, even if they should not.
- (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
- a shell command opens a cmd-window, whereas in windows7 it did not)
- In this case, pass an explicit false argument to suppress it.
- This argument is ignored on Unix systems.
- See examples below.
+ you can control (have to - sigh) if a window should be shown for the command or not.
+ This is the OS's H_SHOWWINDOW argument.
+ If you pass nil as showWindow-argument, the OS's default is used for the particular
+ command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+ executables will not.
+ However, some command-line executables show a window, even if they should not.
+ (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+ a shell command opens a cmd-window, whereas in windows7 it did not)
+ In this case, pass an explicit false argument to suppress it.
+ This argument is ignored on Unix systems.
+ See examples below.
"
^ self
- executeCommand:aCommandString
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- environment:nil
- inDirectory:nil
- lineWise:false
- showWindow:aBooleanOrNil
- onError:[:status| false]
+ executeCommand:aCommandString
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ auxFrom:nil
+ environment:nil
+ inDirectory:nil
+ lineWise:false
+ showWindow:aBooleanOrNil
+ onError:[:status| false]
"unix:
@@ -2780,12 +2503,11 @@
"return true, if the OS can execute aCommand.
For now, this only works with UNIX."
- |fn fullPath|
-
- fullPath := (self pathOfCommand:aCommandString).
+ |fullPath|
+
+ fullPath := self pathOfCommand:aCommandString.
fullPath isNil ifTrue:[^ false].
- fn := fullPath asFilename.
- ^ fn exists and:[fn isExecutableProgram].
+ ^ fullPath asFilename isExecutableProgram.
"
OperatingSystem canExecuteCommand:'fooBar'
@@ -2850,9 +2572,9 @@
'./stx' asFilename exists ifTrue:[
path := './stx'
].
- ].
- path isNil ifTrue:[
- 'OperatingSystem [warning]: cannot figure out my executable''s path' infoPrintCR.
+ path isNil ifTrue:[
+ 'OperatingSystem [warning]: cannot figure out my executable''s path' infoPrintCR.
+ ].
].
^ path
@@ -2866,6 +2588,7 @@
!AbstractOperatingSystem class methodsFor:'executing OS commands-wrappers'!
exec:aCommandPath withArguments:argArray
+ <resource: #obsolete>
"execute the OS command specified by the argument, aCommandPath, with
arguments in argArray (no arguments, if nil).
If successful, this method does NOT return and smalltalk is gone.
@@ -2880,13 +2603,26 @@
fork:false
newPgrp:false
inDirectory:nil
+ showWindow:false
"/ never reached ...
"Modified: / 12.11.1998 / 14:44:26 / cg"
!
+exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork newPgrp:newGrp inDirectory:aDirectory
+ <resource: #obsolete>
+ "execute an OS command"
+
+ ^ self
+ exec:aCommandPath withArguments:argArray environment:env fileDescriptors:fds fork:doFork
+ newPgrp:newGrp inDirectory:aDirectory showWindow:false
+
+ "Created: / 12.11.1998 / 14:46:15 / cg"
+!
+
exec:aCommandPath withArguments:argArray fileDescriptors:fileDescriptors fork:doFork newPgrp:newPgrp inDirectory:aDirectory
+ <resource: #obsolete>
^ self
exec:aCommandPath
withArguments:argArray
@@ -2895,9 +2631,11 @@
fork:doFork
newPgrp:newPgrp
inDirectory:aDirectory
+ showWindow:false
!
exec:aCommandPath withArguments:argArray fork:doFork
+ <resource: #obsolete>
"execute an OS command without I/O redirection.
The command reads its input and writes its output
from/to whatever terminal device ST/X was started
@@ -2911,7 +2649,7 @@
fork:doFork
newPgrp:false
inDirectory:nil
-
+ showWindow:false
"
|id|
@@ -2950,6 +2688,7 @@
!
exec:aCommandPath withArguments:argArray fork:doFork inDirectory:aDirectory
+ <resource: #obsolete>
"execute an OS command without I/O redirection.
The command reads its input and writes its output
from/to whatever terminal device ST/X was started
@@ -2963,7 +2702,7 @@
fork:doFork
newPgrp:false
inDirectory:aDirectory
-
+ showWindow:false
"
|id|
@@ -3003,6 +2742,7 @@
!
exec:aCommandPath withArguments:argArray showWindow:showWindowBooleanOrNil
+ <resource: #obsolete>
"execute the OS command specified by the argument, aCommandPath, with
arguments in argArray (no arguments, if nil).
If successful, this method does NOT return and smalltalk is gone.
@@ -3010,18 +2750,128 @@
Can be used on UNIX with fork or on other systems to chain to another program."
^ self
- exec:aCommandPath
- withArguments:argArray
- environment:nil
- fileDescriptors:#(0 1 2)
- fork:false
- newPgrp:false
- inDirectory:nil
- showWindow:showWindowBooleanOrNil
+ exec:aCommandPath
+ withArguments:argArray
+ environment:nil
+ fileDescriptors:#(0 1 2)
+ fork:false
+ newPgrp:false
+ inDirectory:nil
+ showWindow:showWindowBooleanOrNil
"/ never reached ...
"Modified: / 12.11.1998 / 14:44:26 / cg"
+!
+
+startProcess:aCommandString
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:nil outputTo:nil
+ errorTo:nil auxFrom:nil environment:nil
+ inDirectory:nil newPgrp:true showWindow:nil
+
+ "
+ |pid|
+
+ pid := OperatingSystem startProcess:'sleep 2; echo 1; sleep 2; echo 2'.
+ (Delay forSeconds:3) wait.
+ OperatingSystem killProcess:pid.
+ "
+ "
+ |pid|
+
+ pid := OperatingSystem startProcess:'dir/l'.
+ (Delay forSeconds:1) wait.
+ OperatingSystem killProcess:pid.
+ "
+ "
+ |pid|
+
+ pid := OperatingSystem
+ startProcess:'dir/l'
+ inputFrom:nil
+ outputTo:Stdout
+ errorTo:nil
+ inDirectory:nil.
+ (Delay forSeconds:2) wait.
+ OperatingSystem killProcess:pid.
+ "
+
+ "Modified: / 21.3.1997 / 10:04:35 / dq"
+ "Modified: / 10.11.1998 / 21:03:50 / cg"
+!
+
+startProcess:aCommandString inDirectory:aDirectory
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:nil outputTo:nil
+ errorTo:nil auxFrom:nil environment:nil
+ inDirectory:aDirectory newPgrp:true showWindow:nil
+ "
+ |pid|
+
+ pid := OperatingSystem startProcess:'sleep 2; echo 1; sleep 2; echo 2'.
+ (Delay forSeconds:3) wait.
+ OperatingSystem killProcess:pid.
+ "
+
+ "Modified: / 21.3.1997 / 10:04:35 / dq"
+ "Modified: / 28.1.1998 / 14:13:33 / md"
+ "Modified: / 10.11.1998 / 20:59:33 / cg"
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:nil environment:nil
+ inDirectory:nil newPgrp:true showWindow:nil
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment inDirectory:dir
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
+ inDirectory:dir newPgrp:true showWindow:nil
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
+ inDirectory:dir showWindow:showWindowBooleanOrNil
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
+ inDirectory:dir newPgrp:true showWindow:showWindowBooleanOrNil
+
+ "Modified: / 08-11-2016 / 21:24:27 / cg"
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anAuxiliaryStream inDirectory:dir
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:nil environment:nil
+ inDirectory:dir newPgrp:true showWindow:nil
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream inDirectory:dir
+ <resource: #obsolete>
+
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:nil environment:nil
+ inDirectory:dir newPgrp:true showWindow:nil
! !
!AbstractOperatingSystem class methodsFor:'file access'!
@@ -3159,14 +3009,14 @@
self createDirectory:dirName.
(self isDirectory:dirName) ifFalse:[
- nextDirName := dirName asFilename directoryName.
- dirName ~= nextDirName ifTrue:[
- osErrorHolder := self recursiveCreateDirectory:nextDirName.
- osErrorHolder notNil ifTrue:[
- ^ osErrorHolder.
- ].
- ].
- ^ self createDirectory:dirName.
+ nextDirName := dirName asFilename directoryName.
+ dirName ~= nextDirName ifTrue:[
+ osErrorHolder := self recursiveCreateDirectory:nextDirName.
+ osErrorHolder notNil ifTrue:[
+ ^ osErrorHolder.
+ ].
+ ].
+ ^ self createDirectory:dirName.
].
^ nil.
@@ -3519,9 +3369,9 @@
The info object returned is OS-specific, however it responds to at
least
- #isFor32BitArchitecture
- #isFor64BitArchitecture ... returns true, if the given object is for
- 32bit, 64bit architecture respectively
+ #isFor32BitArchitecture
+ #isFor64BitArchitecture ... returns true, if the given object is for
+ 32bit, 64bit architecture respectively
"
^ self subclassResponsibility
@@ -4350,7 +4200,7 @@
getCCDefine
<resource: #obsolete>
-
+
"return a string which was used to identify the C-Compiler used
when STX was compiled, and which should be passed down when compiling methods.
For example, on linux, this is '__GNUC__';
@@ -4585,7 +4435,7 @@
getNetworkMACAddresses
"return a dictionary with key:name of interface and
- value:the MAC address for each interface"
+ value:the MAC address for each interface"
self subclassResponsibility
!
@@ -4606,7 +4456,7 @@
getOSDefine
<resource: #obsolete>
-
+
"return a string which was used to identify this machine when stx was
compiled, and which should be passed down when compiling methods.
For example, on linux, this is '-D__linux__'."
@@ -4776,7 +4626,7 @@
getPlatformDefine
<resource: #obsolete>
-
+
"return a string which defines the platform,
and which should be passed down when compiling methods.
For example, on all unices, this is '-DUNIX'."
@@ -5336,7 +5186,7 @@
(packagePath includes:each) ifFalse:[
packagePath addFirst:each.
].
- ].
+ ].
].
"/ $HOME/.smalltalk/packages (on Windows %USERPROFILE%\.smalltalk\packages)
@@ -5851,6 +5701,13 @@
domainSymbol = @symbol(AF_PACKET);
break;
#endif
+#ifdef AF_LINK
+# if AF_LINK != AF_PACKET
+ case AF_LINK:
+ domainSymbol = @symbol(AF_LINK);
+ break;
+# endif
+#endif
#ifdef AF_ASH
case AF_ASH:
domainSymbol = @symbol(AF_ASH);
@@ -6309,6 +6166,16 @@
socketSize = __mkSmallInteger( sizeof(struct sockaddr_isdn) );
break;
#endif
+#ifdef WANT__AF_PACKET
+ case AF_PACKET:
+ socketSize = __mkSmallInteger( sizeof(struct sockaddr_ll) );
+ break;
+#endif
+#ifdef WANT__AF_LINK
+ case AF_LINK:
+ socketSize = __mkSmallInteger( sizeof(struct sockaddr_dl) );
+ break;
+#endif
#ifdef WANT__AF_SYSTEM
case AF_SYSTEM:
socketSize = __mkSmallInteger( sizeof(struct sockaddr_sys) );
@@ -6466,6 +6333,8 @@
#AF_CLUSTER
#AF_12844
#AF_NETDES
+ #AF_PACKET
+ #AF_LINK
) select:[:sym | (AbstractOperatingSystem domainCodeOf:sym) isInteger ]
"
@@ -6702,10 +6571,10 @@
Notice, that the # of cycles has to be multiplied by the cycle time (1/cpu-frequency).
For x86:
- the CPU cycle count register value is returned (RDTSC instruction).
- answer 0 if RDTSC instruction is not supported (which is unlikely, nowadays).
+ the CPU cycle count register value is returned (RDTSC instruction).
+ answer 0 if RDTSC instruction is not supported (which is unlikely, nowadays).
For others:
- answer 0"
+ answer 0"
%{ /* NOCONTEXT */
unsigned INT low, high;
@@ -6766,8 +6635,8 @@
Use the millisecondTimeXXX:-methods to compare and add time deltas - these know about the wrap.
BAD DESIGN:
- This should be changed to return some instance of RelativeTime,
- and these computations moved there.
+ This should be changed to return some instance of RelativeTime,
+ and these computations moved there.
Do not use this method in application code since it is an internal (private)
interface. For compatibility with ST-80, use Time millisecondClockValue.
@@ -6832,9 +6701,9 @@
This should really be moved to some RelativeTime class."
(msTime1 > msTime2) ifTrue:[
- ^ (msTime1 - msTime2) <= (SmallInteger maxVal // 4).
+ ^ (msTime1 - msTime2) <= (SmallInteger maxVal // 4).
] ifFalse:[
- ^ (msTime2 - msTime1) > ((SmallInteger maxVal // 4) + 1)
+ ^ (msTime2 - msTime1) > ((SmallInteger maxVal // 4) + 1)
].
!
@@ -6849,8 +6718,8 @@
sum := msTime1 + msTime2.
(sum > (SmallInteger maxVal // 2)) ifTrue:[
- self assert:(sum <= SmallInteger maxVal) message:'overflow in timer computation'.
- ^ sum - (SmallInteger maxVal // 2 + 1).
+ self assert:(sum <= SmallInteger maxVal) message:'overflow in timer computation'.
+ ^ sum - (SmallInteger maxVal // 2 + 1).
].
(sum < 0) ifTrue:[^ sum + (SmallInteger maxVal // 2 + 1)].
^ sum
@@ -6871,13 +6740,13 @@
diff := msTime1 - msTime2.
diff < (SmallInteger maxVal // -4) ifTrue:[
- ^ diff + (SmallInteger maxVal // 2) + 1.
+ ^ diff + (SmallInteger maxVal // 2) + 1.
].
diff <= (SmallInteger maxVal // 4) ifTrue:[
- ^ diff.
+ ^ diff.
] ifFalse:[
- ^ diff - (SmallInteger maxVal // 2 + 1).
+ ^ diff - (SmallInteger maxVal // 2 + 1).
].
@@ -7136,7 +7005,7 @@
"/ fallBack dummy
aNumber == self getUserID ifTrue:[
- ^ self getLoginName
+ ^ self getLoginName
].
^ '? (' , aNumber printString , ')'
--- a/AbstractTime.st Fri Dec 09 22:31:28 2016 +0000
+++ b/AbstractTime.st Mon Feb 13 21:29:46 2017 +0000
@@ -52,7 +52,7 @@
"
!
-iso8601Format
+iso8601FormatDocumentation
"
Abstract
@@ -140,6 +140,74 @@
YYYY-MM-DDThh:mm:ss.sTZD (eg 1997-07-16T19:20:30.45+01:00)
Timestamp now printStringFormat:'%(year)-%(month)-%(day)T%h:%m:%s.%(milli2)%(TZD)'
"
+!
+
+printFormatDocumentation
+"
+ bindings:
+ %h hours, 00..23 (i.e. european) 0-padded to length 2
+ %u hours, 00..12 (i.e. us) 0-padded to length 2
+ %m minutes, 00..59 0-padded to length 2
+ %s seconds, 00..59 0-padded to length 2
+ %i milliseconds, 000..999 0-padded to length 3
+ %a am/pm
+
+ Timestamp only:
+ %(day) day, 00..31 0-padded to length 2
+ %(month) month, 00..12 0-padded to length 2
+ %(year) year, 4 digits 0-padded to length 4
+
+ special:
+ %H 24-hours - unpadded
+ %U 12-hours - unpadded
+ %M minutes - unpadded
+ %S seconds - unpadded
+ %I milliseconds, unpadded
+ %A AM/PM - uppercase
+
+ %t seconds within hour (unpadded)
+ %T seconds from midNight (unpadded)
+
+ %(TZD) timeZone delta of the receiver from UTC in the format +/-hh:mm
+
+ %(milli1) milliseconds, truncated to 1/10th of a second 0..9
+ %(milli2) milliseconds, truncated to 1/100th of a second 00..99 0-padded to length 2
+ %(milli3) milliseconds, same as %i for convenience
+
+ Timestamp only:
+ %(Day) - day - unpadded
+ %(Month) - month - unpadded
+ %(yearOrTime) - year or time 5 digits as in unix-ls:
+ year if it is not the current year;
+ time otherwise
+ %(weekDay) - day in week (1->monday, 2->tuesday, ... ,7->sunday)
+
+ %(dayName) - full day name
+ %(DayName) - full day name, first character uppercase
+ %(DAYNAME) - full day name, all uppercase
+
+ %(monthName) - full month name
+ %(MonthName) - full month name, first character uppercase
+ %(MONTHNAME) - full month name, all uppercase
+
+ %(shortDayName) - short (abbreviated) day name
+ %(ShortDayName) - short (abbreviated) day name, first character uppercase
+ %(SHORTDAYNAME) - short (abbreviated) day name, all uppercase
+
+ %(shortMonthName) - short (abbreviated) month name
+ %(ShortMonthName) - short (abbreviated) month name, first character uppercase
+ %(SHORTMONTHNAME) - short (abbreviated) month name, all uppercase
+
+ %(nth) - counting day-in-month (1->'st'; 2->'nd'; 3->'rd'; 4...->'th')
+ %(weekDayNth) - counting day-in-week (1->'st'; 2->'nd'; 3->'rd'; 4...->'th')
+ %(weekNth) - counting week-in-year (1->'st'; 2->'nd'; 3->'rd'; 4...->'th')
+
+ %(yearRoman) - year, in roman letters
+ %(monthRoman) - month, in roman letters
+
+
+ The ISO8601 printString are documented in iso8601FormatDocumentation:
+"
! !
!AbstractTime class methodsFor:'instance creation'!
--- a/ApplicationDefinition.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ApplicationDefinition.st Mon Feb 13 21:29:46 2017 +0000
@@ -1583,11 +1583,11 @@
generateSubProjectLibs_bc_dot_mak
^ String streamContents:[:s |
- self subProjects do:[:projectID |
+ (self effectiveSubProjects:#win32) do:[:projectID |
|libPath libobjPath|
libPath := self pathToPackage:projectID withSeparator:'\'.
- libobjPath := libPath , '\', (self libraryNameFor:projectID).
+ libobjPath := libPath , '\$(OBJDIR)\', (self libraryNameFor:projectID).
s space; nextPutAll:libobjPath; nextPutLine:'.dll \'.
].
s cr.
@@ -1600,11 +1600,12 @@
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 14-09-2006 / 18:46:09 / cg"
+ "Modified: / 17-01-2017 / 21:26:08 / stefan"
!
generateSubProjectLibs_make_dot_proto
^ String streamContents:[:s |
- self effectiveSubProjects do:[:projectID |
+ (self effectiveSubProjects:#unix) do:[:projectID |
|libPath libobjPath|
libPath := self pathToPackage:projectID withSeparator:'/'.
@@ -1617,11 +1618,13 @@
"
exept_expecco_application generateSubProjectLibs_make_dot_proto
"
+
+ "Modified: / 17-01-2017 / 16:16:38 / stefan"
!
generateSubProjectLines_bc_dot_mak
^ String streamContents:[:s |
- self effectiveSubProjects do:[:projectID |
+ (self effectiveSubProjects:#win32) do:[:projectID |
|mappings newObjectLine|
mappings := self subProjectLine_bc_dot_mak_mappings: projectID.
@@ -1633,17 +1636,19 @@
]
"
+ exept_expecco_application generateSubProjectLines_bc_dot_mak
bosch_dapasx_application generateSubProjectLines_bc_dot_mak
cg_newCompiler_driver_stc generateSubProjectLines_bc_dot_mak
"
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 14-09-2006 / 18:46:09 / cg"
+ "Modified (comment): / 17-01-2017 / 17:01:38 / stefan"
!
generateSubProjectLines_make_dot_proto
^ String streamContents:[:s |
- self effectiveSubProjects do:[:projectID |
+ (self effectiveSubProjects:#unix) do:[:projectID |
|mappings newObjectLine|
mappings := self subProjectLine_make_dot_proto_mappings: projectID.
@@ -1661,11 +1666,12 @@
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 14-09-2006 / 18:46:09 / cg"
+ "Modified: / 17-01-2017 / 16:17:16 / stefan"
!
generateSubProjectLines_modules_dot_stx
^ String streamContents:[:s |
- self effectiveSubProjects do:[:projectID |
+ (self effectiveSubProjects:#win32) do:[:projectID |
(self shouldBeLoadedInitially:projectID) ifFalse:[
s nextPut:$*.
].
@@ -1679,6 +1685,7 @@
"
"Modified: / 17-08-2006 / 17:22:37 / cg"
+ "Modified: / 17-01-2017 / 16:17:36 / stefan"
! !
!ApplicationDefinition class methodsFor:'file templates'!
@@ -1793,6 +1800,8 @@
REQUIRED_LIBS=librun.dll %(REQUIRED_LIBS)
REQUIRED_FILES=$(RT_DLL) $(X11_DLL) $(XEXT_DLL) symbols.stc $(REQUIRED_LIBS)
+SUBPROJECT_LIBS=%(SUBPROJECT_LIBS)
+
REQUIRED_SUPPORT_DIRS=%(REQUIRED_SUPPORT_DIRS)
target: %(BUILD_TARGET) postBuildCleanup
@@ -1801,7 +1810,7 @@
ALL:: prereq ALL_NP
# all, but no prereqs
-ALL_NP:: exe $(REQUIRED_SUPPORT_DIRS) postBuildCleanup
+ALL_NP:: exe $(REQUIRED_SUPPORT_DIRS) postBuildCleanup subProjects
exe: newBuildDate $(REQUIRED_LIBS) noConsoleApp consoleApp registerApplication
@@ -1831,7 +1840,15 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
- $(MAKE) -N -f bc.mak $(USE_ARG) FORCE=FORCE_BUILD $(REQUIRED_LIBS)
+ $(MAKE) -N -f bc.mak $(USE_ARG) FORCE=FORCE_BUILD makePrereq
+
+makePrereq: $(REQUIRED_LIBS)
+
+subProjects:
+ $(MAKE) -N -f bc.mak $(USE_ARG) FORCE=FORCE_BUILD makeSubProjects
+
+makeSubProjects: $(SUBPROJECT_LIBS)
+ @echo "sub-projects made"
FORCE_BUILD:
@rem Dummy target to force a build
@@ -2015,8 +2032,9 @@
%(ADDITIONAL_RULES_HG)'.
"Modified: / 02-06-2015 / 17:40:03 / gg"
- "Modified: / 26-01-2016 / 14:23:35 / jv"
"Modified: / 03-03-2016 / 21:15:43 / cg"
+ "Modified: / 19-01-2017 / 11:50:05 / stefan"
+ "Modified: / 25-01-2017 / 20:03:01 / jv"
!
bc_dot_mak_app_source_rules
@@ -2470,7 +2488,7 @@
all:: prereq ALL_NP
# like ALL, but not prereqs
-ALL_NP:: exe $(SUBPROJECT_LIBS) $(REQUIRED_SUPPORT_DIRS) $(SETUP_RULE)
+ALL_NP:: exe subProjects $(REQUIRED_SUPPORT_DIRS) $(SETUP_RULE)
exe: %(APPLICATION) registerApplication
@@ -2492,7 +2510,15 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
- $(MAKE) FORCE=@@@FORCE-BUILD@@@ $(REQUIRED_LIBOBJS)
+ $(MAKE) FORCE=@@@FORCE-BUILD@@@ makePrereq
+
+makePrereq: $(REQUIRED_LIBOBJS)
+
+subProjects:
+ $(MAKE) FORCE=@@@FORCE-BUILD@@@ makeSubProjects
+
+makeSubProjects: $(SUBPROJECT_LIBS)
+ @echo "sub-projects made"
#
# a self installable delivery
@@ -2539,7 +2565,8 @@
"Created: / 29-09-2006 / 23:47:07 / cg"
"Modified: / 24-06-2009 / 21:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 26-07-2012 / 00:57:07 / cg"
- "Modified: / 28-11-2012 / 10:18:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-01-2017 / 11:41:26 / stefan"
+ "Modified: / 25-01-2017 / 22:01:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
make_dot_proto_app_source_rules
@@ -3096,7 +3123,7 @@
WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "Publisher" "${PRODUCT_PUBLISHER}"
SectionEnd
-LangString appOpen ${LANG_GERMAN} "Mit %(PRODUCT_NAME) ffnen"
+LangString appOpen ${LANG_GERMAN} "Mit %(PRODUCT_NAME) öffnen"
LangString appOpen ${LANG_ENGLISH} "Open with %(PRODUCT_NAME)"
LangString DESC_Section1 ${LANG_ENGLISH} "Program components of %(PRODUCT_NAME)"
@@ -3130,7 +3157,7 @@
Function un.onInit
!!insertmacro MUI_UNGETLANGUAGE
- MessageBox MB_ICONQUESTION|MB_YESNO|MB_DEFBUTTON2 "Mchten Sie %(PRODUCT_NAME) und alle seine Komponenten deinstallieren?" IDYES +2
+ MessageBox MB_ICONQUESTION|MB_YESNO|MB_DEFBUTTON2 "Möchten Sie %(PRODUCT_NAME) und alle seine Komponenten deinstallieren?" IDYES +2
Abort
FunctionEnd
--- a/ArithmeticValue.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ArithmeticValue.st Mon Feb 13 21:29:46 2017 +0000
@@ -776,13 +776,13 @@
!
degreesToRadians
- "interpreting the receiver as radians, return the degrees"
+ "interpreting the receiver as degrees, return the radians"
^ self asFloat degreesToRadians
!
radiansToDegrees
- "interpreting the receiver as degrees, return the radians"
+ "interpreting the receiver as radians, return the degrees"
^ self asFloat radiansToDegrees
! !
--- a/AutoDeletedFilename.st Fri Dec 09 22:31:28 2016 +0000
+++ b/AutoDeletedFilename.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2007 by eXept Software AG
All Rights Reserved
@@ -41,8 +39,13 @@
documentation
"
Used with temporary files - these will automatically delete themself,
- when no longer referenced.
+ when no longer referenced (i.e. when finalized)
+
See -> Filename asAutoDeletedFilename
+
+ [author:]
+ cg - original code
+ sv - fixed and enhanced
"
!
--- a/Autoload.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Autoload.st Mon Feb 13 21:29:46 2017 +0000
@@ -172,12 +172,12 @@
nameSymbol := aClassName asSymbol.
(Smalltalk at:nameSymbol) isNil ifTrue:[
- cls := Autoload
- subclass:nameSymbol
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:aCategory.
+ cls := self
+ subclass:nameSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:aCategory.
].
^ cls
--- a/Behavior.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Behavior.st Mon Feb 13 21:29:46 2017 +0000
@@ -2984,16 +2984,16 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ [
- |newObject|
-
- newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
- ((newObject class == self) or:[newObject isKindOf:self])
- ifTrue:[newObject]
- ifFalse:[exceptionBlock value].
+ |newObject|
+
+ newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
+ ((newObject class == self) or:[newObject isKindOf:self])
+ ifTrue:[newObject]
+ ifFalse:[^ exceptionBlock value].
] on:Error do:exceptionBlock.
"
@@ -3001,7 +3001,7 @@
s := WriteStream on:String new.
#(1 2 3 4) storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -3009,7 +3009,7 @@
s := WriteStream on:String new.
#[1 2 3 4] storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -4772,7 +4772,7 @@
hasMethods
"return true, if there are any (local) methods in this class"
- ^ (self methodDictionary size ~~ 0)
+ ^ ("self " methodDictionary size ~~ 0)
"
True hasMethods
--- a/Block.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Block.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -762,7 +760,7 @@
numArgs
"return the number of arguments I expect for evaluation.
- Please use argumentCount, which is ANSI"
+ Please use argumentCount for ANSI compatibility"
"/ <resource: #obsolete>
@@ -906,7 +904,7 @@
micros < 1000 ifTrue:[
"/ too stupid: many fonts do not have a mu,
"/ so I output it as us here.
- Transcript show:micros; show:' µs'.
+ Transcript show:micros; show:' s'.
] ifFalse:[
micros < 100000 ifTrue:[
millis := (micros / 1000.0) asFixedPointRoundedToScale:2.
@@ -3264,12 +3262,12 @@
"create a new process, give it a name and let it start
executing the receiver at the current priority."
- |newProcess|
-
- newProcess := self newProcess.
- newProcess name:aString.
- newProcess resume.
- ^ newProcess.
+ ^ self newProcess
+ name:aString;
+ resume;
+ yourself.
+
+ "Modified: / 27-01-2017 / 18:10:16 / stefan"
!
forkWith:argArray
--- a/CharacterArray.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterArray.st Mon Feb 13 21:29:46 2017 +0000
@@ -294,7 +294,7 @@
!
writeStreamClass
- "the class used by writeStream.
+ "the type of stream used in writeStream.
Here, we return CharacterWriteStream, which automatically changes
the underlying collection to a multiByte string (i.e. UnicodeString).
So you can stream wide characters into it."
@@ -303,6 +303,14 @@
"
String writeStream
+
+ - the following delivers a Unicode16String:
+
+ String streamContents:[:s |
+ s nextPut:(Character value:16r3f30).
+ s nextPutAll:'hello'.
+ s cr.
+ ]
"
"Created: / 09-01-2011 / 10:37:57 / cg"
@@ -435,7 +443,8 @@
"/ but the max unicode character is defined as 16r10 FFFF anyway
^ DecodingError newException
defaultValue:aStringOrByteCollection;
- raiseRequestWith:aStringOrByteCollection errorString:'unicode character out of range'.
+ raiseRequestWith:aStringOrByteCollection
+ errorString:('unicode character out of range at: %1' bindWith:srcIdx).
].
nFollowBytes := 5.
minValue := 16r4000000.
@@ -451,7 +460,8 @@
(byte bitAnd:2r11000000) ~~ 2r10000000 ifTrue:[
^ DecodingError newException
defaultValue:aStringOrByteCollection;
- raiseRequestWith:aStringOrByteCollection errorString:'illegal followbyte'.
+ raiseRequestWith:aStringOrByteCollection
+ errorString:('illegal followbyte: 0x%1 at:%2' bindWith:(byte hexPrintString:2) with:srcIdx-1).
].
ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111).
].
@@ -634,6 +644,7 @@
"
! !
+
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -1495,6 +1506,7 @@
"
'foo bar, baz' substringsSeparatedBy:$,
+ '1.2.3.4' substringsSeparatedBy:$.
"
!
@@ -1726,6 +1738,8 @@
"return a copy of the receiver, where a '%i' escape
is replaced by the coresponding string from the argument array.
'i' may be between 1 and 9 (i.e. a maximum of 9 placeholders is allowed).
+ To get an integer-indexed placeHolder followed by another digit,
+ or an index > 9, you must use %(digit).
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:anArrayOfStrings
@@ -1962,7 +1976,10 @@
!
isCharacters
- "added for visual works compatibility"
+ "true, if the receiver is a string-like thing.
+ added for visual works compatibility"
+
+ "/ kept in libbasic package, because it is used in libjava and imap-implementation
^ true
! !
@@ -4855,7 +4872,8 @@
utf8Encoded
"return the UTF-8 representation of a Unicode string.
The resulting string is only useful to be stored on some external file,
- not for being used inside ST/X."
+ or sent to a communaction channel.
+ Not for being used inside ST/X."
|string stream|
@@ -4886,6 +4904,10 @@
(Character value:16r4000) asString utf8Encoded asByteArray #[228 128 128]
(Character value:16r8000) asString utf8Encoded asByteArray #[232 128 128]
(Character value:16rFFFF) asString utf8Encoded asByteArray #[239 191 191]
+ (Character value:16r1FFFF) asString utf8Encoded asByteArray #[240 159 191 191]
+ (Character value:16r3FFFF) asString utf8Encoded asByteArray #[240 191 191 191]
+ (Character value:16rFFFFF) asString utf8Encoded asByteArray #[243 191 191 191]
+ (Character value:16r3FFFFF) asString utf8Encoded asByteArray #[248 143 191 191 191]
'abcde1234' asUnicode32String utf8Encoded
'abcdeäöüß' asUnicode32String utf8Encoded
@@ -6195,8 +6217,11 @@
containsNon8BitElements
"return true, if the underlying string contains elements larger than a single byte"
- |sz "{ Class:SmallInteger }"|
-
+ |string sz "{ Class:SmallInteger }"|
+
+ (string := self string) ~~ self ifTrue:[
+ ^ string containsNon8BitElements
+ ].
sz := self size.
1 to:sz do:[:idx|
(self at:idx) codePoint > 16rFF ifTrue:[
@@ -6422,6 +6447,14 @@
"Modified: / 06-03-2007 / 11:51:15 / cg"
!
+speciesForSubcollection
+ "answer the class, when splitting instances into subcollections"
+
+ ^ StringCollection
+
+ "Created: / 24-01-2017 / 18:54:18 / stefan"
+!
+
stringSpecies
"return the underlying strings bitsPerCharacter
(i.e. is it a regular String or a TwoByteString)"
@@ -6590,7 +6623,7 @@
(argArrayOrDictionary includesKey:key) ifTrue:[
v := argArrayOrDictionary at:key
] ifFalse:[
- key := key asSymbolIfInterned ? key.
+ key := key asSymbolIfInternedOrSelf.
(argArrayOrDictionary includesKey:key) ifTrue:[
v := argArrayOrDictionary at:key
] ifFalse:[
@@ -6610,9 +6643,9 @@
v := argArrayOrDictionary
at:next
ifAbsent:[
- "try symbol instead of character"
+ "try symbol or string instead of character"
argArrayOrDictionary
- at:next asSymbol
+ at:next asString asSymbolIfInternedOrSelf
ifAbsent:[String with:escapeCharacter with:next].
].
] ifFalse:[
@@ -8042,6 +8075,42 @@
"
!
+isInfix
+ "return true, if the receiver is a binary message selector"
+
+ ^ self first isLetterOrDigit not
+
+ "
+ #at:put: isInfix
+ #at: isInfix
+ #+ isInfix
+ #size isInfix
+ "
+
+ "Created: / 1.11.1997 / 12:34:55 / cg"
+ "Modified: / 1.11.1997 / 12:36:37 / cg"
+!
+
+isKeyword
+ "return true, if the receiver is a keyword message selector.
+ This is a quick check, which only looks at the last character.
+ Should only be used, if we already know that the receiver forms a valid selector.
+ To check an arbitrary string, use isKeywordSelector.
+ Bad naming, but compatibility is asking for it."
+
+ ^ self last == $:
+
+ "
+ #at:put: isKeyword
+ #at: isKeyword
+ #+ isKeyword
+ #size isKeyword
+ "
+
+ "Created: / 01-11-1997 / 12:34:55 / cg"
+ "Modified (comment): / 30-04-2016 / 18:19:11 / cg"
+!
+
isKeywordSelector
"return true, iff there are only alphanumeric or underline characters separated by colons.
Must end with a colon.
@@ -8154,6 +8223,14 @@
^ true
!
+isUnary
+ "Answer true if the receiver is a unary selector.
+ That is not a check for being a valid selector, but instead relies on
+ the selector being valid."
+
+ ^ self isUnarySelector
+!
+
isUnarySelector
"Answer true if the receiver contains only chars in an ANSI unary method selector, false otherwise."
@@ -8223,7 +8300,8 @@
numArgs
<resource: #obsolete>
- "treating the receiver as a message selector, return how many arguments would it take"
+ "treating the receiver as a message selector, return how many arguments would it take.
+ Please use argumentCount for ANSI compatibility."
^ self argumentCount
!
--- a/CharacterEncoder.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoder.st Mon Feb 13 21:29:46 2017 +0000
@@ -1666,6 +1666,8 @@
!CharacterEncoder::InverseEncoder methodsFor:'queries'!
characterSize:charOrcodePoint
+ "return the number of bytes required to encode codePoint"
+
^ decoder characterSize:charOrcodePoint
! !
@@ -1780,6 +1782,8 @@
!CharacterEncoder::TwoStepEncoder methodsFor:'queries'!
characterSize:codePoint
+ "return the number of bytes required to encode codePoint"
+
"/ naive; actually, we have to do a real encoding to get this info proper
^ (encoder2 characterSize:codePoint)
--- a/CharacterEncoderImplementations__ISO10646_1.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__ISO10646_1.st Mon Feb 13 21:29:46 2017 +0000
@@ -34,6 +34,13 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ I am a dummy encoder for Unicode.
+ Dummy, because that is the standard encding inside ST/X anyway
+"
! !
!ISO10646_1 class methodsFor:'queries'!
@@ -63,7 +70,7 @@
!ISO10646_1 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO10646_1.st,v 1.4 2004/03/09 22:00:08 cg Exp $'
+ ^ '$Header$'
!
version_SVN
--- a/CharacterEncoderImplementations__ISO10646_to_UTF16BE.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__ISO10646_to_UTF16BE.st Mon Feb 13 21:29:46 2017 +0000
@@ -39,6 +39,14 @@
documentation
"
encodes/decodes UTF16 BigEndian (big-end-first)
+
+ Notice the naming (many are confused):
+ Unicode is the set of number-to-glyph assignments
+ whereas:
+ UTF8, UTF16 etc. are a concrete way of xmitting Unicode codePoints (numbers).
+
+ ST/X NEVER uses UTF8 or UTF16 internally - all characters are full 24bit characters.
+ Only when exchanging data, are these converted into UTF8 (or other) byte sequences.
"
!
--- a/CharacterEncoderImplementations__ISO10646_to_UTF16LE.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__ISO10646_to_UTF16LE.st Mon Feb 13 21:29:46 2017 +0000
@@ -39,6 +39,14 @@
documentation
"
encodes/decodes UTF16 LittleEndian (little-end-first)
+
+ Notice the naming (many are confused):
+ Unicode is the set of number-to-glyph assignments
+ whereas:
+ UTF8, UTF16 etc. are a concrete way of xmitting Unicode codePoints (numbers).
+
+ ST/X NEVER uses UTF8 or UTF16 internally - all characters are full 24bit characters.
+ Only when exchanging data, are these converted into UTF8 (or other) byte sequences.
"
!
--- a/CharacterEncoderImplementations__ISO10646_to_UTF8.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__ISO10646_to_UTF8.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2004 by eXept Software AG
All Rights Reserved
@@ -45,6 +43,21 @@
"
!
+documentation
+"
+ I can encode characters into/from UTF8
+
+ Notice the naming (many are confused):
+ Unicode is the set of number-to-glyph assignments
+ whereas:
+ UTF8 is a concrete way of xmitting Unicode codePoints (numbers).
+ UTF16 is another concrete encoding, for example.
+
+ ST/X NEVER uses UTF8 internally - all characters are full 24bit characters.
+ Only when exchanging data, are these converted into UTF8 (or other) byte sequences.
+"
+!
+
examples
"
Encoding (unicode to utf8)
@@ -54,7 +67,7 @@
Decoding (utf8 to unicode):
|t|
- t := ISO10646_to_UTF8 encodeString:'Helloœ'.
+ t := ISO10646_to_UTF8 encodeString:'Hello'.
ISO10646_to_UTF8 decodeString:t.
"
! !
@@ -198,6 +211,10 @@
^ '$Header$'
!
+version_CVS
+ ^ '$Header$'
+!
+
version_HG
^ '$Changeset: <not expanded> $'
--- a/CharacterEncoderImplementations__KOI8_R.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__KOI8_R.st Mon Feb 13 21:29:46 2017 +0000
@@ -34,6 +34,12 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ I encode/decode KOI8 encoded documents (cyrillic - russia)
+"
! !
!KOI8_R class methodsFor:'mapping'!
@@ -858,5 +864,6 @@
!KOI8_R class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__KOI8_R.st,v 1.4 2012-07-11 16:42:56 stefan Exp $'
+ ^ '$Header$'
! !
+
--- a/CharacterEncoderImplementations__KOI8_U.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__KOI8_U.st Mon Feb 13 21:29:46 2017 +0000
@@ -34,6 +34,12 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ I encode/decode KOI8-U encoded documents (cyrillic - ukraine)
+"
! !
!KOI8_U class methodsFor:'mapping'!
@@ -416,5 +422,6 @@
!KOI8_U class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__KOI8_U.st,v 1.4 2012-07-11 16:43:20 stefan Exp $'
+ ^ '$Header$'
! !
+
--- a/CharacterEncoderImplementations__MAC_Roman.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__MAC_Roman.st Mon Feb 13 21:29:46 2017 +0000
@@ -34,6 +34,12 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ I encode/decode MAC roman encoded documents
+"
! !
!MAC_Roman class methodsFor:'mapping'!
@@ -965,9 +971,10 @@
!MAC_Roman class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Roman.st,v 1.4 2011-01-29 20:33:33 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Roman.st,v 1.4 2011-01-29 20:33:33 cg Exp $'
+ ^ '$Header$'
! !
+
--- a/CharacterEncoderImplementations__SingleByteEncoder.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__SingleByteEncoder.st Mon Feb 13 21:29:46 2017 +0000
@@ -47,6 +47,14 @@
!SingleByteEncoder class methodsFor:'queries'!
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here; false for subclasses.
+ Abstract subclasses must redefine this again."
+
+ ^ self == CharacterEncoderImplementations::SingleByteEncoder
+!
+
maxCode
^ 255
!
@@ -58,6 +66,7 @@
!SingleByteEncoder methodsFor:'queries'!
characterSize:codePoint
+ "return the number of bytes required to encode codePoint"
^1
--- a/CharacterEncoderImplementations__TwoByteEncoder.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CharacterEncoderImplementations__TwoByteEncoder.st Mon Feb 13 21:29:46 2017 +0000
@@ -34,10 +34,24 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ abstract superclass of all two-byte encoders
+"
! !
!TwoByteEncoder class methodsFor:'queries'!
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here; false for subclasses.
+ Abstract subclasses must redefine this again."
+
+ ^ self == CharacterEncoderImplementations::TwoByteEncoder
+!
+
maxCode
^ 16rFFFF
!
@@ -49,6 +63,7 @@
!TwoByteEncoder methodsFor:'queries'!
characterSize:codePoint
+ "return the number of bytes required to encode codePoint"
^2
--- a/Class.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Class.st Mon Feb 13 21:29:46 2017 +0000
@@ -4884,6 +4884,7 @@
!
nameOfVersionMethod
+ <resource: #obsolete>
"this is now more or less obsolete, as multiple sourceCodeManagers might use
different version_XXX methods. Keep this for backward compatibility.
As classes are checked in using the new source code manager, these methods will
--- a/ClassBuilder.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ClassBuilder.st Mon Feb 13 21:29:46 2017 +0000
@@ -42,6 +42,23 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentaiton
+"
+ an old, ugly beast.
+ instances are temporarily created to figure out,
+ which methods and which subclasses need to be recompiled whenever a class's definition
+ changes.
+ For fast turn around times, it is good to recompile the smallest needed amount.
+ (However, in the meantime, so many checks and small-lints and others are watching for
+ such changes, that recompilation gets a little slow at times.
+ Also, the more browsers you have open, which react and research on changes,
+ the slower you get)
+
+ Code here is ugly and hard to maintain.
+ Keep your fingers away...
+ "
! !
!ClassBuilder class methodsFor:'change & update'!
--- a/Collection.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Collection.st Mon Feb 13 21:29:46 2017 +0000
@@ -425,11 +425,13 @@
difference: aCollection
"Answer the set-theoretic difference of two collections."
- ^ self reject:[:each | aCollection includes: each]
+ ^ self \ aCollection
"
#(0 2 4 6 8) difference:#(2 4)
"
+
+ "Modified: / 20-01-2017 / 19:21:35 / stefan"
!
gather:aBlock
@@ -1650,6 +1652,12 @@
!
+asCollectionDo:aBlock
+ "enumerate myself"
+
+ self do:aBlock
+!
+
asDictionary
"return a Dictionary with the receiver collection's elements,
using the original keys of the receiver as dictionary key.
@@ -2742,7 +2750,7 @@
"Note that there is no way to get the first element
which works for all kinds of Collections.
Must therefore test every one (maxValue is nil for the first element)."
- (maxValue == nil or:[val > maxValue]) ifTrue: [
+ (maxValue isNil or:[val > maxValue]) ifTrue: [
maxElement := each.
maxValue := val
]
@@ -2770,7 +2778,7 @@
"Note that there is no way to get the first element
which works for all kinds of Collections.
Must therefore test every one (minValue is nil for the first element)."
- (minValue == nil or:[val < minValue]) ifTrue: [
+ (minValue isNil or:[val < minValue]) ifTrue: [
minElement := each.
minValue := val
]
@@ -3546,7 +3554,7 @@
|newCollection|
- newCollection := self species new.
+ newCollection := self speciesForAdding new.
self do:[:each |
(aBlock value:each) ifTrue:[newCollection add:each].
].
@@ -3558,6 +3566,7 @@
"
"Modified: / 07-08-2010 / 16:26:40 / cg"
+ "Modified: / 20-01-2017 / 17:42:33 / stefan"
!
select:aBlock as:aCollectionClass
@@ -3613,6 +3622,7 @@
"
#(1 2 3 4) select:[:e | e > 10] ifNone:['sorry']
+ #(1 2 3 4) select:[:e | e > 10]
"
!
@@ -3631,12 +3641,12 @@
!
select:selectBlock thenCollect:collectBlock as:aCollectionClass
- "return a new collection with all elements from the receiver, for which
- the argument selectBlock evaluates to true.
+ "return a new collection with all elements from the receiver,
+ for which the argument selectBlock evaluates to true.
Process the elements through collectBlock before adding.
Returns the same as if three separate collect+select+as: messages were sent,
- but avoids the creation of intermediate collections, so this is nicer for
- big collections."
+ but avoids the creation of intermediate collections,
+ so this is nicer for big collections."
|newCollection|
@@ -5273,43 +5283,36 @@
which are NOT also contained in the aCollection
For large collections you better use a Set for aCollection"
-
- |newCollection|
-
- newCollection := self speciesForAdding new.
- self do:[:element |
- (aCollection includes:element) ifFalse:[
- newCollection add:element
- ]
- ].
- ^ newCollection
+ ^ self select:[:eachElement | (aCollection includes:eachElement) not].
"
#(0 1 2 3 4 5 6 7 8 9) \ #(1 2 3) asSet
#(0 1 2 3 4 5 6 7 8 9) \ #(1 2 3)
- ('hello' \ 'l') asString
- "
+ ('hello' \ 'l')
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ \ (Dictionary withKeysAndValues:#(1 'uno' 4 'quatro'))
+ "
+
+ "Modified (comment): / 20-01-2017 / 19:28:00 / stefan"
!
intersect:aCollection
"return a new set containing all elements of the receiver,
which are also contained in the argument collection.
- For large collections you better use a Set for self"
-
- |newCollection|
-
- newCollection := self speciesForAdding new.
- aCollection do:[:element |
- (self includes:element) ifTrue:[
- newCollection add:element
- ]
- ].
- ^ newCollection
+ For large collections you better use a Set for aCollection"
+
+ ^ aCollection select:[:eachElement | self includes:eachElement].
"
#(0 1 2 3 4 5 6 7 8 9) asSet intersect:#(1 2 3 11)
#(0 1 2 3 4 5 6 7 8 9) intersect:#(1 2 3 11)
- "
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ intersect:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Modified: / 20-01-2017 / 19:33:14 / stefan"
!
union:aCollection
@@ -5326,7 +5329,12 @@
"
#(0 2 4 6 8) union:#(1 3 5 7)
#(0 2 4 6 8) union:#(0 1 3 5 7)
- "
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ union:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Modified (comment): / 20-01-2017 / 19:35:23 / stefan"
!
xor:aCollection
@@ -5353,6 +5361,9 @@
"
#(0 1 2 3 4 5 6 7 8 9) xor:#(1 2 3 11)
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ xor:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+
"
"
@@ -5363,6 +5374,8 @@
c1 symmetricDifference:c2.
self assert:(c1 symmetricDifference:c2) asSet = (c2 symmetricDifference:c1) asSet
"
+
+ "Modified (comment): / 20-01-2017 / 19:37:58 / stefan"
! !
!Collection methodsFor:'sorting & reordering'!
--- a/CompiledCode.st Fri Dec 09 22:31:28 2016 +0000
+++ b/CompiledCode.st Mon Feb 13 21:29:46 2017 +0000
@@ -201,6 +201,32 @@
"
! !
+!CompiledCode methodsFor:'Compatibility-ANSI'!
+
+argumentCount
+ "ANSI alias for numArgs: return the number of arguments, the method expects."
+
+%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( self.getNumberOfArguments() );
+#else
+ /* made this a primitive to get define in stc.h */
+
+ RETURN (__mkSmallInteger((__intVal(__INST(flags)) & F_NARGS) >> F_NARGSHIFT));
+#endif
+%}.
+ "
+ The old implementation simply counted the arguments from
+ the methods source - new versions include this information
+ in the flag instVar, for more security in #perform:
+ "
+
+ "
+ (Method compiledMethodAt:#source) numArgs
+ (Method compiledMethodAt:#source:) numArgs
+ "
+! !
+
!CompiledCode methodsFor:'Compatibility-ST80'!
getSource
@@ -1692,30 +1718,6 @@
!CompiledCode methodsFor:'queries'!
-argumentCount
- "ANSI alias for numArgs: return the number of arguments, the method expects."
-
-%{ /* NOCONTEXT */
-#ifdef __SCHTEAM__
- return __c__._RETURN( self.getNumberOfArguments() );
-#else
- /* made this a primitive to get define in stc.h */
-
- RETURN (__mkSmallInteger((__intVal(__INST(flags)) & F_NARGS) >> F_NARGSHIFT));
-#endif
-%}.
- "
- The old implementation simply counted the arguments from
- the methods source - new versions include this information
- in the flag instVar, for more security in #perform:
- "
-
- "
- (Method compiledMethodAt:#source) numArgs
- (Method compiledMethodAt:#source:) numArgs
- "
-!
-
decompileTo:aStream
|decompilerClass decompiler|
@@ -1849,7 +1851,8 @@
!
numArgs
- "return the number of arguments, the method expects."
+ "return the number of arguments, the method expects.
+ Please use argumentCount for ANSI compatibility."
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -1939,7 +1942,7 @@
"/ for ST80 compatibility (where variableBindings are used...)
lit := lit key
].
- ^ (self literalsDetect:[:mthdLit| mthdLit == lit] ifNone:[nil]) ~~ nil.
+ ^ (self literalsDetect:[:mthdLit| mthdLit == lit] ifNone:[nil]) notNil.
"
(CompiledCode compiledMethodAt:#referencesLiteral:) referencesGlobal:#literalsDetect:ifNone:
--- a/Complex.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Complex.st Mon Feb 13 21:29:46 2017 +0000
@@ -448,6 +448,8 @@
!
differenceFromFixedPoint: aFixedPoint
+ "Return the difference of the argument, aFixedPoint and the receiver."
+
^ aFixedPoint asComplex - self
!
@@ -469,10 +471,14 @@
!
differenceFromFraction: aFraction
+ "Return the difference of the argument, aFraction and the receiver."
+
^ aFraction asComplex - self
!
differenceFromInteger: anInteger
+ "Return the difference of the argument, anInteger and the receiver."
+
^ anInteger asComplex - self
!
@@ -499,6 +505,8 @@
!
productFromFixedPoint: aFixedPoint
+ "Return the product of the receiver and the argument, aFixedPoint."
+
^ aFixedPoint asComplex * self
!
@@ -523,10 +531,14 @@
!
productFromFraction: aFraction
+ "Return the product of the receiver and the argument, aFraction."
+
^ aFraction asComplex * self
!
productFromInteger: anInteger
+ "Return the product of the receiver and the argument, anInteger."
+
^ anInteger asComplex * self
!
@@ -601,6 +613,8 @@
!
sumFromFixedPoint: aFixedPoint
+ "Return the sum of the receiver and the argument, aFixedPoint."
+
^ aFixedPoint asComplex + self
!
@@ -622,10 +636,14 @@
!
sumFromFraction: aFraction
+ "Return the sum of the receiver and the argument, aFraction."
+
^ aFraction asComplex + self
!
sumFromInteger: anInteger
+ "Return the sum of the receiver and the argument, anInteger."
+
^ anInteger asComplex + self
! !
--- a/Context.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Context.st Mon Feb 13 21:29:46 2017 +0000
@@ -933,12 +933,34 @@
withAllSendersDo:aBlock
"evaluate aBlock for me and all contexts of my sender chain"
+ self withSendersUpToContextForWhich:[:con | false] do:aBlock
+!
+
+withSendersThroughContextForWhich:checkBlock do:aBlock
+ "evaluate aBlock for me and all contexts of my sender chain,
+ until checkBlock returns true (incl. that last one)"
+
|con|
con := self.
[ con notNil ] whileTrue:[
- aBlock value:con.
- con := con sender.
+ aBlock value:con.
+ (checkBlock value:con) ifTrue:[^ self].
+ con := con sender.
+ ]
+!
+
+withSendersUpToContextForWhich:checkBlock do:aBlock
+ "evaluate aBlock for me and all contexts of my sender chain,
+ until checkBlock returns true, excl. that context."
+
+ |con|
+
+ con := self.
+ [ con notNil ] whileTrue:[
+ (checkBlock value:con) ifTrue:[^ self].
+ aBlock value:con.
+ con := con sender.
]
! !
@@ -1777,9 +1799,8 @@
fullPrintAllOn:aStream throughContextForWhich:aBlock
"print a full walkback (incl arguments) starting at the receiver"
- self withAllSendersDo:[:con |
+ self withSendersThroughContextForWhich:aBlock do:[:con |
con fullPrintOn:aStream. aStream cr.
- (aBlock value:con) ifTrue:[^ self].
].
"
@@ -1790,8 +1811,7 @@
fullPrintAllOn:aStream upToContextForWhich:aBlock
"print a full walkback (incl arguments) starting at the receiver"
- self withAllSendersDo:[:con |
- (aBlock value:con) ifTrue:[^ self].
+ self withSendersUpToContextForWhich:aBlock do:[:con |
con fullPrintOn:aStream. aStream cr.
].
@@ -1803,7 +1823,11 @@
fullPrintAllString
"return a string containing the full walkback (incl. arguments)"
- ^ String streamContents:[:s | self fullPrintAllOn:s]
+ |s|
+
+ s := WriteStream on:''.
+ self fullPrintAllOn:s.
+ ^ s contents
"
thisContext fullPrintAllString
@@ -1885,6 +1909,30 @@
"Created: 15.1.1997 / 18:09:05 / cg"
!
+printAllOn:aStream throughContextForWhich:aBlock
+ "print a short walkback (excl. arguments) starting at the receiver"
+
+ self withSendersThroughContextForWhich:aBlock do:[:con |
+ con printOn:aStream. aStream cr.
+ ].
+
+ "
+ thisContext printAllOn:Transcript throughContextForWhich:[:con | con selector == #doIt].
+ "
+!
+
+printAllOn:aStream upToContextForWhich:aBlock
+ "print a short walkback (excl. arguments) starting at the receiver"
+
+ self withSendersUpToContextForWhich:aBlock do:[:con |
+ con printOn:aStream. aStream cr.
+ ].
+
+ "
+ thisContext printAllOn:Transcript upToContextForWhich:[:con | con selector == #withCursor:do:].
+ "
+!
+
printAllString
"return a string containing the walkback (excl. arguments)"
--- a/Date.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Date.st Mon Feb 13 21:29:46 2017 +0000
@@ -375,17 +375,17 @@
|weekDayOfJan4 dayInYear year|
year := yearArg.
- weekDayOfJan4 := (Date year:year month:1 day:4) dayInWeek.
+ weekDayOfJan4 := (self year:year month:1 day:4) dayInWeek.
dayInYear := (week * 7) + dayInWeek - (weekDayOfJan4 + 3).
dayInYear < 1 ifTrue:[
- dayInYear := dayInYear + (Date daysInYear:year-1).
+ dayInYear := dayInYear + (self daysInYear:year-1).
year := year - 1.
].
- dayInYear > (Date daysInYear:year) ifTrue:[
- dayInYear := dayInYear - (Date daysInYear:year).
+ dayInYear > (self daysInYear:year) ifTrue:[
+ dayInYear := dayInYear - (self daysInYear:year).
year := year + 1.
].
- ^ Date newDay:dayInYear year:year.
+ ^ self newDay:dayInYear year:year.
"
Date newDayInWeek:6 week:39 year:2008
@@ -532,14 +532,14 @@
].
dayOfYear notNil ifTrue:[
- monthAndDay := Date monthAndDayFromDayInYear:dayOfYear forYear:year.
+ monthAndDay := self monthAndDayFromDayInYear:dayOfYear forYear:year.
month := (monthAndDay at:1).
day := (monthAndDay at:2).
].
day isNil ifTrue:[ day := 1 ].
month isNil ifTrue:[ month := 1 ].
- year isNil ifTrue:[ year := Date today year ].
+ year isNil ifTrue:[ year := self today year ].
(year between:0 and:99) ifTrue:[
year := UserPreferences current twoDigitDateHandler value:year.
@@ -736,7 +736,7 @@
"return a date, representing tomorrow.
See also: Time now / Timestamp now."
- ^ Date today addDays:1
+ ^ self today addDays:1
"
Date tomorrow
@@ -812,7 +812,7 @@
"return a date, representing yesterday.
See also: Time now / Timestamp now."
- ^ Date today subtractDays:1
+ ^ self today subtractDays:1
"
Date yesterday
@@ -925,6 +925,7 @@
"
! !
+
!Date class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -1132,7 +1133,7 @@
|day dayInWeekOf1stJan firstThursday firstDayInWeek|
"/ find the first thursday ...
- day := Date newDay:1 year:aYear.
+ day := self newDay:1 year:aYear.
dayInWeekOf1stJan := day dayInWeek.
dayInWeekOf1stJan > 4 ifTrue:[
firstThursday := day addDays:(4 - dayInWeekOf1stJan + 7).
@@ -1570,7 +1571,7 @@
numDays < 0 ifTrue:[
"/ not in a week here ...
"/ can be either 52 or 53, depending on the previous year.
- ^ self weekInYearOf:(Date year:date year - 1 month:12 day:31)
+ ^ self weekInYearOf:(self year:date year - 1 month:12 day:31)
].
"/ compute the week
@@ -1896,6 +1897,7 @@
"Modified: 8.10.1996 / 19:25:39 / cg"
! !
+
!Date class methodsFor:'private'!
dayAbbrevsForLanguage:languageOrNilForDefault
@@ -2022,13 +2024,13 @@
].
(format sameAs:'monthName') ifTrue:[
monthName := string.
- month := (Date monthNamesForLanguage:languageOrNil) findFirst:[:m | monthName sameAs:m].
+ month := (self monthNamesForLanguage:languageOrNil) findFirst:[:m | monthName sameAs:m].
"/ month == 0 ifTrue:[self error:'invalid month name'].
^ #month -> month
].
(format sameAs:'shortMonthName') ifTrue:[
monthName := string.
- month := (Date abbreviatedMonthNamesForLanguage:languageOrNil) findFirst:[:m | monthName sameAs:m].
+ month := (self abbreviatedMonthNamesForLanguage:languageOrNil) findFirst:[:m | monthName sameAs:m].
"/ month == 0 ifTrue:[self error:'invalid month name'].
^ #month -> month
].
@@ -2112,6 +2114,7 @@
"
! !
+
!Date methodsFor:'Compatibility-ANSI'!
dayOfWeek
@@ -2756,7 +2759,7 @@
daysInMonth
"return the number of days in the month of the receiver"
- ^ Date daysInMonth:(self month) forYear:(self year)
+ ^ self class daysInMonth:(self month) forYear:(self year)
"
Date today daysInMonth
@@ -2766,7 +2769,7 @@
daysInYear
"return the number of days in the year of the receiver"
- ^ Date daysInYear:(self year)
+ ^ self class daysInYear:(self year)
"
Date today daysInYear
@@ -2788,7 +2791,7 @@
Today is excluded from the count (i.e. in a non-leap-year,
the first january will return 364)"
- ^ (Date daysInYear:(self year)) - self dayOfYear
+ ^ (self class daysInYear:(self year)) - self dayOfYear
"
Date today daysLeftInYear
@@ -2798,7 +2801,7 @@
isLeapYear
"return true, if the receiver's year is a leap year"
- ^ Date leapYear:(self year)
+ ^ self class leapYear:self year
"
Date today isLeapYear
@@ -3022,7 +3025,7 @@
- (self month * 100) "in the line above the new month is already completely calculated. So subtract the current month"
- self day "in the line below the new day is already completely calculated. So subtract the current day"
+ (self day min: self daysInMonth). "the new day considering the maximum number of days in the new month."
- ^ Date
+ ^ self class
year: newEncoding // 10000
month: (newEncoding // 100 \\ 100)
day: newEncoding \\ 100.
@@ -3120,7 +3123,7 @@
month := (12 - (monthNegated \\ 12)).
].
- ^ Date year:year month:month day:1.
+ ^ self class year:year month:month day:1.
"
(Date newDay:3 month:6 year:2009) firstDayInMonth
@@ -3171,7 +3174,7 @@
"/ the argument must understand year, month and day to be
"/ comparable, whatever it is
- ^ dateEncoding < (Date encodeYear:aDate year month:aDate month day:aDate day)
+ ^ dateEncoding < (self class encodeYear:aDate year month:aDate month day:aDate day)
"
Date today < (Date day:24 month:12 year:2000)
@@ -3212,7 +3215,7 @@
"/ the argument must understand year, month and day,
"/ to be comparable, whatever it is
- ^ dateEncoding > (Date encodeYear:aDate year month:aDate month day:aDate day)
+ ^ dateEncoding > (self class encodeYear:aDate year month:aDate month day:aDate day)
"
Date today > (Date newDay:24 month:12 year:2099)
@@ -3271,6 +3274,7 @@
! !
+
!Date methodsFor:'obsolete'!
asAbsoluteTime
@@ -3341,6 +3345,7 @@
^ self addDays:days
! !
+
!Date methodsFor:'printing & storing'!
addPrintBindingsTo:aDictionary
@@ -3442,7 +3447,7 @@
aDictionary at:#week put:wsPadded0.
aDictionary at:#Week put:ws.
- year ~~ Date today year ifTrue:[
+ year ~~ self class today year ifTrue:[
aDictionary at:#yearOrTime put:(' ' , year printString).
].
--- a/Dictionary.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Dictionary.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
@@ -992,10 +990,10 @@
If it was not in the collection report an error.
WARNING: do not remove elements while iterating over the receiver.
- See #saveRemoveKey: to do this."
+ See #safeRemoveKey: to do this."
aKeyCollection do:[:eachKey |
- self removeKey:eachKey ifAbsent:[self errorKeyNotFound:eachKey]
+ self removeKey:eachKey ifAbsent:[self errorKeyNotFound:eachKey]
].
!
@@ -1804,28 +1802,6 @@
"Modified: 20.4.1996 / 11:31:15 / cg"
!
-collect:aBlock
- "for each element in the receiver, evaluate the argument, aBlock
- and return a Bag with the results.
-
- See also:
- #associationsCollect: (which passes key-value associations)
- #keysAndValuesCollect: (which passes keys & values separately)
-
- WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
-
- |newCollection|
-
- newCollection := Bag new.
- self do:[:each |
- newCollection add:(aBlock value:each)
- ].
- ^ newCollection
-
- "Modified: 20.4.1996 / 11:29:58 / cg"
-!
-
do:aBlock
"perform the block for all values in the collection.
@@ -2038,6 +2014,34 @@
Same as #do: - for VisualWorks compatibility"
^ self do:aBlock
+!
+
+xor:aCollection
+ "return a new set containing all elements,
+ which are contained in either the receiver or aCollection, but not in both."
+
+ |newCollection|
+
+ newCollection := self species new.
+ self keysAndValuesDo:[:key :value |
+ (aCollection includes:value) ifFalse:[
+ newCollection at:key put:value
+ ]
+ ].
+ aCollection keysAndValuesDo:[:key :value |
+ (self includes:value) ifFalse:[
+ newCollection at:key put:value
+ ]
+ ].
+
+ ^ newCollection
+
+ "
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ xor:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Created: / 20-01-2017 / 19:43:48 / stefan"
! !
@@ -2244,6 +2248,17 @@
^ Array basicNew:n
! !
+!Dictionary methodsFor:'queries'!
+
+speciesForCollecting
+ "like species, but used when doing collect operations.
+ Redefined for collections which return a different classes object when doing collect."
+
+ ^ Bag
+
+ "Created: / 20-01-2017 / 17:46:16 / stefan"
+! !
+
!Dictionary methodsFor:'searching'!
findFirst:aBlock ifNone:exceptionValue
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/EventSemaphore.st Mon Feb 13 21:29:46 2017 +0000
@@ -0,0 +1,170 @@
+"
+ COPYRIGHT (c) 2016 by eXept Sofware AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: Smalltalk }"
+
+Semaphore subclass:#EventSemaphore
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Processes'
+!
+
+!EventSemaphore class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2016 by eXept Sofware AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ Processes wait for an EventSemaphores until it is signaled.
+ The EventSemaphore is not consumed and remains signaled until manually reset.
+
+ [author:]
+ Stefan Vogel
+
+ [see also:]
+ Semaphore
+"
+!
+
+example
+"
+ Create an event and signal it.
+ After being signaled waiter on the event return immediately.
+
+ [exBegin]
+ |event|
+
+ event := EventSemaphore new.
+ [ event wait. Transcript showCR:'Process 1 continued' ] forkAt:9.
+ [ event wait. Transcript showCR:'Process 2 continued' ] forkAt:9.
+ event signal.
+ event wait.
+ event wait.
+ [exEnd]
+"
+! !
+
+!EventSemaphore class methodsFor:'signaling'!
+
+new:n
+ "count must be 0 or 1"
+
+ (n == 0 or:[n == 1]) ifTrue:[
+ self new:n.
+ ].
+ ^ self error:'invalid count'.
+! !
+
+!EventSemaphore methodsFor:'blocked'!
+
+signalForAll
+ "blocked, since it would only set the event if there was anyone waiting"
+
+ ^ self shouldNotImplement.
+!
+
+signalIf
+ "blocked, since it would only set the event if there was anyone waiting"
+
+ ^ self shouldNotImplement.
+!
+
+waitWithTimeoutMs:milliSeconds state:waitStateSymbol
+ "blocked, since we had to re-implement it here"
+
+ ^ self shouldNotImplement
+! !
+
+!EventSemaphore methodsFor:'misc'!
+
+reset
+ "reset the event to the non-signaled state"
+
+ count := 0
+! !
+
+!EventSemaphore methodsFor:'semaphoreSet interface'!
+
+checkAndAddWaitingProcess:process
+ "interface for SemaphoreSet.
+ If the semaphore is available, return true.
+ Otherwise register our process to be wakened up once the semaphore is available
+ and return false.
+ ATTENTION: this must be invoked with OperatingSystem-interrupts-blocked.
+ "
+
+ count > 0 ifTrue:[
+ ^ true
+ ].
+ (waitingProcesses notNil and:[(waitingProcesses includesIdentical:process)]) ifFalse:[
+ self addWaitingProcess:process.
+ ].
+ ^ false
+
+ "Modified: / 14-12-1995 / 10:32:17 / stefan"
+ "Modified: / 11-08-2011 / 14:36:20 / cg"
+! !
+
+!EventSemaphore methodsFor:'signaling'!
+
+signal
+ "redefined to limit count to 1"
+
+ self signalOnce.
+! !
+
+!EventSemaphore methodsFor:'waiting'!
+
+wait
+ "once signaled, do not decrement the count"
+
+ self waitUncounted
+!
+
+waitWithTimeoutMs:milliSeconds
+ "wait for the semaphore, but abort the wait after some time.
+ return the receiver if the semaphore triggered normal, nil if we return
+ due to a timeout.
+ With zero timeout, this can be used to poll a semaphore (returning
+ the receiver if the semaphore is available, nil if not).
+ However, polling is not the intended use of semaphores, though.
+ If milliSeconds is nil, wait without timeout.
+
+ Redefined: once signaled, do not decrement the count"
+
+ ^ self waitUncountedWithTimeoutMs:milliSeconds.
+! !
+
+!EventSemaphore class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/ExternalStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ExternalStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -1690,18 +1690,16 @@
This may be used to wrap fd's as returned by user
primitive code, or to wrap pipe-fds into externalStreams."
- |newStream|
-
- newStream := self basicNew.
- newStream text; buffered:buffered; eolMode:DefaultEOLMode; clearEOF.
- ^ newStream connectTo:aFileDescriptor withMode:modeSymbol handleType:handleTypeSymbol
+ ^ self new
+ buffered:buffered;
+ connectTo:aFileDescriptor withMode:modeSymbol handleType:handleTypeSymbol.
"
the example below will probably fail (15 is a random FD):
|s|
- s := ExternalStream forFileDescriptor:15 mode:#radonly handleType:#filePointer.
+ s := ExternalStream forFileDescriptor:15 mode:#readonly buffered:false handleType:#filePointer.
s next.
"
@@ -2072,8 +2070,8 @@
"return the kind of object to be returned by sub-collection builders
(such as upTo)"
- binary == true ifTrue:[
- ^ ByteArray
+ binary ifTrue:[
+ ^ ByteArray
].
^ String
!
@@ -2081,33 +2079,42 @@
eolMode
"return how end-of-line (EOL) is to be marked.
Returns one one of:
- #crlf -> add a CR-NL, as in MSDOS
- #cr -> add a CR, as in VMS
- #nl -> add a NL, as in Unix
- nil -> transparent
+ #crlf -> add a CR-NL, as in MSDOS
+ #cr -> add a CR, as in VMS
+ #nl -> add a NL, as in Unix
+ #eot -> add an EOT (= 0x04, as used in some modems/protocols)
+ #etx -> add an ETX (= 0x03, as used in some modems/protocols)
+ #nl -> add a NL, as in Unix
+ nil -> transparent
"
^ eolMode
+
+ "Modified (comment): / 06-12-2016 / 14:26:24 / cg"
!
eolMode:aSymbolOrNil
"specify how end-of-line (EOL) is to be marked.
The argument may be one of:
- #crlf -> add a CR-NL, as in MSDOS
- #cr -> add a CR, as in VMS
- #nl -> add a NL, as in Unix
- anyOther -> like #nl
+ #crlf -> add a CR-NL, as in MSDOS
+ #cr -> add a CR, as in VMS
+ #nl -> add a NL, as in Unix
+ #eot -> add an EOT (= 0x04, as used in some modems/protocols)
+ #etx -> add an ETX (= 0x03, as used in some modems/protocols)
+ anyOther -> like #nl
"
aSymbolOrNil == #crnl ifTrue:[
- eolMode := #crlf
+ eolMode := #crlf
] ifFalse:[
- aSymbolOrNil == #lf ifTrue:[
- eolMode := #nl
- ] ifFalse:[
- eolMode := aSymbolOrNil
- ]
+ aSymbolOrNil == #lf ifTrue:[
+ eolMode := #nl
+ ] ifFalse:[
+ eolMode := aSymbolOrNil
+ ]
].
+
+ "Modified (comment): / 06-12-2016 / 14:26:37 / cg"
!
fileDescriptor
@@ -2119,14 +2126,15 @@
OBJ _handle = __INST(handle);
if (_handle != nil) {
- if (__INST(handleType) == @symbol(socketHandle)) {
- RETURN (_handle);
- } else if ((__INST(handleType) == nil)
- || (__INST(handleType) == @symbol(filePointer))
- || (__INST(handleType) == @symbol(socketFilePointer))
- || (__INST(handleType) == @symbol(pipeFilePointer))) {
- RETURN ( __MKINT(fileno(__FILEVal(_handle))));
- }
+ if ((__INST(handleType) == @symbol(fileHandle))
+ || (__INST(handleType) == @symbol(socketHandle))) {
+ RETURN (_handle);
+ } else if ((__INST(handleType) == nil)
+ || (__INST(handleType) == @symbol(filePointer))
+ || (__INST(handleType) == @symbol(socketFilePointer))
+ || (__INST(handleType) == @symbol(pipeFilePointer))) {
+ RETURN ( __MKINT(fileno(__FILEVal(_handle))));
+ }
}
%}.
handle isNil ifTrue:[^ self errorNotOpen].
@@ -2159,6 +2167,9 @@
|| (__INST(handleType) == @symbol(socketHandle))) {
RETURN (_handle);
}
+ if (__INST(handleType) == @symbol(pipeFilePointer)) {
+ RETURN (__MKINT(fileno(__FILEVal(_handle))));
+ }
if ((__INST(handleType) == nil)
|| (__INST(handleType) == @symbol(filePointer))
|| (__INST(handleType) == @symbol(socketFilePointer))
@@ -2188,6 +2199,10 @@
^ self error:'not a FILE*'
!
+handle
+ ^ handle
+!
+
handleType
^ handleType
!
@@ -2744,14 +2759,14 @@
^ line , self nextLine
].
- (hitEOF == true) ifTrue:[^ self pastEndRead].
+ hitEOF ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
lastErrorNumber := error.
^ self readError:error
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
- (binary == true) ifTrue:[^ self errorBinary].
+ binary ifTrue:[^ self errorBinary].
^ super nextLine
!
@@ -3022,13 +3037,6 @@
"
!
-create
- "create the stream
- - this must be redefined in subclass"
-
- ^ self subclassResponsibility
-!
-
ioctl:ioctlNumber
"to provide a simple ioctl facility - an ioctl is performed
on the underlying file; no arguments are passed."
@@ -4826,7 +4834,7 @@
The openMode ('r', 'w' etc.) must match the mode in which
the fileDescriptor was originally opened (otherwise i/o errors will be reported later)."
- |retVal error openmode|
+ |error openmode|
handle notNil ifTrue:[^ self errorAlreadyOpen].
mode := modeSymbol.
@@ -4839,60 +4847,57 @@
if (__isStringLike(openmode)) {
#ifdef __win32__
- __stxWrapApiEnterCritical();
+ __stxWrapApiEnterCritical();
#endif
- if (__isSmallInteger(aFileDescriptor)) {
- fd = __intVal(aFileDescriptor);
- }
+ if (__isSmallInteger(aFileDescriptor)) {
+ fd = __intVal(aFileDescriptor);
+ }
#ifdef __win32__
- else if (__isExternalAddressLike(aFileDescriptor)) {
- fd = _open_osfhandle((long)__externalAddressVal(aFileDescriptor), O_BINARY);
- if (fd < 0) {
- if (__threadErrno == 0) {
- // no more file descriptors
- __threadErrno = EMFILE;
- }
- error = __mkSmallInteger(__threadErrno);
- __stxWrapApiLeaveCritical();
- goto out;
- }
- }
+ else if (__isExternalAddressLike(aFileDescriptor)) {
+ fd = _open_osfhandle((long)__externalAddressVal(aFileDescriptor), O_BINARY);
+ if (fd < 0) {
+ if (__threadErrno == 0) {
+ // no more file descriptors
+ __threadErrno = EMFILE;
+ }
+ error = __mkSmallInteger(__threadErrno);
+ __stxWrapApiLeaveCritical();
+ goto out;
+ }
+ }
#endif
- f = (FILEPOINTER) fdopen(fd, (char *)__stringVal(openmode));
+ f = (FILEPOINTER) fdopen(fd, (char *)__stringVal(openmode));
#ifdef __win32__
- __stxWrapApiLeaveCritical();
+ __stxWrapApiLeaveCritical();
#endif
- if (f == NULL) {
- error =__mkSmallInteger(__threadErrno);
- } else {
- if (@global(FileOpenTrace) == true) {
- fprintf(stderr, "fdopen [ExternalStream] %"_ld_" (%"_lx_") -> %"_lx_"\n", (INT)fd, (INT)fd, (INT)f);
- }
-
- fp = __MKFILEPOINTER(f); __INST(handle) = fp; __STORE(self, fp);
- retVal = self;
- }
+ if (f == NULL) {
+ error =__mkSmallInteger(__threadErrno);
+ } else {
+ if (@global(FileOpenTrace) == true) {
+ fprintf(stderr, "fdopen [ExternalStream] %"_ld_" (%"_lx_") -> %"_lx_"\n", (INT)fd, (INT)fd, (INT)f);
+ }
+
+ fp = __MKFILEPOINTER(f); __INST(handle) = fp; __STORE(self, fp);
+ }
}
out:;
%}.
- retVal notNil ifTrue:[
- position := 0.
- buffered isNil ifTrue:[
- buffered := true. "default is buffered"
- ].
- handleType := handleTypeSymbol.
- self registerForFinalization.
- ^ retVal
+ error notNil ifTrue:[
+ "
+ the open failed for some reason ...
+ "
+ OperatingSystem closeFd:aFileDescriptor.
+ lastErrorNumber := error.
+ position := nil.
+ ^ self openError:error
].
- error notNil ifTrue:[
- OperatingSystem closeFd:aFileDescriptor.
- lastErrorNumber := error.
- position := nil.
- "
- the open failed for some reason ...
- "
- ^ self openError:error
+
+ position := 0.
+ buffered isNil ifTrue:[
+ buffered := true. "default is buffered"
].
+ handleType := handleTypeSymbol.
+ self registerForFinalization.
!
dupFd
@@ -5004,15 +5009,6 @@
handleType := what.
!
-setFileDescriptor:anInteger mode:openMode
- <resource: #obsolete>
- "set the handle based upon a given fileDescriptor -
- notice: this one is based on the underlying OSs fileDescriptor -
- this may not be available on all platforms (i.e. non unix systems)."
-
- self setFileHandle:anInteger mode:openMode
-!
-
setFileHandle:something
"set the fileHandle to the given one;
low level private & friend interface; may also be used to connect to some
@@ -5137,37 +5133,8 @@
!
numAvailable
- "return the number of bytes available for reading"
-
- |fd|
-
- handle isNil ifTrue:[^ self errorNotOpen].
- mode == #writeonly ifTrue:[^ self errorWriteOnly].
- fd := self fileDescriptor.
-
-%{
-#ifdef __win32__
- int res = 1;
- int success = 0;
-
- if (__INST(handleType) == @symbol(socketHandle)) {
- success = ioctlsocket((SOCKET)__externalAddressVal(fd), FIONREAD, &res) == 0;
- } else if (__INST(handleType) == @symbol(socketFilePointer)) {
- success = ioctlsocket((SOCKET)_get_osfhandle(__intVal(fd)), FIONREAD, &res) == 0;
- } else if (__INST(handleType) == @symbol(pipeFilePointer)) {
- success = PeekNamedPipe((HANDLE)_get_osfhandle(__intVal(fd)),0,0,0,&res,0);
- }
- if (success) {
- if (__INST(readAhead) != nil) res++;
- RETURN(__mkSmallInteger(res));
- }
-#endif
-%}.
-
- ^ (readAhead notNil or:[OperatingSystem readCheck:fd]) ifTrue:[1] ifFalse:[0].
-
- "Created: / 4.2.1998 / 16:56:01 / cg"
- "Modified: / 4.2.1998 / 17:31:11 / cg"
+ <resource: #obsolete>
+ ^ self numAvailableForRead
! !
!ExternalStream methodsFor:'reading'!
@@ -5245,7 +5212,7 @@
}
#endif /* not SCHTEAM */
%}.
- hitEOF == true ifTrue:[^ self pastEndRead].
+ hitEOF ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
lastErrorNumber := error.
^ self readError:error
@@ -5264,7 +5231,7 @@
c isNil ifTrue:[
^ self pastEndRead.
].
- binary == true ifTrue:[
+ binary ifTrue:[
^ c
].
^ Character value:c
@@ -5343,7 +5310,7 @@
}
}
%}.
- hitEOF == true ifTrue:[^ nil].
+ hitEOF ifTrue:[^ nil].
error notNil ifTrue:[
lastErrorNumber := error.
^ self readError:error.
@@ -5423,7 +5390,7 @@
}
}
%}.
- hitEOF == true ifTrue:[^ self pastEndRead].
+ hitEOF ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
lastErrorNumber := error.
^ self readError:error.
@@ -5495,7 +5462,7 @@
}
}
%}.
- hitEOF == true ifTrue:[^ nil].
+ hitEOF ifTrue:[^ nil].
error notNil ifTrue:[
lastErrorNumber := error.
^ self readError:error.
@@ -5594,23 +5561,15 @@
(see NonPositionableExternalStream)"
%{
- OBJ fp, pos, lim;
+ OBJ fp, lim;
char c;
if (__INST(hitEOF) == true) {
RETURN (true);
}
- pos = __INST(position);
lim = __INST(readLimit);
- if (lim != nil) {
- off_t _pos, _readLimit;
-
- _pos = __signedLongIntVal(pos);
- _pos = _pos - __intVal( @global(PositionableStream:ZeroPosition)) + 1;
- _readLimit = __signedLongIntVal(lim);
- if (_pos > _readLimit) {
- RETURN (true);
- }
+ if (lim != nil && __signedLongIntVal(__INST(position)) >= __signedLongIntVal(lim)) {
+ RETURN (true);
}
__INST(lastErrorNumber) = nil;
@@ -5627,10 +5586,8 @@
if (_buffered) {
__READING__(f);
- } else {
- if (__INST(readAhead) != nil) {
- RETURN (false);
- }
+ } else if (__INST(readAhead) != nil) {
+ RETURN (false);
}
/*
@@ -5643,7 +5600,7 @@
__BEGIN_INTERRUPTABLE__
__READBYTE__(ret, f, &c, _buffered, __INST(handleType));
__END_INTERRUPTABLE__
-#endif
+#endif /* not __win32__ */
} while ((ret < 0) && (__threadErrno == EINTR));
if (ret > 0) {
__UNGETC__(c&0xff, f, _buffered);
@@ -5674,18 +5631,18 @@
We know, that error conditions do not block, so return true for errors."
^ readAhead notNil
- or:[handle isNil
- or:[mode == #writeonly
- or:[OperatingSystem readCheck:self fileDescriptor]]]
+ or:[handle isNil
+ or:[mode == #writeonly
+ or:[OperatingSystem readCheck:self fileHandle]]]
"
|pipe|
pipe := PipeStream readingFrom:'(sleep 10; echo hello)'.
pipe canReadWithoutBlocking ifTrue:[
- Transcript showCR:'data available'
+ Transcript showCR:'data available'
] ifFalse:[
- Transcript showCR:'no data available'
+ Transcript showCR:'no data available'
].
pipe close
"
@@ -5699,14 +5656,14 @@
We know, that error conditions do not block, so return true for errors."
^ handle isNil
- or:[mode == #readonly
- or:[OperatingSystem writeCheck:self fileDescriptor]]
+ or:[mode == #readonly
+ or:[OperatingSystem writeCheck:self fileHandle]]
!
gotErrorOrEOF
"answer true, if amn error or eof has been occurred on the stream"
- ^ hitEOF == true or:[lastErrorNumber notNil]
+ ^ hitEOF or:[lastErrorNumber notNil]
!
isBinary
@@ -5739,13 +5696,13 @@
isReadable
"return true, if this stream can be read from"
- ^ (mode ~~ #writeonly)
+ ^ mode ~~ #writeonly
!
isWritable
"return true, if this stream can be written to"
- ^ (mode ~~ #readonly)
+ ^ mode ~~ #readonly
! !
!ExternalStream methodsFor:'waiting for I/O'!
@@ -5767,14 +5724,15 @@
mode == #writeonly ifTrue:[
^ self errorWriteOnly
].
- available := OperatingSystem numAvailableForReadOn:self fileDescriptor.
+ available := OperatingSystem numAvailableForReadOn:self fileHandle.
readAhead notNil ifTrue:[
available := available + 1
].
^ available.
"
- '/etc/hosts' asFilename readStream bytesAvailable"
+ '/etc/hosts' asFilename readStream numAvailableForRead
+ "
!
readWaitWithTimeoutMs:timeoutOrNil
@@ -5791,7 +5749,7 @@
handle isNil ifTrue:[^ self errorNotOpen].
mode == #writeonly ifTrue:[^ self errorWriteOnly].
- fd := self fileDescriptor.
+ fd := self fileHandle.
(OperatingSystem readCheck:fd) ifTrue:[^ false].
"cannot do a readWait (which means possible suspend),
@@ -5837,7 +5795,7 @@
^ self errorNotOpen
].
- fd := self fileDescriptor.
+ fd := self fileHandle.
(OperatingSystem readWriteCheck:fd) ifTrue:[^ false].
wasBlocked := OperatingSystem blockInterrupts.
@@ -5875,7 +5833,7 @@
^ self errorNotOpen
].
- fd := self fileDescriptor.
+ fd := self fileHandle.
(OperatingSystem writeExceptionCheck:fd) ifTrue:[^ false].
wasBlocked := OperatingSystem blockInterrupts.
@@ -5916,7 +5874,7 @@
^ self errorReadOnly
].
- fd := self fileDescriptor.
+ fd := self fileHandle.
(OperatingSystem writeCheck:fd) ifTrue:[^ false].
wasBlocked := OperatingSystem blockInterrupts.
@@ -6008,7 +5966,7 @@
lastErrorNumber notNil ifTrue:[self writeError. ^ self].
handle isNil ifTrue:[self errorNotOpen. ^ self].
(mode == #readonly) ifTrue:[self errorReadOnly. ^ self].
- (binary==true) ifTrue:[self errorBinary. ^ self].
+ binary ifTrue:[self errorBinary. ^ self].
(eolMode == #cr) ifTrue:[
self nextPut:(Character return).
@@ -6071,9 +6029,9 @@
if ((handle != STObject.Nil)
&& (aCharacter.isSTCharacter())) {
- handle.writeChar( aCharacter );
- self.instVarAt_put(I_position, STObject.Nil);
- return __c__._RETURN_self();
+ handle.writeChar( aCharacter );
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN_self();
}
#else
__INST(lastErrorNumber) = nil;
@@ -6082,112 +6040,109 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- OBJ fp;
-
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(readonly))
- ) {
- FILEPOINTER f = __FILEVal(fp);
- int _buffered = (__INST(buffered) == true);
- unsigned codePoint;
- unsigned char c;
- int cnt;
- char buff[2];
- int nBytes = 1;
-
- if (__INST(binary) != true) {
- if (__isCharacter(aCharacter)) {
-
- codePoint = __intVal(__characterVal(aCharacter));
- if (codePoint <= 0xFF) {
- c = codePoint;
- buff[0] = c; nBytes = 1;
-
- if (c == '\n') {
- OBJ mode = __INST(eolMode);
- if (mode == @symbol(nl)) {
- // no EOL translation
- } else if (mode == nil) {
- // no EOL translation
- } else if (mode == @symbol(cr)) {
- buff[0] = '\r';
- } else if (mode == @symbol(eot)) {
- buff[0] = '\004';
- } else if (mode == @symbol(etx)) {
- buff[0] = '\003';
- } else if (mode == @symbol(crlf)) {
- buff[0] = '\r';
- buff[1] = '\n';
- nBytes = 2;
- }
- }
+ OBJ fp;
+
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(readonly))
+ ) {
+ FILEPOINTER f = __FILEVal(fp);
+ int _buffered = (__INST(buffered) == true);
+ int cnt;
+ char buff[2];
+ int nBytes = 1;
+
+ if (__INST(binary) != true) {
+ if (__isCharacter(aCharacter)) {
+ unsigned int codePoint = __intVal(__characterVal(aCharacter));
+ if (codePoint <= 0xFF) {
+ unsigned char c = codePoint;
+ buff[0] = c; nBytes = 1;
+
+ if (c == '\n') {
+ OBJ mode = __INST(eolMode);
+ if (mode == @symbol(nl)) {
+ // no EOL translation
+ } else if (mode == nil) {
+ // no EOL translation
+ } else if (mode == @symbol(cr)) {
+ buff[0] = '\r';
+ } else if (mode == @symbol(eot)) {
+ buff[0] = '\004';
+ } else if (mode == @symbol(etx)) {
+ buff[0] = '\003';
+ } else if (mode == @symbol(crlf)) {
+ buff[0] = '\r';
+ buff[1] = '\n';
+ nBytes = 2;
+ }
+ }
doWrite:
- if (! f) {
- fprintf(stderr, "oops - fileHandle is NULL in nextPut:\n");
- __INST(handle) = nil;
- goto out;
- }
-
- if (_buffered) {
- __WRITING__(f)
- }
+ if (! f) {
+ fprintf(stderr, "oops - fileHandle is NULL in nextPut:\n");
+ __INST(handle) = nil;
+ goto out;
+ }
+
+ if (_buffered) {
+ __WRITING__(f)
+ }
#if defined(WIN32) && !defined(__MINGW__)
- if ((f == __win32_stdout()) || (f == __win32_stderr())) {
- cnt = __win32_fwrite(buff, 1, nBytes, f);
- } else
+ if ((f == __win32_stdout()) || (f == __win32_stderr())) {
+ cnt = __win32_fwrite(buff, 1, nBytes, f);
+ } else
# endif
- {
- __WRITEBYTES__(cnt, f, buff, nBytes, _buffered, __INST(handleType));
- }
- if (cnt == nBytes) {
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + nBytes;
- OBJ t;
-
- t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- RETURN ( self );
- }
- error = __mkSmallInteger(__threadErrno);
- }
- }
- } else {
- if (__isSmallInteger(aCharacter)) {
- c = __intVal(aCharacter);
- buff[0] = c; nBytes = 1;
- goto doWrite;
- }
- }
- }
+ {
+ __WRITEBYTES__(cnt, f, buff, nBytes, _buffered, __INST(handleType));
+ }
+ if (cnt == nBytes) {
+ if (__isSmallInteger(__INST(position))) {
+ INT np = __intVal(__INST(position)) + nBytes;
+ OBJ t;
+
+ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ RETURN ( self );
+ }
+ error = __mkSmallInteger(__threadErrno);
+ }
+ }
+ } else {
+ if (__isSmallInteger(aCharacter)) {
+ unsigned char c = __intVal(aCharacter);
+ buff[0] = c; nBytes = 1;
+ goto doWrite;
+ }
+ }
+ }
}
out: ;
#endif /* not SCHTEAM */
%}.
error notNil ifTrue:[
- lastErrorNumber := error.
- self writeError:error.
- ^ self
+ lastErrorNumber := error.
+ self writeError:error.
+ ^ self
].
handle isNil ifTrue:[self errorNotOpen. ^ self].
(mode == #readonly) ifTrue:[self errorReadOnly. ^ self].
- binary == true ifFalse:[
- (aCharacter isCharacter not
- or:[aCharacter codePoint > 16rFF]) ifTrue:[
- self argumentMustBeCharacter.
- ^ self.
- ].
- ] ifTrue:[
- aCharacter isInteger ifFalse:[
- self argumentMustBeInteger.
- ^ self.
- ].
+ binary == true ifTrue:[
+ aCharacter isInteger ifFalse:[
+ self argumentMustBeInteger.
+ ^ self.
+ ].
+ ] ifFalse:[
+ (aCharacter isCharacter not
+ or:[aCharacter codePoint > 16rFF]) ifTrue:[
+ self argumentMustBeCharacter.
+ ^ self.
+ ].
].
"/ migration support
self
- nextPutByte:aCharacter asInteger
- toFile:handle
+ nextPutByte:aCharacter asInteger
+ toFile:handle
!
nextPutAll:aCollection
@@ -6762,100 +6717,6 @@
"normal streams can not handle multi-byte characters, so convert them to utf8"
self nextPutUtf8:aCharacter.
-!
-
-old_nextPut:aCharacter
- "write the argument, aCharacter - return nil if failed, self if ok.
- Only single-byte characters are currently supported"
-
- |error|
-%{
- OBJ fp;
-
- __INST(lastErrorNumber) = nil;
- if ((__INST(handleType) == nil)
- || (__INST(handleType) == @symbol(filePointer))
- || (__INST(handleType) == @symbol(socketFilePointer))
- || (__INST(handleType) == @symbol(socketHandle))
- || (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(readonly))
- ) {
- unsigned char c;
- int _buffered = (__INST(buffered) == true);
- FILEPOINTER f = __FILEVal(fp);
-
- if (__INST(binary) != true) {
- if (__isCharacter(aCharacter)) {
- unsigned codePoint = __intVal(__characterVal(aCharacter));
-
- if (codePoint <= 0xFF) {
- int cnt;
-
- c = codePoint;
- doWrite:
- if (! f) {
- fprintf(stderr, "oops - fileHandle is NULL in nextPut:\n");
- __INST(handle) = nil;
- goto out;
- }
-
- if (_buffered) {
- __WRITING__(f)
- }
-#if defined(WIN32) && !defined(__MINGW__)
- if ((f == __win32_stdout()) || (f == __win32_stderr())) {
- cnt = __win32_fwrite(&c, 1, 1, f);
- } else
-#endif
- __WRITEBYTE__(cnt, f, &c, _buffered, __INST(handleType));
- if (cnt == 1) {
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + 1;
- OBJ t;
-
- t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- RETURN ( self );
- }
- error = __mkSmallInteger(__threadErrno);
- }
- }
- } else {
- if (__isSmallInteger(aCharacter)) {
- c = __intVal(aCharacter);
- goto doWrite;
- }
- }
- }
- }
-out: ;
-%}.
- error notNil ifTrue:[
- lastErrorNumber := error.
- self writeError:error.
- ^ self
- ].
- handle isNil ifTrue:[self errorNotOpen. ^ self].
- (mode == #readonly) ifTrue:[self errorReadOnly. ^ self].
- binary == true ifFalse:[
- (aCharacter isCharacter not
- or:[aCharacter codePoint > 16rFF]) ifTrue:[
- self argumentMustBeCharacter.
- ^ self.
- ].
- ] ifTrue:[
- aCharacter isInteger ifFalse:[
- self argumentMustBeInteger.
- ^ self.
- ].
- ].
- "/ migration support
- self
- nextPutByte:aCharacter asInteger
- toFile:handle
! !
!ExternalStream class methodsFor:'documentation'!
--- a/FileStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/FileStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -754,19 +754,21 @@
which is normally retrieved by Filename>>#accessRights
or FileStreamm>>#accessRights."
- (OperatingSystem changeAccessModeOfFd:self fileDescriptor to:opaqueData) ifFalse:[
- ^ self fileName accessDeniedError:self
+ (OperatingSystem changeAccessModeOfFd:self fileHandle to:opaqueData) ifFalse:[
+ OperatingSystem accessDeniedErrorSignal
+ raiseRequestWith:self
+ errorString:(' - cannot change access rights: ' , self pathName).
].
"
'Make.proto' asFilename readingFileDo:[:s|
- s accessRights:s accessRights
+ s accessRights:s accessRights
]
"
"
'/' asFilename readingFileDo:[:s|
- s accessRights:s accessRights
+ s accessRights:s accessRights
]
"
! !
@@ -895,19 +897,19 @@
Therefore, this method is reimplemented here (from ExternalStream)"
outStream isExternalStream ifTrue:[
- pos := self position.
- n := self size - pos.
- nWritten := OperatingSystem
- copyFromFd:self fileDescriptor
- toFd:outStream fileDescriptor
- startIndex:pos
- count:n.
- nWritten > 0 ifTrue:[
- self position:pos+nWritten.
- ].
- nWritten = n ifTrue:[
- ^ self
- ].
+ pos := self position.
+ n := self size - pos.
+ nWritten := OperatingSystem
+ copyFromFd:self fileHandle
+ toFd:outStream fileHandle
+ startIndex:pos
+ count:n.
+ nWritten > 0 ifTrue:[
+ self position:pos+nWritten.
+ ].
+ nWritten = n ifTrue:[
+ ^ self
+ ].
].
^ super copyToEndInto:outStream bufferSize:bufferSize.
--- a/Filename.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Filename.st Mon Feb 13 21:29:46 2017 +0000
@@ -4580,11 +4580,24 @@
!Filename methodsFor:'private-accessing'!
getName
+ <resource: #obsolete>
"get the raw filename"
^ nameString
!
+nameString
+ "raw access to nameString - req'd for xml-store/reload"
+
+ ^ nameString
+!
+
+nameString:aString
+ "raw access to nameString - req'd for xml-store/reload"
+
+ nameString := aString
+!
+
setName:aString
"set the filename"
@@ -5588,18 +5601,6 @@
"Modified: 18.1.1996 / 21:36:27 / cg"
!
-nameString
- "raw access to nameString - req'd for xml-store/reload"
-
- ^ nameString
-!
-
-nameString:aString
- "raw access to nameString - req'd for xml-store/reload"
-
- nameString := aString
-!
-
pathName
"return the full pathname of the file represented by the receiver,
as a string. This will not include ..'s.
--- a/Float.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Float.st Mon Feb 13 21:29:46 2017 +0000
@@ -777,6 +777,7 @@
"
! !
+
!Float class methodsFor:'queries'!
exponentCharacter
@@ -831,6 +832,7 @@
^ 2 "must be careful here, whenever ST/X is used on VAX or a 370"
! !
+
!Float methodsFor:'arithmetic'!
* aNumber
@@ -1545,6 +1547,10 @@
read: http://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
"
+ Epsilon isNil ifTrue:[
+ Epsilon := self class computeEpsilon.
+ ].
+
%{ /* NOCONTEXT */
/*
@@ -1559,29 +1565,29 @@
INT64 ulpDiff;
union {
- double d;
- INT64 i;
+ double d;
+ INT64 i;
} myself, otherFloat;
int nEpsilon;
double scaledEpsilon;
if (!__isSmallInteger(nE)) {
- goto tryHarder;
+ goto tryHarder;
}
nEpsilon = __intVal(nE);
scaledEpsilon = nEpsilon *__floatVal(@global(Epsilon));
if (__isSmallInteger(aNumber)) {
- otherFloat.d = (double)(__intVal(aNumber));
+ otherFloat.d = (double)(__intVal(aNumber));
} else if (aNumber == nil) {
- RETURN(false)
+ RETURN(false)
} else if (__qIsFloatLike(aNumber)) {
- otherFloat.d = (double)(__floatVal(aNumber));
+ otherFloat.d = (double)(__floatVal(aNumber));
} else if (__qIsShortFloat(aNumber)) {
- otherFloat.d = (double)(__shortFloatVal(aNumber));
+ otherFloat.d = (double)(__shortFloatVal(aNumber));
} else {
- goto tryHarder;
+ goto tryHarder;
}
myself.d = __floatVal(self);
@@ -1589,12 +1595,12 @@
// Check if the numbers are really close -- needed
// when comparing numbers near zero (ULP method below fails for numbers near 0!).
if (fabs(myself.d - otherFloat.d) <= scaledEpsilon) {
- RETURN(true);
+ RETURN(true);
}
// if the signs differ, the numbers are different
if ((myself.d >= 0) != (otherFloat.d >= 0)) {
- RETURN(false);
+ RETURN(false);
}
// compute the difference of the 'units in the last place" ULP
@@ -1602,9 +1608,9 @@
ulpDiff = myself.i - otherFloat.i;
if (ulpDiff < 0) ulpDiff = -ulpDiff;
if (ulpDiff <= nEpsilon) {
- RETURN(true);
+ RETURN(true);
} else {
- RETURN(false)
+ RETURN(false)
}
tryHarder:;
@@ -1612,13 +1618,13 @@
^ aNumber isAlmostEqualToFromFloat:self nEpsilon:nE
"
- 67329.234 isAlmostEqualTo:67329.23400000001 nEpsilon:1
- 1.0 isAlmostEqualTo:1.0001 nEpsilon:1
- 1.0 isAlmostEqualTo:-1.0 nEpsilon:1
- 1 isAlmostEqualTo:1.000000000000001 nEpsilon:1
- 1 isAlmostEqualTo:1.000000000000001 nEpsilon:10
- 1.0 isAlmostEqualTo:1 nEpsilon:1
- 1.0 isAlmostEqualTo:1 asFraction nEpsilon:1
+ 67329.234 isAlmostEqualTo:67329.23400000001 nEpsilon:1
+ 1.0 isAlmostEqualTo:1.0001 nEpsilon:1
+ 1.0 isAlmostEqualTo:-1.0 nEpsilon:1
+ 1 isAlmostEqualTo:1.000000000000001 nEpsilon:1
+ 1 isAlmostEqualTo:1.000000000000001 nEpsilon:10
+ 1.0 isAlmostEqualTo:1 nEpsilon:1
+ 1.0 isAlmostEqualTo:1 asFraction nEpsilon:1
"
!
@@ -2344,6 +2350,7 @@
"
! !
+
!Float methodsFor:'testing'!
isFinite
--- a/Infinity.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Infinity.st Mon Feb 13 21:29:46 2017 +0000
@@ -197,7 +197,7 @@
!
- aNumber
- "Subtracet aNumber from the receiver and answer the result."
+ "Subtract aNumber from the receiver and answer the result."
(aNumber isInfinite and:[aNumber sign == self sign]) ifTrue: [
self errorUndefinedResult: #-.
@@ -316,6 +316,13 @@
^ self negated
!
+equalFromSomeNumber:aNumber
+ "Sent from aNumber = self, if aNumber does not know how to handle this.
+ Return true if aNumber = self."
+
+ ^ aNumber isInfinite and:[self sign == aNumber sign]
+!
+
lessFromSomeNumber:aNumber
"Sent from aNumber < self, if aNumber does not know how to handle this.
Return true if aNumber < self."
--- a/LimitedPrecisionReal.st Fri Dec 09 22:31:28 2016 +0000
+++ b/LimitedPrecisionReal.st Mon Feb 13 21:29:46 2017 +0000
@@ -312,7 +312,7 @@
|num|
- num := super readFrom:aStringOrStream onError:exceptionBlock.
+ num := super readFrom:aStringOrStream onError:[^ exceptionBlock value].
^ self coerce:num
"
@@ -327,6 +327,10 @@
LongFloat readFrom:'.1'
LongFloat readFrom:'0.1'
LongFloat readFrom:'0'
+
+ LimitedPrecisionReal readFrom:'bla' onError:nil
+ Float readFrom:'bla' onError:nil
+ ShortFloat readFrom:'bla' onError:nil
"
"Created: / 07-01-1998 / 16:17:19 / cg"
@@ -1193,6 +1197,7 @@
! !
+
!LimitedPrecisionReal methodsFor:'printing & storing'!
printOn:aStream
@@ -1263,6 +1268,7 @@
^ 0
! !
+
!LimitedPrecisionReal methodsFor:'testing'!
isFinite
--- a/Lookup.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Lookup.st Mon Feb 13 21:29:46 2017 +0000
@@ -89,7 +89,7 @@
|cls md method|
"Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
+ It is not necessary, however it speeds up UI code,
since it heavily uses perform:"
%{
RETURN ( __lookup(initialSearchClass, selector) );
@@ -128,15 +128,13 @@
|cls md method|
"Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
+ It is not necessary, however it speeds up UI code,
since it heavily uses perform:"
%{
RETURN ( __lookup(initialSearchClass, selector) );
%}.
^ self lookupMethodForSelector: selector
- directedTo: initialSearchClass
-
-
+ directedTo: initialSearchClass
!
lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache
@@ -157,7 +155,7 @@
| method |
"Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
+ It is not necessary, however it speeds up UI code,
since it heavily uses perform:"
%{
method = __lookup(initialSearchClass, selector);
--- a/MD5Stream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/MD5Stream.st Mon Feb 13 21:29:46 2017 +0000
@@ -67,6 +67,7 @@
performance: roughly
+ 150 Mb/s on a 2007 MAC Powerbook (2.6Ghz I7-Duo)
104000 Kb/s on a 2.5Ghz 64X2 Athlon 4800+ (64bit)
80000 Kb/s on a 2Ghz Duo
27200 Kb/s on a 1.2Ghz Athlon
--- a/Magnitude.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Magnitude.st Mon Feb 13 21:29:46 2017 +0000
@@ -39,7 +39,7 @@
documentation
"
This is an abstract class definining common methods for
- Objects which can be compared by a kind of less than relation.
+ Objects which can be compared by a kind of less-than relation.
[author:]
Claus Gittinger
--- a/Make.proto Fri Dec 09 22:31:28 2016 +0000
+++ b/Make.proto Mon Feb 13 21:29:46 2017 +0000
@@ -173,7 +173,6 @@
$(OUTDIR)Message.$(O) Message.$(C) Message.$(H): Message.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)MiniDebugger.$(O) MiniDebugger.$(C) MiniDebugger.$(H): MiniDebugger.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)MiniInspector.$(O) MiniInspector.$(C) MiniInspector.$(H): MiniInspector.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)MiniLogger.$(O) MiniLogger.$(C) MiniLogger.$(H): MiniLogger.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)NameSpace.$(O) NameSpace.$(C) NameSpace.$(H): NameSpace.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)OSErrorHolder.$(O) OSErrorHolder.$(C) OSErrorHolder.$(H): OSErrorHolder.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)OSProcess.$(O) OSProcess.$(C) OSProcess.$(H): OSProcess.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -212,6 +211,7 @@
$(OUTDIR)CompiledCode.$(O) CompiledCode.$(C) CompiledCode.$(H): CompiledCode.st $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ControlInterrupt.$(O) ControlInterrupt.$(C) ControlInterrupt.$(H): ControlInterrupt.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)Date.$(O) Date.$(C) Date.$(H): Date.st $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)EventSemaphore.$(O) EventSemaphore.$(C) EventSemaphore.$(H): EventSemaphore.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Semaphore.$(H) $(STCHDR)
$(OUTDIR)Exception.$(O) Exception.$(C) Exception.$(H): Exception.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ExternalFunction.$(O) ExternalFunction.$(C) ExternalFunction.$(H): ExternalFunction.st $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)False.$(O) False.$(C) False.$(H): False.st $(INCLUDE_TOP)/stx/libbasic/Boolean.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -223,6 +223,7 @@
$(OUTDIR)LibraryDefinition.$(O) LibraryDefinition.$(C) LibraryDefinition.$(H): LibraryDefinition.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
$(OUTDIR)LookupKey.$(O) LookupKey.$(C) LookupKey.$(H): LookupKey.st $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)MessageSend.$(O) MessageSend.$(C) MessageSend.$(H): MessageSend.st $(INCLUDE_TOP)/stx/libbasic/Message.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)MiniLogger.$(O) MiniLogger.$(C) MiniLogger.$(H): MiniLogger.st $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)NamespaceAwareLookup.$(O) NamespaceAwareLookup.$(C) NamespaceAwareLookup.$(H): NamespaceAwareLookup.st $(INCLUDE_TOP)/stx/libbasic/Lookup.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)NoHandlerError.$(O) NoHandlerError.$(C) NoHandlerError.$(H): NoHandlerError.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)Notification.$(O) Notification.$(C) Notification.$(H): Notification.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/Make.spec Fri Dec 09 22:31:28 2016 +0000
+++ b/Make.spec Mon Feb 13 21:29:46 2017 +0000
@@ -83,7 +83,6 @@
Message \
MiniDebugger \
MiniInspector \
- MiniLogger \
NameSpace \
OSErrorHolder \
OSProcess \
@@ -122,6 +121,7 @@
CompiledCode \
ControlInterrupt \
Date \
+ EventSemaphore \
Exception \
ExternalFunction \
False \
@@ -133,6 +133,7 @@
LibraryDefinition \
LookupKey \
MessageSend \
+ MiniLogger \
NamespaceAwareLookup \
NoHandlerError \
Notification \
@@ -420,7 +421,6 @@
BadRomanNumberFormatError \
WIN32_CLASSES= \
- Win32Process \
PCFilename \
Win32Constants \
Win32Handle \
@@ -474,7 +474,6 @@
$(OUTDIR_SLASH)Message.$(O) \
$(OUTDIR_SLASH)MiniDebugger.$(O) \
$(OUTDIR_SLASH)MiniInspector.$(O) \
- $(OUTDIR_SLASH)MiniLogger.$(O) \
$(OUTDIR_SLASH)NameSpace.$(O) \
$(OUTDIR_SLASH)OSErrorHolder.$(O) \
$(OUTDIR_SLASH)OSProcess.$(O) \
@@ -513,6 +512,7 @@
$(OUTDIR_SLASH)CompiledCode.$(O) \
$(OUTDIR_SLASH)ControlInterrupt.$(O) \
$(OUTDIR_SLASH)Date.$(O) \
+ $(OUTDIR_SLASH)EventSemaphore.$(O) \
$(OUTDIR_SLASH)Exception.$(O) \
$(OUTDIR_SLASH)ExternalFunction.$(O) \
$(OUTDIR_SLASH)False.$(O) \
@@ -524,6 +524,7 @@
$(OUTDIR_SLASH)LibraryDefinition.$(O) \
$(OUTDIR_SLASH)LookupKey.$(O) \
$(OUTDIR_SLASH)MessageSend.$(O) \
+ $(OUTDIR_SLASH)MiniLogger.$(O) \
$(OUTDIR_SLASH)NamespaceAwareLookup.$(O) \
$(OUTDIR_SLASH)NoHandlerError.$(O) \
$(OUTDIR_SLASH)Notification.$(O) \
@@ -811,7 +812,6 @@
$(OUTDIR_SLASH)BadRomanNumberFormatError.$(O) \
WIN32_OBJS= \
- $(OUTDIR_SLASH)Win32Process.$(O) \
$(OUTDIR_SLASH)PCFilename.$(O) \
$(OUTDIR_SLASH)Win32Constants.$(O) \
$(OUTDIR_SLASH)Win32Handle.$(O) \
--- a/Method.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Method.st Mon Feb 13 21:29:46 2017 +0000
@@ -1059,6 +1059,7 @@
"Modified (format): / 18-11-2011 / 14:47:06 / cg"
! !
+
!Method methodsFor:'accessing-visibility'!
isIgnored
@@ -1980,7 +1981,8 @@
classAndSelector notNil ifTrue:[
(classAndSelector methodClass) name printOn:aStream.
"/ print out in a form that can directly be evaluated (>> is a selector in Behavior)
- "/ aStream nextPutAll:' '.
+ "/ in order to not break existing code which parses those strings,
+ "/ do not replace '>>' by ' '
aStream nextPutAll:' >> '.
(classAndSelector methodSelector) printOn:aStream.
] ifFalse:[
@@ -2027,6 +2029,27 @@
"
"Modified: 1.11.1996 / 16:27:04 / cg"
+!
+
+whoStringWith:sep
+ "return a string like className>>selector,
+ if this is not an unbound method.
+ Otherwise return 'unbound'. Used with debugging."
+
+ |who|
+
+ who := self who.
+ who notNil ifTrue:[
+ ^ who methodClass name , sep , (who methodSelector storeString)
+ ].
+ ^ 'unboundMethod'
+
+ "
+ Method new whoStringWith:' >> '
+ (Method compiledMethodAt:#whoString) whoStringWith:' >> '
+ (Method compiledMethodAt:#whoString) whoStringWith:' '
+ (Method compiledMethodAt:#whoString) whoStringWith:' -> '
+ "
! !
!Method methodsFor:'private'!
@@ -3760,6 +3783,7 @@
"Created: / 23-07-2012 / 11:16:36 / cg"
! !
+
!Method methodsFor:'source management'!
revisionInfo
--- a/MethodDictionary.st Fri Dec 09 22:31:28 2016 +0000
+++ b/MethodDictionary.st Mon Feb 13 21:29:46 2017 +0000
@@ -235,22 +235,6 @@
!MethodDictionary methodsFor:'enumerating'!
-collect:aBlock
- "for each element in the receiver, evaluate the argument, aBlock
- and return a Bag with the results."
-
- |newCollection|
-
- newCollection := Bag new.
- self do:[:value |
- newCollection add:(aBlock value:value)
- ].
- ^ newCollection
-
- "Created: / 24-06-1996 / 17:41:41 / cg"
- "Modified: / 08-08-2006 / 16:12:04 / cg"
-!
-
do:aBlock
"evaluate aBlock for each value (i.e. each method)"
@@ -330,6 +314,12 @@
"return the number of elements (associations) in the receiver"
^ self basicSize // 2
+!
+
+speciesForCollecting
+ ^ Bag
+
+ "Created: / 20-01-2017 / 18:07:53 / stefan"
! !
!MethodDictionary methodsFor:'removing'!
--- a/NamespaceAwareLookup.st Fri Dec 09 22:31:28 2016 +0000
+++ b/NamespaceAwareLookup.st Mon Feb 13 21:29:46 2017 +0000
@@ -89,11 +89,11 @@
"JV @ 2010-07-24
Following C code is just a performance optimization.
- It is not neccessary, however it speeds things in most
+ It is not necessary, however it speeds things in most
cases. Such optimization significantly speeds up the IDE
since class browser involves dozens of super-polymorphic
sends (> 1000 receiver classes per send-site).
- "
+ "
%{
OBJ sendingMthd = nil;
@@ -110,17 +110,16 @@
}
if (__Class(sendingMthd) == Method &&
- __MethodInstPtr(sendingMthd)->m_annotation == nil) {
- OBJ m = __lookup(initialSearchClass, selector);
- if (m != nil) RETURN ( m );
+ __MethodInstPtr(sendingMthd)->m_annotation == nil) {
+ OBJ m = __lookup(initialSearchClass, selector);
+ if (m != nil) RETURN ( m );
}
%}.
^Instance lookupMethodForSelector: selector directedTo: initialSearchClass
- for: receiver withArguments: argArrayOrNil
- from: sendingContext
+ for: receiver withArguments: argArrayOrNil
+ from: sendingContext
ilc: ilc
-
! !
!NamespaceAwareLookup methodsFor:'lookup'!
@@ -133,7 +132,7 @@
"JV @ 2010-07-24
Following C code is just a performance optimization.
- It is not neccessary, however it speeds things in most
+ It is not necessary, however it speeds things in most
cases. Such optimization significantly speeds up the IDE
since class browser involves dozens of super-polymorphic
sends (> 1000 receiver classes per send-site).
@@ -423,7 +422,7 @@
!NamespaceAwareLookup class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NamespaceAwareLookup.st,v 1.4 2015-05-18 00:05:38 cg Exp $'
+ ^ '$Header$'
!
version_HG
@@ -432,7 +431,7 @@
!
version_SVN
- ^ '$Id: NamespaceAwareLookup.st,v 1.4 2015-05-18 00:05:38 cg Exp $'
+ ^ '$Id$'
! !
--- a/NoHandlerError.st Fri Dec 09 22:31:28 2016 +0000
+++ b/NoHandlerError.st Mon Feb 13 21:29:46 2017 +0000
@@ -520,6 +520,7 @@
!
unhandledException
+ <resource: #obsolete>
"the original exception, which was responsible for this.
Obsolete: use #exception for ANSI comatibility."
--- a/NonPositionableExternalStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/NonPositionableExternalStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -116,6 +116,62 @@
^ StdOutStream
!
+makeBidirectionalPipe
+ "return an array with two streams - the first one for reading,
+ the second for writing.
+ This is the higher level equivalent of OperatingSystem>>makeBidirectionalPipe
+ (which returns an array of file-descriptors)."
+
+ |pipe rs ws|
+
+ pipe := OperatingSystem makeBidirectionalPipe.
+ pipe isNil ifTrue:[
+ "/ ok, maybe someone has forgotten to close a stream; enforce finalization and try again
+ 'makePipe: enforcing finalization to close any open streams' infoPrintCR.
+ ObjectMemory garbageCollect; finalize.
+ pipe := OperatingSystem makeBidirectionalPipe.
+ ].
+
+ pipe isNil ifTrue:[
+ |errorNumber errorHolder|
+
+ errorNumber := OperatingSystem lastErrorNumber.
+ errorHolder := errorNumber.
+ OpenError newException
+ errorCode:errorNumber;
+ osErrorHolder:errorHolder;
+ raise.
+ ].
+
+ rs := NonPositionableExternalStream forFileDescriptor:(pipe at:1) mode:#readWrite buffered:false handleType:#pipeFilePointer.
+ ws := NonPositionableExternalStream forFileDescriptor:(pipe at:2) mode:#readWrite buffered:false handleType:#pipeFilePointer.
+ ^ Array with:rs with:ws
+
+ "
+ |pipe rs ws|
+
+ pipe := NonPositionableExternalStream makeBidirectionalPipe.
+ rs := pipe at:1.
+ ws := pipe at:2.
+
+ 'read ...'.
+ [
+ 1 to:10 do:[:i |
+ Transcript showCR:rs nextLine
+ ].
+ rs close.
+ ] forkAt:7.
+
+ 'write ...'.
+ [
+ 1 to:10 do:[:i |
+ ws nextPutAll:'hello world '; nextPutAll:i printString; cr
+ ].
+ ws close.
+ ] fork.
+ "
+!
+
makePTYPair
"return an array with two streams - the first one is the master,
the second the slave of a ptym/ptys pair.
@@ -129,13 +185,13 @@
ptyPair := OperatingSystem makePTYPair.
ptyPair notNil ifTrue:[
- master := self forReadWriteToFileDescriptor:(ptyPair at:1).
- master buffered:false.
- slave := self forReadWriteToFileDescriptor:(ptyPair at:2).
- slave buffered:false.
- ptyPair at:1 put:master.
- ptyPair at:2 put:slave.
- ^ ptyPair
+ master := NonPositionableExternalStream forReadWriteToFileDescriptor:(ptyPair at:1).
+ master buffered:false.
+ slave := NonPositionableExternalStream forReadWriteToFileDescriptor:(ptyPair at:2).
+ slave buffered:false.
+ ptyPair at:1 put:master.
+ ptyPair at:2 put:slave.
+ ^ ptyPair
].
^ nil
@@ -152,22 +208,30 @@
This is the higher level equivalent of OperatingSystem>>makePipe
(which returns an array of file-descriptors)."
- |pipe rs ws|
+ |pipeArray rs ws|
- pipe := OperatingSystem makePipe.
- pipe isNil ifTrue:[
- "/ ok, maybe someone has forgotten to close a stream; enforce finalization and try again
- 'makePipe: enforcing finalization to close any open streams' infoPrintCR.
- ObjectMemory garbageCollect; finalize.
- pipe := OperatingSystem makePipe.
+ pipeArray := OperatingSystem makePipe.
+ pipeArray isNil ifTrue:[
+ "/ ok, maybe someone has forgotten to close a stream; enforce finalization and try again
+ 'makePipe: enforcing finalization to close any open streams' infoPrintCR.
+ ObjectMemory garbageCollect; finalize.
+ pipeArray := OperatingSystem makePipe.
].
- pipe notNil ifTrue:[
- rs := self forFileDescriptor:(pipe at:1) mode:#readonly buffered:false handleType:#pipeFilePointer.
- ws := self forFileDescriptor:(pipe at:2) mode:#writeonly buffered:false handleType:#pipeFilePointer.
- ^ Array with:rs with:ws
+ pipeArray isNil ifTrue:[
+ |errorNumber errorHolder|
+
+ errorNumber := OperatingSystem lastErrorNumber.
+ errorHolder := errorNumber.
+ OpenError newException
+ errorCode:errorNumber;
+ osErrorHolder:errorHolder;
+ raise.
].
- ^ nil
+
+ rs := NonPositionableExternalStream forFileDescriptor:(pipeArray at:1) mode:#readonly buffered:false handleType:#pipeFilePointer.
+ ws := NonPositionableExternalStream forFileDescriptor:(pipeArray at:2) mode:#writeonly buffered:false handleType:#pipeFilePointer.
+ ^ Array with:rs with:ws
"
|pipe rs ws|
@@ -178,18 +242,18 @@
'read ...'.
[
- 1 to:10 do:[:i |
- Transcript showCR:rs nextLine
- ].
- rs close.
+ 1 to:10 do:[:i |
+ Transcript showCR:rs nextLine
+ ].
+ rs close.
] forkAt:7.
'write ...'.
[
- 1 to:10 do:[:i |
- ws nextPutAll:'hello world '; nextPutAll:i printString; cr
- ].
- ws close.
+ 1 to:10 do:[:i |
+ ws nextPutAll:'hello world '; nextPutAll:i printString; cr
+ ].
+ ws close.
] fork.
"
@@ -303,12 +367,25 @@
^ bytes signedInt32At:1 MSB:msbFlag.
!
+nextInt64MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:8.
+ nRead := self nextBytes:8 into:bytes startingAt:1.
+ nRead ~~ 8 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes signedInt64At:1 MSB:msbFlag.
+!
+
nextUnsignedInt16MSB:msbFlag
"redefined to wait for data on pipes and sockets"
|bytes nRead|
- bytes := ByteArray uninitializedNew:4.
+ bytes := ByteArray uninitializedNew:2.
nRead := self nextBytes:2 into:bytes startingAt:1.
nRead ~~ 2 ifTrue:[
^ self pastEndRead.
@@ -327,6 +404,19 @@
^ self pastEndRead.
].
^ bytes unsignedInt32At:1 MSB:msbFlag.
+!
+
+nextUnsignedInt64MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:8.
+ nRead := self nextBytes:8 into:bytes startingAt:1.
+ nRead ~~ 8 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes unsignedInt64At:1 MSB:msbFlag.
! !
!NonPositionableExternalStream methodsFor:'positioning'!
@@ -409,7 +499,7 @@
handle notNil ifTrue:[
"make sure, that no select is performed on closed file descriptors"
- semasToSignal := Processor disableFd:self fileDescriptor doSignal:false.
+ semasToSignal := Processor disableFd:self fileHandle doSignal:false.
super closeFile.
"tell the waiters that they must not wait any longer"
@@ -620,7 +710,20 @@
answerStream := WriteStream on:(String uninitializedNew:80).
[
+ "#atEnd waits for new data or EOF"
+ self atEnd ifTrue:[
+ answerStream size == 0 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ answerStream contents.
+ ].
available := self numAvailableForRead.
+ available == 0 ifTrue:[
+ "so #atEnd didn't wait above, but no data is present - check for error"
+ self peek.
+ available := self numAvailableForRead.
+ ].
+
wasBinary := binary. "temporarily set to text mode"
binary := false.
available timesRepeat:[
@@ -637,14 +740,6 @@
].
].
binary := wasBinary. "restore saved mode"
-
- "#atEnd waits for new data or EOF"
- self atEnd ifTrue:[
- answerStream size == 0 ifTrue:[
- ^ self pastEndRead.
- ].
- ^ answerStream contents.
- ].
] loop.
"not reached"
@@ -700,7 +795,17 @@
|element available "{ Class:SmallInteger }"|
[
+ "#atEnd waits for new data or EOF"
+ self atEnd ifTrue:[
+ ^ self.
+ ].
available := self numAvailableForRead.
+ available == 0 ifTrue:[
+ "so #atEnd didn't wait above, but no data is present - check for error"
+ self peek.
+ available := self numAvailableForRead.
+ ].
+
available timesRepeat:[
element := super next. "we know that there is data"
element = anObject ifTrue:[
@@ -708,10 +813,6 @@
].
aStream nextPut:element.
].
- "#atEnd waits for new data or EOF"
- self atEnd ifTrue:[
- ^ self.
- ].
] loop.
"not reached"
--- a/Number.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Number.st Mon Feb 13 21:29:46 2017 +0000
@@ -157,11 +157,25 @@
In contrast to readFrom:, no garbage is allowed after the number.
I.e. the string must contain exactly one valid number (with optional separators around)"
- ^ self readFrom:aString decimalPointCharacters:decimalPointCharacters onError:exceptionBlock
+ |s num|
+
+ s := aString readStream.
+ num := self readFrom:s decimalPointCharacters:decimalPointCharacters onError:[^ exceptionBlock value].
+ s atEnd ifFalse:[
+ s skipSeparators.
+ s atEnd ifFalse:[
+ ^ exceptionBlock value "/ - garbage at end of number'
+ ].
+ ].
+ ^ num.
"
Number fromString:'12345' onError:0
+ Number fromString:'12,345' decimalPointCharacters:',' onError:0
+ Number fromString:'12,345' decimalPointCharacters:',' onError:0
Number fromString:'fooBarBaz' onError:0
+ Number fromString:'123fooBarBaz' onError:0
+ Number fromString:'123,fooBarBaz' decimalPointCharacters:',' onError:0
"
"Modified: / 3.8.1998 / 20:05:34 / cg"
@@ -172,11 +186,12 @@
In contrast to readFrom:, no garbage is allowed after the number.
I.e. the string must contain exactly one valid number (with optional separators around)"
- ^ self readFrom:aString onError:exceptionBlock
+ ^ self fromString:aString decimalPointCharacters:(self decimalPointCharactersForReading) onError:exceptionBlock
"
Number fromString:'12345' onError:0
Number fromString:'fooBarBaz' onError:0
+ Number fromString:'123fooBarBaz' onError:0
"
"Modified: / 3.8.1998 / 20:05:34 / cg"
@@ -503,6 +518,7 @@
^ Integer readFrom:aStream radix:radix
! !
+
!Number class methodsFor:'constants'!
decimalPointCharacter
@@ -710,6 +726,7 @@
"
! !
+
!Number class methodsFor:'private'!
readMantissaAndScaleFrom:aStream radix:radix
@@ -784,6 +801,7 @@
^ self == Number
! !
+
!Number methodsFor:'Compatibility-Squeak'!
asSmallAngleDegrees
@@ -933,6 +951,7 @@
^ self rounded printString
! !
+
!Number methodsFor:'coercing & converting'!
i
@@ -1105,7 +1124,7 @@
!
degreesToRadians
- "interpreting the receiver as radians, return the degrees"
+ "interpreting the receiver as degrees, return the radians"
^ self * (Float pi / 180.0)
@@ -1138,7 +1157,7 @@
!
radiansToDegrees
- "interpreting the receiver as degrees, return the radians"
+ "interpreting the receiver as radians, return the degrees"
^ self * (180.0 / Float pi)
@@ -2791,6 +2810,7 @@
"Modified: / 5.11.2001 / 17:54:22 / cg"
! !
+
!Number class methodsFor:'documentation'!
version
--- a/OSProcess.st Fri Dec 09 22:31:28 2016 +0000
+++ b/OSProcess.st Mon Feb 13 21:29:46 2017 +0000
@@ -3,7 +3,9 @@
"{ NameSpace: Smalltalk }"
Object subclass:#OSProcess
- instanceVariableNames:'pid parentPid commandLine'
+ instanceVariableNames:'pid command environment directory inStream outStream errorStream
+ auxStream showWindow lineWise newPgrp exitStatus finishSema
+ shufflerProcesses streamsToClose terminateActionBlock'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -13,7 +15,7 @@
documentation
"
- OSProcess is an abstract class. Instances represent operating system processes
+ Instances of OSProcess represent operating system processes thatr can be executed.
(as opposed to Smalltalk processes).
[author:]
@@ -21,8 +23,7 @@
[instance variables:]
pid SmallInteger the process id
- parentPid SmallInteger the process id of the parent process
- commandLine String the command line of the running command.
+ command String the command line of the running command.
[class variables:]
@@ -30,42 +31,263 @@
Process
"
+!
+
+examples
+ "
+ |outStream|
+
+ outStream := '' writeStream.
+
+ self new
+ command:'ls -l';
+ inStream:'abc' readStream;
+ outStream:outStream;
+ lineWise:true;
+ execute.
+
+ outStream contents
+ "
+
+ "
+ |outStream|
+
+ outStream := '' writeStream.
+
+ self new
+ command:'ls -l; sleep 10; echo =================================; echo hallo after 10s; echo >&2 +++++++++++++++++++++; cat >&2';
+ inStream:'abc' readStream;
+ outStream:outStream;
+ errorStream:outStream;
+ startProcess.
+
+ outStream inspect
+ "
+
+ "
+ |outStream|
+
+ outStream := '' writeStream.
+
+ self new
+ command:'ls -l & ls -l >&2';
+ inStream:'abc' readStream;
+ outStream:outStream;
+ errorStream:outStream;
+ startProcess.
+
+ outStream inspect
+ "
+! !
+
+!OSProcess class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!OSProcess class methodsFor:'initialize'!
+
+initialize
+ "Backward compatibility"
+ Win32Process := self.
! !
!OSProcess methodsFor:'accessing'!
-accessor
- ^ self
+auxStream
+ ^ auxStream
+!
+
+auxStream:something
+ "set an auxilliary input stream that will be available to the command as
+ file descriptor 3"
+
+ auxStream := something.
+!
+
+command
+ "return the value of the instance variable 'command' (automatically generated)"
+
+ ^ command
+
+ "Created: / 10.11.1998 / 21:27:07 / cg"
+!
+
+command:aStringOrArray
+ "set the command to be executed.
+ If aStringOrArray is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.exe' in your Windows manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case."
+
+ command := aStringOrArray.
!
-commandLine
- ^ commandLine
+directory
+ "return the value of the instance variable 'directory' (automatically generated)"
+
+ ^ directory
+
+ "Created: / 10.11.1998 / 21:21:52 / cg"
+!
+
+directory:aString
+ "set the directory that will be set as the current directory of the command to be executed"
+
+ directory := aString.
+!
+
+environment
+ "return the value of the instance variable 'environment' (automatically generated)"
+
+ ^ environment
+
+ "Created: / 10.11.1998 / 21:26:34 / cg"
+!
+
+environment:aDictionary
+ "set the environment variables of the command to be executed"
+
+ environment := aDictionary.
+!
+
+errorStream
+ "return the value of the instance variable 'errorStream' (automatically generated)"
+
+ ^ errorStream
+
+ "Created: / 10.11.1998 / 21:26:34 / cg"
+!
+
+errorStream:aStream
+ "set the stream where the stderr output of the command is directed to"
+
+ errorStream := aStream.
!
-commandLine:something
- commandLine := something.
+exitStatus
+ "answer the exit status of the command or nil, if the command has not yet been finished"
+
+ ^ exitStatus
+!
+
+exitStatus:something
+ "set the value of the instance variable 'exitStatus' (automatically generated)"
+
+ exitStatus := something.
+
+ "Created: / 10.11.1998 / 21:24:55 / cg"
+!
+
+finishSema
+ "wait on this semaphore if yo want to wait until the os process has finished.
+ There may be multiple waiters, so it is a good idea to do a #waitUncounted"
+
+ ^ finishSema
+!
+
+inStream
+ "return the value of the instance variable 'inStream' (automatically generated)"
+
+ ^ inStream
+
+ "Created: / 10.11.1998 / 21:26:34 / cg"
+!
+
+inStream:aStream
+ "set the stream where the stdin input of the command is read from"
+
+ inStream := aStream.
!
-parentPid
- ^ parentPid
+lineWise
+ ^ lineWise
+!
+
+lineWise:aBoolean
+ "When setting to true, read linewise from the command's output and error.
+ This is a bit slower than lineWise = false.
+
+ You may use it also when streaming to e.g. Transcript"
+
+ lineWise := aBoolean.
+!
+
+newPgrp
+ ^ newPgrp
!
-parentPid:something
- parentPid := something.
+newPgrp:aBoolean
+ "if aBoolean is true, a new process group will be created for the command and its subprocesses"
+
+ newPgrp := aBoolean.
+!
+
+outStream
+ "return the value of the instance variable 'outStream' (automatically generated)"
+
+ ^ outStream
+
+ "Created: / 10.11.1998 / 21:26:34 / cg"
+!
+
+outStream:aStream
+ "set the stream where the stdout output of the command is directed to"
+
+ outStream := aStream.
!
pid
+ "answer the pid of the process the command is running in or nil, if the command has not yet been started."
+
^ pid
!
pid:something
pid := something.
+!
+
+showWindow
+ ^ showWindow
+!
+
+showWindow:aBooleanOrNil
+ "This parameter is ignored on Unix systems.
+
+ You can control (have to - sigh) if a window should be shown for the command or not.
+ This is the OS's H_SHOWWINDOW argument.
+ If you pass nil as showWindow-argument, the OS's default is used for the particular
+ command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+ executables will not.
+ However, some command-line executables show a window, even if they should not.
+ (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+ a shell command opens a cmd-window, whereas in windows7 it did not)
+ In this case, pass an explicit false argument to suppress it."
+
+ showWindow := aBooleanOrNil.
+!
+
+terminateActionBlock
+ ^ terminateActionBlock
+!
+
+terminateActionBlock:aBlock
+ "set the block that will be executed when the command has been finished or terminated."
+
+ terminateActionBlock := aBlock.
! !
-!OSProcess methodsFor:'file queries'!
+!OSProcess methodsFor:'initialization'!
-isExecutable:aPathName
- ^ aPathName asFilename isExecutable
+initialize
+ "Invoked when a new instance is created."
+
+ showWindow := false. "/ for backward compatibility
+ lineWise := false.
+ newPgrp := true.
! !
!OSProcess methodsFor:'printing'!
@@ -76,24 +298,130 @@
nextPut:$(.
pid printOn:aStream.
aStream space.
- commandLine printOn:aStream.
+ command printOn:aStream.
aStream nextPut:$)
! !
+!OSProcess methodsFor:'private'!
+
+setupShufflerForInput:aStream
+ "if aStream is an internal Stream, set up a pipe for the command input.
+ Start a process that shuffles tha data fron the internal stream into the pipe
+ (and into the command's input)."
+
+ |pipe externalStream shuffledStream shufflerProcess|
+
+ (aStream isNil or:[aStream isExternalStream]) ifTrue:[
+ ^ aStream.
+ ].
+
+ pipe := NonPositionableExternalStream makePipe.
+ externalStream := pipe at:1.
+ shuffledStream := pipe at:2.
+ lineWise ifFalse:[
+ shuffledStream blocking:false.
+ ].
+ aStream isBinary ifTrue:[
+ shuffledStream binary.
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ inStream to the pipe (which is connected to the commands input)
+ shufflerProcess := [
+ [
+ lineWise ifTrue:[
+ "shuffle until end-of-input"
+ [aStream atEnd] whileFalse:[
+ |data|
+
+ data := aStream nextLine.
+ data notNil ifTrue:[
+ shuffledStream nextPutLine:data.
+ shuffledStream flush.
+ ].
+ ].
+ ] ifFalse:[
+ aStream copyToEndInto:shuffledStream.
+ ].
+ ] on:WriteError do:[:ex|
+ "ignore"
+ ] ensure:[
+ shuffledStream close.
+ ]
+ ] newProcess
+ name:'OSProcess input shuffler';
+"/ beSystemProcess;
+ resume.
+
+ shufflerProcesses add:shufflerProcess.
+ streamsToClose add:externalStream.
+
+ ^ externalStream
+
+ "Modified: / 31-01-2017 / 16:50:39 / stefan"
+!
+
+setupShufflerForOutput:aStream
+ "if aStream is an internal Stream, set up a pipe for the command output.
+ Start a process that shuffles the data fron the pipe into the internal stream."
+
+ |pipe externalStream shuffledStream shufflerProcess|
+
+ (aStream isNil or:[aStream isExternalStream]) ifTrue:[
+ ^ aStream.
+ ].
+
+ pipe := NonPositionableExternalStream makePipe.
+ externalStream := pipe at:2.
+ shuffledStream := pipe at:1.
+ aStream isBinary ifTrue:[
+ shuffledStream binary.
+ ].
+
+ shufflerProcess := [
+ [
+ "shuffle until the pipe closes"
+ lineWise ifTrue:[
+ [shuffledStream atEnd] whileFalse:[
+ |data|
+
+ data := shuffledStream nextLine.
+ data notNil ifTrue:[
+ aStream nextPutLine:data
+ ].
+ ].
+ ] ifFalse:[
+ shuffledStream copyToEndInto:aStream.
+ ].
+ ] on:WriteError do:[:ex |
+ "ignore"
+ ] ensure:[
+ shuffledStream close.
+ ].
+ ] newProcess
+ priority:(Processor userSchedulingPriority "+ 1");
+ name:'OSProcess output shuffler';
+"/ beSystemProcess;
+ resume.
+
+ shufflerProcesses add:shufflerProcess.
+ streamsToClose add:externalStream.
+
+ ^ externalStream
+
+ "Modified: / 31-01-2017 / 16:57:25 / stefan"
+! !
+
!OSProcess methodsFor:'queries'!
-getProcessHandle
- "some OperatingSystems redefine this to resolve this to a processHandle
- (which must be explicitely freed later).
- Others simply return the pid here"
-
- ^ self subclassResponsibility
+finishedWithSuccess
+ ^ exitStatus notNil and:[exitStatus success].
!
isAlive
"answer true, if the process is still alive"
- ^ self subclassResponsibility
+ ^ pid notNil and:[exitStatus isNil]
!
isDead
@@ -102,30 +430,130 @@
^ self isAlive not
! !
+!OSProcess methodsFor:'starting'!
+
+execute
+ "execute the command.
+ Wait until is is finished.
+ Abort the execution if I am interrupted.
+ Answer true if the terminated succesfully,
+ false if it could not be started or terminated with error."
+
+ |ok|
+
+ [
+ ok := self startProcess.
+ ok ifTrue:[
+ self waitUntilFinished.
+ ok := self finishedWithSuccess.
+ ].
+ ] ifCurtailed:[
+ "/ we were interrupted -
+ "/ terminate the os-command (and all of its forked commands)
+ pid notNil ifTrue:[
+ self terminateGroup.
+ ].
+ ].
+ ^ ok.
+!
+
+startProcess
+ "If there are non-external streams, setup transfer (shuffler) processes
+ to transfer data from a pipe to the internal stream.
+ Start the command.
+ Answer true if the command could be started, false if not.
+ Return immediately (do not wait until the command is finished)."
+
+ |externalInStream externalAuxStream externalErrorStream externalOutStream|
+
+ shufflerProcesses := OrderedCollection new:4.
+ streamsToClose := OrderedCollection new:2.
+
+ externalInStream := self setupShufflerForInput:inStream.
+ externalAuxStream := self setupShufflerForInput:auxStream.
+ externalOutStream := self setupShufflerForOutput:outStream.
+ errorStream == outStream ifTrue:[
+ externalErrorStream := externalOutStream.
+ ] ifFalse:[
+ externalErrorStream := self setupShufflerForOutput:errorStream.
+ ].
+
+ "start the command"
+ finishSema := EventSemaphore new.
+
+ Processor
+ monitor:[
+ pid := OperatingSystem
+ startProcess:command
+ inputFrom:externalInStream
+ outputTo:externalOutStream
+ errorTo:externalErrorStream
+ auxFrom:externalAuxStream
+ environment:environment
+ inDirectory:directory
+ newPgrp:newPgrp
+ showWindow:showWindow.
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
+ pid notNil ifTrue:[
+ OperatingSystem closePid:pid.
+ ].
+"/ shufflerProcesses do:[:eachProcess|
+"/ "terminate the shuffler processes.
+"/ They close the local side of the pipe when being terminated"
+"/ eachProcess terminate.
+"/ ].
+ finishSema signal.
+ terminateActionBlock value.
+ ].
+ ].
+
+ "we can close the remote side of the pipes after the os process has been started (after the fork)"
+ streamsToClose do:[:eachStream | eachStream close].
+ streamsToClose := nil.
+
+ pid isNil ifTrue:[
+ "process could not be started - terminate shufflers"
+ shufflerProcesses do:[:eachProcess|
+ eachProcess terminate.
+ ].
+ shufflerProcesses := nil.
+ exitStatus := OperatingSystem osProcessStatusClass processCreationFailure.
+ finishSema signal.
+ ^ false.
+ ].
+
+ ^ true.
+! !
+
!OSProcess methodsFor:'terminating'!
kill
"kill the process - the process does not get the chance to clean up"
- ^ self subclassResponsibility.
+ pid notNil ifTrue:[
+ OperatingSystem killProcess:pid.
+ ].
!
killGroup
"kill the processGroup - the processes do not get the chance to clean up"
- ^ self subclassResponsibility.
-!
-
-killWithAllChildren
- "terminate gracefully the process with all of its child processes"
-
- ^ self subclassResponsibility.
+ pid notNil ifTrue:[
+ OperatingSystem
+ killProcessGroup:pid;
+ killProcess:pid.
+ ].
!
terminate
"terminate the process gracefully"
- ^ self subclassResponsibility.
+ pid notNil ifTrue:[
+ OperatingSystem terminateProcess:pid.
+ ].
!
terminateGroup
@@ -133,13 +561,35 @@
Under Windows, these is the same as terminateWithhAllChildren,
under unix, this terminates a subset of all children"
- ^ self subclassResponsibility.
+ pid notNil ifTrue:[
+ OperatingSystem
+ terminateProcessGroup:pid;
+ terminateProcess:pid.
+ ].
+! !
+
+!OSProcess methodsFor:'waiting'!
+
+waitUntilFinished
+ ^ self waitUntilFinishedWithTimeout:nil
!
-terminateWithAllChildren
- "terminate gracefully the process with all of its child processes"
+waitUntilFinishedWithTimeout:timeout
+ |processList|
+
+ (finishSema waitWithTimeout:timeout) isNil ifTrue:[
+ "timed out"
+ ^ nil.
+ ].
- ^ self subclassResponsibility.
+ "have to wait until the shufflers have finished their work"
+ processList := shufflerProcesses.
+ processList notEmptyOrNil ifTrue:[
+ processList do:[:eachProcess |
+ eachProcess waitUntilTerminated.
+ ].
+ shufflerProcesses := nil.
+ ].
! !
!OSProcess class methodsFor:'documentation'!
@@ -152,3 +602,5 @@
^ '$Header$'
! !
+
+OSProcess initialize!
--- a/Object.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Object.st Mon Feb 13 21:29:46 2017 +0000
@@ -522,16 +522,6 @@
-!Object methodsFor:'Compatibility-Dolphin'!
-
-stbFixup: anSTBInFiler at: newObjectIndex
- "Answer the true object that must be used to represent the receiver when read from anSTBInFiler.
- Typically this is overridden by subclasses of STBProxy to answer the proxied object. Other classes
- may also override this method to effectively 'one way become' the receiver to some other object"
-
- ^ self
-! !
-
!Object methodsFor:'Compatibility-GNU'!
display
@@ -551,20 +541,14 @@
!Object methodsFor:'Compatibility-ST80'!
isMetaclass
+ "same as isMeta for ST80/Squeak and VW compatibility.
+ kept in the libbasic package, because it is used often"
+
^ self isMeta
! !
!Object methodsFor:'Compatibility-Squeak'!
-becomeForward:anotherObject
- self becomeSameAs:anotherObject
-!
-
-becomeForward:anotherObject copyHash:copyHash
- copyHash ifTrue:[ self error:'unsupported operation' ].
- self becomeSameAs:anotherObject
-!
-
clone
^ self shallowCopy
!
@@ -604,13 +588,6 @@
"
!
-explore
- (self confirm:'The Squeak explorer has not yet been ported to ST/X\\Inspect instead ?' withCRs)
- ifTrue:[
- self inspect
- ]
-!
-
flag:aString
"Send this message, with a relevant symbol as argument, to flag a message for subsequent retrieval. For example, you might put the following line in a number of messages:
self flag: #returnHereUrgently
@@ -619,32 +596,11 @@
"Created: / 21-04-2015 / 15:50:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-inform: aString
- "Display a message for the user to read and then dismiss."
-
- self information:aString
-!
-
isCompiledMethod
"same as isMethod - for squeak compatibility"
- ^ false
-!
-
-isInMemory
- "All normal objects are."
-
- ^ true
-!
-
-stringForReadout
- ^ self stringRepresentation
-!
-
-stringRepresentation
- "Answer a string that represents the receiver. For most objects this is simply its printString, but for strings themselves, it's themselves. 6/12/96 sw"
-
- ^ self printString
+ "/ left in libbasic package, because it is used by refactory code
+ ^ false
!
veryDeepCopy
@@ -654,7 +610,10 @@
!Object methodsFor:'Compatibility-VW'!
isCharacters
- "added for visual works compatibility"
+ "true, if the receiver is a string-like thing.
+ added for visual works compatibility"
+
+ "/ kept in libbasic package, because it is used in libjava and imap-implementation
^ false
!
@@ -667,30 +626,8 @@
keyNotFoundError:aKey
"VW compatibility"
+ "/ kept in libbasic package, because it is used by the refactory code
self errorKeyNotFound:aKey.
-!
-
-oneWayBecome:anotherObject
- ^ self becomeSameAs:anotherObject
-
- "
- |arr o1 o2|
-
- arr := Array new:2.
- arr at:1 put:(o1 := Object new).
- arr at:2 put:(o2 := Point new).
- o1 oneWayBecome:o2.
- (arr at:1) ~~ o2 ifTrue:[self halt].
- "
- "
- |arr o1 o2|
-
- arr := Array new:2.
- arr at:1 put:(o1 := Object new).
- arr at:2 put:(o2 := Point new).
- o1 becomeSameAs:o2.
- (arr at:1) ~~ o2 ifTrue:[self halt].
- "
! !
@@ -1790,6 +1727,8 @@
"
! !
+
+
!Object methodsFor:'attributes access'!
objectAttributeAt:attributeKey
@@ -1917,6 +1856,8 @@
! !
+
+
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
@@ -2387,6 +2328,13 @@
^ Array with:self
!
+asCollectionDo:aBlock
+ "enumerate myself as a Collection.
+ Redefined in collection."
+
+ ^ aBlock value:self
+!
+
asLink
"return a valueLink for the receiver.
Used to make sure the receiver can be added to a linked list"
@@ -3392,7 +3340,9 @@
!
todo
- "used to mark code pieces that have to be implemented"
+ "used to mark code pieces that have to be implemented.
+ Halts when reached in development mode;
+ ignored in deployed production code."
<resource: #skipInDebuggersWalkBack>
@@ -3408,7 +3358,8 @@
!
todo:aBlock
- "used to mark code pieces that have to be implemented"
+ "used to mark code pieces that have to be implemented.
+ The coe in aBlock is ignored."
<resource: #skipInDebuggersWalkBack>
@@ -5317,8 +5268,10 @@
n := 0.
[con notNil and:[remaining > 0]] whileTrue:[
sender := con sender.
- '| ' errorPrint. con fullPrint.
-
+ RecursionInterruptSignal handle:[:ex |
+ ] do:[
+ '| ' _errorPrint. con fullPrint.
+ ].
nSkipped := 0.
[sender notNil and:[sender sender notNil
and:[sender selector == con selector
@@ -5329,7 +5282,7 @@
sender := con sender.
].
nSkipped > 0 ifTrue:[
- '| ... ***** ' errorPrint. nSkipped errorPrint. ' recursive contexts skipped *****' errorPrintCR.
+ '| ... ***** ' _errorPrint. nSkipped _errorPrint. ' recursive contexts skipped *****' _errorPrintCR.
].
con := sender.
remaining := remaining - 1
@@ -5367,8 +5320,8 @@
action title screen|
thisContext isRecursive ifTrue:[
- 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
- 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
+ 'Severe error: signalInterrupt while processing a signalInterrupt.' _errorPrintCR.
+ 'Terminating process ' _errorPrint. Processor activeProcess _errorPrintCR.
"/ GenericException handle:[:ex |
"/ "/ ignore any error during termination
"/ ] do:[
@@ -10524,7 +10477,7 @@
notify:aString
"launch a Notifier, telling user something.
Use #information: for ignorable messages.
- If nobody handles the exception, the dafault action of UserNotification
+ If nobody handles the exception, the default action of UserNotification
pops up a warn dialog."
@@ -10540,7 +10493,8 @@
self notify:'hello there'
"
- "Modified: 20.5.1996 / 10:28:48 / cg"
+ "Modified: / 20-05-1996 / 10:28:48 / cg"
+ "Modified (comment): / 23-01-2017 / 16:17:50 / stefan"
!
warn:aString
@@ -10588,6 +10542,7 @@
+
!Object class methodsFor:'documentation'!
version
--- a/ObjectMemory.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ObjectMemory.st Mon Feb 13 21:29:46 2017 +0000
@@ -1996,40 +1996,40 @@
|names oClass|
referent == Smalltalk ifTrue:[
- referent keysAndValuesDo:[:key :val |
- |idx|
-
- (anObject == val) ifTrue:[
- "/ for our convenience - if its a nameSpace, cut off Smalltalk.
- idx := key string indexOf:$:.
- (idx ~~ 0
- and:[idx < key string size
- and:[(key string at:(idx+1)) == $:]]) ifTrue:[
- ^ key allBold "/ (key copyFrom:(idx+2)) allBold
- ].
- ^ 'Smalltalk:' , (key allBold).
- ]
- ].
+ referent keysAndValuesDo:[:key :val |
+ |idx|
+
+ (anObject == val) ifTrue:[
+ "/ for our convenience - if its a nameSpace, cut off Smalltalk.
+ idx := key string indexOf:$:.
+ (idx ~~ 0
+ and:[idx < key string size
+ and:[(key string at:(idx+1)) == $:]]) ifTrue:[
+ ^ key allBold "/ (key copyFrom:(idx+2)) allBold
+ ].
+ ^ 'Smalltalk:' , (key allBold).
+ ]
+ ].
] ifFalse:[
- names := referent class allInstVarNames.
- oClass := referent class.
- oClass == anObject ifTrue:[
- ^ oClass name.
- ].
- 1 to:oClass instSize do:[:i |
- ((referent instVarAt:i) == anObject) ifTrue:[
- ^ '%1 [%2]' bindWith:referent classNameWithArticle with:(names at:i) allBold.
- ].
- ].
- oClass isVariable ifTrue:[
- oClass isPointers ifTrue:[
- 1 to:referent basicSize do:[:i |
- ((referent basicAt:i) == anObject) ifTrue:[
- ^ '%1 [%2] (sz=%2)' bindWith:referent classNameWithArticle with:i printString allBold with:referent basicSize printString
- ]
- ]
- ]
- ].
+ names := referent class allInstVarNames.
+ oClass := referent class.
+ oClass == anObject ifTrue:[
+ ^ oClass name.
+ ].
+ 1 to:oClass instSize do:[:i |
+ ((referent instVarAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2]' bindWith:referent class nameWithArticle with:(names at:i) allBold.
+ ].
+ ].
+ oClass isVariable ifTrue:[
+ oClass isPointers ifTrue:[
+ 1 to:referent basicSize do:[:i |
+ ((referent basicAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2] (sz=%2)' bindWith:referent class nameWithArticle with:i printString allBold with:referent basicSize printString
+ ]
+ ]
+ ]
+ ].
].
self error:'no reference' mayProceed:true.
^ nil.
--- a/OrderedDictionary.st Fri Dec 09 22:31:28 2016 +0000
+++ b/OrderedDictionary.st Mon Feb 13 21:29:46 2017 +0000
@@ -144,12 +144,8 @@
!OrderedDictionary class methodsFor:'instance creation'!
-new
- ^ super new initializeOrder
-!
-
-new: anInteger
- ^(super new: anInteger) initializeOrder
+new:anInteger
+ ^ (super new:anInteger) initializeOrder:anInteger
! !
!OrderedDictionary methodsFor:'accessing'!
@@ -317,6 +313,28 @@
"
!
+firstKey
+ "Return the first key of the receiver.
+ Raises an error if the receiver contains no elements."
+
+ ^ order first
+
+ "
+ OrderedDictionary new first
+ OrderedDictionary new firstKey
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ first
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ firstKey
+ "
+!
+
keyAt:index
"get the key at the given index"
@@ -358,6 +376,28 @@
"
!
+lastKey
+ "Return the last key of the receiver.
+ Raises an error if the receiver contains no elements."
+
+ ^ order last
+
+ "
+ OrderedDictionary new last
+ OrderedDictionary new lastKey
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ last
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ lastKey
+ "
+!
+
order
"returns the keys in the order of their appearance"
@@ -847,8 +887,8 @@
!OrderedDictionary methodsFor:'initialization'!
-initializeOrder
- order := OrderedCollection new
+initializeOrder:count
+ order := OrderedCollection new:count
! !
!OrderedDictionary methodsFor:'private'!
--- a/OrderedSet.st Fri Dec 09 22:31:28 2016 +0000
+++ b/OrderedSet.st Mon Feb 13 21:29:46 2017 +0000
@@ -108,16 +108,8 @@
!OrderedSet class methodsFor:'instance creation'!
-new
- ^super new initializeOrder
-
- "Created: / 16.11.2001 / 10:10:37 / cg"
-!
-
-new: anInteger
- ^(super new: anInteger) initializeOrder
-
- "Created: / 16.11.2001 / 10:10:07 / cg"
+new:anInteger
+ ^ (super new:anInteger) initializeOrder:anInteger
! !
!OrderedSet methodsFor:'accessing'!
@@ -259,7 +251,7 @@
"remove all elements from the receiver. Returns the receiver."
super removeAll.
- self initializeOrder.
+ self initializeOrder:0.
"Created: / 16.11.2001 / 10:21:40 / cg"
!
@@ -413,10 +405,8 @@
!OrderedSet methodsFor:'initialization'!
-initializeOrder
- order := OrderedCollection new
-
- "Created: / 16.11.2001 / 10:06:05 / cg"
+initializeOrder:count
+ order := OrderedCollection new:count
! !
!OrderedSet methodsFor:'searching'!
--- a/PCFilename.st Fri Dec 09 22:31:28 2016 +0000
+++ b/PCFilename.st Mon Feb 13 21:29:46 2017 +0000
@@ -422,33 +422,37 @@
|retryCtr newFilename|
- newFilename := newName asFilename.
- newFilename exists ifTrue:[
- (self pathName sameAs:newFilename pathName) ifFalse:[
- newFilename delete
+
+ "try 5 times (retry 4 times) if file has just been written to and is locked by a virus scanner"
+ retryCtr := 4.
+ [
+ ^ super renameTo:newName
+ ] on:OSErrorHolder existingReferentSignal do:[:ex|
+ |newFilename|
+
+ newFilename := newName asFilename.
+ (self pathName sameAs:newFilename pathName) ifTrue:[
+ ex reject.
].
- ].
-
- "try 5 times if file has just been written to and is locked by a virus scanner"
- retryCtr := 5.
- OperatingSystem accessDeniedErrorSignal handle:[:ex|
- retryCtr := retryCtr - 1.
+ newFilename remove.
+ ex restart.
+ ] on:OSErrorHolder noPermissionsSignal do:[:ex|
retryCtr > 0 ifTrue:[
Logger warning:'Error caught while renaming %1 to %2 - maybe temporary locked by virus scanner, still trying: %3'
with:self pathName
with:newFilename pathName
with:ex description.
+ retryCtr := retryCtr - 1.
+ Delay waitForMilliseconds:200.
+ ex restart.
] ifFalse:[
ex reject
].
- Delay waitForMilliseconds:200.
- ex restart.
- ] do:[
- ^ super renameTo:newName
].
"
- '\tmp\foo' asFilename renameTo:'\tmp\bar'
+ 'c:\users\stefan\test.txt' asFilename renameTo:'c:\users\stefan\test1.txt'
+ 'c:\users\stefan\test12.txt' asFilename renameTo:'c:\users\stefan\test.txt'
"
"Modified: / 20-01-1998 / 15:33:00 / md"
--- a/PeekableStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/PeekableStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -530,61 +530,25 @@
!PeekableStream methodsFor:'reading'!
-nextDecimalInteger
- "read the next integer in radix 10.
- Does NOT skip initial whitespace.
- The streams elements should be characters.
-
- Be careful - this method returns 0 if not positioned on a digit intitially
- or if the end of the stream is encountered."
-
- |nextOne value|
-
- nextOne := self peekOrNil.
- value := 0.
- [nextOne notNil and:[nextOne isDigitRadix:10]] whileTrue:[
- value := (value * 10) + nextOne digitValue.
- self next.
- nextOne := self peekOrNil
- ].
- ^ value
-
- "
- |s|
+nextDelimited:terminator
+ "return the contents of the receiver, up to the next terminator element.
+ Doubled terminators indicate an embedded terminator element.
+ For example: 'this '' was a quote'.
+ Start positioned before the initial terminator."
- s := '1234 5678' readStream.
- s nextDecimalInteger.
- "
-
- "
- |s|
-
- s := '1234 5678' readStream.
- s nextDecimalInteger.
- s skipSpaces.
- s nextDecimalInteger.
- "
-!
-
-nextDelimited:terminator
- "return the contents of the receiver, up to the next terminator character.
- Doubled terminators indicate an embedded terminator character.
- For example: 'this '' was a quote'.
- Start postioned before the initial terminator."
-
- | out ch |
+ | out element |
self atEnd ifTrue: [^ ''].
self next == terminator ifFalse: [self skip: -1]. "absorb initial terminator"
out := WriteStream on:(self contentsSpecies new).
- [(ch := self next) == nil] whileFalse: [
- (ch == terminator) ifTrue: [
+ [(element := self nextOrNil) isNil and:[self atEnd]] whileFalse:[
+ element == terminator ifTrue: [
self peek == terminator ifFalse: [
^ out contents "terminator is not doubled; we're done!!"
].
self next. "skip doubled terminator"
].
- out nextPut: ch.
+ out nextPut:element.
].
^ out contents
@@ -694,6 +658,42 @@
"Modified: / 5.3.1998 / 13:45:07 / cg"
!
+skipUntil:aBlock
+ "skip all elements for which aBlock returns false.
+ Return true if more elements can be read, false if eof has been reached."
+
+ [self atEnd] whileFalse:[
+ (aBlock value: self peek) ifTrue:[^ true].
+ self next
+ ].
+ ^ false
+
+ "
+ #(1 2 3 4 5 6 7 8 9 10) readStream
+ skipUntil:[:el | el >= 5];
+ next
+ "
+!
+
+skipWhile:aBlock
+ "skip all elements for which aBlock returns true. Return true if more elements can be read,
+ false if eof has been reached."
+
+ [self atEnd] whileFalse:[
+ (aBlock value: self peek) ifFalse:[^ true].
+ self next
+ ].
+ ^ false
+
+ "
+ #(1 2 3 4 5 6 7 8 9 10) readStream
+ skipWhile:[:el | el <= 5];
+ next
+ "
+
+ "Created: / 23-09-2011 / 13:32:40 / cg"
+!
+
throughAnyForWhich:checkBlock
"read & return a collection of all objects up-to and including
the elements for which checkBlock returns true.
@@ -728,6 +728,137 @@
"
"Modified: / 11.1.1998 / 15:28:04 / cg"
+!
+
+upToAny:aCollectionOfObjects
+ "read a collection of all objects up-to a element which is contained in
+ aCollectionOfObjects and return these elements, but excluding the matching one.
+ The next read operation will return the element AFTER anObject.
+ If no such element is encountered, all elements up to the end are read
+ and returned.
+ Compare this with #throughAll: which also reads up to some object
+ and also positions behind it, but DOES include it in the returned
+ value."
+
+ |result|
+
+ result := self upToBeforeAny:aCollectionOfObjects.
+ self atEnd ifFalse:[
+ self next.
+ ].
+ ^ result
+
+ "
+ |s|
+ s := ReadStream on:'hello world'.
+ Transcript showCR:(s upToAny:(Array with:Character space)).
+ Transcript showCR:(s upToEnd)
+
+ 'Makefile' asFilename readStream upToAny:($A to:$Z)
+ "
+
+ "Created: / 30.8.1997 / 03:02:05 / cg"
+ "Modified: / 11.1.1998 / 15:19:18 / cg"
+!
+
+upToBeforeAny:aCollectionOfObjects
+ "read a collection of all objects up-to a element which is contained in
+ aCollectionOfObjects and return these elements, but excluding the matching one.
+ The next read operation will return the matching element.
+ If no such element is encountered, all elements up to the end are read
+ and returned.
+ This returns the exact same as upToAny: would, but leaves the stream's position so that
+ the next read returns the matching delimiter instead of skipping it.
+ Caveat: this is the one which should have been called upTo: in the first place;
+ however, it seems now too late for a change."
+
+ |answerStream element|
+
+ answerStream := WriteStream on:(self contentsSpecies new).
+ [self atEnd] whileFalse:[
+ element := self peek.
+ (aCollectionOfObjects includes:element) ifTrue: [
+ ^ answerStream contents
+ ].
+ answerStream nextPut:element.
+ self next.
+ ].
+ ^ answerStream contents
+
+ "
+ |s|
+ s := ReadStream on:'hello world'.
+ Transcript showCR:(s upToBeforeAny:(Array with:Character space)).
+ Transcript showCR:(s upToEnd)
+
+ 'Make.proto' asFilename readStream upToBeforeAny:($A to:$Z)
+ "
+
+ "Created: / 30.8.1997 / 03:02:05 / cg"
+ "Modified: / 11.1.1998 / 15:19:18 / cg"
+!
+
+upToElementForWhich:aBlock
+ "read elements until aBlock returns true for an element.
+ Return the collected elements excluding that element.
+ Leave the stream positioned for the next read to return that element.
+ If no element matches, all elements up to the end are returned"
+
+ |answerStream next|
+
+ answerStream := WriteStream on:(self contentsSpecies new).
+
+ [
+ self atEnd
+ or:[ (aBlock value: (next := self peek)) ]
+ ] whileFalse:[
+ answerStream nextPut:next.
+ self next.
+ ].
+ ^ answerStream contents
+
+ "
+ #(1 2 3 4 5 6 7 8 9 10) readStream
+ upToElementForWhich:[:el | el > 5]
+ "
+! !
+
+!PeekableStream methodsFor:'reading-numbers'!
+
+nextDecimalInteger
+ "read the next integer in radix 10.
+ Does NOT skip initial whitespace.
+ The streams elements should be characters.
+
+ Be careful - this method returns 0 if not positioned on a digit intitially
+ or if the end of the stream is encountered."
+
+ |nextOne value|
+
+ nextOne := self peekOrNil.
+ value := 0.
+ [nextOne notNil and:[nextOne isDigitRadix:10]] whileTrue:[
+ value := (value * 10) + nextOne digitValue.
+ self next.
+ nextOne := self peekOrNil
+ ].
+ ^ value
+
+ "
+ |s|
+
+ s := '1234 5678' readStream.
+ s nextDecimalInteger.
+ "
+
+ "
+ |s|
+
+ s := '1234 5678' readStream.
+ s nextDecimalInteger.
+ s skipSpaces.
+ s nextDecimalInteger.
+ "
! !
!PeekableStream methodsFor:'reading-strings'!
--- a/PipeStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/PipeStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -14,7 +16,7 @@
"{ NameSpace: Smalltalk }"
NonPositionableExternalStream subclass:#PipeStream
- instanceVariableNames:'commandString pid exitStatus exitSema exitAction'
+ instanceVariableNames:'commandString osProcess'
classVariableNames:'BrokenPipeSignal'
poolDictionaries:''
category:'Streams-External'
@@ -222,7 +224,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
"
@@ -275,48 +277,53 @@
The commands error output is send to my own error output."
^ self
- readingFrom:commandString
- errorDisposition:#stderr
- inDirectory:nil
+ readingFrom:commandString
+ errorDisposition:#stderr
+ inDirectory:nil
"unix:
- PipeStream readingFrom:'ls -l'.
- "
-
- "
- |p|
-
- p := PipeStream readingFrom:'ls -l'.
- Transcript showCR:p nextLine.
- p close
+ PipeStream readingFrom:'ls -l'.
"
"
- |s|
- s := PipeStream readingFrom:'sh -c sleep\ 600'.
- (Delay forSeconds:2) wait.
- s shutDown
+ |p|
+
+ p := PipeStream readingFrom:'ls -l'.
+ Transcript showCR:p nextLine.
+ p close
"
- "vms:
- PipeStream readingFrom:'dir'.
+
+ "
+ |p|
+
+ p := PipeStream readingFrom:'echo error >&2'.
+ Transcript showCR:p nextLine.
+ p close
"
"
- |p|
- p := PipeStream readingFrom:'dir'.
- Transcript showCR:p nextLine.
- p close
+ |s|
+ s := PipeStream readingFrom:'sh -c sleep\ 600'.
+ (Delay forSeconds:2) wait.
+ s abortAndClose
"
- "msdos:
- PipeStream readingFrom:'dir'.
+ "
+ |p|
+ p := PipeStream readingFrom:'dir'.
+ Transcript showCR:p nextLine.
+ p close
+ "
+
+ "Windows:
+ PipeStream readingFrom:'dir'.
"
"
- |p|
- p := PipeStream readingFrom:'dir'.
- Transcript showCR:p nextLine.
- p close
+ |p|
+ p := PipeStream readingFrom:'dir'.
+ Transcript showCR:p nextLine.
+ p close
"
"Modified: 24.4.1996 / 09:09:25 / stefan"
@@ -334,10 +341,27 @@
Nil is treated like #stderr"
^ self basicNew
- openPipeFor:commandString
- withMode:#r
- errorDisposition:errorDisposition
- inDirectory:aDirectory
+ openPipeFor:commandString
+ withMode:#r
+ errorDisposition:errorDisposition
+ inDirectory:aDirectory
+
+
+ "
+ |p|
+
+ p := PipeStream readingFrom:'bla' errorDisposition:Transcript inDirectory:nil.
+ Transcript showCR:p nextLine.
+ p close
+ "
+
+ "
+ |p|
+
+ p := PipeStream readingFrom:'bla' errorDisposition:#inline inDirectory:nil.
+ Transcript showCR:p nextLine.
+ p close
+ "
!
readingFrom:commandString inDirectory:aDirectory
@@ -472,15 +496,21 @@
exitStatus
"return the exitStatus"
- ^ exitStatus
-
+ osProcess isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ osProcess exitStatus.
+
"Created: 28.12.1995 / 14:54:41 / stefan"
!
pid
"return pid"
- ^ pid
+ osProcess isNil ifTrue:[
+ ^ nil.
+ ].
+ ^ osProcess pid.
"Created: 28.12.1995 / 14:54:30 / stefan"
! !
@@ -495,12 +525,12 @@
"terminate first under windows"
OperatingSystem isMSDOSlike ifTrue:[
self terminatePipeCommand.
- self closeFileDescriptor.
+ self closeFile.
^ self.
].
"terminate last under unix"
- self closeFileDescriptor.
+ self closeFile.
self terminatePipeCommand.
!
@@ -511,10 +541,8 @@
handle notNil ifTrue:[
super close.
- pid notNil ifTrue:[
- "/ wait for the pipe-command to terminate.
- self waitForPipeCommandWithTimeout:nil.
- ].
+ "/ wait for the pipe-command to terminate.
+ self waitForPipeCommandWithTimeout:nil.
].
"Modified: / 12.9.1998 / 16:51:04 / cg"
@@ -552,55 +580,6 @@
!PipeStream methodsFor:'private'!
-closeFileDescriptor
- "alternative very low level close
- This closes the underlying OS-fileDescriptor
- - and will NOT write any buffered data to the stream.
- You have been warned."
-
- |action|
-
-%{
-#if !defined(transputer)
- OBJ fp;
- FILE *f;
- extern close();
- int retVal;
-
- if ((fp = __INST(handle)) != nil) {
- __INST(handle) = nil;
- f = __FILEVal(fp);
- if (@global(FileOpenTrace) == true) {
- console_fprintf(stderr, "close [PipeStream] %"_lx_" fd=%d\n", (INT)f, fileno(f));
- }
-#ifdef __win32__
- do {
- __threadErrno = 0;
- retVal = __STX_C_NOINT_CALL1( "close", (void*)close, (void*)fileno(f) );
- } while ((retVal < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- close(fileno(f));
- __END_INTERRUPTABLE__
-#endif
- }
-#endif /* not transputer */
-%}.
- exitAction notNil ifTrue:[
- action := exitAction.
- exitAction := nil.
- action value.
- ]
-!
-
-exitAction:aBlock
- "define a block to be evaluated when the pipe is closed.
- This is only used with VMS, to remove any temporary COM file.
- (see readingFrom:inDirectory:)"
-
- exitAction := aBlock
-!
-
openPipeFor:aCommandString withMode:rwMode errorDisposition:errorDisposition inDirectory:aDirectory
"open a pipe to the OS command in commandString;
rwMode may be 'r' or 'w' or 'r+'.
@@ -611,9 +590,7 @@
#stderr causes it to be written to smalltalks own stderr.
Nil is treated like #stderr"
- |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
- shellPath shellArgs mbx mbxName
- realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
+ |pipeArray remotePipeEnd nullOutput errorNumber myPipeEnd result|
handle notNil ifTrue:[
"the pipe was already open ...
@@ -632,185 +609,97 @@
]].
lastErrorNumber := nil.
- exitStatus := nil.
- exitSema := Semaphore new name:'pipe exitSema'.
-
- realCmd := aCommandString.
- execDirectory := aDirectory.
- execFdArray := #(0 1 2) copy.
+ commandString := aCommandString.
+ "stdio lib does not work with blocking pipes and interrupts
+ for WIN, Linux, Solaris and probably any other UNIX"
+ buffered := false.
+ hitEOF := false.
+ binary := false.
- OperatingSystem isVMSlike ifTrue:[
- "/
- "/ the generated COM-file includes a 'set default'
- "/
- tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
- realCmd := '@' , tmpComFile osName.
- execDirectory := nil.
+ osProcess := OSProcess new
+ command:aCommandString;
+ directory:aDirectory.
- mbx := OperatingSystem createMailBox.
- mbx isNil ifTrue:[
+ mode == #readwrite ifTrue:[
+ pipeArray := self class makeBidirectionalPipe.
+ pipeArray isNil ifTrue:[
lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- tmpComFile delete.
^ self openError:errorNumber.
].
- mbxName := OperatingSystem mailBoxNameOf:mbx.
-
- "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
- shellPath := ''.
- shellArgs := realCmd.
-
- rwMode = #r ifTrue:[
- "redirect stdout of subprocess to write to mailbox"
- execFdArray at:2 put:mbx.
- ] ifFalse:[
- "redirect stdin of subprocess to read from mailbox"
- execFdArray at:1 put:mbx.
+ myPipeEnd := pipeArray at:1.
+ remotePipeEnd := pipeArray at:2.
+ osProcess inStream:remotePipeEnd.
+ osProcess outStream:remotePipeEnd.
+ ] ifFalse:[
+ pipeArray := self class makePipe.
+ pipeArray isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError:errorNumber.
].
- ] ifFalse:[
- shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
- shellPath := shellAndArgs at:1.
- shellArgs := shellAndArgs at:2.
- mode == #readwrite ifTrue:[
- pipeFdArray := OperatingSystem makeBidirectionalPipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- ^ self openError:errorNumber.
- ].
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:1 put:execFd.
- execFdArray at:2 put:execFd.
+ mode == #readonly ifTrue:[
+ "redirect stdout of subprocess to write to pipe"
+ myPipeEnd := pipeArray at:1.
+ remotePipeEnd := pipeArray at:2.
+ osProcess outStream:remotePipeEnd.
] ifFalse:[
- pipeFdArray := OperatingSystem makePipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- ^ self openError:errorNumber.
- ].
-
- mode == #readonly ifTrue:[
- "redirect stdout of subprocess to write to pipe"
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:2 put:execFd.
- ] ifFalse:[
- "redirect stdin of subprocess to read from pipe"
- myFd := pipeFdArray at:2.
- execFd := pipeFdArray at:1.
- execFdArray at:1 put:execFd.
- ].
+ "redirect stdin of subprocess to read from pipe"
+ myPipeEnd := pipeArray at:2.
+ remotePipeEnd := pipeArray at:1.
+ osProcess inStream:remotePipeEnd.
].
].
errorDisposition == #discard ifTrue:[
nullOutput := Filename nullDevice writeStream.
- execFdArray at:3 put:nullOutput fileDescriptor
- ] ifFalse:[
- (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
- execFdArray at:3 put:1
- ] ifFalse:[
-"/ errorDisposition isStream ifTrue:[
-"/self halt.
-"/ ].
- ].
+ osProcess errorStream:nullOutput.
+ ] ifFalse:[(errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
+ osProcess errorStream:osProcess outStream.
+ ] ifFalse:[(errorDisposition == #stderr or:[errorDisposition isNil]) ifTrue:[
+ osProcess errorStream:Stderr.
+ ] ifFalse:[errorDisposition isStream ifTrue:[
+ osProcess errorStream:errorDisposition.
+ ]]]].
+
+ mode ~~ #readonly ifTrue:[
+ osProcess terminateActionBlock:[
+ "writing doesn't make sense - there is no reader any longer"
+ mode == #readwrite ifTrue:[
+ "... but allow to read the rest of the command's output"
+ self shutDownOutput.
+ ] ifFalse:[mode == #writeonly ifTrue:[
+ self closeFile.
+ ]].
+ ].
].
- "/ must block here, to avoid races due to early finishing
- "/ subprocesses ...
-
- blocked := OperatingSystem blockInterrupts.
-
- "beware: pid may change if subprocess is fast"
- pid := resultPid := Processor
- monitor:[
- OperatingSystem
- exec:shellPath
- withArguments:shellArgs
- environment:nil
- fileDescriptors:execFdArray
- fork:true
- newPgrp:true
- inDirectory:execDirectory
- showWindow:false.
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
-
- "writing doesn't make sense - there is no reader any longer"
- mode == #readwrite ifTrue:[
- "... but allow to read the rest of the command's output"
- self shutDownOutput.
- ] ifFalse:[mode == #writeonly ifTrue:[
- self closeFileDescriptor.
- ]].
-
- OperatingSystem closePid:pid.
- pid := nil.
- exitSema signal.
- ].
- ].
+ result := osProcess startProcess.
"subprocess has been created.
close unused filedescriptors"
-
- execFd notNil ifTrue:[
- OperatingSystem closeFd:execFd.
+ remotePipeEnd notNil ifTrue:[
+ remotePipeEnd close.
].
-
nullOutput notNil ifTrue:[
nullOutput close
].
- resultPid notNil ifTrue:[
+ result ifTrue:[
"successfull creation of subprocesss"
- OperatingSystem isVMSlike ifTrue:[
- "/
- "/ reopen the mailbox as a file ...
- "/
- mbxName := OperatingSystem mailBoxNameOf:mbx.
- mbxName notNil ifTrue:[
- super open:mbxName withMode:rwMode.
- exitAction := [tmpComFile delete].
- ].
- ] ifFalse:[
- self setFileHandle:myFd mode:rwMode.
- handleType := #pipeFilePointer.
- ]
+ handle := myPipeEnd handle.
+ handleType := myPipeEnd handleType.
+ myPipeEnd unregisterForFinalization. "make sure filedesciptor is not closed by finalizer"
+ myPipeEnd := nil.
] ifFalse:[
- "creation of subprocesss failed"
- lastErrorNumber := OperatingSystem currentErrorNumber.
- OperatingSystem isVMSlike ifTrue:[
- OperatingSystem destroyMailBox:mbx.
- tmpComFile delete.
- ] ifFalse:[
- OperatingSystem closeFd:myFd.
- ].
- ].
-
- blocked ifFalse:[
- OperatingSystem unblockInterrupts
- ].
-
- (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
- "
- the pipe open failed for some reason ...
+ "the pipe open failed for some reason ...
... this may be either due to an invalid command string,
or due to the system running out of memory (when forking
- the unix process)
- "
- exitAction value.
+ the unix process)"
+ lastErrorNumber := OperatingSystem lastErrorNumber.
+ myPipeEnd close.
^ self openError:lastErrorNumber.
].
- commandString := realCmd.
-
- "stdio lib does not work with blocking pipes and interrupts
- for WIN, Linux, Solaris and probably any other UNIX"
- buffered := false.
- position := 0.
- hitEOF := false.
- binary := false.
self registerForFinalization.
"Modified: / 23.4.1996 / 17:05:59 / stefan"
@@ -819,11 +708,8 @@
!
terminatePipeCommand
- |tpid|
-
- (tpid := pid) notNil ifTrue:[
- OperatingSystem terminateProcessGroup:tpid.
- OperatingSystem terminateProcess:tpid.
+ osProcess notNil ifTrue:[
+ osProcess terminateGroup.
].
!
@@ -831,14 +717,10 @@
"wait for the pipe command to terminate itself.
Return true, if a timeout occurred."
- pid notNil ifTrue:[
- [
- pid notNil ifTrue:[
- exitSema waitWithTimeout:seconds.
- ]
- ] valueUninterruptably
+ osProcess notNil ifTrue:[
+ ^ osProcess finishSema waitWithTimeout:seconds.
].
- ^ pid notNil
+ ^ false
! !
!PipeStream class methodsFor:'documentation'!
--- a/PositionableStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/PositionableStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -218,16 +218,6 @@
^ collection
!
-peek
- "look ahead for and return the next element"
-
- |peekObject|
-
- peekObject := self next.
- self backStep.
- ^ peekObject
-!
-
peekForAll:aCollection
"return true and advance if the next elements are the same
as aCollection.
@@ -386,6 +376,48 @@
"
! !
+!PositionableStream methodsFor:'non homogenous reading'!
+
+nextBytes:numBytes into:aCollection startingAt:initialIndex
+ "return the next numBytes from the stream. If the end is
+ reached before, only that many bytes are copyied into the
+ collection.
+ Returns the number of bytes that have been actually read.
+ The receiver must support reading of binary bytes.
+
+ Notice: this method is provided here for protocol completeness
+ with externalStreams - it is normally not used with other
+ streams."
+
+ |max|
+
+ (collection isByteCollection
+ and:[aCollection isByteCollection]) ifTrue:[
+ "do it the fast way"
+ max := (readLimit - position) min: numBytes.
+ aCollection
+ replaceBytesFrom:initialIndex
+ to:(initialIndex + max - 1)
+ with:collection
+ startingAt:position+1.
+ position := position + max.
+ ^ max
+ ].
+ "do it the hard way"
+ ^ super nextBytes:numBytes into:aCollection startingAt:initialIndex
+
+ "
+ |s n buffer|
+
+ buffer := ByteArray new:10.
+
+ s := ReadStream on:#[1 2 3 4 5 6 7 8 9].
+ s next:3.
+ n := s nextBytes:9 into:buffer startingAt:1.
+ Transcript showCR:('n = %1; buffer = <%2>' bindWith:n with:buffer)
+ "
+! !
+
!PositionableStream methodsFor:'positioning'!
backStep
@@ -816,91 +848,14 @@
"
!
-nextBytes:numBytes into:aCollection startingAt:initialIndex
- "return the next numBytes from the stream. If the end is
- reached before, only that many bytes are copyied into the
- collection.
- Returns the number of bytes that have been actually read.
- The receiver must support reading of binary bytes.
-
- Notice: this method is provided here for protocol completeness
- with externalStreams - it is normally not used with other
- streams."
-
- |max|
-
- (collection isByteCollection
- and:[aCollection isByteCollection]) ifTrue:[
- "do it the fast way"
- max := (readLimit - position) min: numBytes.
- aCollection
- replaceBytesFrom:initialIndex
- to:(initialIndex + max - 1)
- with:collection
- startingAt:position+1.
- position := position + max.
- ^ max
- ].
- "do it the hard way"
- ^ super nextBytes:numBytes into:aCollection startingAt:initialIndex
-
- "
- |s n buffer|
-
- buffer := ByteArray new:10.
-
- s := ReadStream on:#[1 2 3 4 5 6 7 8 9].
- s next:3.
- n := s nextBytes:9 into:buffer startingAt:1.
- Transcript showCR:('n = %1; buffer = <%2>' bindWith:n with:buffer)
- "
-!
+peek
+ "look ahead for and return the next element"
-nextLine
- "return the characters upTo (but excluding) the next cr (carriage return)
- character (i.e. read a single line of text).
- If the previous-to-last character is a cr, this is also removed,
- so it's possible to read alien (i.e. ms-dos) text as well.
- Added for protocol compatibility with externalStreams."
-
- |start "{ Class:SmallInteger }"
- end "{ Class:SmallInteger }"|
-
- collection isString ifTrue:[
- position == readLimit ifTrue:[
- ^ self pastEndRead
- ].
- start := position+1.
- end := collection indexOf:Character cr startingAt:start.
+ |peekObject|
- (end == 0 or:[end > readLimit]) ifTrue:[
- end := position := readLimit.
- ] ifFalse:[
- position := end.
- end := end - 1. "skip lf"
- ].
- start > end ifTrue:[
- ^ ''.
- ].
- (collection at:end) == Character return ifTrue:[
- end := end - 1. "skip return"
- ].
- ^ collection copyFrom:start to:end.
- ].
- ^ super nextLine.
-
- "
- '12345678' readStream nextLine
- '12345678' allBold readStream nextLine
- '12\34\56\78' withCRs readStream nextLine
- '12\34\56\78' withCRs readStream nextLine; nextLine
- (ReadStream on:('12\34\56\78' withCRs) from:1 to:4) nextLine; nextLine
- ('12\' withCRs, Character return, '34') readStream nextLine; nextLine
- Character cr asString readStream nextLine
- Character return asString readStream nextLine
- (Character return, Character cr) asString readStream nextLine
- Character return asString readStream nextLine; nextLine
- "
+ peekObject := self next.
+ self backStep.
+ ^ peekObject
!
upToAll:aCollection
@@ -1019,6 +974,55 @@
"
! !
+!PositionableStream methodsFor:'reading-strings'!
+
+nextLine
+ "return the characters upTo (but excluding) the next cr (carriage return)
+ character (i.e. read a single line of text).
+ If the previous-to-last character is a cr, this is also removed,
+ so it's possible to read alien (i.e. ms-dos) text as well.
+ Added for protocol compatibility with externalStreams."
+
+ |start "{ Class:SmallInteger }"
+ end "{ Class:SmallInteger }"|
+
+ collection isString ifTrue:[
+ position == readLimit ifTrue:[
+ ^ self pastEndRead
+ ].
+ start := position+1.
+ end := collection indexOf:Character cr startingAt:start.
+
+ (end == 0 or:[end > readLimit]) ifTrue:[
+ end := position := readLimit.
+ ] ifFalse:[
+ position := end.
+ end := end - 1. "skip lf"
+ ].
+ start > end ifTrue:[
+ ^ ''.
+ ].
+ (collection at:end) == Character return ifTrue:[
+ end := end - 1. "skip return"
+ ].
+ ^ collection copyFrom:start to:end.
+ ].
+ ^ super nextLine.
+
+ "
+ '12345678' readStream nextLine
+ '12345678' allBold readStream nextLine
+ '12\34\56\78' withCRs readStream nextLine
+ '12\34\56\78' withCRs readStream nextLine; nextLine
+ (ReadStream on:('12\34\56\78' withCRs) from:1 to:4) nextLine; nextLine
+ ('12\' withCRs, Character return, '34') readStream nextLine; nextLine
+ Character cr asString readStream nextLine
+ Character return asString readStream nextLine
+ (Character return, Character cr) asString readStream nextLine
+ Character return asString readStream nextLine; nextLine
+ "
+! !
+
!PositionableStream methodsFor:'testing'!
atEnd
--- a/Process.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Process.st Mon Feb 13 21:29:46 2017 +0000
@@ -18,7 +18,7 @@
restartable interruptActions exitActions suspendSemaphore
singleStepping emergencySignalHandler suspendActions creatorId
processGroupId interruptsDisabled priorityRange
- exceptionHandlerSet processType environment'
+ exceptionHandlerSet processType environment startTimestamp'
classVariableNames:'TerminateSignal RestartSignal CaughtSignals SysProcessId'
poolDictionaries:''
category:'Kernel-Processes'
@@ -484,9 +484,12 @@
!Process class methodsFor:'instance retrieval'!
findProcessWithId:id
+ <resource: #obsolete>
"return a process with a particular id.
This is only a debugging helper, to allow
- easy access of a process by name in the MiniDebugger"
+ easy access of a process by name in the MiniDebugger.
+ Do not use - ask Processor instead!!"
+
^ self allSubInstances detect:[:aProcess | aProcess id = id] ifNone:nil.
@@ -498,9 +501,11 @@
!
findProcessWithName:name
+ <resource: #obsolete>
"return a process with a particular name.
This is only a debugging helper, to allow
- easy access of a process by name in the MiniDebugger"
+ easy access of a process by name in the MiniDebugger
+ Do not use - ask Processor instead!!"
^ self allSubInstances detect:[:aProcess | aProcess name = name] ifNone:nil.
@@ -512,8 +517,9 @@
!
findProcessesWithGroupId:aGroupId
+ <resource: #obsolete>
"return a collection of processes with the particular group id.
- "
+ Do not use - ask Processor instead!!"
^ self allSubInstances select:[:aProcess | aProcess processGroupId = aGroupId ].
@@ -728,6 +734,17 @@
^ startBlock
!
+startTimestamp
+ "return the processes' start time"
+
+ startTimestamp notNil ifTrue:[
+ ^ startTimestamp
+ ].
+ "/ the very first system process has no starttime set
+ startTimestamp := Smalltalk imageStartTime.
+ ^ startTimestamp
+!
+
state
"return a symbol describing the processes state"
@@ -1717,40 +1734,45 @@
|block|
- (block := startBlock) notNil ifTrue:[
- "/
- "/ just for your convenience ...
- "/
- name isNil ifTrue:[
- name := '(' , block displayString , ')'
- ].
- restartable ~~ true ifTrue:[startBlock := nil].
-
- [
- "/
- "/ handle Process-Termination, Process-Restart and Abort
- "/
- CaughtSignals handle:[:ex |
- ex creator == RestartProcessRequest ifTrue:[
- ex restart
- ].
- ex return
- ] do:[
- exceptionHandlerSet isNil ifTrue:[
- exceptionHandlerSet := ExceptionHandlerSet new.
- ].
- "/
- "/ block is the one which received the fork some time ago...
- "/
- exceptionHandlerSet handleDo:block
- ]
- ] ensure:[self terminateNoSignal].
- ] ifFalse:[
- "is this artificial restriction useful ?"
- self error:'a process cannot be started twice' mayProceed:true
- ]
-
- "Modified: / 17.11.2001 / 16:45:32 / cg"
+ startBlock isNil ifTrue:[
+ "is this artificial restriction useful ?"
+ self error:'a process cannot be started twice' mayProceed:true.
+ ^ self.
+ ].
+
+ "/
+ "/ just for your convenience ...
+ "/
+ startTimestamp := Timestamp now.
+ name isNil ifTrue:[
+ name := '(' , startBlock displayString , ')'
+ ].
+
+ "save block for possible restart"
+ block := startBlock.
+ restartable ~~ true ifTrue:[
+ startBlock := nil
+ ].
+
+ [
+ "/
+ "/ block is the one which received the fork/newProcess some time ago...
+ "/
+ self exceptionHandlerSet handleDo:block
+ ] on:CaughtSignals do:[:ex |
+ "/
+ "/ CaughtSignals: handle Process-Termination, Process-Restart and Abort
+ "/
+ ex creator == RestartProcessRequest ifTrue:[
+ ex restart
+ ].
+ ex return
+ ] ensure:[
+ self terminateNoSignal
+ ].
+
+ "Modified: / 17-11-2001 / 16:45:32 / cg"
+ "Modified: / 31-01-2017 / 16:41:05 / stefan"
! !
!Process methodsFor:'suspend & resume'!
@@ -1867,52 +1889,52 @@
|wasBlocked|
- Processor activeProcess ~~ self ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- [
- state == #osWait ifTrue:[
- self terminateNoSignal.
- ^ self.
- ].
-
- "if the receiver had no chance to execute yet,
- it can be shot down without a signal"
-
- self suspendedContext isNil ifTrue:[
- self terminateNoSignal.
- ^ self
- ]
- ] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
- ].
-
- "register an interrupt action and resume that process"
- self interruptWith:[
- NoHandlerError handle:[:ex |
- ex exception creator == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
- ].
- ] ifFalse:[
- "terminating myself"
-
- NoHandlerError handle:[:ex |
- ex exception creator == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
- ]
-
- "Modified: / 24.8.1998 / 18:29:46 / cg"
+ Processor activeProcess == self ifTrue:[
+ "suicide: terminating myself"
+ NoHandlerError handle:[:ex |
+ "unhandled TerminateProcessRequest is not an error"
+ ex exception creator ~~ TerminateProcessRequest ifTrue:[
+ ex reject.
+ ].
+ ] do:[
+ TerminateProcessRequest raise.
+ ].
+ self terminateNoSignal.
+ "not reached"
+ ^ self.
+ ].
+
+ "the receiver is terminated from another process"
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ (state isNil or:[state == #dead]) ifTrue:[
+ ^ self.
+ ].
+ state == #osWait ifTrue:[
+ "osWait processes cannot be interrupted"
+ self terminateNoSignal.
+ ^ self.
+ ].
+
+ self suspendedContext isNil ifTrue:[
+ "if the receiver had no chance to execute yet,
+ it can be shot down without a signal"
+ self terminateNoSignal.
+ ^ self
+ ]
+ ] ensure:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
+ ].
+
+ "register an interrupt action, so that I am terminating myself"
+ self interruptWith:[
+ self terminate.
+ ].
+ "maybe I am stopped - resume so that I can die"
+ self resume.
+
+ "Modified: / 24-08-1998 / 18:29:46 / cg"
+ "Modified (comment): / 27-01-2017 / 18:08:46 / stefan"
!
terminateAllGUISubprocesses
@@ -1934,17 +1956,14 @@
^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess creatorId == id ifTrue:[
- aProcess isGUIProcess ifTrue:[
- aProcess terminateWithAllGUISubprocesses
- ]
- ]
- ]
+ (aProcess ~~ self and:[aProcess creatorId == id and:[aProcess isGUIProcess]]) ifTrue:[
+ aProcess terminateWithAllGUISubprocesses
+ ].
].
"Created: / 28-10-1996 / 20:43:32 / cg"
"Modified: / 26-10-2012 / 13:16:35 / cg"
+ "Modified: / 24-01-2017 / 17:38:10 / stefan"
!
terminateAllSubprocessesInGroup
@@ -1976,15 +1995,14 @@
and recursively oll of their group processes.)."
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- (aProcess processGroupId == aGroup) ifTrue:[
- aProcess terminateWithAllSubprocessesInGroup
- ]
- ]
+ (aProcess ~~ self and:[aProcess processGroupId == aGroup]) ifTrue:[
+ aProcess terminateWithAllSubprocessesInGroup
+ ].
].
- "Created: / 28.10.1996 / 20:43:32 / cg"
- "Modified: / 3.11.1997 / 00:28:06 / cg"
+ "Created: / 28-10-1996 / 20:43:32 / cg"
+ "Modified: / 03-11-1997 / 00:28:06 / cg"
+ "Modified: / 24-01-2017 / 17:42:33 / stefan"
!
terminateGroup
@@ -2005,13 +2023,13 @@
^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess processGroupId == id ifTrue:[
- aProcess terminate
- ]
- ]
+ (aProcess ~~ self and:[aProcess processGroupId == id]) ifTrue:[
+ aProcess terminate
+ ].
].
self terminate
+
+ "Modified: / 24-01-2017 / 17:41:12 / stefan"
!
terminateNoSignal
@@ -2065,17 +2083,20 @@
ProcessorScheduler invalidProcessSignal
raiseWith:self errorString:'trying to terminate the system process group'.
].
- ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- (aProcess processGroupId == processGroupId
- or:[aProcess processGroupId == id]) ifTrue:[
- aProcess terminate
- ]
- ]
+ ProcessorScheduler knownProcesses do:[:eachProcess |
+ eachProcess ~~ self ifTrue:[
+ |eachProcessGroupId|
+
+ eachProcessGroupId := eachProcess processGroupId.
+ (eachProcessGroupId == processGroupId or:[eachProcessGroupId == id]) ifTrue:[
+ eachProcess terminate
+ ].
+ ].
].
- "Created: 28.10.1996 / 20:41:49 / cg"
- "Modified: 26.8.1997 / 03:09:57 / cg"
+ "Created: / 28-10-1996 / 20:41:49 / cg"
+ "Modified: / 26-08-1997 / 03:09:57 / cg"
+ "Modified: / 24-01-2017 / 17:35:25 / stefan"
!
terminateWithAllGUISubprocesses
--- a/ProcessorScheduler.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ProcessorScheduler.st Mon Feb 13 21:29:46 2017 +0000
@@ -577,6 +577,16 @@
"Processor currentPriority"
!
+exitWhenNoMoreUserProcesses:aBoolean
+ "set/clear the flag, which controls if the scheduler should exit and return
+ when the last user process finishes (and therefore exit the smalltalk system).
+ A userProcess is defined as a process with a non-zero processGroup.
+ This flag is typically set for standAlone operation, to terminate the (Unix-)
+ process, when the last thread terminates."
+
+ exitWhenNoMoreUserProcesses := aBoolean
+!
+
interruptCounter
"for statistics: counts the overall number of interrupts"
@@ -898,16 +908,6 @@
"Modified: / 23-09-1996 / 14:19:56 / stefan"
"Modified: / 20-07-2012 / 18:34:48 / cg"
-!
-
-exitWhenNoMoreUserProcesses:aBoolean
- "set/clear the flag, which controls if the scheduler should exit and return
- when the last user process finishes (and therefore exit the smalltalk system).
- A userProcess is defined as a process with a non-zero processGroup.
- This flag is typically set for standAlone operation, to terminate the (Unix-)
- process, when the last thread terminates."
-
- exitWhenNoMoreUserProcesses := aBoolean
! !
!ProcessorScheduler methodsFor:'initialization'!
@@ -1208,7 +1208,7 @@
status of the OS process changes (e.g. the process terminates).
The method returns the value from aBlockReturningPid (i.e. a pid or nil)."
- |pid wasBlocked|
+ |pid wasBlocked exitStatus|
"/ aBlock will be evaluated:
"/ on unix: as soon as a SIGCHLD interrupt for pid has been received.
@@ -1219,7 +1219,14 @@
"/ start the OS-Process
pid := aBlockReturningPid value.
pid notNil ifTrue:[
- osChildExitActions at:pid put:actionBlock.
+ osChildExitActions at:pid put:actionBlock.
+ ].
+ "check for a race, that SIGCHILD was received before we could register the actionBlock"
+ exitStatus := OperatingSystem childProcessWait:false pid:pid.
+ exitStatus notNil ifTrue:[
+ self unmonitorPid:pid.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ actionBlock value:exitStatus.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ pid
@@ -1348,12 +1355,14 @@
]
].
zombie notNil ifTrue:[
+ "delayed processing of terminated process (see #terminateNoSignal)"
self class threadDestroy:zombie.
zombie := nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
"Modified: / 23-07-2010 / 10:32:11 / cg"
+ "Modified (format): / 24-01-2017 / 17:50:12 / stefan"
! !
!ProcessorScheduler methodsFor:'priority constants'!
@@ -1734,6 +1743,32 @@
Processor processWithId:4
Processor processWithId:4711
"
+!
+
+processesWithGroupId:anInteger
+ "answer a collection of processes with processGroupId, anInteger"
+
+ |wasBlocked coll|
+
+ coll := OrderedCollection new.
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ KnownProcesses validElementsDo:[:eachProcess|
+ eachProcess processGroupId = anInteger ifTrue:[
+ coll add:eachProcess.
+ ].
+ ].
+
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts.
+ ].
+
+ ^ coll.
+
+ "
+ Processor processesWithGroupId:0
+ Processor processesWithGroupId:4711
+ "
! !
!ProcessorScheduler methodsFor:'scheduling'!
@@ -2688,11 +2723,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onInput:aStream fileDescriptor orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onInput:aStream fileHandle orCheck:nil
] ifFalse:[
- "/ nope - must poll ...
- self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
+ "/ nope - must poll ...
+ self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
]
"Modified: / 14.12.1999 / 23:58:50 / cg"
@@ -2789,11 +2824,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onOutput:aStream fileDescriptor orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onOutput:aStream fileHandle orCheck:nil
] ifFalse:[
- "/ nope - must poll ...
- self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
+ "/ nope - must poll ...
+ self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
]
"Modified: / 14.12.1999 / 23:59:19 / cg"
@@ -3406,158 +3441,158 @@
newProcessMaybeReady := false.
readableResultFdArray size < readFdArray size ifTrue:[
- readableResultFdArray := Array new:(40 max:readFdArray size).
+ readableResultFdArray := Array new:(40 max:readFdArray size).
].
writableResultFdArray size < writeFdArray size ifTrue:[
- writableResultFdArray := Array new:(40 max:writeFdArray size).
+ writableResultFdArray := Array new:(40 max:writeFdArray size).
].
exceptArray := exceptFdArray.
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- |hasPids|
-
- hasPids := false.
- osChildExitActions keysDo:[:eachPid|
- eachPid address = 0 ifTrue:[
- 'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ] ifFalse:[
- hasPids := true.
- ].
- ].
- hasPids ifTrue:[
- exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ |hasPids|
+
+ hasPids := false.
+ osChildExitActions keysDo:[:eachPid|
+ eachPid address = 0 ifTrue:[
+ Logger warning:'Processor: remove 0-handle pid: %1' with:eachPid.
+ osChildExitActions safeRemoveKey:eachPid.
+ ] ifFalse:[
+ hasPids := true.
+ ].
+ ].
+ hasPids ifTrue:[
+ exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
"/'exceptArray: ' print. exceptArray printCR.
- ].
+ ].
].
exceptResultFdArray size < exceptArray size ifTrue:[
- exceptResultFdArray := Array new:(40 max:exceptArray size).
+ exceptResultFdArray := Array new:(40 max:exceptArray size).
].
nReady := OperatingSystem
- selectOnAnyReadable:readFdArray
- writable:writeFdArray
- exception:exceptArray
- readableInto:readableResultFdArray
- writableInto:writableResultFdArray
- exceptionInto:exceptResultFdArray
- withTimeOut:millis.
+ selectOnAnyReadable:readFdArray
+ writable:writeFdArray
+ exception:exceptArray
+ readableInto:readableResultFdArray
+ writableInto:writableResultFdArray
+ exceptionInto:exceptResultFdArray
+ withTimeOut:millis.
wasBlocked ifTrue:[
- OperatingSystem blockInterrupts.
+ OperatingSystem blockInterrupts.
].
nReady <= 0 ifTrue:[
- "/ either still nothing to do,
- "/ or error (which should not happen)
-
- (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
- err == #EBADF ifTrue:[
- "/ mhmh - one of the fd's given to me is corrupt.
- "/ find out which one .... and remove it
- self removeCorruptedFds
- ] ifFalse:[
- err == #ENOENT ifTrue:[
- 'Processor [warning]: ENOENT in select; rd=' infoPrint.
- readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
- ] ifFalse:[
- 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
- ]
- ].
- ]
+ "/ either still nothing to do,
+ "/ or error (which should not happen)
+
+ (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
+ err == #EBADF ifTrue:[
+ "/ mhmh - one of the fd's given to me is corrupt.
+ "/ find out which one .... and remove it
+ self removeCorruptedFds
+ ] ifFalse:[
+ err == #ENOENT ifTrue:[
+ 'Processor [warning]: ENOENT in select; rd=' infoPrint.
+ readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
+ ] ifFalse:[
+ 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
+ ]
+ ].
+ ]
] ifFalse:[
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= readableResultFdArray size
- and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
- index := readFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := readCheckArray at:index.
- sema := readSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "before May 2014 we disabled the sema in the caller after wakeup.
- This caused ST/X to consume 100% cpu, when the caller didn't read
- the data (e.g. because his process was stopped)."
- "disable possible write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- newProcessMaybeReady := true.
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
-
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= writableResultFdArray size
- and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
- index := writeFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := writeCheckArray at:index.
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "now this is a one shot operation - see the input above"
- "disable possible read side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- newProcessMaybeReady := true.
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= readableResultFdArray size
+ and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
+ index := readFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := readCheckArray at:index.
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "before May 2014 we disabled the sema in the caller after wakeup.
+ This caused ST/X to consume 100% cpu, when the caller didn't read
+ the data (e.g. because his process was stopped)."
+ "disable possible write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ newProcessMaybeReady := true.
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
+
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= writableResultFdArray size
+ and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
+ index := writeFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := writeCheckArray at:index.
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "now this is a one shot operation - see the input above"
+ "disable possible read side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ newProcessMaybeReady := true.
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
"/'except result got: ' print. exceptArray printCR. exceptResultFdArray printCR.
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= exceptResultFdArray size
- and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= exceptResultFdArray size
+ and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
"/'except got: ' print. fdOrPid printCR.
- index := exceptFdArray identityIndexOf:fdOrPid.
- index ~~ 0 ifTrue:[
- sema := exceptSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- "disable possible read/write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ] ifFalse:[ "may be a PID?"
- |osProcessStatus actionBlock|
-
- actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
+ index := exceptFdArray identityIndexOf:fdOrPid.
+ index ~~ 0 ifTrue:[
+ sema := exceptSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ "disable possible read/write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ] ifFalse:[ "may be a PID?"
+ |osProcessStatus actionBlock|
+
+ actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
"/'pid signaled: ' print. fdOrPid printCR.
- actionBlock notNil ifTrue:[
- osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
- (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
- actionBlock value:osProcessStatus.
- newProcessMaybeReady := true.
- ].
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ actionBlock notNil ifTrue:[
+ osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
+ (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
+ actionBlock value:osProcessStatus.
+ newProcessMaybeReady := true.
+ ].
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
].
^ newProcessMaybeReady
--- a/Project.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Project.st Mon Feb 13 21:29:46 2017 +0000
@@ -737,8 +737,7 @@
!
removeFromSystem
- "remove the project and all of its classes & patches from the
- system"
+ "remove the project and all of its classes & patches from the system"
self removeClassesFromSystem.
AllProjects remove:self ifAbsent:nil.
--- a/ProjectDefinition.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ProjectDefinition.st Mon Feb 13 21:29:46 2017 +0000
@@ -1636,17 +1636,43 @@
!
effectiveSubProjects
- "get the subProjects, that are not excluded"
+ "get the subProjects for the current OS platform, that are not excluded"
+
+ ^ self effectiveSubProjects:OperatingSystem platformName
+
+ "Modified: / 17-01-2017 / 16:31:42 / stefan"
+!
+
+effectiveSubProjects:osSymbol
+ "get the subProjects, that are not excluded.
+ osSymbol can be #win32 or #unix (for now)."
|subProjects|
- subProjects := self subProjects asNewOrderedSet.
- subProjects
- addAll:self includedInSubProjects;
- removeAllFoundIn:self excludedFromSubProjects;
- remove:self package ifAbsent:[].
+ subProjects := (self subProjects, self includedInSubProjects) collect:[:eachLine|
+ eachLine isString ifTrue:[
+ eachLine
+ ] ifFalse:[eachLine second = osSymbol ifTrue:[
+ eachLine first.
+ ] ifFalse:[
+ nil.
+ ]].
+ ] as:OrderedSet.
+
+ subProjects remove:self package ifAbsent:[].
+ subProjects remove:nil ifAbsent:[].
+
+ self excludedFromSubProjects do:[:eachLine|
+ eachLine isString ifTrue:[
+ subProjects remove:eachLine ifAbsent:[].
+ ] ifFalse:[eachLine second = osSymbol ifTrue:[
+ subProjects remove:eachLine first ifAbsent:[].
+ ]].
+ ].
^ subProjects
+
+ "Created: / 17-01-2017 / 16:16:03 / stefan"
!
excludedFromPreRequisites_code
@@ -2277,18 +2303,19 @@
def := self definitionClassForPackage:packageId
] on:PackageLoadError do:[:ex| def := nil].
].
- ^ def isNil
- ifTrue:[
- "Still no project definition - maybe it does not exist?"
- Transcript showCR:'Warning: no definition class for package: ', packageId.
- ((self searchForPreRequisites:packageId)
- fold:[:d1 :d2| d1 addAll:d2; yourself]) keys
- ]
- ifFalse:[ def effectivePreRequisites ]
+ ^ def isNil ifTrue:[
+ "Still no project definition - maybe it does not exist?"
+ Transcript showCR:'Warning: no definition class for package: ', packageId.
+ ((self searchForPreRequisites:packageId)
+ fold:[:d1 :d2| d1 addAll:d2; yourself]) keys
+ ] ifFalse:[
+ def effectivePreRequisites
+ ]
"Created: / 24-02-2011 / 22:47:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2011 / 14:52:43 / cg"
"Modified (format): / 19-11-2011 / 11:25:36 / cg"
+ "Modified: / 17-01-2017 / 16:55:39 / stefan"
!
referencedPreRequisites
@@ -2869,6 +2896,8 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
+
+
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -4437,8 +4466,11 @@
classNamesDict := self classNamesByCategory.
^ String streamContents:[:s |
- classNamesDict keysAndValuesDo:[:eachCategory :classNames|
- s nextPutLine:eachCategory,'_CLASSES= \'.
+ classNamesDict keys asArray sort do:[:eachCategory|
+ | classNames |
+
+ classNames := classNamesDict at: eachCategory.
+ s nextPutAll:eachCategory; nextPutLine:'_CLASSES= \'.
classNames do:[:eachClassName|
s tab; nextPutAll:eachClassName; nextPutLine:' \'.
].
@@ -4456,6 +4488,7 @@
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 20-10-2006 / 16:18:54 / cg"
+ "Modified: / 01-02-2017 / 21:57:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateDefinitionClassLine_libInit_dot_cc
@@ -4749,11 +4782,14 @@
s nextPutLine:newObjectLine.
].
- classNamesDict keysAndValuesDo:[:eachCategory :classNames|
- s nextPutLine:eachCategory,'_OBJS= \'.
+ classNamesDict keys asArray sort do:[:eachCategory |
+ | classNames |
+
+ classNames := classNamesDict at: eachCategory.
+ s nextPutAll:eachCategory; nextPutLine:'_OBJS= \'.
classNames do:putLineForClassName.
(eachCategory = 'COMMON' and:[self hasExtensionMethods]) ifTrue:[
- s nextPutLine:' $(OUTDIR_SLASH)extensions.$(O) \'.
+ s nextPutLine:' $(OUTDIR)extensions.$(O) \'.
].
s cr.
@@ -4770,6 +4806,7 @@
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 20-10-2006 / 16:18:54 / cg"
+ "Modified: / 01-02-2017 / 21:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateRequiredMakePrerequisites_bc_dot_mak
@@ -4939,7 +4976,7 @@
"for xxxmake.bat files"
^ String streamContents:[:s |
- self effectiveSubProjects do:[:packageID |
+ (self effectiveSubProjects:#win32) do:[:packageID |
|pkgLabel skipLabel joinLabel|
pkgLabel := (packageID copyReplaceAll:$: with:$_) copyReplaceAll:$/ with:$_.
@@ -4966,6 +5003,7 @@
"Created: / 14-09-2006 / 18:40:09 / cg"
"Modified: / 27-09-2011 / 19:36:12 / cg"
"Modified: / 12-09-2015 / 12:33:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 17-01-2017 / 16:32:45 / stefan"
!
subProjectMingwmakeCalls
@@ -4990,6 +5028,7 @@
^ self subProjectMakeCallsUsing:'call vcmake %1 %2'.
! !
+
!ProjectDefinition class methodsFor:'file templates'!
autopackage_default_dot_apspec
@@ -5333,7 +5372,7 @@
objectLine_make_dot_spec
- ^' $(OUTDIR_SLASH)%(CLASSFILE).$(O) \'
+ ^' $(OUTDIR)%(CLASSFILE).$(O) \'
"Created: / 08-08-2006 / 20:16:46 / fm"
"Modified: / 23-08-2006 / 11:11:38 / cg"
@@ -5749,7 +5788,7 @@
of 'super additionalClassAttributesFor: aClass'.
Here, we add #autoload attributes to all test cases and
- test resources, as they are not neccessary for the package
+ test resources, as they are not necessary for the package
and should not be compiled (because of unwanted dependency
on stx:goodies/sunit package)
@@ -8148,7 +8187,7 @@
emptyOrNonProjects notEmpty ifTrue:[
(Dialog
- confirm:('The following projects are non-existent, empty or without description:\\ '
+ confirm:('The following subprojects are non-existent, empty or without description:\\ '
, ((emptyOrNonProjects
asSortedCollection
collect:[:p | p allBold])
@@ -8241,6 +8280,7 @@
"
"Modified: / 06-03-2012 / 11:31:37 / cg"
+ "Modified: / 17-01-2017 / 16:33:56 / stefan"
!
validateOrderOfClasses
--- a/ProtoObject.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ProtoObject.st Mon Feb 13 21:29:46 2017 +0000
@@ -159,6 +159,497 @@
valueWithReceiver:self
arguments:{index}
selector:#instVarAt:
+!
+
+isKindOf:aBehavior
+ "this method is required Behavior>>#allSubInstancesDo:"
+
+ aBehavior == Object ifTrue:[^ true].
+
+ ^ (Object compiledMethodAt:#isKindOf:)
+ valueWithReceiver:self
+ arguments:{aBehavior}
+ selector:#isKindOf:
+!
+
+perform:aSelector
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:#().
+!
+
+perform:aSelector with:arg1
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1}.
+!
+
+perform:aSelector with:arg1 with:arg2
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1. arg2}.
+!
+
+perform:aSelector with:arg1 with:arg2 with:arg3
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1. arg2. arg3}.
+!
+
+perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1. arg2. arg3. arg4}.
+!
+
+perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1. arg2. arg3. arg4. arg5}.
+!
+
+perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
+ "this method is required to allow inspection of the object"
+
+ ^ self perform:aSelector withArguments:{arg1. arg2. arg3. arg4. arg5. arg6}.
+!
+
+perform:aSelector withArguments:argArray
+ "send the message aSelector with all args taken from argArray
+ to the receiver.
+
+ 1-to-1 Copy from the same method in Object!!"
+
+ |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
+
+%{
+#ifdef __SCHTEAM__
+ return context.PERFORM_WITH_ARGUMENTS(self, aSelector, argArray);
+#else
+ REGISTER OBJ *argP;
+ int nargs;
+ OBJ l;
+
+ if (__isArrayLike(argArray)) {
+ nargs = __arraySize(argArray);
+ argP = __arrayVal(argArray);
+ } else {
+ if (__isNonNilObject(argArray)) {
+ static struct inlineCache ilcSize = __ILC0(@line);
+ int i;
+
+ numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
+ if (!__isSmallInteger(numberOfArgs))
+ goto bad;
+ nargs = __intVal(numberOfArgs);
+ argP = (OBJ *)(&a1);
+ for (i=1; i <= nargs; i++) {
+ *argP++ = __AT_(argArray, __mkSmallInteger(i));
+ }
+ argP = (OBJ *)(&a1);
+ } else {
+ nargs = 0;
+ }
+ }
+ switch (nargs) {
+ case 0:
+ if (InterruptPending == nil) {
+ static OBJ last0_0 = nil; static struct inlineCache ilc0_0 = __ILCPERF0(@line);
+ static OBJ last0_1 = nil; static struct inlineCache ilc0_1 = __ILCPERF0(@line);
+ static OBJ last0_2 = nil; static struct inlineCache ilc0_2 = __ILCPERF0(@line);
+ static OBJ last0_3 = nil; static struct inlineCache ilc0_3 = __ILCPERF0(@line);
+ static int flip0 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last0_0) {
+ pIlc = &ilc0_0;
+ } else if (aSelector == last0_1) {
+ pIlc = &ilc0_1;
+ } else if (aSelector == last0_2) {
+ pIlc = &ilc0_2;
+ } else if (aSelector == last0_3) {
+ pIlc = &ilc0_3;
+ } else {
+ if (flip0 == 0) {
+ pIlc = &ilc0_0;
+ flip0 = 1;
+ last0_0 = aSelector;
+ } else if (flip0 == 1) {
+ pIlc = &ilc0_1;
+ flip0 = 2;
+ last0_1 = aSelector;
+ } else if (flip0 == 2) {
+ pIlc = &ilc0_2;
+ flip0 = 3;
+ last0_2 = aSelector;
+ } else {
+ pIlc = &ilc0_3;
+ flip0 = 0;
+ last0_3 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND0ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
+ } else {
+ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
+ RETURN (_SEND0(self, aSelector, nil, &ilc0));
+ }
+
+ case 1:
+ if (InterruptPending == nil) {
+ static OBJ last1_0 = nil; static struct inlineCache ilc1_0 = __ILCPERF1(@line);
+ static OBJ last1_1 = nil; static struct inlineCache ilc1_1 = __ILCPERF1(@line);
+ static OBJ last1_2 = nil; static struct inlineCache ilc1_2 = __ILCPERF1(@line);
+ static OBJ last1_3 = nil; static struct inlineCache ilc1_3 = __ILCPERF1(@line);
+ static int flip1 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last1_0) {
+ pIlc = &ilc1_0;
+ } else if (aSelector == last1_1) {
+ pIlc = &ilc1_1;
+ } else if (aSelector == last1_2) {
+ pIlc = &ilc1_2;
+ } else if (aSelector == last1_3) {
+ pIlc = &ilc1_3;
+ } else {
+ if (flip1 == 0) {
+ pIlc = &ilc1_0;
+ flip1 = 1;
+ last1_0 = aSelector;
+ } else if (flip1 == 1) {
+ pIlc = &ilc1_1;
+ flip1 = 2;
+ last1_1 = aSelector;
+ } else if (flip1 == 2) {
+ pIlc = &ilc1_2;
+ flip1 = 3;
+ last1_2 = aSelector;
+ } else {
+ pIlc = &ilc1_3;
+ flip1 = 0;
+ last1_3 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND1ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
+ } else {
+ static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
+ RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
+ }
+
+ case 2:
+ if (InterruptPending == nil) {
+ static OBJ last2_0 = nil; static struct inlineCache ilc2_0 = __ILCPERF2(@line);
+ static OBJ last2_1 = nil; static struct inlineCache ilc2_1 = __ILCPERF2(@line);
+ static int flip2 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last2_0) {
+ pIlc = &ilc2_0;
+ } else if (aSelector == last2_1) {
+ pIlc = &ilc2_1;
+ } else {
+ if (flip2 == 0) {
+ pIlc = &ilc2_0;
+ flip2 = 1;
+ last2_0 = aSelector;
+ } else {
+ pIlc = &ilc2_1;
+ flip2 = 0;
+ last2_1 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND2ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1]));
+ } else {
+ static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
+ RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
+ }
+
+ case 3:
+ if (InterruptPending == nil) {
+ static OBJ last3_0 = nil; static struct inlineCache ilc3_0 = __ILCPERF3(@line);
+ static OBJ last3_1 = nil; static struct inlineCache ilc3_1 = __ILCPERF3(@line);
+ static int flip3 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last3_0) {
+ pIlc = &ilc3_0;
+ } else if (aSelector == last3_1) {
+ pIlc = &ilc3_1;
+ } else {
+ if (flip3 == 0) {
+ pIlc = &ilc3_0;
+ flip3 = 1;
+ last3_0 = aSelector;
+ } else {
+ pIlc = &ilc3_1;
+ flip3 = 0;
+ last3_1 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND3ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1], argP[2]));
+ } else {
+ static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
+ RETURN (_SEND3(self, aSelector, nil, &ilc3, argP[0], argP[1], argP[2]));
+ }
+
+ case 4:
+ {
+ static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last4)) {
+ ilc4.ilc_func = __SEND4ADDR__;
+ if (ilc4.ilc_poly) {
+ __flushPolyCache(ilc4.ilc_poly);
+ ilc4.ilc_poly = 0;
+ }
+ last4 = aSelector;
+ }
+ RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
+ argP[0], argP[1], argP[2], argP[3]));
+ }
+
+ case 5:
+ {
+ static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last5)) {
+ ilc5.ilc_func = __SEND5ADDR__;
+ if (ilc5.ilc_poly) {
+ __flushPolyCache(ilc5.ilc_poly);
+ ilc5.ilc_poly = 0;
+ }
+ last5 = aSelector;
+ }
+ RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5,
+ argP[0], argP[1], argP[2], argP[3], argP[4]));
+ }
+
+ case 6:
+ {
+ static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last6)) {
+ ilc6.ilc_func = __SEND6ADDR__;
+ if (ilc6.ilc_poly) {
+ __flushPolyCache(ilc6.ilc_poly);
+ ilc6.ilc_poly = 0;
+ }
+ last6 = aSelector;
+ }
+ RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5]));
+ }
+
+ case 7:
+ {
+ static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last7)) {
+ ilc7.ilc_func = __SEND7ADDR__;
+ if (ilc7.ilc_poly) {
+ __flushPolyCache(ilc7.ilc_poly);
+ ilc7.ilc_poly = 0;
+ }
+ last7 = aSelector;
+ }
+ RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6]));
+ }
+
+ case 8:
+ {
+ static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last8)) {
+ ilc8.ilc_func = __SEND8ADDR__;
+ if (ilc8.ilc_poly) {
+ __flushPolyCache(ilc8.ilc_poly);
+ ilc8.ilc_poly = 0;
+ }
+ last8 = aSelector;
+ }
+ RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7]));
+ }
+
+ case 9:
+ {
+ static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last9)) {
+ ilc9.ilc_func = __SEND9ADDR__;
+ if (ilc9.ilc_poly) {
+ __flushPolyCache(ilc9.ilc_poly);
+ ilc9.ilc_poly = 0;
+ }
+ last9 = aSelector;
+ }
+ RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8]));
+ }
+
+ case 10:
+ {
+ static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last10)) {
+ ilc10.ilc_func = __SEND10ADDR__;
+ if (ilc10.ilc_poly) {
+ __flushPolyCache(ilc10.ilc_poly);
+ ilc10.ilc_poly = 0;
+ }
+ last10 = aSelector;
+ }
+ RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9]));
+ }
+
+ case 11:
+ {
+ static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last11)) {
+ ilc11.ilc_func = __SEND11ADDR__;
+ if (ilc11.ilc_poly) {
+ __flushPolyCache(ilc11.ilc_poly);
+ ilc11.ilc_poly = 0;
+ }
+ last11 = aSelector;
+ }
+ RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10]));
+ }
+
+ case 12:
+ {
+ static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last12)) {
+ ilc12.ilc_func = __SEND12ADDR__;
+ if (ilc12.ilc_poly) {
+ __flushPolyCache(ilc12.ilc_poly);
+ ilc12.ilc_poly = 0;
+ }
+ last12 = aSelector;
+ }
+ RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11]));
+ }
+
+ case 13:
+ {
+ static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last13)) {
+ ilc13.ilc_func = __SEND13ADDR__;
+ if (ilc13.ilc_poly) {
+ __flushPolyCache(ilc13.ilc_poly);
+ ilc13.ilc_poly = 0;
+ }
+ last13 = aSelector;
+ }
+ RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12]));
+ }
+
+ case 14:
+ {
+ static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last14)) {
+ ilc14.ilc_func = __SEND14ADDR__;
+ if (ilc14.ilc_poly) {
+ __flushPolyCache(ilc14.ilc_poly);
+ ilc14.ilc_poly = 0;
+ }
+ last14 = aSelector;
+ }
+ RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13]));
+ }
+
+ case 15:
+ {
+ static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last15)) {
+ ilc15.ilc_func = __SEND15ADDR__;
+ if (ilc15.ilc_poly) {
+ __flushPolyCache(ilc15.ilc_poly);
+ ilc15.ilc_poly = 0;
+ }
+ last15 = aSelector;
+ }
+ RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13],
+ argP[14]));
+ }
+ }
+bad:;
+#endif
+%}.
+
+ "/ arrive here, if bad number of arguments (too many)
+ "/ ST/X (currently) only allows up to 15 method arguments
+
+ ^ self primitiveFailed
+!
+
+referencesAny:anObject
+ "this method is required to allow inspection of the object"
+
+ ^ (Object compiledMethodAt:#referencesAny:)
+ valueWithReceiver:self
+ arguments:{anObject}
+ selector:#referencesAny
+!
+
+referencesObject:anObject
+ "this method is required to allow inspection of the object"
+
+ ^ (Object compiledMethodAt:#referencesObject:)
+ valueWithReceiver:self
+ arguments:{anObject}
+ selector:#referencesObject
! !
!ProtoObject methodsFor:'queries'!
--- a/ReadStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ReadStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -428,69 +428,6 @@
^ ret
!
-nextDecimalInteger
- "read the next integer in radix 10.
- Does NOT skip initial whitespace.
- The streams elements should be characters.
-
- Be careful - this method returns 0 if not positioned on a digit intitially
- or if the end of the stream is encountered.
-
- Tuned for speed on String-Streams for faster scanning"
-
- |value nextOne|
-%{
- INT pos, limit, sz;
- REGISTER unsigned char *cp;
- REGISTER unsigned ch;
- INT val = 0;
- OBJ coll, p, l;
-
- coll = __INST(collection);
- p = __INST(position);
- l = __INST(readLimit);
-
- if (__isStringLike(coll) && __bothSmallInteger(p, l)) {
-
- pos = __intVal(p);
- /* make 1-based */
- pos++;
- limit = __intVal(l);
- sz = __qSize(coll) - OHDR_SIZE;
- if (sz < limit)
- limit = sz;
- cp = __stringVal(coll) + pos - 1;
-
- for (;;) {
- if (pos > limit) break;
- ch = *cp;
-
- if ((ch < '0') || (ch > '9')) break;
- val = val * 10 + (ch - '0');
- pos++;
- if (val > (_MAX_INT / 10)) goto oops;
- cp++;
- }
- pos--;
- __INST(position) = __mkSmallInteger(pos);
- RETURN (__mkSmallInteger(val));
- }
-oops:
- value = __mkSmallInteger(val);
-%}
-.
- "fall-back for non-string streams - we have to continue where
- above primitive left off, in case of a large integer ...
- (instead of doing a super nextDecimalInteger)"
-
- nextOne := self peek.
- [nextOne notNil and:[nextOne isDigitRadix:10]] whileTrue:[
- value := (value * 10) + nextOne digitValue.
- nextOne := self nextPeek
- ].
- ^ value
-!
-
nextOrNil
"return the next element; advance read pointer.
return nil, if there is no next element.
@@ -950,6 +887,71 @@
^ super upTo:anObject
! !
+!ReadStream methodsFor:'reading-numbers'!
+
+nextDecimalInteger
+ "read the next integer in radix 10.
+ Does NOT skip initial whitespace.
+ The streams elements should be characters.
+
+ Be careful - this method returns 0 if not positioned on a digit intitially
+ or if the end of the stream is encountered.
+
+ Tuned for speed on String-Streams for faster scanning"
+
+ |value nextOne|
+%{
+ INT pos, limit, sz;
+ REGISTER unsigned char *cp;
+ REGISTER unsigned ch;
+ INT val = 0;
+ OBJ coll, p, l;
+
+ coll = __INST(collection);
+ p = __INST(position);
+ l = __INST(readLimit);
+
+ if (__isStringLike(coll) && __bothSmallInteger(p, l)) {
+
+ pos = __intVal(p);
+ /* make 1-based */
+ pos++;
+ limit = __intVal(l);
+ sz = __qSize(coll) - OHDR_SIZE;
+ if (sz < limit)
+ limit = sz;
+ cp = __stringVal(coll) + pos - 1;
+
+ for (;;) {
+ if (pos > limit) break;
+ ch = *cp;
+
+ if ((ch < '0') || (ch > '9')) break;
+ val = val * 10 + (ch - '0');
+ pos++;
+ if (val > (_MAX_INT / 10)) goto oops;
+ cp++;
+ }
+ pos--;
+ __INST(position) = __mkSmallInteger(pos);
+ RETURN (__mkSmallInteger(val));
+ }
+oops:
+ value = __mkSmallInteger(val);
+%}
+.
+ "fall-back for non-string streams - we have to continue where
+ above primitive left off, in case of a large integer ...
+ (instead of doing a super nextDecimalInteger)"
+
+ nextOne := self peek.
+ [nextOne notNil and:[nextOne isDigitRadix:10]] whileTrue:[
+ value := (value * 10) + nextOne digitValue.
+ nextOne := self nextPeek
+ ].
+ ^ value
+! !
+
!ReadStream methodsFor:'writing'!
nextPut:anElement
--- a/ReadWriteStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ReadWriteStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -102,16 +100,6 @@
].
].
^ super next:count
-!
-
-peek
- "return the element to be read next without advancing read position.
- If there are no more elements, nil is returned."
-
- (position >= readLimit) ifTrue:[^ self pastEndRead].
- ^ collection at:(position+1)
-
- "Modified: 5.2.1996 / 21:57:47 / stefan"
! !
!ReadWriteStream methodsFor:'accessing'!
@@ -198,6 +186,18 @@
^ (readLimit ? 0) max:(position ? 0).
! !
+!ReadWriteStream methodsFor:'reading'!
+
+peek
+ "return the element to be read next without advancing read position.
+ If there are no more elements, nil is returned."
+
+ (position >= readLimit) ifTrue:[^ self pastEndRead].
+ ^ collection at:(position+1)
+
+ "Modified: 5.2.1996 / 21:57:47 / stefan"
+! !
+
!ReadWriteStream class methodsFor:'documentation'!
version
--- a/Rectangle.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Rectangle.st Mon Feb 13 21:29:46 2017 +0000
@@ -105,10 +105,10 @@
topLeft := bottomRight := nil.
listOfPoints do:[:p |
- topLeft == nil
- ifTrue: [topLeft := bottomRight := p]
- ifFalse: [topLeft := topLeft min: p.
- bottomRight := bottomRight max: p]
+ topLeft isNil
+ ifTrue: [topLeft := bottomRight := p]
+ ifFalse: [topLeft := topLeft min: p.
+ bottomRight := bottomRight max: p]
].
^ topLeft corner: bottomRight
@@ -186,13 +186,13 @@
topLeft := bottomRight := nil.
listOfRects do:[:r |
- topLeft == nil ifTrue: [
- topLeft := r topLeft.
- bottomRight := r bottomRight
- ] ifFalse: [
- topLeft := topLeft min: r topLeft.
- bottomRight := bottomRight max: r bottomRight
- ]
+ topLeft isNil ifTrue: [
+ topLeft := r topLeft.
+ bottomRight := r bottomRight
+ ] ifFalse: [
+ topLeft := topLeft min: r topLeft.
+ bottomRight := bottomRight max: r bottomRight
+ ]
].
^ topLeft corner: bottomRight
!
@@ -1518,31 +1518,128 @@
"Created: 25.1.1997 / 17:30:21 / cg"
!
-areasOutside: aRectangle
- "Answer an Array of Rectangles comprising the parts of the receiver not
- intersecting aRectangle."
+areasOutside:aRectangle
+ "Answer an Array of Rectangles comprising the parts of the receiver
+ not intersecting aRectangle.
+ That is all areas with no common pixels."
+
+ |areas|
+
+ "Make sure the intersection is non-empty"
+ (self origin <= aRectangle corner and: [aRectangle origin <= self corner]) ifFalse: [
+ ^ Array with: self
+ ].
+ areas := OrderedCollection new.
+ self areasOutside:aRectangle do:[:r | areas add:r].
+ ^ areas asArray
+
+ "/ cg: the old code below was wrong ...
- | areas yOrigin yCorner origin corner|
+"/ "----------------------------------------------------------------
+"/ | added for GNU-ST compatibility
+"/ |
+"/ | author: Doug McCallum <uunet!!ico.isc.com!!dougm>
+"/ |
+"/ |areasOutside: aRectangle
+"/ | most complicated of the Rectangle primitives
+"/ | The basic methodology is to first determine that there is an
+"/ | intersection by finding the overlapping rectangle. From the
+"/ | overlapping rectangle, first determine if it runs along an edge.
+"/ | If it doesn't, extend the rectangle up to the top edge and add
+"/ | the new rectangle to the collection and start the rest of the
+"/ | process. If the left edge does not touch the left edge of self,
+"/ | extend it to the edge saving the new rectangle. Then do the
+"/ | same to the right edge. Then check top and bottom edges. Most
+"/ | of the time only 2 or 3 rectangles get formed, occasionally 4.
+"/ | It should be possible to never get more than 3 but requires more
+"/ | work.
+"/ ----------------------------------------------------------------"
+"/
+"/ | collect iRect tmp |
+"/
+"/ iRect := self intersect: aRectangle.
+"/ iRect isNil ifTrue: [^nil]. "case of no intersection"
+"/ "the collect collection gathers Rectangles"
+"/ collect := OrderedCollection new: 4.
+"/ "is it floating or on the edge?"
+"/ (((((iRect top) ~= self top)
+"/ and: [ (iRect bottom) ~= self bottom ])
+"/ and: [ (iRect left) ~= self left ])
+"/ and: [ (iRect right) ~= self right ] )
+"/ ifTrue: "entirely in the center."
+"/ [tmp := Rectangle origin: (Point x: iRect left y: self top)
+"/ corner: iRect bottomRight.
+"/ collect add: tmp.
+"/ iRect := iRect merge: tmp].
+"/ ((iRect left) ~= self left)
+"/ ifTrue: "doesn't touch left edge so make it touch"
+"/ [tmp := Rectangle origin: (Point x: self left y: iRect top)
+"/ corner: iRect bottomLeft.
+"/ collect add: tmp.
+"/ "merge new (tmp) with overlap to keep track"
+"/ iRect := iRect merge: tmp].
+"/ ((iRect right) ~= self right)
+"/ ifTrue: "doesn't touch right edge so extend it"
+"/ [tmp := Rectangle origin: iRect topRight
+"/ corner: (Point x: self right y: iRect bottom).
+"/ collect add: tmp.
+"/ iRect := iRect merge: tmp].
+"/ (((iRect left) ~= self left) or: [(iRect top) ~= self top])
+"/ ifTrue: "whole top part can be taken now"
+"/ [tmp := Rectangle origin: self origin corner: iRect topRight.
+"/ collect add: tmp].
+"/ (((iRect right) ~= self right) or: [(iRect bottom) ~= self bottom])
+"/ ifTrue: "whole bottom open and can be taken"
+"/ [tmp := Rectangle origin: iRect bottomLeft corner: self corner.
+"/ collect add: tmp].
+"/ ^collect
+!
+
+areasOutside:aRectangle do:aBlock
+ "evaluate aBlock for Rectangles comprising the parts of the receiver
+ not intersecting aRectangle.
+ That is all areas with no common pixels."
+
+ |yOrigin yCorner origin corner|
origin := self origin.
corner := self corner.
"Make sure the intersection is non-empty"
(origin <= aRectangle corner and: [aRectangle origin <= corner])
- ifFalse: [^ Array with: self].
- areas := OrderedCollection new.
- aRectangle origin y > origin y
- ifTrue: [areas addLast: (origin corner: corner x @ (yOrigin := aRectangle origin y))]
- ifFalse: [yOrigin := origin y].
- aRectangle corner y < corner y
- ifTrue: [areas addLast: (origin x @ (yCorner := aRectangle corner y) corner: corner)]
- ifFalse: [yCorner := corner y].
- aRectangle origin x > origin x
- ifTrue: [areas addLast: (origin x @ yOrigin corner: aRectangle origin x @ yCorner)].
- aRectangle corner x < corner x
- ifTrue: [areas addLast: (aRectangle corner x @ yOrigin corner: corner x @ yCorner)].
- ^areas
+ ifFalse: [ aBlock value:self. ^ self].
+ aRectangle origin y > origin y ifTrue: [
+ aBlock value: (origin corner: corner x @ (yOrigin := aRectangle origin y))
+ ] ifFalse: [
+ yOrigin := origin y
+ ].
+ aRectangle corner y < corner y ifTrue: [
+ aBlock value: (origin x @ (yCorner := aRectangle corner y) corner: corner)
+ ] ifFalse: [
+ yCorner := corner y
+ ].
+ aRectangle origin x > origin x ifTrue: [
+ aBlock value: (origin x @ yOrigin corner: aRectangle origin x @ yCorner)
+ ].
+ aRectangle corner x < corner x ifTrue: [
+ aBlock value: (aRectangle corner x @ yOrigin corner: corner x @ yCorner)
+ ].
+
+ "
+ self assert:
+ ((0@0 corner:100@100) areasOutside:(0@0 corner:50@50)) asArray
+ = { (Rectangle origin:0@50 extent:100@50) . (Rectangle origin:50@0 extent:50@50) }
+
+ self assert:
+ ((0@0 corner:150@100) areasOutside:(0@0 corner:100@100)) asArray
+ = { (Rectangle origin:100@0 extent:50@100) }
+
+ self assert:
+ ((0@0 corner:100@150) areasOutside:(0@0 corner:100@100)) asArray
+ = { (Rectangle origin:0@100 extent:100@50) }
+ "
+
"/ cg: the old code below was wrong ...
"/ "----------------------------------------------------------------
--- a/RecursionLock.st Fri Dec 09 22:31:28 2016 +0000
+++ b/RecursionLock.st Mon Feb 13 21:29:46 2017 +0000
@@ -183,7 +183,6 @@
|wasBlocked|
process ~~ Processor activeProcess ifTrue:[
- "I have already got the lock"
self error:'RecursionLock - signaling process doesn''t own the lock'.
].
--- a/SHA1Stream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SHA1Stream.st Mon Feb 13 21:29:46 2017 +0000
@@ -312,29 +312,30 @@
This may be used as checksum or for generating cryptographic signatures.
Notice (2005):
- Be aware that SHA-1 is considered broken and may not be appropriate in some applications.
- Especially it should no longer be used for security stuff.
+ Be aware that SHA-1 is considered broken and may not be appropriate in some applications.
+ Especially it should no longer be used for security stuff.
performance: roughly
- 120400 Kb/s on a 2.5Ghz 64X2 Athlon 4800+ (64bit)
- 47400 Kb/s on a 2Ghz Duo (old measure)
- 9580 Kb/s on a 400Mhz PIII
- 3970 Kb/s on a 300Mhz Sparc
+ 150 Mb/s on a 2007 MAC Powerbook (2.6Ghz I7-Duo)
+ 120400 Kb/s on a 2.5Ghz 64X2 Athlon 4800+ (64bit)
+ 47400 Kb/s on a 2Ghz Duo (old measure)
+ 9580 Kb/s on a 400Mhz PIII
+ 3970 Kb/s on a 300Mhz Sparc
[author:]
- Stefan Vogel
+ Stefan Vogel
[see also:]
- MD5Stream
- SHA256Stream SHA512Stream (in libcrypt)
+ MD5Stream
+ SHA256Stream SHA512Stream (in libcrypt)
[class variables:]
- HashSize size of returned hash value
- ContextSize (implementation) size of hash context
+ HashSize size of returned hash value
+ ContextSize (implementation) size of hash context
[instance variables:]
- hashContext (implementation)
- internal buffer for computation of the hash value
+ hashContext (implementation)
+ internal buffer for computation of the hash value
"
!
--- a/Semaphore.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Semaphore.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -412,17 +410,17 @@
NOTE: must be called with blocked interrupts"
- "for now"
waitingProcesses isNil ifTrue:[
- waitingProcesses := Array with:aProcess
+ "for now - assume that there is probably only one waiter"
+ waitingProcesses := Array with:aProcess
] ifFalse:[
- waitingProcesses isArray ifTrue:[
- "add 2 to reserve space for additional waiters"
- waitingProcesses := (OrderedCollection new:waitingProcesses size + 2)
- addAll:waitingProcesses;
- yourself.
- ].
- waitingProcesses add:aProcess.
+ waitingProcesses isArray ifTrue:[
+ "add 2 to reserve space for additional waiters"
+ waitingProcesses := (OrderedCollection new:waitingProcesses size + 2)
+ addAll:waitingProcesses;
+ yourself.
+ ].
+ waitingProcesses add:aProcess.
].
"/ "Sort, so that higher priority process are resumed first.
@@ -1016,7 +1014,8 @@
|millis|
secondsOrNilOrTimeDuration notNil ifTrue:[
- millis := secondsOrNilOrTimeDuration asFloat * 1000
+ "asFloat converts a TimeDuration to a Float"
+ millis := (secondsOrNilOrTimeDuration asFloat * 1000) asInteger
].
^ self waitWithTimeoutMs:millis.
!
--- a/SequenceableCollection.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SequenceableCollection.st Mon Feb 13 21:29:46 2017 +0000
@@ -2484,7 +2484,7 @@
stop "{ Class:SmallInteger }"
mySize "{ Class:SmallInteger }"|
- pieces := OrderedCollection new.
+ pieces := self speciesForSubcollection new.
start := 1. stop := start + pieceSize - 1.
mySize := self size.
[stop <= mySize] whileTrue:[
@@ -2501,6 +2501,8 @@
'123123123123123123' asCollectionOfSubCollectionsOfSize:3
'12312312312312312312' asCollectionOfSubCollectionsOfSize:3
"
+
+ "Modified: / 24-01-2017 / 18:55:07 / stefan"
!
asCollectionOfSubCollectionsSeparatedBy:anElement
@@ -2513,7 +2515,7 @@
mySize "{ Class:SmallInteger }" startIndex "{ Class:SmallInteger }"
stopIndex "{ Class:SmallInteger }" |
- cols := OrderedCollection new.
+ cols := self speciesForSubcollection new.
myClass := self species.
mySize := self size.
@@ -2544,6 +2546,8 @@
'foobarbaz' asCollectionOfSubCollectionsSeparatedBy: $-.
'' asCollectionOfSubCollectionsSeparatedBy: $-.
"
+
+ "Modified (format): / 24-01-2017 / 18:55:53 / stefan"
!
asCollectionOfSubCollectionsSeparatedBy:anElement do:aBlock
@@ -2612,33 +2616,36 @@
startIndex "{ Class:SmallInteger }"
stopIndex "{ Class:SmallInteger }" |
- items := OrderedCollection new.
+ items := self speciesForSubcollection new.
myClass := self species.
startIndex := 1.
done := false.
[done] whileFalse:[
- stopIndex := self indexOfSubCollection:aSeparatorCollection startingAt:startIndex.
- stopIndex == 0 ifTrue:[
- stopIndex := self size.
- done := true.
- ] ifFalse: [
- stopIndex := stopIndex - 1.
- ].
-
- (stopIndex < startIndex) ifTrue: [
- items add:(myClass new:0)
- ] ifFalse: [
- items add:(self copyFrom:startIndex to:stopIndex)
- ].
- startIndex := stopIndex + (aSeparatorCollection size) + 1.
+ stopIndex := self indexOfSubCollection:aSeparatorCollection startingAt:startIndex.
+ stopIndex == 0 ifTrue:[
+ stopIndex := self size.
+ done := true.
+ ] ifFalse: [
+ stopIndex := stopIndex - 1.
+ ].
+
+ (stopIndex < startIndex) ifTrue: [
+ items add:(myClass new:0)
+ ] ifFalse: [
+ items add:(self copyFrom:startIndex to:stopIndex)
+ ].
+ startIndex := stopIndex + (aSeparatorCollection size) + 1.
].
^ items
"
'1::2::3::4::5::' asCollectionOfSubCollectionsSeparatedByAll:'::'
#(1 2 3 1 2 3 4 3 1 1 2 3 1 4 5) asCollectionOfSubCollectionsSeparatedByAll:#(3 1)
- "
+ 'hello+#world+#here' asCollectionOfSubCollectionsSeparatedByAll:'+#'
+ "
+
+ "Modified (comment): / 24-01-2017 / 18:57:03 / stefan"
!
asCollectionOfSubCollectionsSeparatedByAny:aCollectionOfSeparators
@@ -2669,25 +2676,25 @@
stop "{ Class:SmallInteger }"
mySize "{ Class:SmallInteger }"|
- words := OrderedCollection new.
+ words := self speciesForSubcollection new.
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- "skip multiple separators"
- [ aBlock value:(self at:start)] whileTrue:[
- start := start + 1 .
- start > mySize ifTrue:[
- ^ words
- ].
- ].
-
- stop := self findFirst:aBlock startingAt:start.
- stop == 0 ifTrue:[
- words add:(self copyFrom:start to:mySize).
- ^ words
- ].
- words add:(self copyFrom:start to:(stop - 1)).
- start := stop
+ "skip multiple separators"
+ [ aBlock value:(self at:start)] whileTrue:[
+ start := start + 1 .
+ start > mySize ifTrue:[
+ ^ words
+ ].
+ ].
+
+ stop := self findFirst:aBlock startingAt:start.
+ stop == 0 ifTrue:[
+ words add:(self copyFrom:start to:mySize).
+ ^ words
+ ].
+ words add:(self copyFrom:start to:(stop - 1)).
+ start := stop
].
^ words
@@ -2696,6 +2703,8 @@
'h1e2l3l4o' asCollectionOfSubCollectionsSeparatedByAnyForWhich:[:ch | ch isDigit]
#(1 9 2 8 3 7 4 6 5 5) asCollectionOfSubCollectionsSeparatedByAnyForWhich:[:n | n odd]
"
+
+ "Modified (format): / 24-01-2017 / 18:57:57 / stefan"
!
asSequenceableCollection
@@ -7852,6 +7861,14 @@
^ self subclassResponsibility
!
+speciesForSubcollection
+ "answer the class, when splitting instances into subcollections"
+
+ ^ OrderedCollection
+
+ "Created: / 24-01-2017 / 18:53:44 / stefan"
+!
+
zeroIndex
"return the index value which is returned when nothing
is found in an indexOf* kind of search.
@@ -9307,6 +9324,26 @@
"Modified: / 22-10-2008 / 15:37:48 / cg"
!
+removeAndAddFirst:anElement
+ "if the anElement is in the receiver collection, remove it (compare by equality);
+ then add it to the beginning.
+ Effectively moving the element to the beginning if it is already present,
+ or adding it to the beginning if not already there"
+
+ self remove:anElement ifAbsent:[].
+ self addFirst:anElement.
+!
+
+removeAndAddLast:anElement
+ "if the anElement is in the receiver collection, remove it (compare by equality);
+ then add it to the end.
+ Effectively moving the element to the end if it is already present,
+ or adding it to the end if not already there"
+
+ self remove:anElement ifAbsent:[].
+ self addLast:anElement.
+!
+
reverse
"destructively reverse the order of the elements inplace.
WARNING: this is a destructive operation, which modifies the receiver.
--- a/ShortFloat.st Fri Dec 09 22:31:28 2016 +0000
+++ b/ShortFloat.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
@@ -522,6 +520,7 @@
"Modified: 23.4.1996 / 09:26:45 / cg"
! !
+
!ShortFloat class methodsFor:'queries'!
exponentCharacter
@@ -1048,6 +1047,10 @@
read: http://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
"
+ Epsilon isNil ifTrue:[
+ Epsilon := self class computeEpsilon.
+ ].
+
%{ /* NOCONTEXT */
/*
@@ -1062,29 +1065,29 @@
INT32 ulpDiff;
union {
- float f;
- INT32 i;
+ float f;
+ INT32 i;
} myself, otherFloat;
int nEpsilon;
float scaledEpsilon;
if (!__isSmallInteger(nE)) {
- goto tryHarder;
+ goto tryHarder;
}
nEpsilon = __intVal(nE);
scaledEpsilon = nEpsilon *__shortFloatVal(@global(Epsilon));
if (__isSmallInteger(aNumber)) {
- otherFloat.f = (float)(__intVal(aNumber));
+ otherFloat.f = (float)(__intVal(aNumber));
} else if (aNumber == nil) {
- RETURN(false)
+ RETURN(false)
} else if (__qIsFloatLike(aNumber)) {
- otherFloat.f = (float)(__floatVal(aNumber));
+ otherFloat.f = (float)(__floatVal(aNumber));
} else if (__qIsShortFloat(aNumber)) {
- otherFloat.f = (double)(__shortFloatVal(aNumber));
+ otherFloat.f = (double)(__shortFloatVal(aNumber));
} else {
- goto tryHarder;
+ goto tryHarder;
}
myself.f = __shortFloatVal(self);
@@ -1092,12 +1095,12 @@
// Check if the numbers are really close -- needed
// when comparing numbers near zero (ULP method below fails for numbers near 0!).
if (fabs(myself.f - otherFloat.f) <= scaledEpsilon) {
- RETURN(true);
+ RETURN(true);
}
// if the signs differ, the numbers are different
if ((myself.f >= 0) != (otherFloat.f >= 0)) {
- RETURN(false);
+ RETURN(false);
}
// compute the difference of the 'units in the last place" ULP
@@ -1105,9 +1108,9 @@
ulpDiff = myself.i - otherFloat.i;
if (ulpDiff < 0) ulpDiff = -ulpDiff;
if (ulpDiff <= nEpsilon) {
- RETURN(true);
+ RETURN(true);
} else {
- RETURN(false)
+ RETURN(false)
}
tryHarder:;
@@ -1115,10 +1118,10 @@
^ aNumber isAlmostEqualToFromShortFloat:self nEpsilon:nE
"
- 67329.234 asShortFloat isAlmostEqualTo:67329.23400000001 nEpsilon:1
- 1.0 asShortFloat isAlmostEqualTo:1.0001 nEpsilon:1
- 1.0 asShortFloat isAlmostEqualTo:-1.0 nEpsilon:1
- 1.0 asShortFloat isAlmostEqualTo:1 nEpsilon:1
+ 67329.234 asShortFloat isAlmostEqualTo:67329.23400000001 nEpsilon:1
+ 1.0 asShortFloat isAlmostEqualTo:1.0001 nEpsilon:1
+ 1.0 asShortFloat isAlmostEqualTo:-1.0 nEpsilon:1
+ 1.0 asShortFloat isAlmostEqualTo:1 nEpsilon:1
"
!
--- a/SmallInteger.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SmallInteger.st Mon Feb 13 21:29:46 2017 +0000
@@ -51,8 +51,9 @@
These are no real objects - they have no instances (not even storage !!)
and cannot be subclassed.
- The reason is to save both storage and runtime by not collecting
- SmallIntegers in the system. SmallInts are marked by having the TAG_INT
+ The reason is to save both storage and runtime by not boxing and
+ garbage collecting SmallIntegers in the system.
+ SmallInts are marked by having the TAG_INT
bit set, in contrast to all other objects which do not.
Since this knowledge is hardwired into the system (and there is no
class-field stored with SmallIntegers) there can be no subclass of
@@ -61,6 +62,12 @@
If you really need this kind of thing, create a subclass of Integer,
with an instance variable holding the value.
+ Because the range and sharing of SmallIntegers is different among implementations
+ (both in different dialects, and in different architectures within the Smalltalk/X family),
+ you should not depend on the identity of two integers with the same value.
+ For portable code, when comparing integers, use #'=' and #'~=' (instead of #'==' / #'~~'),
+ unless you are comparing very small integers in the -1024 .. 0 .. 1024 range.
+
[author:]
Claus Gittinger
@@ -961,6 +968,7 @@
! !
+
!SmallInteger methodsFor:'bit operators'!
bitAnd:anInteger
@@ -5239,6 +5247,13 @@
9 nextPowerOf2
22 nextPowerOf2
+ 32 nextPowerOf2
+ 16rFFFF nextPowerOf2 = 16r10000
+ 16rFFFFFFFF nextPowerOf2 = 16r100000000
+ 16r1FFFFFFFFFFFFFFF nextPowerOf2 = 16r2000000000000000
+ 16r3FFFFFFFFFFFFFFF nextPowerOf2 = 16r4000000000000000
+ 16r7FFFFFFFFFFFFFFF nextPowerOf2 = 16r8000000000000000
+ 16rFFFFFFFFFFFFFFFF nextPowerOf2 = 16r10000000000000000
10 factorial nextPowerOf2
20 factorial nextPowerOf2
100 factorial nextPowerOf2
--- a/Smalltalk.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Smalltalk.st Mon Feb 13 21:29:46 2017 +0000
@@ -2075,24 +2075,25 @@
allClassesAndMetaclassesDo:aBlock
"evaluate the argument, aBlock for all classes and metaclasses in the system."
- |already|
-
- already := IdentitySet new:NumberOfClassesHint*2.
+ |already numClassesHintTimes2|
+
+ numClassesHintTimes2 := NumberOfClassesHint*2.
+ already := IdentitySet new:numClassesHintTimes2.
self allClassesDo:[:eachClass |
- |cls|
-
- cls := eachClass theNonMetaclass.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
+ |theNonMeta theMeta|
+
+ theNonMeta := eachClass theNonMetaclass.
+ (already includes:theNonMeta) ifFalse:[
+ aBlock value:theNonMeta.
+ already add:theNonMeta.
].
- cls := cls class.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
+ theMeta := theNonMeta class.
+ (already includes:theMeta) ifFalse:[
+ aBlock value:theMeta.
+ already add:theMeta.
].
- already size > (NumberOfClassesHint * 2) ifTrue:[
- NumberOfClassesHint := (already size // 2) + 1
+ already size > numClassesHintTimes2 ifTrue:[
+ NumberOfClassesHint := (already size // 2) + 10
].
].
!
@@ -2248,7 +2249,10 @@
<resource: #obsolete>
"evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+ self obsoleteMethodWarning:'please use #keysDo:'.
self keysDo:aBlock
+
+ "Modified: / 20-01-2017 / 17:52:40 / stefan"
!
allMethodCategories
@@ -2753,7 +2757,11 @@
AbstractSourceCodeManager notNil ifTrue:[
sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString.
sourceCodeManager notNil ifTrue:[
- ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
+ PackageLoadError handle:[:ex2 |
+ ex reject
+ ] do:[
+ ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
+ ].
].
].
].
@@ -3888,21 +3896,22 @@
startBlocks := self startBlocks.
startBlocks notNil ifTrue:[
- 'Smalltalk [info]: execute startBlocks...' infoPrintCR.
- startBlocks do:[:aBlock|
- Error handle:[:ex |
- InfoPrinting == true ifTrue:[
- 'Smalltalk [warning]: error caught in startBlock: ' infoPrint.
- ex description infoPrintCR.
- ex infoPrintCR.
- thisContext fullPrintAll.
- ].
- ] do: aBlock
- ].
- startBlocks removeAll.
+ Logger info: 'Executing start blocks'.
+ startBlocks copy do:[:aBlock|
+ startBlocks remove: aBlock.
+ aBlock on: Error do:[:ex |
+ Logger error: 'Error when executing start block: %1' with: ex description.
+ InfoPrinting == true ifTrue:[
+ ex description infoPrintCR.
+ ex infoPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ]
+ ].
].
"Created: / 07-01-2012 / 12:58:39 / cg"
+ "Modified: / 18-01-2017 / 22:45:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hideSplashWindow
--- a/SmalltalkLanguage.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SmalltalkLanguage.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,3 +1,14 @@
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -11,6 +22,20 @@
!SmalltalkLanguage class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
documentation
"
provide info about which tools are to be used for smalltalk code
--- a/SomeNumber.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SomeNumber.st Mon Feb 13 21:29:46 2017 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
MetaNumber subclass:#SomeNumber
instanceVariableNames:'realNumber'
classVariableNames:''
@@ -86,6 +88,15 @@
as the receiver, false otherwise."
^ something equalFromSomeNumber:self
+
+ "
+ Float infinity = Infinity positive
+ Infinity positive = Float infinity
+ Float negativeInfinity = Infinity negative
+ Infinity negative = Float negativeInfinity
+ Float negativeInfinity = Infinity positive
+ Infinity positive = Float negativeInfinity
+ "
! !
!SomeNumber methodsFor:'printing'!
@@ -106,6 +117,10 @@
!SomeNumber methodsFor:'queries'!
+isInfinite
+ ^ realNumber isInfinite
+!
+
sign
"return the sign of the receiver (-1, 0 or 1)"
@@ -115,6 +130,6 @@
!SomeNumber class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SomeNumber.st,v 1.4 2014-06-30 14:27:34 stefan Exp $'
+ ^ '$Header$'
! !
--- a/Stream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Stream.st Mon Feb 13 21:29:46 2017 +0000
@@ -2525,45 +2525,91 @@
codePoint := aCharacter codePoint.
codePoint <= 16r7F ifTrue:[
+ "/ 7 bits - 1 byte
self nextPut:aCharacter.
^ self.
].
-
- b1 := Character codePoint:((codePoint bitAnd:16r3F) bitOr:2r10000000).
- v := codePoint bitShift:-6.
- v <= 16r1F ifTrue:[
- self nextPut:(Character value:(v bitOr:2r11000000)).
- self nextPut:b1.
+ codePoint <= 16r7FF ifTrue:[
+ "/ 11 bits - 2 byte sequence 5+6
+ self
+ nextPut:(Character value:(((codePoint bitShift:-6) bitAnd:16r1F) bitOr:16rC0));
+ nextPut:(Character value:((codePoint bitAnd:16r3F) bitOr:16r80)).
+ ^ self.
+ ].
+ codePoint <= 16rFFFF ifTrue:[
+ "/ 16 bits - 3 byte sequence 4+6+6
+ self
+ nextPut:(Character value:(((codePoint bitShift:-12) bitAnd:16r0F) bitOr:16rE0));
+ nextPut:(Character value:(((codePoint bitShift:-6) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:((codePoint bitAnd:16r3F) bitOr:16r80)).
^ self.
].
- b2 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
- v := v bitShift:-6.
- v <= 16r0F ifTrue:[
- self nextPut:(Character value:(v bitOr:2r11100000)).
- self nextPut:b2; nextPut:b1.
+ codePoint <= 16r1FFFFF ifTrue:[
+ "/ 21 bits - 4 byte sequence 3+6+6+6
+ self
+ nextPut:(Character value:(((codePoint bitShift:-18) bitAnd:16r07) bitOr:16rF0));
+ nextPut:(Character value:(((codePoint bitShift:-12) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-6) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:((codePoint bitAnd:16r3F) bitOr:16r80)).
+ ^ self.
+ ].
+ codePoint <= 16r1FFFFF ifTrue:[
+ "/ 26 bits - 5 byte sequence 2+6+6+6+6
+ self
+ nextPut:(Character value:(((codePoint bitShift:-24) bitAnd:16r03) bitOr:16rF8));
+ nextPut:(Character value:(((codePoint bitShift:-18) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-12) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-6) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:((codePoint bitAnd:16r3F) bitOr:16r80)).
^ self.
].
- b3 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
- v := v bitShift:-6.
- v <= 16r07 ifTrue:[
- self nextPut:(Character value:(v bitOr:2r11110000)).
- self nextPut:b3; nextPut:b2; nextPut:b1.
+ codePoint <= 16r3FFFFFF ifTrue:[
+ "/ 31 bits - 6 byte sequence 1+6+6+6+6+6
+ self
+ nextPut:(Character value:(((codePoint bitShift:-30) bitAnd:16r01) bitOr:16rFC));
+ nextPut:(Character value:(((codePoint bitShift:-24) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-18) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-12) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:(((codePoint bitShift:-6) bitAnd:16r3F) bitOr:16r80));
+ nextPut:(Character value:((codePoint bitAnd:16r3F) bitOr:16r80)).
^ self.
].
- b4 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
- v := v bitShift:-6.
- v <= 16r03 ifTrue:[
- self nextPut:(Character value:(v bitOr:2r11111000)).
- self nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
- ^ self.
- ].
- b5 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
- v := v bitShift:-6.
- v <= 16r01 ifTrue:[
- self nextPut:(Character value:(v bitOr:2r11111100)).
- self nextPut:b5; nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
- ^ self.
- ].
+
+"/ b1 := Character codePoint:((codePoint bitAnd:16r3F) bitOr:2r10000000).
+"/ v := codePoint bitShift:-6.
+"/ v <= 16r1F ifTrue:[
+"/ self nextPut:(Character value:(v bitOr:2r11000000)).
+"/ self nextPut:b1.
+"/ ^ self.
+"/ ].
+"/ b2 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
+"/ v := v bitShift:-6.
+"/ v <= 16r0F ifTrue:[
+"/ self nextPut:(Character value:(v bitOr:2r11100000)).
+"/ self nextPut:b2; nextPut:b1.
+"/ ^ self.
+"/ ].
+"/ b3 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
+"/ v := v bitShift:-6.
+"/ v <= 16r07 ifTrue:[
+"/ self nextPut:(Character value:(v bitOr:2r11110000)).
+"/ self nextPut:b3; nextPut:b2; nextPut:b1.
+"/ ^ self.
+"/ ].
+"/ b4 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
+"/ v := v bitShift:-6.
+"/ v <= 16r03 ifTrue:[
+"/ self nextPut:(Character value:(v bitOr:2r11111000)).
+"/ self nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
+"/ ^ self.
+"/ ].
+"/ b5 := Character codePoint:((v bitAnd:16r3F) bitOr:2r10000000).
+"/ v := v bitShift:-6.
+"/ v <= 16r01 ifTrue:[
+"/ self nextPut:(Character value:(v bitOr:2r11111100)).
+"/ self nextPut:b5; nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
+"/ ^ self.
+"/ ].
EncodingError raiseWith:aCharacter errorString:'codePoint > 31bit in #nextPutUtf8:'.
@@ -3244,42 +3290,6 @@
"Modified: 11.1.1997 / 19:09:06 / cg"
!
-skipUntil:aBlock
- "skip all elements for which aBlock returns false.
- Return true if more elements can be read, false if eof has been reached."
-
- [self atEnd] whileFalse:[
- (aBlock value: self peek) ifTrue:[^ true].
- self next
- ].
- ^ false
-
- "
- #(1 2 3 4 5 6 7 8 9 10) readStream
- skipUntil:[:el | el >= 5];
- next
- "
-!
-
-skipWhile:aBlock
- "skip all elements for which aBlock returns true. Return true if more elements can be read,
- false if eof has been reached."
-
- [self atEnd] whileFalse:[
- (aBlock value: self peek) ifFalse:[^ true].
- self next
- ].
- ^ false
-
- "
- #(1 2 3 4 5 6 7 8 9 10) readStream
- skipWhile:[:el | el <= 5];
- next
- "
-
- "Created: / 23-09-2011 / 13:32:40 / cg"
-!
-
through:anObject
"read a collection of all objects up-to anObject and return these
elements, including anObject.
@@ -3330,16 +3340,15 @@
If aCollection is not encountered, all elements up to the end are read
and returned."
- |answerStream element last rslt|
+ |answerStream element last|
last := aCollection last.
answerStream := WriteStream on:(self contentsSpecies new).
- [self atEnd] whileFalse:[
- element := self next.
+ [(element := self nextOrNil) isNil and:[self atEnd]] whileFalse:[
answerStream nextPut:element.
element == last ifTrue:[
- ((rslt := answerStream contents) endsWith:aCollection) ifTrue:[
- ^ rslt
+ (answerStream endsWith:aCollection) ifTrue:[
+ ^ answerStream contents
]
].
].
@@ -3521,10 +3530,10 @@
last := aCollection last.
answerStream := ReadWriteStream on:(self contentsSpecies new).
- [(element := self nextOrNil) notNil] whileTrue:[
+ [(element := self nextOrNil) isNil and:[self atEnd]] whileFalse:[
answerStream nextPut:element.
element == last ifTrue:[
- (answerStream contents endsWith:aCollection) ifTrue:[
+ (answerStream endsWith:aCollection) ifTrue:[
|pos|
pos := answerStream position.
answerStream reset.
@@ -3545,99 +3554,6 @@
"Created: / 15.6.1998 / 19:11:31 / cg"
!
-upToAny:aCollectionOfObjects
- "read a collection of all objects up-to a element which is contained in
- aCollectionOfObjects and return these elements, but excluding the matching one.
- The next read operation will return the element AFTER anObject.
- If no such element is encountered, all elements up to the end are read
- and returned.
- Compare this with #throughAll: which also reads up to some object
- and also positions behind it, but DOES include it in the returned
- value."
-
- |result|
-
- result := self upToBeforeAny:aCollectionOfObjects.
- self atEnd ifFalse:[
- self next.
- ].
- ^ result
-
- "
- |s|
- s := ReadStream on:'hello world'.
- Transcript showCR:(s upToAny:(Array with:Character space)).
- Transcript showCR:(s upToEnd)
-
- 'Makefile' asFilename readStream upToAny:($A to:$Z)
- "
-
- "Created: / 30.8.1997 / 03:02:05 / cg"
- "Modified: / 11.1.1998 / 15:19:18 / cg"
-!
-
-upToBeforeAny:aCollectionOfObjects
- "read a collection of all objects up-to a element which is contained in
- aCollectionOfObjects and return these elements, but excluding the matching one.
- The next read operation will return the matching element.
- If no such element is encountered, all elements up to the end are read
- and returned.
- This returns the exact same as upToAny: would, but leaves the stream's position so that
- the next read returns the matching delimiter instead of skipping it.
- Caveat: this is the one which should have been called upTo: in the first place;
- however, it seems now too late for a change."
-
- |answerStream element|
-
- answerStream := WriteStream on:(self contentsSpecies new).
- [self atEnd] whileFalse:[
- element := self peek.
- (aCollectionOfObjects includes:element) ifTrue: [
- ^ answerStream contents
- ].
- answerStream nextPut:element.
- self next.
- ].
- ^ answerStream contents
-
- "
- |s|
- s := ReadStream on:'hello world'.
- Transcript showCR:(s upToBeforeAny:(Array with:Character space)).
- Transcript showCR:(s upToEnd)
-
- 'Make.proto' asFilename readStream upToBeforeAny:($A to:$Z)
- "
-
- "Created: / 30.8.1997 / 03:02:05 / cg"
- "Modified: / 11.1.1998 / 15:19:18 / cg"
-!
-
-upToElementForWhich:aBlock
- "read elements until aBlock returns true for an element.
- Return the collected elements excluding that element.
- Leave the stream positioned for the next read to return that element.
- If no element matches, all elements up to the end are returned"
-
- |answerStream next|
-
- answerStream := WriteStream on:(self contentsSpecies new).
-
- [
- self atEnd
- or:[ (aBlock value: (next := self peek)) ]
- ] whileFalse:[
- answerStream nextPut:next.
- self next.
- ].
- ^ answerStream contents
-
- "
- #(1 2 3 4 5 6 7 8 9 10) readStream
- upToElementForWhich:[:el | el > 5]
- "
-!
-
upToEnd
"return a collection of the elements up-to the end.
Return an empty collection, if the stream-end is already at the end."
--- a/Symbol.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Symbol.st Mon Feb 13 21:29:46 2017 +0000
@@ -788,57 +788,6 @@
!Symbol methodsFor:'queries'!
-isInfix
- "return true, if the receiver is a binary message selector"
-
- ^ self first isLetterOrDigit not
-
- "
- #at:put: isInfix
- #at: isInfix
- #+ isInfix
- #size isInfix
- "
-
- "Created: / 1.11.1997 / 12:34:55 / cg"
- "Modified: / 1.11.1997 / 12:36:37 / cg"
-!
-
-isKeyword
- "return true, if the receiver is a keyword message selector.
- This is a quick check, which only looks at the last character.
- Should only be used, if we already know that the receiver forms a valid selector.
- To check an arbitrary string, use isKeywordSelector.
- Bad naming, but compatibility is asking for it."
-
- ^ self last == $:
-
- "
- #at:put: isKeyword
- #at: isKeyword
- #+ isKeyword
- #size isKeyword
- "
-
- "Created: / 01-11-1997 / 12:34:55 / cg"
- "Modified (comment): / 30-04-2016 / 18:19:11 / cg"
-!
-
-isSymbol
- "return true, if the receiver is some kind of symbol.
- Since I am a symbol, return always true"
-
- ^ true
-!
-
-isUnary
- "Answer true if the receiver is a unary selector.
- That is not a check for being a valid selector, but instead relies on
- the selector being valid."
-
- ^ self isUnarySelector
-!
-
species
"when copying, or concatenating, return instances of this class"
@@ -906,6 +855,13 @@
Must replace foo isMemberOf:String and foo class == String"
^ false
+!
+
+isSymbol
+ "return true, if the receiver is some kind of symbol.
+ Since I am a symbol, return always true"
+
+ ^ true
! !
!Symbol methodsFor:'tracing'!
--- a/SystemChangeNotifier.st Fri Dec 09 22:31:28 2016 +0000
+++ b/SystemChangeNotifier.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,14 @@
-"{ Encoding: utf8 }"
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -13,6 +22,21 @@
!SystemChangeNotifier class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+
+"
+!
+
documentation
"
For now, this implementation is mostly for squeak compatibility.
--- a/Timestamp.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Timestamp.st Mon Feb 13 21:29:46 2017 +0000
@@ -105,16 +105,12 @@
!Timestamp class methodsFor:'initialization'!
initialize
-
- "/ soon no longer;
- "/ will be changed soon.
- "/ if you need it for backward compatibility, define it in your smalltalk.rc
- AbsoluteTime := self. "backward compatibility"
-
MinOSTime := OperatingSystem epochStartOSTime.
MaxOSTime := OperatingSystem epochEndOSTime.
Epoch := UtcTimestamp basicNew setSeconds:0.
+
+ "Modified: / 19-01-2017 / 17:01:59 / stefan"
! !
!Timestamp class methodsFor:'instance creation'!
@@ -469,6 +465,7 @@
"
! !
+
!Timestamp class methodsFor:'private'!
basicReadFrom:aStream
@@ -1727,6 +1724,7 @@
"
! !
+
!Timestamp methodsFor:'accessing'!
day
@@ -3094,6 +3092,8 @@
"
! !
+
+
!Timestamp methodsFor:'testing'!
isLocalTimestamp
--- a/UndefinedObject.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UndefinedObject.st Mon Feb 13 21:29:46 2017 +0000
@@ -110,6 +110,7 @@
"Modified: 3.1.1997 / 15:06:15 / cg"
! !
+
!UndefinedObject class methodsFor:'queries'!
canBeSubclassed
@@ -306,6 +307,7 @@
^ 0
! !
+
!UndefinedObject methodsFor:'subclass creation'!
nilSubclass:action
@@ -329,7 +331,7 @@
newClass setSuperclass:nil.
newClass class setSuperclass:Class.
- newClass methodDictionary size == 0 ifTrue:[
+ newClass hasMethods ifFalse:[
Class addChangeRecordForClass:newClass.
CreateMinimumProtocolInNewSubclassQuery query
@@ -738,6 +740,7 @@
^ aVisitor visitNilWith:aParameter
! !
+
!UndefinedObject class methodsFor:'documentation'!
version
--- a/UninterpretedBytes.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UninterpretedBytes.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -932,7 +930,7 @@
longLongAt:index
"return the 8-bytes starting at index as a signed Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machineÄs natural byte order.
+ The value is retrieved in the machineÄs natural byte order.
This may be worth a primitive."
^ self signedInt64At:index MSB:IsBigEndian
@@ -4764,14 +4762,6 @@
"
! !
-!UninterpretedBytes methodsFor:'inspecting'!
-
-inspector2Tabs
- ^ super inspector2Tabs , #( inspector2TabForHexDump )
-
- "Created: / 27-02-2012 / 21:51:36 / cg"
- "Modified: / 13-02-2015 / 21:03:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
!UninterpretedBytes methodsFor:'misc'!
@@ -4922,6 +4912,79 @@
^ 0
!
+isValidUTF8
+ "returns true, if the receiver contains a valid UTF8 encoded string"
+
+ |trailing "{ Class: SmallInteger }"|
+
+ trailing := 0.
+
+ 1 to:self size do:[:idx |
+ |byte "{ Class: SmallInteger }" |
+
+ byte := self byteAt:idx.
+ trailing ~~ 0 ifTrue:[
+ (byte bitAnd:2r11000000) == 2r10000000 ifFalse:[^ false].
+ trailing := trailing - 1.
+ ] ifFalse:[
+ (byte bitAnd:16r80) == 0 ifTrue:[
+ "/ continue
+ ] ifFalse:[
+ (byte bitAnd:2r11100000) == 2r11000000 ifTrue:[
+ "/ strict: should not be encoded this way (could have used a shorter sequence)
+ (byte bitAnd:2r00011110) == 0 ifTrue:[
+ ^ false
+ ].
+ trailing := 1.
+ ] ifFalse:[
+ (byte bitAnd:2r11110000) == 2r11100000 ifTrue:[
+ trailing := 2.
+ ] ifFalse:[
+ (byte bitAnd:2r11111000) == 2r11110000 ifTrue:[
+ trailing := 3.
+ ] ifFalse:[
+ (byte bitAnd:2r11111100) == 2r11111000 ifTrue:[
+ trailing := 4.
+ ] ifFalse:[
+ (byte bitAnd:2r11111110) == 2r11111100 ifTrue:[
+ trailing := 5.
+ ] ifFalse:[
+ ^ false
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ^ trailing == 0
+
+ "
+ 'abc' isValidUTF8
+ 'abcöäü' isValidUTF8
+ 'abcöäü' utf8Encoded isValidUTF8
+ (Character value:16r800) utf8Encoded isValidUTF8
+ (Character value:16r1000) utf8Encoded isValidUTF8
+
+ 1 to:255 do:[:c1 |
+ 1 to:255 do:[:c2 |
+ 1 to:255 do:[:c3 |
+ self assert:(c1 asCharacter , c2 asCharacter , c3 asCharacter) utf8Encoded isValidUTF8
+ ]
+ ]
+ ]
+
+ |s|
+ 1 to:10000 do:[:c1 |
+ 1 to:255 do:[:c2 |
+ s := (c1 asCharacter , c2 asCharacter).
+ self assert:s utf8Encoded isValidUTF8
+ ]
+ ]
+ "
+!
+
referencesAny:aCollection
"redefined to speed up searching when many of my instances are present"
--- a/UnixFilename.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UnixFilename.st Mon Feb 13 21:29:46 2017 +0000
@@ -45,7 +45,7 @@
examples
"
- (self named:'/tmp/äöü') writeStream close
+ (self named:'/tmp/') writeStream close
"
! !
@@ -144,13 +144,14 @@
!UnixFilename methodsFor:'file queries'!
fileType
- "this returns a string describing the type of contents of
- the file. This is done using the unix 'file' command,
+ "this returns a string describing the type of contents of the file.
+ This is done using the unix 'file' command,
(which usually is configurable by /etc/magic).
Warning:
Since the returned string differs among systems (and language settings),
it is only useful for user-information;
- NOT as a tag to be used by a program."
+ NOT as a tag to be used by a program.
+ For this, use mimeType or mimeTypeOfContents."
|typeString|
--- a/UnixOperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UnixOperatingSystem.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -1000,16 +998,16 @@
Never access UnixOperatingSystem directly. Always only refer to OperatingSystem,
if at all. Most functionality is actually used indirectly, via the Filename, PipeStream
or Socket classes.
-
- Some of the functions are specific for unix, some may not be found in other OS's
+
+ Some of the functions are specific for unix, some may not be found in other OS's
or behave slightly different, returning different data.
-
+
For portable programs, only rely on protocol which is found in my abstract
superclass, and will therefore also be found in my correspnding sibling os-classes
(i.e. Win32OperatingSystem).
If you need os-specific functionality, surround it by a condition, such as
OperatingSystem isUNIXlike or OperatingSystem isMSWINDOWSlike.
-
+
On the other hand: I do not want to hide all features
from you - in some situations it MAY be interesting to be
able to get down to a select or fork system call easily (at least on Unix systems).
@@ -1018,26 +1016,26 @@
Notice, that on Unix systems, the Win32OperatingSystem class is not even loaded,
and vice versa. So you may have to open a changes browser on the other class, to check
how the corresponding function operates in the other os.
-
+
[Class variables:]
- HostName <String> remembered hostname
-
- DomainName <String> remembered domainname
-
- SlowFork <Boolean> if set, fork and popen are avoided;
- (more or less obsolete now)
-
-
- CurrentDirectory <String> remembered currentDirectories path
+ HostName <String> remembered hostname
+
+ DomainName <String> remembered domainname
+
+ SlowFork <Boolean> if set, fork and popen are avoided;
+ (more or less obsolete now)
+
+
+ CurrentDirectory <String> remembered currentDirectories path
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- OSProcessStatus
- Filename Date Time
- ExternalStream FileStream PipeStream Socket
+ OSProcessStatus
+ Filename Date Time
+ ExternalStream FileStream PipeStream Socket
"
!
@@ -2066,16 +2064,16 @@
cmd := 'xterm -e "%1"' bindWith:shellCommand.
inBackground ifTrue:[
- ^ self
- startProcess:cmd
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- environment:nil
- inDirectory:nil
+ ^ self
+ startProcess:cmd
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ auxFrom:nil
+ environment:nil
+ inDirectory:nil
] ifFalse:[
- ^ self executeCommand:cmd
+ ^ self executeCommand:cmd
].
"
@@ -3186,70 +3184,34 @@
!UnixOperatingSystem class methodsFor:'executing OS commands-implementation'!
exec:aCommandPathArg withArguments:argColl environment:environmentDictionary
- fileDescriptors:fdColl fork:doFork newPgrp:newPgrp inDirectory:aDirectory
-
- ^ self
- exec:aCommandPathArg withArguments:argColl environment:environmentDictionary
- fileDescriptors:fdColl fork:doFork newPgrp:newPgrp inDirectory:aDirectory showWindow:nil
-
- "
- |id|
-
- id := OperatingSystem fork.
- id == 0 ifTrue:[
- 'I am the child'.
- OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
- 'not reached'.
- ]
- "
- "
- |id|
-
- id := OperatingSystem fork.
- id == 0 ifTrue:[
- 'I am the child'.
- OperatingSystem
- exec:'/bin/sh'
- withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
- 'not reached'.
- ].
- id printNL.
- (Delay forSeconds:3.5) wait.
- 'killing ...' printNL.
- OperatingSystem sendSignal:(OperatingSystem sigTERM) to:id.
- OperatingSystem sendSignal:(OperatingSystem sigKILL) to:id
- "
-!
-
-exec:aCommandPathArg withArguments:argColl environment:environmentDictionary
fileDescriptors:fdColl fork:doFork newPgrp:newPgrp inDirectory:aDirectory showWindow:ignoredHere
"Internal lowLevel entry for combined fork & exec;
If fork is false (chain a command):
- execute the OS command specified by the argument, aCommandPath, with
- arguments in argArray (no arguments, if nil).
- If successful, this method does not return and smalltalk is gone.
- If not successful, it does return.
- Normal use is with forkForCommand.
+ execute the OS command specified by the argument, aCommandPath, with
+ arguments in argArray (no arguments, if nil).
+ If successful, this method does not return and smalltalk is gone.
+ If not successful, it does return.
+ Normal use is with forkForCommand.
If fork is true (subprocess command execution):
- fork a child to do the above.
- The process id of the child process is returned; nil if the fork failed.
+ fork a child to do the above.
+ The process id of the child process is returned; nil if the fork failed.
fdColl contains the filedescriptors, to be used for the child (if fork is true).
- fdArray[1] = 15 -> use fd 15 as stdin.
- If an element of the array is set to nil, the corresponding filedescriptor
- will be closed for the child.
- fdArray[1] == StdIn for child
- fdArray[2] == StdOut for child
- fdArray[3] == StdErr for child
- on VMS, these must be channels as returned by createMailBox.
- All filedescriptors not present in fdColl will be closed for the child.
+ fdArray[1] = 15 -> use fd 15 as stdin.
+ If an element of the array is set to nil, the corresponding filedescriptor
+ will be closed for the child.
+ fdArray[1] == StdIn for child
+ fdArray[2] == StdOut for child
+ fdArray[3] == StdErr for child
+ on VMS, these must be channels as returned by createMailBox.
+ All filedescriptors not present in fdColl will be closed for the child.
If newPgrp is true, the subprocess will be established in a new process group.
- The processgroup will be equal to id.
- newPgrp is not used on WIN32 and VMS systems.
+ The processgroup will be equal to id.
+ newPgrp is not used on WIN32 and VMS systems.
environmentDictionary specifies environment variables which are passed differently from
the current environment. If non-nil, it must be a dictionary providing
@@ -3257,33 +3219,33 @@
To pass a variable as empty (i.e. unset), pass a nil value.
Notice: this used to be two separate ST-methods; however, in order to use
- vfork on some machines, it had to be merged into one, to avoid write
- accesses to ST/X memory from the vforked-child.
- The code below only does read accesses."
+ vfork on some machines, it had to be merged into one, to avoid write
+ accesses to ST/X memory from the vforked-child.
+ The code below only does read accesses."
|envArray argArray fdArray dirName cnt aCommandPath|
environmentDictionary notEmptyOrNil ifTrue:[
- envArray := Array new:environmentDictionary size.
- cnt := 1.
- environmentDictionary keysAndValuesDo:[:key :val |
- val isNil ifTrue:[
- envArray at:cnt put:((self encodePath:key), '=')
- ] ifFalse:[
- envArray at:cnt put:((self encodePath:key), '=', (self encodePath:val))
- ].
- cnt := cnt + 1.
- ].
+ envArray := Array new:environmentDictionary size.
+ cnt := 1.
+ environmentDictionary keysAndValuesDo:[:key :val |
+ val isNil ifTrue:[
+ envArray at:cnt put:((self encodePath:key), '=')
+ ] ifFalse:[
+ envArray at:cnt put:((self encodePath:key), '=', (self encodePath:val))
+ ].
+ cnt := cnt + 1.
+ ].
].
argColl notNil ifTrue:[
- argArray := argColl asArray collect:[:eachArg| self encodePath:eachArg].
+ argArray := argColl asArray collect:[:eachArg| self encodePath:eachArg].
].
fdColl notNil ifTrue:[
- fdArray := fdColl asArray
+ fdArray := fdColl asArray
].
aDirectory notNil ifTrue:[
- dirName := aDirectory asFilename osNameForFile.
- dirName := self encodePath:dirName.
+ dirName := aDirectory asFilename osNameForFile.
+ dirName := self encodePath:dirName.
].
aCommandPath := self encodePath:aCommandPathArg.
@@ -3299,210 +3261,210 @@
char **_env, **_nEnv;
if (__isStringLike(aCommandPath) &&
- ((argArray == nil) || __isArrayLike(argArray)) &&
- ((fdArray == nil) || __isArrayLike(fdArray))
+ ((argArray == nil) || __isArrayLike(argArray)) &&
+ ((fdArray == nil) || __isArrayLike(fdArray))
) {
- nargs = argArray == nil ? 0 : __arraySize(argArray);
- argv = (char **) malloc(sizeof(char *) * (nargs + 1));
- if (argv) {
- int nOldEnv, nNewEnv;
-
- for (i=0; i < nargs; i++) {
- arg = __ArrayInstPtr(argArray)->a_element[i];
- if (__isStringLike(arg)) {
- argv[i] = (char *) __stringVal(arg);
- } else {
- argv[i] = "";
- }
- }
- argv[i] = NULL;
-
- /*
- * number of new items in environment ..
- */
- nNewEnv = 0;
- if ((envArray != nil) && __isArrayLike(envArray)) {
- nNewEnv = __arraySize(envArray);
- }
-
- if (nNewEnv == 0) {
- _nEnv = environ;
- } else {
- _env = environ;
- /*
- * get size of environment
- */
- nOldEnv = 0;
- if (_env) {
- while (*_env) {
- nOldEnv++;
- _env++;
- }
- }
-
- /*
- * generate a new environment
- * I have not found a spec which defines if
- * items at the end overwrite previous definitions,
- * or if the first encountered definition is valid.
- * To be prepared for any case, simply add the new definitions
- * at both ends - that should do it in any case.
- * Someone with more know-how may want to fix this.
- * getenv() searches for the first entry.
- * But maybe someone creates a Dictionary from the environment.
- * In this case the last entry would overwrite previous entries.
- */
- _nEnv = (char **)malloc(sizeof(char *) * (nNewEnv + nOldEnv + nNewEnv + 1));
- if (_nEnv) {
- char **eO, **eN;
-
- eN = _nEnv;
- if (nNewEnv) {
- /*
- * add new items at the front ...
- */
- int i;
- OBJ *t;
-
- for (i=0, t = __arrayVal(envArray);
- i < __arraySize(envArray);
- i++, t++) {
-
- if (__isStringLike(*t)) {
- *eN++ = (char *)__stringVal(*t);
- }
- }
- }
-
- if (nOldEnv) {
- /*
- * append old environment
- */
- for (eO = environ; *eO; *eN++ = *eO++)
- continue;
- }
-
- if (nNewEnv) {
- /*
- * append new items again at the end
- */
- for (eO = _nEnv, i=0; i<nNewEnv; i++) {
- *eN++ = *eO++;
- }
- }
- *eN = NULL;
- }
- }
-
- if (doFork == true) {
- /*
- * fork a subprocess.
- */
- int nfd;
-
- nfd = fdArray == nil ? 0 : __arraySize(fdArray);
- id = FORK ();
- if (id == 0) {
- /*
- ** In child.
- ** first: dup filedescriptors.
- */
- for (i = 0; i < nfd; i++) {
- OBJ fd;
- int rslt;
-
- fd = __arrayVal(fdArray)[i];
- if (__isSmallInteger(fd) && (__intVal(fd) != i)) {
- do {
- rslt = dup2(__intVal(fd), i);
- } while ((rslt < 0) && (errno == EINTR));
- }
- }
- /*
- ** Second: close descriptors
- ** marked as unwanted
- ** (extra loop to allow duping of low filedescriptor numbers to
- ** higher fd numbers)
- */
- for (i = 0; i < nfd; i++) {
- if (__arrayVal(fdArray)[i] == nil) {
- close(i);
- }
- }
-
- /*
- ** third: close all filedescriptors larger
- ** then the explicitely closed or duped
- ** filedescriptors
- */
+ nargs = argArray == nil ? 0 : __arraySize(argArray);
+ argv = (char **) malloc(sizeof(char *) * (nargs + 1));
+ if (argv) {
+ int nOldEnv, nNewEnv;
+
+ for (i=0; i < nargs; i++) {
+ arg = __ArrayInstPtr(argArray)->a_element[i];
+ if (__isStringLike(arg)) {
+ argv[i] = (char *) __stringVal(arg);
+ } else {
+ argv[i] = "";
+ }
+ }
+ argv[i] = NULL;
+
+ /*
+ * number of new items in environment ..
+ */
+ nNewEnv = 0;
+ if ((envArray != nil) && __isArrayLike(envArray)) {
+ nNewEnv = __arraySize(envArray);
+ }
+
+ if (nNewEnv == 0) {
+ _nEnv = environ;
+ } else {
+ _env = environ;
+ /*
+ * get size of environment
+ */
+ nOldEnv = 0;
+ if (_env) {
+ while (*_env) {
+ nOldEnv++;
+ _env++;
+ }
+ }
+
+ /*
+ * generate a new environment
+ * I have not found a spec which defines if
+ * items at the end overwrite previous definitions,
+ * or if the first encountered definition is valid.
+ * To be prepared for any case, simply add the new definitions
+ * at both ends - that should do it in any case.
+ * Someone with more know-how may want to fix this.
+ * getenv() searches for the first entry.
+ * But maybe someone creates a Dictionary from the environment.
+ * In this case the last entry would overwrite previous entries.
+ */
+ _nEnv = (char **)malloc(sizeof(char *) * (nNewEnv + nOldEnv + nNewEnv + 1));
+ if (_nEnv) {
+ char **eO, **eN;
+
+ eN = _nEnv;
+ if (nNewEnv) {
+ /*
+ * add new items at the front ...
+ */
+ int i;
+ OBJ *t;
+
+ for (i=0, t = __arrayVal(envArray);
+ i < __arraySize(envArray);
+ i++, t++) {
+
+ if (__isStringLike(*t)) {
+ *eN++ = (char *)__stringVal(*t);
+ }
+ }
+ }
+
+ if (nOldEnv) {
+ /*
+ * append old environment
+ */
+ for (eO = environ; *eO; *eN++ = *eO++)
+ continue;
+ }
+
+ if (nNewEnv) {
+ /*
+ * append new items again at the end
+ */
+ for (eO = _nEnv, i=0; i<nNewEnv; i++) {
+ *eN++ = *eO++;
+ }
+ }
+ *eN = NULL;
+ }
+ }
+
+ if (doFork == true) {
+ /*
+ * fork a subprocess.
+ */
+ int nfd;
+
+ nfd = fdArray == nil ? 0 : __arraySize(fdArray);
+ id = FORK ();
+ if (id == 0) {
+ /*
+ ** In child.
+ ** first: dup filedescriptors.
+ */
+ for (i = 0; i < nfd; i++) {
+ OBJ fd;
+ int rslt;
+
+ fd = __arrayVal(fdArray)[i];
+ if (__isSmallInteger(fd) && (__intVal(fd) != i)) {
+ do {
+ rslt = dup2(__intVal(fd), i);
+ } while ((rslt < 0) && (errno == EINTR));
+ }
+ }
+ /*
+ ** Second: close descriptors
+ ** marked as unwanted
+ ** (extra loop to allow duping of low filedescriptor numbers to
+ ** higher fd numbers)
+ */
+ for (i = 0; i < nfd; i++) {
+ if (__arrayVal(fdArray)[i] == nil) {
+ close(i);
+ }
+ }
+
+ /*
+ ** third: close all filedescriptors larger
+ ** then the explicitely closed or duped
+ ** filedescriptors
+ */
#ifndef OPEN_MAX
# define OPEN_MAX 256
#endif
- for ( ;i < OPEN_MAX; i++) {
- close(i);
- }
-
- if (newPgrp == true) {
+ for ( ;i < OPEN_MAX; i++) {
+ close(i);
+ }
+
+ if (newPgrp == true) {
#ifndef NEXT
- setsid();
+ setsid();
#endif
#if defined(TIOCSCTTY)
- ioctl(0, TIOCSCTTY, 0) ;
+ ioctl(0, TIOCSCTTY, 0) ;
#endif
#if defined(TIOCSPGRP)
- {
- int pgrp = getpid();
-
- ioctl(0, TIOCSPGRP, (char *)&pgrp);
- }
+ {
+ int pgrp = getpid();
+
+ ioctl(0, TIOCSPGRP, (char *)&pgrp);
+ }
#endif
#if defined(_POSIX_JOB_CONTROL) || defined(__osx__)
- (void) setpgid(0, 0);
+ (void) setpgid(0, 0);
#else
# if defined(BSD) || defined(LINUX) || defined(__osx__)
- (void) setpgrp(0);
-# endif
-#endif
- }
-
- if (dirName == nil || chdir((char *)__stringVal(dirName)) == 0) {
- execve((char *)__stringVal(aCommandPath), argv, _nEnv);
- }
- /* reached if chdir failed or aCommandPathh cannot be executed */
- _exit(127); /* POSIX 2 compatible exit value */
- }
- } else {
- /*
- * no subprocess (i.e. transfer to another program)
- */
- if (dirName == nil || chdir((char *)__stringVal(dirName)) == 0) {
- execve((char *)__stringVal(aCommandPath), argv, _nEnv);
- }
- /*
- * reached if chdir failed or command-path cannot be executed
- */
- id = -1;
- }
-
- if (nNewEnv && (_nEnv != NULL)) {
- /*
- * free new environment stuff
- */
- free(_nEnv);
- }
-
- free(argv);
-
- /*
- * In parent: succes or failure
- */
- if (id == -1) {
- RETURN (nil);
- } else {
- RETURN (__mkSmallInteger(id));
- }
- }
+ (void) setpgrp(0);
+# endif
+#endif
+ }
+
+ if (dirName == nil || chdir((char *)__stringVal(dirName)) == 0) {
+ execve((char *)__stringVal(aCommandPath), argv, _nEnv);
+ }
+ /* reached if chdir failed or aCommandPathh cannot be executed */
+ _exit(127); /* POSIX 2 compatible exit value */
+ }
+ } else {
+ /*
+ * no subprocess (i.e. transfer to another program)
+ */
+ if (dirName == nil || chdir((char *)__stringVal(dirName)) == 0) {
+ execve((char *)__stringVal(aCommandPath), argv, _nEnv);
+ }
+ /*
+ * reached if chdir failed or command-path cannot be executed
+ */
+ id = -1;
+ }
+
+ if (nNewEnv && (_nEnv != NULL)) {
+ /*
+ * free new environment stuff
+ */
+ free(_nEnv);
+ }
+
+ free(argv);
+
+ /*
+ * In parent: succes or failure
+ */
+ if (id == -1) {
+ RETURN (nil);
+ } else {
+ RETURN (__mkSmallInteger(id));
+ }
+ }
}
%}.
"
@@ -3518,9 +3480,9 @@
id := OperatingSystem fork.
id == 0 ifTrue:[
- 'I am the child'.
- OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
- 'not reached'.
+ 'I am the child'.
+ OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
+ 'not reached'.
]
"
"
@@ -3528,11 +3490,11 @@
id := OperatingSystem fork.
id == 0 ifTrue:[
- 'I am the child'.
- OperatingSystem
- exec:'/bin/sh'
- withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
- 'not reached'.
+ 'I am the child'.
+ OperatingSystem
+ exec:'/bin/sh'
+ withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
+ 'not reached'.
].
id printNL.
(Delay forSeconds:3.5) wait.
@@ -3546,12 +3508,12 @@
"fork a new (HEAVY-weight) unix process.
Not supported with MSDOS & VMS systems.
Don't confuse this with Block>>fork, which creates
- lightweight smalltalk processes.
- This method will return 0 to the child process,
- and a non-zero number (which is the childs unix-process-id)
+ lightweight smalltalk processes.
+ This method will return 0 to the child process,
+ and a non-zero number (which is the childs unix-process-id)
to the parent (original) process.
- In normal situations, you don't need to use this low level entry;
+ In normal situations, you don't need to use this low level entry;
see #startProcess: and #executeCommand: for higher level interfaces."
%{ /* NOCONTEXT */
@@ -3571,251 +3533,34 @@
t1 := Timestamp now.
id := OperatingSystem fork.
id == 0 ifTrue:[
- 'Child t=' print. (Timestamp now - t1) printCR.
- 'I am the child process' printCR.
- OperatingSystem exit
- ].
- 'Parent t=' print. (Timestamp now - t1) printCR.
- "
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
- environment:anEvironmentDictionary inDirectory:dir
-
- ^ self
- startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
- environment:anEvironmentDictionary inDirectory:dir showWindow:nil
-
- "blocking at current prio (i.e. only higher prio threads execute):
-
- OperatingSystem executeCommand:'ls -l > out'.
- OperatingSystem executeCommand:#('/bin/ls' '-l') outputTo:Transcript.
- "
-
- "non-blocking (lower prio threads continue):
-
- |in out err pid sema|
-
- in := 'out' asFilename readStream.
- out := 'out2' asFilename writeStream.
- err := 'err' asFilename writeStream.
-
- sema := Semaphore new.
- pid := OperatingSystem startProcess:'sleep 10; grep drw' inputFrom:in outputTo:out errorTo:err.
-
- The following will no longer work. monitorPid has disappeared
-
- pid notNil ifTrue:[
- Processor monitorPid:pid action:[:osStatus | sema signal ].
+ 'Child t=' print. (Timestamp now - t1) printCR.
+ 'I am the child process' printCR.
+ OperatingSystem exit
].
- in close.
- out close.
- err close.
- sema wait.
- Transcript showCR:'finished'
- "
-
- "
- |pid sema|
-
- sema := Semaphore new.
-
- Processor
- monitor:[
- pid := OperatingSystem startProcess:'(sleep 2; ls -l) > out 2>err'
- ]
- action:[:osStatus | sema signal ].
-
- sema wait.
- Transcript showCR:'finished'
- "
-
- "
- |pid sema|
-
- sema := Semaphore new.
-
- Processor
- monitor:[
- pid := OperatingSystem startProcess:'(sleep 1; echo 1; sleep 9; ls -l) > out 2>err'
- ]
- action:[:osStatus | sema signal ].
-
- Delay waitForSeconds:2.
- OperatingSystem terminateProcess:pid.
- Transcript showCR:'terminated'
- "
-
- "Modified: / 21.3.1997 / 10:04:35 / dq"
- "Modified: / 15.7.1997 / 16:03:51 / stefan"
- "Modified: / 5.6.1998 / 19:03:51 / cg"
- "Created: / 12.11.1998 / 14:39:20 / cg"
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
- environment:anEvironmentDictionary inDirectory:dir newPgrp:newPgrp showWindow:ignoredHere
-
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- If aCommandString is a String, the commandString is passed to a shell for execution
- - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- If aCommandString is an Array, the first element is the command to be executed,
- and the other elements are the arguments to the command. No shell is invoked in this case.
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- |nullStream in out err shellAndArgs rslt auxFd|
-
- aCommandString isNil ifTrue:[^ nil].
-
- (in := anExternalInStream) isNil ifTrue:[
- nullStream := Filename nullDevice readWriteStream.
- in := nullStream.
- ].
- (out := anExternalOutStream) isNil ifTrue:[
- nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
- out := nullStream.
- ].
- (err := anExternalErrStream) isNil ifTrue:[
- err := out
- ].
- anAuxiliaryStream notNil ifTrue:[
- auxFd := anAuxiliaryStream fileDescriptor
- ].
-
- shellAndArgs := self commandAndArgsForOSCommand:aCommandString.
-
- rslt := self
- exec:(shellAndArgs at:1)
- withArguments:(shellAndArgs at:2)
- environment:anEvironmentDictionary
- fileDescriptors:(Array with:in fileDescriptor
- with:out fileDescriptor
- with:err fileDescriptor
- with:auxFd)
- fork:true
- newPgrp:newPgrp
- inDirectory:dir.
-
- nullStream notNil ifTrue:[
- nullStream close.
- ].
-
- ^ rslt
-
- "blocking at current prio (i.e. only higher prio threads execute):
-
- OperatingSystem executeCommand:'ls -l > out'.
- OperatingSystem executeCommand:#('/bin/ls' '-l') outputTo:Transcript.
- "
-
- "non-blocking (lower prio threads continue):
-
- |in out err pid sema|
-
- in := 'out' asFilename readStream.
- out := 'out2' asFilename writeStream.
- err := 'err' asFilename writeStream.
-
- sema := Semaphore new.
- pid := OperatingSystem startProcess:'sleep 10; grep drw' inputFrom:in outputTo:out errorTo:err.
-
- The following will no longer work. monitorPid has disappeared
-
- pid notNil ifTrue:[
- Processor monitorPid:pid action:[:osStatus | sema signal ].
- ].
- in close.
- out close.
- err close.
- sema wait.
- Transcript showCR:'finished'
- "
-
- "
- |pid sema|
-
- sema := Semaphore new.
-
- Processor
- monitor:[
- pid := OperatingSystem startProcess:'(sleep 2; ls -l) > out 2>err'
- ]
- action:[:osStatus | sema signal ].
-
- sema wait.
- Transcript showCR:'finished'
- "
-
- "
- |pid sema|
-
- sema := Semaphore new.
-
- Processor
- monitor:[
- pid := OperatingSystem startProcess:'(sleep 1; echo 1; sleep 9; ls -l) > out 2>err'
- ]
- action:[:osStatus | sema signal ].
-
- Delay waitForSeconds:2.
- OperatingSystem terminateProcess:pid.
- Transcript showCR:'terminated'
- "
-
- "Modified: / 21.3.1997 / 10:04:35 / dq"
- "Modified: / 15.7.1997 / 16:03:51 / stefan"
- "Modified: / 5.6.1998 / 19:03:51 / cg"
- "Created: / 12.11.1998 / 14:39:20 / cg"
-!
-
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
- environment:anEvironmentDictionary inDirectory:dir showWindow:ignoredHere
-
- "start executing the OS command as specified by the argument, aCommandString
- as a separate process; do not wait for the command to finish.
- If aCommandString is a String, the commandString is passed to a shell for execution
- - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- If aCommandString is an Array, the first element is the command to be executed,
- and the other elements are the arguments to the command. No shell is invoked in this case.
- The command gets stdIn, stdOut and stdErr assigned from the arguments;
- each may be nil.
- Return the processId if successful, nil otherwise.
- Use #monitorPid:action: for synchronization and exec status return,
- or #killProcess: to stop it."
-
- ^ self
- startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
- errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
- environment:anEvironmentDictionary inDirectory:dir newPgrp:true showWindow:ignoredHere
+ 'Parent t=' print. (Timestamp now - t1) printCR.
+ "
! !
!UnixOperatingSystem class methodsFor:'executing OS commands-queries'!
commandAndArgsForOSCommand:aCommandStringOrArray
"get a shell and shell arguments for command execution.
- If aCommandString is a String, the commandString is passed to a shell for execution
+ If aCommandStringOrArray is a String, the commandString is passed to a shell for execution
- see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
- If aCommandString is an Array, the first element is the command to be executed,
- and the other elements are the arguments to the command. No shell is invoked in this case."
+ If aCommandStringOrArray is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
+ The third element is nil - here for windows compatibility (showWindow in windows)"
aCommandStringOrArray isNonByteCollection ifTrue:[
"if an array is passed, the command string has already been parsed an no shell is invoked"
- ^ Array with:aCommandStringOrArray first with:aCommandStringOrArray.
+ ^ Array with:aCommandStringOrArray first with:aCommandStringOrArray with:nil.
].
"/
"/ '/bin/sh -c <command>'
"/
- ^ Array with:'/bin/sh' with:(Array with:'sh' with:'-c' with:aCommandStringOrArray)
+ ^ Array with:'/bin/sh' with:(Array with:'sh' with:'-c' with:aCommandStringOrArray) with:nil.
"Modified: / 20.1.1998 / 16:57:19 / md"
"Modified: / 5.6.1998 / 17:40:48 / cg"
@@ -3833,10 +3578,10 @@
Notice: we cannot depend on /proc to be present (actually only is on linux)"
info := '/proc/self/exe' asFilename linkInfo.
info notNil ifTrue:[
- path := info path.
- path notEmptyOrNil ifTrue:[
- ^ path
- ].
+ path := info path.
+ path notEmptyOrNil ifTrue:[
+ ^ path
+ ].
].
"Fall back - do it the hard way"
@@ -3857,44 +3602,44 @@
commandFilename := aCommand asFilename.
commandFilename isAbsolute ifTrue:[
- "/ something like "/foo/...", tried path is it
- commandFilename isExecutable ifFalse:[^ nil].
- ^ commandFilename pathName
+ "/ something like "/foo/...", tried path is it
+ commandFilename isExecutable ifFalse:[^ nil].
+ ^ commandFilename pathName
].
commandFilename isExplicitRelative ifTrue:[
- "/ something like "../foo/...", tried path resolved relative to the current directory
- commandFilename isExecutable ifFalse:[^ nil].
- ^ commandFilename pathName
+ "/ something like "../foo/...", tried path resolved relative to the current directory
+ commandFilename isExecutable ifFalse:[^ nil].
+ ^ commandFilename pathName
].
(aCommand includes:$/) ifTrue:[
- "/ something like "smalltalk/stx", tried path is relative to the current directory
- (f := ('./',aCommand) asFilename) isExecutable ifTrue:[
- ^ f pathName
- ].
- ^ nil
+ "/ something like "smalltalk/stx", tried path is relative to the current directory
+ (f := ('./',aCommand) asFilename) isExecutable ifTrue:[
+ ^ f pathName
+ ].
+ ^ nil
].
"/ command is a single word, not relative and not absolute.
"/ search along PATH environment variable to see what a shell would do.
path := self getEnvironment:'PATH'.
path notEmptyOrNil ifTrue:[
- (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
- eachPathComponent isEmpty ifTrue:[
- f := commandFilename
- ] ifFalse:[
- f := eachPathComponent asFilename construct:aCommand.
- ].
- self executableFileExtensions do:[:eachExtension |
- eachExtension notEmpty ifTrue:[
- fExt := f addSuffix:eachExtension.
- ] ifFalse:[
- fExt := f.
- ].
- fExt isExecutable ifTrue:[
- ^ fExt pathName
- ].
- ].
- ].
+ (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
+ eachPathComponent isEmpty ifTrue:[
+ f := commandFilename
+ ] ifFalse:[
+ f := eachPathComponent asFilename construct:aCommand.
+ ].
+ self executableFileExtensions do:[:eachExtension |
+ eachExtension notEmpty ifTrue:[
+ fExt := f addSuffix:eachExtension.
+ ] ifFalse:[
+ fExt := f.
+ ].
+ fExt isExecutable ifTrue:[
+ ^ fExt pathName
+ ].
+ ].
+ ].
].
^ nil
@@ -3946,7 +3691,7 @@
&& __isSmallInteger(outFd)
&& __isSmallInteger(startIdx)
&& __isSmallInteger(count)) {
- off_t startOffset = __intVal(startIdx);
+ off_t startOffset = __intVal(startIdx);
ssize_t nWritten;
nWritten = sendfile(__intVal(outFd), __intVal(inFd), &startOffset, __intVal(count));
@@ -3988,10 +3733,10 @@
%{
if (__isStringLike(encodedPathName) && __isSmallInteger(umask)) {
- if (mkdir(__stringVal(encodedPathName), __smallIntegerVal(umask)) >= 0) {
- RETURN(nil);
- }
- error = __mkSmallInteger(errno);
+ if (mkdir(__stringVal(encodedPathName), __smallIntegerVal(umask)) >= 0) {
+ RETURN(nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
"/ could not create - if it already existed this is ok
@@ -3999,8 +3744,8 @@
(self isDirectory:aPathName) ifTrue:[^ nil].
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -4041,21 +3786,21 @@
int ret;
if (__isStringLike(encodedOldPathName) && __isStringLike(encodedNewPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = link((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = link((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
"/
@@ -4082,29 +3827,29 @@
int ret;
if (__isStringLike(encodedOldPathName) && __isStringLike(encodedNewPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = symlink((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = symlink((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
#endif
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
(encodedOldPathName isString not or:[encodedNewPathName isString not]) ifTrue:[
- "/
- "/ bad argument(s) given
- "/
- ^ self primitiveFailed
+ "/
+ "/ bad argument(s) given
+ "/
+ ^ self primitiveFailed
].
"/
@@ -4301,22 +4046,22 @@
int ret;
if (__isStringLike(encodedPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = rmdir((char *) __stringVal(encodedPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = rmdir((char *) __stringVal(encodedPathName));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
"/
@@ -4341,22 +4086,22 @@
int ret;
if (__isStringLike(encodedPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = unlink((char *) __stringVal(encodedPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = unlink((char *) __stringVal(encodedPathName));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
@@ -4380,32 +4125,32 @@
if (__isStringLike(encodedOldPathName) && __isStringLike(encodedNewPathName)) {
#if defined(HAS_RENAME)
- __BEGIN_INTERRUPTABLE__
- do {
- ret = rename((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = rename((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
#else
- ret = link((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
- if (ret >= 0) {
- ret = unlink((char *) __stringVal(encodedOldPathName));
- if (ret < 0) {
- eno = errno;
- unlink((char *) __stringVal(encodedNewPathName));
- errno = eno;
- }
- }
-#endif
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ ret = link((char *) __stringVal(encodedOldPathName), (char *) __stringVal(encodedNewPathName));
+ if (ret >= 0) {
+ ret = unlink((char *) __stringVal(encodedOldPathName));
+ if (ret < 0) {
+ eno = errno;
+ unlink((char *) __stringVal(encodedNewPathName));
+ errno = eno;
+ }
+ }
+#endif
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -4469,69 +4214,69 @@
off_t truncateSize;
if (!__isStringLike(encodedPathName))
- goto getOutOfHere;
+ goto getOutOfHere;
if (__isSmallInteger(newSize)) {
- truncateSize = __intVal(newSize);
- if (truncateSize < 0) {
- goto getOutOfHere;
- }
+ truncateSize = __intVal(newSize);
+ if (truncateSize < 0) {
+ goto getOutOfHere;
+ }
} else {
- truncateSize = __signedLongIntVal(newSize);
- if (truncateSize < 0) {
- goto getOutOfHere;
- }
- if (truncateSize == 0) {
- if (sizeof(truncateSize) == 8) {
- if (__signedLong64IntVal(newSize, &truncateSize) == 0 || truncateSize < 0) {
- goto getOutOfHere;
- }
- } else {
- goto getOutOfHere;
- }
- }
+ truncateSize = __signedLongIntVal(newSize);
+ if (truncateSize < 0) {
+ goto getOutOfHere;
+ }
+ if (truncateSize == 0) {
+ if (sizeof(truncateSize) == 8) {
+ if (__signedLong64IntVal(newSize, &truncateSize) == 0 || truncateSize < 0) {
+ goto getOutOfHere;
+ }
+ } else {
+ goto getOutOfHere;
+ }
+ }
}
#if defined(HAS_TRUNCATE)
- __BEGIN_INTERRUPTABLE__
- do {
- ret = truncate((char *) __stringVal(encodedPathName), truncateSize);
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = truncate((char *) __stringVal(encodedPathName), truncateSize);
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
#elif defined(HAS_FTRUNCATE)
{
- int fd;
-
- do {
- fd = ret = open((char *) __stringVal(encodedPathName), 2);
- } while (fd < 0 && errno == EINTR);
- if (fd >= 0) {
- ret = ftruncate(fd, truncateSize);
- close(fd);
- }
+ int fd;
+
+ do {
+ fd = ret = open((char *) __stringVal(encodedPathName), 2);
+ } while (fd < 0 && errno == EINTR);
+ if (fd >= 0) {
+ ret = ftruncate(fd, truncateSize);
+ close(fd);
+ }
}
#endif /* HAS_FTRUNCATE */
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
getOutOfHere:;
#else
- error = __mkSmallInteger(ENOTSUP);
+ error = __mkSmallInteger(ENOTSUP);
#endif
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
"
- self truncateFile:'foo' to:2222222
+ self truncateFile:'foo' to:2222222
"
! !
@@ -4614,7 +4359,7 @@
"
this could have been implemented as:
- (self infoOf:aPathName) at:#mode
+ (self infoOf:aPathName) at:#mode
but for huge directory searches the code below is faster
"
@@ -4627,24 +4372,24 @@
if (__isStringLike(encodedPathName)) {
#ifdef TRACE_STAT_CALLS
- printf("stat on '%s' for accessMode\n", __stringVal(encodedPathName));
-#endif
- __BEGIN_INTERRUPTABLE__
- do {
- ret = stat((char *) __stringVal(encodedPathName), &buf);
- } while ((ret < 0) && (errno == EINTR));
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
- error = __mkSmallInteger(errno);
+ printf("stat on '%s' for accessMode\n", __stringVal(encodedPathName));
+#endif
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = stat((char *) __stringVal(encodedPathName), &buf);
+ } while ((ret < 0) && (errno == EINTR));
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -4668,31 +4413,31 @@
if (__isSmallInteger(aFileDescriptor)) {
# ifdef TRACE_STAT_CALLS
- printf("fstat on '%d' for accessMode\n", __smallIntegerVal(aFileDescriptor));
-# endif
- __BEGIN_INTERRUPTABLE__
- do {
- ret = fstat(__smallIntegerVal(aFileDescriptor), &buf);
- } while ((ret < 0) && (errno == EINTR));
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
- error = __mkSmallInteger(errno);
+ printf("fstat on '%d' for accessMode\n", __smallIntegerVal(aFileDescriptor));
+# endif
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = fstat(__smallIntegerVal(aFileDescriptor), &buf);
+ } while ((ret < 0) && (errno == EINTR));
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
"
'/' asFilename readingFileDo:[:s|
- (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8
+ (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8
].
"
!
@@ -4710,28 +4455,28 @@
int ret;
if (__isStringLike(encodedPathName) && __isSmallInteger(modeBits)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = chmod((char *)__stringVal(encodedPathName), __intVal(modeBits));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = chmod((char *)__stringVal(encodedPathName), __intVal(modeBits));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
"
- self changeAccessModeOf:'foo' to:8r666
+ self changeAccessModeOf:'foo' to:8r666
"
!
@@ -4748,22 +4493,22 @@
int ret;
if (__isSmallInteger(aFileDescriptor) && __isSmallInteger(modeBits)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = fchmod(__smallIntegerVal(aFileDescriptor), __intVal(modeBits));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
-
- if (ret >= 0) {
- RETURN (nil);
- }
- error = __mkSmallInteger(errno);
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = fchmod(__smallIntegerVal(aFileDescriptor), __intVal(modeBits));
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -5063,9 +4808,13 @@
getCurrentDirectory
"return the name of the current directory"
- |path|
-
- path := self decodePath:self primGetCurrentDirectory.
+ |ret path|
+
+ ret := self primGetCurrentDirectory.
+ ret isNil ifTrue:[
+ self primitiveFailed
+ ].
+ path := self decodePath:ret. "/ possibly decode from UTF8 (depending on the OS)
CurrentDirectory := path.
^ path.
@@ -5218,9 +4967,9 @@
The info object returned is OS-specific, however it responds to at
least
- #isFor32BitArchitecture
- #isFor64BitArchitecture ... returns true, if the given object is for
- 32bit, 64bit architecture respectively
+ #isFor32BitArchitecture
+ #isFor64BitArchitecture ... returns true, if the given object is for
+ 32bit, 64bit architecture respectively
"
^ ELFFileHeader fromFile: aStringOrFilename
@@ -5835,66 +5584,66 @@
|p path command|
path = '.' ifTrue:[
- ^ self getCurrentDirectory.
+ ^ self getCurrentDirectory.
].
"some systems have a convenient function for this ..."
path := self primPathNameOf:(self encodePath:pathName).
path notNil ifTrue:[
- path := self decodePath:path.
+ path := self decodePath:path.
] ifFalse:[
- (self isValidPath:pathName) ifFalse:[
- p := pathName.
- [(p size > 1)
- and:[p endsWith:(self fileSeparator)]
- ] whileTrue:[
- p := p copyButLast.
- ].
- ^ p
- ].
-
- (SlowFork==true or:[PipeFailed==true]) ifFalse:[
- |directoryName fileBaseName|
-
- (self isDirectory:pathName) ifTrue:[
- directoryName := pathName.
- fileBaseName := nil.
- ] ifFalse:[
- |pathFilename|
- pathFilename := pathName asFilename.
- directoryName := pathFilename directoryName.
- fileBaseName := pathFilename baseName.
- ].
-
- PipeStream openErrorSignal handle:[:ex |
- PipeFailed := true.
- 'UnixOperatingSystem [warning]: cannot fork/popen' errorPrintCR.
- ex return.
- ] do:[
- "have to fall back ..."
- command := 'cd "' , directoryName , '"; pwd'.
- p := PipeStream readingFrom:command.
- ].
-
- (p isNil or:[p atEnd]) ifTrue:[
- ('UnixOperatingSystem [warning]: PipeStream for <' , command , '> failed') errorPrintCR.
- ] ifFalse:[
- path := p nextLine.
- p close.
- ].
- fileBaseName notNil ifTrue:[
- path := path, '/', fileBaseName.
- ].
- ].
- path isNil ifTrue:[
- "/
- "/ return the original - there is nothing else can we do
- "/
- path := pathName
- ].
- (SlowFork==true or:[ForkFailed==true]) ifTrue:[
- path := self compressPath:path
- ]
+ (self isValidPath:pathName) ifFalse:[
+ p := pathName.
+ [(p size > 1)
+ and:[p endsWith:(self fileSeparator)]
+ ] whileTrue:[
+ p := p copyButLast.
+ ].
+ ^ p
+ ].
+
+ (SlowFork==true or:[PipeFailed==true]) ifFalse:[
+ |directoryName fileBaseName|
+
+ (self isDirectory:pathName) ifTrue:[
+ directoryName := pathName.
+ fileBaseName := nil.
+ ] ifFalse:[
+ |pathFilename|
+ pathFilename := pathName asFilename.
+ directoryName := pathFilename directoryName.
+ fileBaseName := pathFilename baseName.
+ ].
+
+ PipeStream openErrorSignal handle:[:ex |
+ PipeFailed := true.
+ 'UnixOperatingSystem [warning]: cannot fork/popen' errorPrintCR.
+ ex return.
+ ] do:[
+ "have to fall back ..."
+ command := 'cd "' , directoryName , '"; pwd'.
+ p := PipeStream readingFrom:command.
+ ].
+
+ (p isNil or:[p atEnd]) ifTrue:[
+ ('UnixOperatingSystem [warning]: PipeStream for <' , command , '> failed') errorPrintCR.
+ ] ifFalse:[
+ path := p nextLine.
+ p close.
+ ].
+ fileBaseName notNil ifTrue:[
+ path := path, '/', fileBaseName.
+ ].
+ ].
+ path isNil ifTrue:[
+ "/
+ "/ return the original - there is nothing else can we do
+ "/
+ path := pathName
+ ].
+ (SlowFork==true or:[ForkFailed==true]) ifTrue:[
+ path := self compressPath:path
+ ]
].
^ path.
@@ -5914,22 +5663,23 @@
!
primGetCurrentDirectory
- "return the name of the current directory"
-
- |path|
+ "return the raw name of the current directory (nil if failed - can this ever happen?).
+ Warning:
+ Don't call this from outside: we may have to decode UTF on some systems.
+ See getCurrentDirectory"
%{ /* UNLIMITEDSTACK */
- char nameBuffer[MAXPATHLEN + 1];
-
- if (getcwd(nameBuffer, MAXPATHLEN)) {
- path = __MKSTRING(nameBuffer);
- RETURN(path);
- }
-%}.
- ^ self primitiveFailed.
-
- "
- self primGetCurrentDirectory
+ char nameBuffer[MAXPATHLEN + 1];
+
+ if (getcwd(nameBuffer, MAXPATHLEN)) {
+ OBJ path = __MKSTRING(nameBuffer);
+ RETURN(path);
+ }
+ RETURN(nil);
+%}
+
+ "
+ self primGetCurrentDirectory
"
!
@@ -5987,30 +5737,30 @@
%{ /* UNLIMITEDSTACK */
#ifdef __SCHTEAM__
if (pathName.isStringLike()) {
- java.io.File file = new java.io.File( pathName.asString() );
-
- if (file.exists()) {
- return __c__._RETURN( new STString( file.getAbsolutePath() ));
- }
+ java.io.File file = new java.io.File( pathName.asString() );
+
+ if (file.exists()) {
+ return __c__._RETURN( new STString( file.getAbsolutePath() ));
+ }
}
#else
if (__isStringLike(pathName)) {
# ifdef HAS_REALPATH
- extern char *realpath();
-
- // POSIX-2008 says, that a NULL namebuffer causes realPath to malloc()
- // the required memory. But this does not work as of 2013-04
- char nameBuffer[MAXPATHLEN+1];
- char *nameP = realpath(__stringVal(pathName), nameBuffer);
- if (nameP) {
- OBJ ret = __MKSTRING(nameP);
- // free(nameP);
- RETURN ( ret );
- }
- // fprintf(stderr, "stx[warning]: realpath(\"%s\") failed: %s\n", __stringVal(pathName), strerror(errno));
+ extern char *realpath();
+
+ // POSIX-2008 says, that a NULL namebuffer causes realPath to malloc()
+ // the required memory. But this does not work as of 2013-04
+ char nameBuffer[MAXPATHLEN+1];
+ char *nameP = realpath(__stringVal(pathName), nameBuffer);
+ if (nameP) {
+ OBJ ret = __MKSTRING(nameP);
+ // free(nameP);
+ RETURN ( ret );
+ }
+ // fprintf(stderr, "stx[warning]: realpath(\"%s\") failed: %s\n", __stringVal(pathName), strerror(errno));
# endif /* ! HAS_REALPATH */
} else {
- error = @symbol(argument); // argument is not a string
+ error = @symbol(argument); // argument is not a string
}
#endif
%}.
@@ -6021,9 +5771,9 @@
^ nil
"
- self primPathNameOf:'.'
- self primPathNameOf:'/murks/quatsch/bla/.'
- self primPathNameOf:5555
+ self primPathNameOf:'.'
+ self primPathNameOf:'/murks/quatsch/bla/.'
+ self primPathNameOf:5555
"
!
@@ -6214,8 +5964,8 @@
if (__isSmallInteger(signalNumber)) {
#ifdef SIG_DFL
- signal(__intVal(signalNumber), SIG_DFL);
- RETURN (self);
+ signal(__intVal(signalNumber), SIG_DFL);
+ RETURN (self);
#endif
}
%}.
@@ -6283,23 +6033,23 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
if (signalNumber.isSmallInteger()) {
- int sigNo = signalNumber.intValue();
-
- if (sigNo != 0) {
- java.lang.System.err.println("ignored disable-signal: "+sigNo);
- }
- return context._RETURN(self);
+ int sigNo = signalNumber.intValue();
+
+ if (sigNo != 0) {
+ java.lang.System.err.println("ignored disable-signal: "+sigNo);
+ }
+ return context._RETURN(self);
}
#else
if (__isSmallInteger(signalNumber)) {
- int sigNo = __intVal(signalNumber);
-
- if (sigNo == 0) {
- RETURN (self);
- }
+ int sigNo = __intVal(signalNumber);
+
+ if (sigNo == 0) {
+ RETURN (self);
+ }
# ifdef SIG_IGN
- signal(sigNo, SIG_IGN);
- RETURN (self);
+ signal(sigNo, SIG_IGN);
+ RETURN (self);
# endif
}
#endif
@@ -7904,12 +7654,11 @@
noOfIf := 0.
%{
-#if defined(LINUX)
-# include <ifaddrs.h>
-# include <netinet/in.h>
-# include <sys/socket.h>
-# include <netpacket/packet.h>
+#include <ifaddrs.h>
+#if 0 && defined(linux)
+# include <linux/if_packet.h>
# include <net/ethernet.h> /* the L2 protocols */
+#endif
struct ifaddrs *ifap, *ifaLoop;
int n_ifa = 0;
@@ -7939,20 +7688,25 @@
continue;
family = ifaLoop->ifa_addr->sa_family;
switch (family) {
- case AF_INET:
- len = sizeof(struct sockaddr_in);
- break;
- case AF_INET6:
- len = sizeof(struct sockaddr_in6);
- break;
-#if 0
- case AF_PACKET:
- len = sizeof(sockaddr_ll);
- break;
-#endif
- default:
- /* skip */
- continue;
+ case AF_INET:
+ len = sizeof(struct sockaddr_in);
+ break;
+ case AF_INET6:
+ len = sizeof(struct sockaddr_in6);
+ break;
+# ifdef WANT__AF_PACKET
+ case AF_PACKET:
+ len = sizeof(struct sockaddr_ll);
+ break;
+#endif
+# ifdef WANT__AF_LINK
+ case AF_LINK:
+ len = sizeof(struct sockaddr_dl);
+ break;
+#endif
+ default:
+ /* skip */
+ continue;
};
t = __MKSTRING(ifaLoop->ifa_name);
__arrayVal(returnArray)[retI++] = t; __STORE(returnArray, t);
@@ -7978,9 +7732,6 @@
bad:
freeifaddrs(ifap);
-#else
- error = @symbol(notSupported);
-#endif
out:;
%}.
@@ -7990,7 +7741,7 @@
^ Dictionary new.
].
- retDictionary := Dictionary new:noOfIf.
+ retDictionary := OrderedDictionary new:noOfIf.
retIndex := 1.
1 to:noOfIf do:[:cnt|
@@ -8000,8 +7751,8 @@
addressBytes := returnArray at:retIndex+2.
addressBytes notNil ifTrue:[
- set := retDictionary at:name ifAbsentPut:[Set new].
- dict := Dictionary new:5.
+ set := retDictionary at:name ifAbsentPut:[OrderedCollection new].
+ dict := Dictionary new:4.
dict at:#flags put:(returnArray at:retIndex+1).
dict at:#address put:(SocketAddress fromBytes:addressBytes).
addressBytes := returnArray at:retIndex+3.
@@ -8031,145 +7782,22 @@
getNetworkAddresses
"return a dictionary filled with
key -> name of interface
- value -> the socket address of the interface
+ value -> the first socket address of the interface
for each interface"
- |addressArray nameArray noOfIf retDictionary error|
-
- noOfIf := 0.
-
-%{
-#if defined(SIOCGIFADDR) && defined(SIOCGIFCONF)
- int afinet_socket = -1;
-
- struct ifconf ifc;
- struct ifreq *ifr;
- struct ifreq ifreq;
- unsigned char buf[1024];
- int n_ifs, i, countOfIf;
- OBJ t;
-
- /*
- ** Open an INET socket
- */
-
- afinet_socket = socket(AF_INET, SOCK_DGRAM, 0);
- if (afinet_socket < 0) {
- error = __MKSTRING("Cannot open socket");
- goto bad;
- }
-
- /*
- ** Get the list of network interfaces
- */
-
- ifc.ifc_len = sizeof (buf);
- ifc.ifc_buf = (caddr_t) buf;
-
- if (ioctl (afinet_socket, SIOCGIFCONF, (caddr_t) &ifc) < 0) {
- close(afinet_socket);
- error = __MKSTRING("ioctl(SIOCGIFCONF) failed");
- goto bad;
- }
-
- // get the number of interfaces in the returned structure
-
- // cg: sigh
- // on linux, the records have constant size;
- // on osx, the max of the alen of each entry and the struct size needs to be taken to advance
-
- // I am not sure, which one is the correct way to do (maybe we should invert the test to say #ifdef linux ????
- // Please check on BSD, solaris, etc... (my feeling is, the the other would behave like __osx__ does, as they are all BSDish)
- // see also 2nd loop below
-#ifndef __osx__
- n_ifs = ifc.ifc_len / sizeof (struct ifreq);
-#else
- {
- unsigned char *cp = buf;
- unsigned char *limit = buf + ifc.ifc_len;
-
- n_ifs = 0;
- while (cp < limit) {
- int sz;
-
- ifr = (struct ifreq *)cp;
- sz = IFNAMSIZ + ifr->ifr_addr.sa_len;
-
- cp += sz;
- n_ifs++;
- }
- }
-#endif
-
- nameArray = __ARRAY_NEW_INT(n_ifs);
- addressArray = __ARRAY_NEW_INT(n_ifs);
-
- if (nameArray == nil || addressArray == nil) {
- /* Creating a string wouldn/t work here */
- error = @symbol(allocationFailure);
- goto bad;
- }
-
- /*
- ** Iterate of the list of the system's netif. Find all
- ** active interfaces and their ethernet addresses
- */
- countOfIf = 0;
-
- for (i=0, ifr = ifc.ifc_req; i < n_ifs; i++) {
- /*
- ** Get Flags for this interface
- */
-
- memcpy(&ifreq, ifr, sizeof(ifreq));
- /*
- ** Get address for this interface
- */
- memcpy(&ifreq, ifr, sizeof(ifreq));
- if (ioctl (afinet_socket, SIOCGIFADDR, &ifreq) >= 0) {
- t = __MKBYTEARRAY((char *)&ifreq.ifr_addr, sizeof(ifreq.ifr_addr));
- __arrayVal(addressArray)[countOfIf] = t; __STORE(addressArray, t);
- t = __MKSTRING(&ifreq.ifr_name);
- __arrayVal(nameArray)[countOfIf] = t; __STORE(nameArray, t);
- countOfIf += 1;
- }
- // see (sigh) comment above
-#ifndef __osx__
- ifr++;
-#else
- {
- int sz = IFNAMSIZ + ifr->ifr_addr.sa_len;
-
- ifr = (struct ifreq *)( ((char *)ifr)+sz );
- }
-#endif
- }
-
- noOfIf = __mkSmallInteger(countOfIf);
-bad:
- if (afinet_socket >= 0)
- close(afinet_socket);
-#else
- error = @symbol(notSupported);
-#endif /* defined(SIOCGIFADDR) */
-%}.
-
- retDictionary := Dictionary new:noOfIf.
- error notNil ifTrue:[
- self primitiveFailed:error.
- "return empty dictionary if proceed from error"
- ^ retDictionary.
- ].
-
- 1 to:noOfIf do:[:cnt|
- "take the first address, if there is more than one!!"
- retDictionary at:(nameArray at:cnt) ifAbsentPut:(SocketAddress fromBytes:(addressArray at:cnt)).
- ].
-
- ^ retDictionary
-
- "
- OperatingSystem getNetworkAddresses
+ |addressInfo newDict|
+
+ addressInfo := self getNetworkAddressInfo.
+ newDict := OrderedDictionary new:addressInfo size.
+
+ addressInfo keysAndValuesDo:[:ifName :infoColl|
+ newDict at:ifName put:(infoColl first at:#address)
+ ].
+
+ ^ newDict.
+
+ "
+ self getNetworkAddresses
"
!
@@ -9173,7 +8801,7 @@
%}.
sys isNil ifTrue:[
- ^ self getOSType
+ ^ self getOSType
].
^ sys
@@ -9757,31 +9385,31 @@
decodePathOrCommandOutput:encodedPathNameOrOutputLine
"decode the encodedPathNameOrOutputLine as returned by system calls or output by system commands.
This takes care for any specific OS encodings or specific command encodings.
-
+
E.g. linux system calls return single byte strings only,
so pathNames and command output comes UTF-8 encoded.
(actually, on a mac, it comes utf8-mac encoded)."
Codeset notNil ifTrue:[
- encodedPathNameOrOutputLine notNil ifTrue:[
- [
- "/ cg: I am not sure, why this shortcut.
- "/ calling the decoder directly should be much faster
- Codeset == #utf8 ifTrue:[
- ^ encodedPathNameOrOutputLine utf8Decoded.
- ].
- "/ Codeset encoder might not yet be initialized, sigh...
- CodesetEncoder isNil ifTrue:[
- self getCodesetEncoder
- ].
- CodesetEncoder notNil ifTrue:[
- ^ CodesetEncoder decodeString: encodedPathNameOrOutputLine
- ].
- ] on:DecodingError do:[:ex|
- "maybe there are old filenames in ISO-8859-x,
- just keep them untranslated"
- ].
- ].
+ encodedPathNameOrOutputLine notNil ifTrue:[
+ [
+ "/ cg: I am not sure, why this shortcut.
+ "/ calling the decoder directly should be much faster
+ Codeset == #utf8 ifTrue:[
+ ^ encodedPathNameOrOutputLine utf8Decoded.
+ ].
+ "/ Codeset encoder might not yet be initialized, sigh...
+ CodesetEncoder isNil ifTrue:[
+ self getCodesetEncoder
+ ].
+ CodesetEncoder notNil ifTrue:[
+ ^ CodesetEncoder decodeString: encodedPathNameOrOutputLine
+ ].
+ ] on:DecodingError do:[:ex|
+ "maybe there are old filenames in ISO-8859-x,
+ just keep them untranslated"
+ ].
+ ].
].
^ encodedPathNameOrOutputLine
@@ -9907,7 +9535,7 @@
Codeset := #'utf8-mac'.
CodesetEncoder := nil.
OperatingSystem getCodesetEncoder
- OperatingSystem encodePath:'äöü'
+ OperatingSystem encodePath:''
"
"Modified: / 23-01-2013 / 10:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -10810,32 +10438,32 @@
char *name = (char *)0;
if (firstCall) {
- /*
- * try a few common environment variables ...
- */
- name = getenv("LOGNAME");
- if (! name || (name[0] == 0)) {
- name = getlogin();
- if (! name || (name[0] == 0) ) {
- name = getenv("LOGIN");
- if (! name || (name[0] == 0) ) {
- name = getenv("USER");
- }
- }
- }
- if (name && (strlen(name) < sizeof(cachedName))) {
- strcpy(cachedName, name);
- firstCall = 0;
- }
+ /*
+ * try a few common environment variables ...
+ */
+ name = getenv("LOGNAME");
+ if (! name || (name[0] == 0)) {
+ name = getlogin();
+ if (! name || (name[0] == 0) ) {
+ name = getenv("LOGIN");
+ if (! name || (name[0] == 0) ) {
+ name = getenv("USER");
+ }
+ }
+ }
+ if (name && (strlen(name) < sizeof(cachedName))) {
+ strcpy(cachedName, name);
+ firstCall = 0;
+ }
} else {
- name = cachedName;
+ name = cachedName;
}
/*
* nope - I really don't know who you are.
*/
if (! name || (name[0] == 0) ) {
- name = "you";
+ name = "you";
}
RETURN ( __MKSTRING(name) );
@@ -13206,7 +12834,7 @@
couldNotExecute
"return true when a command could not be executed"
- ^ status == #exit and:[code = 127].
+ ^ status == #failure or:[status == #exit and:[code = 127]].
"Created: 28.12.1995 / 15:43:17 / stefan"
"Modified: 30.4.1996 / 18:27:03 / cg"
@@ -13336,100 +12964,111 @@
!UnixOperatingSystem::SocketHandle class methodsFor:'queries'!
-getAddressInfo:hostName serviceName:serviceNameArg domain:domainArg type:typeArg protocol:protoArg flags:flags
- "answer an Array of socket addresses for serviceName on hostName
+getAddressInfo:hostName serviceName:serviceName domain:domainArg type:typeArg protocol:protoArg flags:flags
+ "answer an Array of socket addresses for serviceName on hostName.
+ A nil hostName will return the loopback address(es) e.g. localhost.
Domain, type, protocol may be nil or specify a hint for the socket
- addresses to be returned."
-
- |result domain type proto serviceName encodedHostName|
-
- domain := OperatingSystem domainCodeOf:domainArg.
- type := OperatingSystem socketTypeCodeOf:typeArg.
- proto := self protocolCodeOf:protoArg.
- serviceNameArg notNil ifTrue:[
- serviceName := serviceNameArg printString. "convert integer port numbers"
+ addresses to be returned.
+ The sorting function used within getaddrinfo() is defined in RFC 3484; in linux the order can be
+ tweaked for a particular system by editing /etc/gai.conf"
+
+ |result domain type proto encodedHostName|
+
+ domainArg notNil ifTrue:[
+ domain := OperatingSystem domainCodeOf:domainArg.
+ ].
+ typeArg notNil ifTrue:[
+ type := OperatingSystem socketTypeCodeOf:typeArg.
+ ].
+ protoArg notNil ifTrue:[
+ proto := self protocolCodeOf:protoArg.
].
hostName isNil ifTrue:[
- encodedHostName := nil.
+ encodedHostName := nil.
] ifFalse:[
- encodedHostName := hostName utf8Encoded.
+ encodedHostName := hostName utf8Encoded.
].
(encodedHostName ~~ hostName and:[OperatingSystem getCodeset ~~ #utf8]) ifTrue:[
- "hostName is not plain ASCII - so this is an IDN domain name. Have to ensure, that the locale is UTF-8.
- Block interrupt to not affect other ST/X processes while the locale is changed."
- |interruptsBlocked oldLocale|
-
- interruptsBlocked := OperatingSystem blockInterrupts.
- oldLocale := OperatingSystem setLocale:#'LC_CTYPE' to:nil.
- OperatingSystem setLocale:#'LC_CTYPE' to:'en_US.UTF-8'.
- result := self primGetAddressInfo:encodedHostName serviceName:serviceName domainCode:domain socketTypeCode:type protocolCode:proto flags:flags.
- OperatingSystem setLocale:#'LC_CTYPE' to:oldLocale.
- interruptsBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
- ].
+ "hostName is not plain ASCII - so this is an IDN domain name. Have to ensure, that the locale is UTF-8.
+ Block interrupt to not affect other ST/X processes while the locale is changed."
+ |interruptsBlocked oldLocale|
+
+ interruptsBlocked := OperatingSystem blockInterrupts.
+ oldLocale := OperatingSystem setLocale:#'LC_CTYPE' to:nil.
+ OperatingSystem setLocale:#'LC_CTYPE' to:'en_US.UTF-8'.
+ result := self primGetAddressInfo:encodedHostName serviceName:serviceName domainCode:domain socketTypeCode:type protocolCode:proto flags:flags.
+ OperatingSystem setLocale:#'LC_CTYPE' to:oldLocale.
+ interruptsBlocked ifFalse:[
+ OperatingSystem unblockInterrupts.
+ ].
] ifFalse:[
- result := self primGetAddressInfo:encodedHostName serviceName:serviceName domainCode:domain socketTypeCode:type protocolCode:proto flags:flags.
+ result := self primGetAddressInfo:encodedHostName serviceName:serviceName domainCode:domain socketTypeCode:type protocolCode:proto flags:flags.
].
result isArray ifFalse:[
- |request|
- request := SocketAddressInfo new
- domain:domainArg;
- type:typeArg;
- protocol:protoArg;
- canonicalName:hostName;
- serviceName:serviceName.
- ^ (HostNameLookupError new
- parameter:result;
- messageText:' - ', (result printString);
- request:request) raiseRequest.
+ |request|
+ request := SocketAddressInfo new
+ domain:domainArg;
+ type:typeArg;
+ protocol:protoArg;
+ canonicalName:hostName;
+ serviceName:serviceName.
+ ^ (HostNameLookupError new
+ parameter:result;
+ messageText:' - ', (result printString);
+ request:request) raiseRequest.
].
1 to:result size do:[:i |
- |entry dom info|
-
- entry := result at:i.
-
- info := SocketAddressInfo new.
- info
- flags:(entry at:1);
- domain:(dom := OperatingSystem domainSymbolOf:(entry at:2));
- type:(OperatingSystem socketTypeSymbolOf:(entry at:3));
- protocol:(self protocolSymbolOf:(entry at:4));
- socketAddress:((SocketAddress newDomain:dom) fromBytes:(entry at:5));
- canonicalName:(entry at:6).
-
- result at:i put:info.
- ].
- ^ result
+ |entry dom info|
+
+ entry := result at:i.
+
+ info := SocketAddressInfo new.
+ info
+ flags:(entry at:1);
+ domain:(dom := OperatingSystem domainSymbolOf:(entry at:2));
+ type:(OperatingSystem socketTypeSymbolOf:(entry at:3));
+ protocol:(self protocolSymbolOf:(entry at:4));
+ socketAddress:((SocketAddress newDomain:dom) fromBytes:(entry at:5));
+ canonicalName:(entry at:6).
+
+ result at:i put:info.
+ ].
+ ^ result.
+
"
self getAddressInfo:'localhost' serviceName:nil
- domain:nil type:nil protocol:nil flags:nil
+ domain:nil type:nil protocol:nil flags:nil
+ self getAddressInfo:nil serviceName:22
+ domain:nil type:nil protocol:nil flags:nil
+ self getAddressInfo:'' serviceName:22
+ domain:nil type:nil protocol:nil flags:nil
self getAddressInfo:'localhost' serviceName:nil
- domain:#inet type:#stream protocol:nil flags:nil
+ domain:nil type:#stream protocol:nil flags:nil
self getAddressInfo:'localhost' serviceName:nil
- domain:#inet type:#stream protocol:#tcp flags:nil
+ domain:#inet type:#stream protocol:#tcp flags:nil
self getAddressInfo:'blurb.exept.de' serviceName:nil
- domain:#inet type:nil protocol:nil flags:nil
+ domain:#inet type:nil protocol:nil flags:nil
self getAddressInfo:'1.2.3.4' serviceName:'bla'
- domain:#inet type:nil protocol:nil flags:nil
+ domain:#inet type:nil protocol:nil flags:nil
self getAddressInfo:'localhost' serviceName:'echo'
- domain:#inet type:nil protocol:nil flags:nil
+ domain:#inet type:nil protocol:nil flags:nil
self getAddressInfo:nil serviceName:'echo'
- domain:#inet type:nil protocol:nil flags:nil
+ domain:#inet type:nil protocol:nil flags:nil
self getAddressInfo:nil serviceName:nil
- domain:#inet type:nil protocol:nil flags:nil
- self getAddressInfo:'www.google.de' serviceName:nil
- domain:nil type:nil protocol:nil flags:nil
+ domain:#inet type:nil protocol:nil flags:nil
+ self getAddressInfo:'www.google.de' serviceName:80
+ domain:nil type:nil protocol:nil flags:nil
self getAddressInfo:'www.exept.de' serviceName:nil
- domain:nil type:nil protocol:nil flags:nil
- self getAddressInfo:'www.exept.de' serviceName:nil
- domain:#'AF_INET' type:nil protocol:nil flags:nil
+ domain:nil type:nil protocol:nil flags:nil
+ self getAddressInfo:'www.exept.de' serviceName:'https'
+ domain:#'AF_INET' type:nil protocol:nil flags:nil
self getAddressInfo:'www.exept.de' serviceName:nil
- domain:#'AF_INET6' type:nil protocol:nil flags:nil
- self getAddressInfo:'www.baden-württemberg.de' serviceName:nil
- domain:#'AF_INET' type:#stream protocol:nil flags:nil
- self getAddressInfo:'www.baden-württemberg.de' serviceName:nil
+ domain:#'AF_INET6' type:nil protocol:nil flags:nil
+ self getAddressInfo:'www.baden-wrttemberg.de' serviceName:nil
+ domain:#'AF_INET' type:#stream protocol:nil flags:nil
+ self getAddressInfo:'www.baden-wrttemberg.de' serviceName:nil
domain:#'AF_INET6' type:#stream protocol:nil flags:nil
"
!
@@ -13670,7 +13309,9 @@
primGetAddressInfo:hostName serviceName:serviceName domainCode:domain socketTypeCode:type protocolCode:proto flags:flags
"answer an Array of socket addresses for serviceName on hostName
Domain, type, protocol may be nil or specify a hint for the socket
- addresses to be returned."
+ addresses to be returned.
+ A nil hostName resolves to the loopback interface address (localhost).
+ An empty hostname resolves to an address that may be used for a lisstening server."
|error errorString result|
@@ -13679,6 +13320,7 @@
#if !defined(NO_SOCKET)
char *__hostName, *__serviceName;
+ char intServiceName[21];
int ret, cnt = 0;
if (hostName == nil) {
@@ -13693,14 +13335,13 @@
__serviceName = 0;
} else if (__isStringLike(serviceName)) {
__serviceName = __stringVal(serviceName);
+ } else if (__isSmallInteger(serviceName)) {
+ __serviceName = intServiceName;
+ snprintf(intServiceName, sizeof(intServiceName), "%d", (int)(__intVal(serviceName)));
} else {
error = @symbol(badArgument2);
goto out;
}
- if (__hostName == 0 && __serviceName == 0) {
- error = @symbol(badArgument);
- goto out;
- }
{
# if defined(AI_NUMERICHOST)
@@ -13710,8 +13351,19 @@
struct addrinfo hints = {0};
struct addrinfo *info = NULL, *infop;
+ hints.ai_flags = AI_ADDRCONFIG // only return IPv6 or IPv4 addresses if there is at least on interface where this address type is configured
+ | AI_V4MAPPED;
+ if (__isSmallInteger(serviceName))
+ hints.ai_flags |= AI_NUMERICSERV;
+
+ if (__hostName && __stringSize(hostName) == 0) {
+ // empty string, this is a listening host - bound to INADDR_ANY
+ __hostName = 0;
+ hints.ai_flags |= AI_PASSIVE;
+ }
+
#if defined(AI_IDN)
- hints.ai_flags = AI_IDN | AI_CANONIDN; // map non-ascii domain names to IDN format
+ hints.ai_flags |= AI_IDN | AI_CANONIDN; // map non-ascii domain names to IDN format
#endif
if (__isSmallInteger(domain))
hints.ai_family = __intVal(domain);
@@ -13727,7 +13379,7 @@
if (__hostName) {
__hostName = __stringVal(hostName);
}
- if (__serviceName) {
+ if (__isStringLike(serviceName)) {
__serviceName = __stringVal(serviceName);
}
@@ -13778,7 +13430,7 @@
error = @symbol(unknownError);
}
errorString = __MKSTRING(gai_strerror(ret));
- goto err;
+ goto ai_out;
}
for (cnt=0, infop=info; infop; infop=infop->ai_next)
cnt++;
@@ -13786,7 +13438,7 @@
result = __ARRAY_NEW_INT(cnt);
if (result == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto ai_out;
}
for (infop=info, cnt=0; infop; infop=infop->ai_next, cnt++) {
OBJ o, resp;
@@ -13794,7 +13446,7 @@
resp = __ARRAY_NEW_INT(6);
if (resp == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto ai_out;
}
__ArrayInstPtr(result)->a_element[cnt] = resp; __STORE(result, resp);
@@ -13809,7 +13461,7 @@
__UNPROTECT__(resp);
if (o == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto ai_out;
}
memcpy(__byteArrayVal(o), infop->ai_addr, infop->ai_addrlen);
__ArrayInstPtr(resp)->a_element[4] = o; __STORE(resp, o);
@@ -13820,13 +13472,13 @@
__UNPROTECT__(resp);
if (o == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto ai_out;
}
__ArrayInstPtr(resp)->a_element[5] = o; __STORE(resp, o);
}
}
-err:
+ai_out:
if (info) freeaddrinfo(info);
# else /* ! AI_NUMERICHOST =============================================================*/
@@ -13850,7 +13502,7 @@
if (sp == NULL) {
errorString = @symbol(unknownService);
error = __mkSmallInteger(-3);
- goto err;
+ goto out;
}
port = sp->s_port;
}
@@ -13897,21 +13549,21 @@
break;
}
error = __mkSmallInteger(h_errno);
- goto err;
+ goto out;
}
# else /* !USE_H_ERRNO */
hp = gethostbyname(__hostName);
if (hp == 0) {
errorString = @symbol(unknownHost);
error = __mkSmallInteger(-1);
- goto err;
+ goto out;
}
# endif /* !USE_H_ERRNO*/
if (__isSmallInteger(domain) && hp->h_addrtype != __smallIntegerVal(domain)) {
errorString = @symbol(unknownHost);
error = __mkSmallInteger(-2);
- goto err;
+ goto out;
}
for (cnt = 0, addrpp = hp->h_addr_list; *addrpp; addrpp++)
@@ -13924,7 +13576,7 @@
result = __ARRAY_NEW_INT(cnt);
if (result == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto out;
}
for (i = 0; i < cnt; i++) {
@@ -13934,7 +13586,7 @@
resp = __ARRAY_NEW_INT(6);
if (resp == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto out;
}
__ArrayInstPtr(result)->a_element[i] = resp; __STORE(result, resp);
@@ -13946,7 +13598,7 @@
__UNPROTECT__(resp);
if (o == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto out;
}
__ArrayInstPtr(resp)->a_element[4] = o; __STORE(resp, o);
sa = (struct sockaddr_in *)__byteArrayVal(o);
@@ -13962,7 +13614,7 @@
__UNPROTECT__(resp);
if (o == nil) {
error = @symbol(allocationFailure);
- goto err;
+ goto out;
}
__ArrayInstPtr(resp)->a_element[5] = o; __STORE(resp, o);
}
@@ -13971,8 +13623,6 @@
__ArrayInstPtr(resp)->a_element[1] = domain; __STORE(resp, domain);
}
}
-
-err:;
# endif /* ! AI_NUMERICHOST */
}
#else /* ! HAS_SOCKET */
--- a/UserMessage.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UserMessage.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,14 @@
-"{ Encoding: utf8 }"
+"
+ COPYRIGHT (c) 2001 by eXept Software AG
+ All Rights Reserved
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -13,6 +22,20 @@
!UserMessage class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2001 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
documentation
"
added for vw5i compatibility, which accesses messageCatalogs
@@ -165,6 +188,8 @@
"return a copy of the receiver, where a '%i' escape
is replaced by the coresponding string from the argument array.
'i' may be between 1 and 9 (i.e. a maximum of 9 placeholders is allowed).
+ To get an integer-indexed placeHolder followed by another digit,
+ or an index > 9, you must use %(digit).
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:anArrayOfStrings
--- a/UserPreferences.st Fri Dec 09 22:31:28 2016 +0000
+++ b/UserPreferences.st Mon Feb 13 21:29:46 2017 +0000
@@ -2079,7 +2079,7 @@
"/ read comment in menuPanel - for now, it should be on,
"/ otherwise you cannot control a menu with cursor keys or escape. sigh.
- ^ self at:#menuPanelTakesFocusOnClick ifAbsent:[ false ]
+ ^ self at:#menuPanelTakesFocusOnClick ifAbsent:[ true "false" ]
"
UserPreferences current menuPanelTakesFocusOnClick
@@ -4069,6 +4069,29 @@
self
at: #'history-manager.allow-edit-of-history'
put:aBoolean
+!
+
+historyManagerEnabled
+ "automatically add history line comments to accepted methods"
+
+ ^self
+ at: #'history-manager.enabled'
+ ifAbsent: true
+!
+
+historyManagerEnabled:aBoolean
+ "automatically add history line comments to accepted methods"
+
+ ^self
+ at: #'history-manager.enabled'
+ put: aBoolean
+
+
+ "
+ UserPreferences current historyManagerEnabled
+ UserPreferences current historyManagerEnabled:true
+ UserPreferences current historyManagerEnabled:false
+ "
! !
!UserPreferences methodsFor:'accessing-prefs-code'!
--- a/VoidObject.st Fri Dec 09 22:31:28 2016 +0000
+++ b/VoidObject.st Mon Feb 13 21:29:46 2017 +0000
@@ -38,7 +38,7 @@
documentation
"
- there is only one instance of this class: void,
+ there is only one instance of this class: Void,
representing a void value.
This is mainly present for Scheme-like read-eval-print loops,
@@ -71,13 +71,14 @@
!VoidObject class methodsFor:'class initialization'!
initialize
- Smalltalk at:#void put:(self basicNew).
+ Smalltalk at:#Void put:(self basicNew).
+ Smalltalk at:#void put:(self basicNew). "/ for JavaScript code
! !
!VoidObject methodsFor:'printing & storing'!
printOn:aStream
- aStream nextPutAll:'void'.
+ aStream nextPutAll:'Void'.
! !
!VoidObject methodsFor:'queries'!
@@ -86,7 +87,7 @@
^ true
"
- void isVoid
+ Void isVoid
"
! !
--- a/Win32OperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
+++ b/Win32OperatingSystem.st Mon Feb 13 21:29:46 2017 +0000
@@ -46,6 +46,13 @@
privateIn:Win32OperatingSystem
!
+Object subclass:#OSProcessDescriptor
+ instanceVariableNames:'pid parentPid commandLine'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Win32OperatingSystem
+!
+
Object subclass:#OSProcessStatus
instanceVariableNames:'pid status code core'
classVariableNames:''
@@ -991,7 +998,6 @@
"Modified: 7.1.1997 / 19:36:11 / stefan"
! !
-
!Win32OperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -1802,47 +1808,47 @@
if ((dirPointer != nil)
&& __isExternalAddressLike(dirPointer)) {
- // __INST(lastErrorNumber) = nil;
- d = _HANDLEVal(dirPointer);
-
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- rslt = (int)(STX_API_NOINT_CALL2( "FindNextFileW", FindNextFileW, d, &data ));
- } while ((rslt < 0) && (__threadErrno == EINTR));
-
- if (rslt > 0) {
- fileSize = __MKLARGEINT64(1, data.nFileSizeLow, data.nFileSizeHigh);
- osPathname = __mkStringOrU16String_maxlen( data.cFileName, MAXPATHLEN );
- osFileAttributes = __mkSmallInteger( data.dwFileAttributes );
-
- osCrtTime = FileTimeToOsTime1970(&data.ftCreationTime);
- osAccTime = FileTimeToOsTime1970(&data.ftLastAccessTime);
- osModTime = FileTimeToOsTime1970(&data.ftLastWriteTime);
- } else {
- // we signal end-of-directory through a nil osPathName
- if (__threadErrno != __WIN32_ERR(ERROR_NO_MORE_FILES))
- error = __mkSmallInteger( __threadErrno );
- }
+ // __INST(lastErrorNumber) = nil;
+ d = _HANDLEVal(dirPointer);
+
+ do {
+ __threadErrno = 0;
+ // do not cast to INT - will loose sign bit then!
+ rslt = (int)(STX_API_NOINT_CALL2( "FindNextFileW", FindNextFileW, d, &data ));
+ } while ((rslt < 0) && (__threadErrno == EINTR));
+
+ if (rslt > 0) {
+ fileSize = __MKLARGEINT64(1, data.nFileSizeLow, data.nFileSizeHigh);
+ osPathname = __mkStringOrU16String_maxlen( data.cFileName, MAXPATHLEN );
+ osFileAttributes = __mkSmallInteger( data.dwFileAttributes );
+
+ osCrtTime = FileTimeToOsTime1970(&data.ftCreationTime);
+ osAccTime = FileTimeToOsTime1970(&data.ftLastAccessTime);
+ osModTime = FileTimeToOsTime1970(&data.ftLastWriteTime);
+ } else {
+ // we signal end-of-directory through a nil osPathName
+ if (__threadErrno != __WIN32_ERR(ERROR_NO_MORE_FILES))
+ error = __mkSmallInteger( __threadErrno );
+ }
}
%}.
error notNil ifTrue:[
- ^ StreamIOError newException
- errorCode:error;
- osErrorHolder:(OperatingSystem errorHolderForNumber:error);
- parameter:aDirectoryStream;
- raiseRequest
+ ^ StreamIOError newException
+ errorCode:error;
+ osErrorHolder:(OperatingSystem errorHolderForNumber:error);
+ parameter:aDirectoryStream;
+ raiseRequest
].
osPathname isNil ifTrue:[^ nil].
^ self
- linkInfoFor:osPathname
- fileSize:fileSize
- fileAttributes:osFileAttributes
- osCrtTime:osCrtTime
- osAccTime:osAccTime
- osModTime:osModTime
+ linkInfoFor:osPathname
+ fileSize:fileSize
+ fileAttributes:osFileAttributes
+ osCrtTime:osCrtTime
+ osAccTime:osAccTime
+ osModTime:osModTime
! !
!Win32OperatingSystem class methodsFor:'error messages'!
@@ -1879,872 +1885,877 @@
int __eno = __unsignedLongIntVal(errNr);
if (__isWIN32Error(__eno)) {
- switch (__eno & 0xFFFF) {
- /*
- * WIN32 GetLastError returns
- */
- case ERROR_INVALID_FUNCTION:
- sym = @symbol(ERROR_INVALID_FUNCTION);
- typ = @symbol(illegalOperationSignal);
- break;
-
- case ERROR_BAD_FORMAT:
- sym = @symbol(ERROR_BAD_FORMAT);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_FILE_NOT_FOUND:
- sym = @symbol(ERROR_FILE_NOT_FOUND);
- typ = @symbol(nonexistentSignal);
- break;
-
- case ERROR_PATH_NOT_FOUND:
- sym = @symbol(ERROR_PATH_NOT_FOUND);
- typ = @symbol(nonexistentSignal);
- break;
-
- case ERROR_TOO_MANY_OPEN_FILES:
- sym = @symbol(ERROR_TOO_MANY_OPEN_FILES);
- typ = @symbol(noResourcesSignal);
- break;
-
- /*
- * what a nice errorCode - thats the most "useful" one I ever
- * encountered ... (... those stupid micro-softies ...)
- */
- case ERROR_OPEN_FAILED:
- sym = @symbol(ERROR_OPEN_FAILED);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_ACCESS_DENIED:
- sym = @symbol(ERROR_ACCESS_DENIED);
- typ = @symbol(noPermissionsSignal);
- break;
-
- case ERROR_INVALID_HANDLE:
- sym = @symbol(ERROR_INVALID_HANDLE);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_NOT_ENOUGH_MEMORY:
- sym = @symbol(ERROR_NOT_ENOUGH_MEMORY);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NO_SYSTEM_RESOURCES:
- sym = @symbol(ERROR_NO_SYSTEM_RESOURCES);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NONPAGED_SYSTEM_RESOURCES:
- sym = @symbol(ERROR_NONPAGED_SYSTEM_RESOURCES);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_PAGED_SYSTEM_RESOURCES:
- sym = @symbol(ERROR_PAGED_SYSTEM_RESOURCES);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_INVALID_ACCESS:
- sym = @symbol(ERROR_INVALID_ACCESS);
- typ = @symbol(inappropriateOperationSignal);
- break;
-
- case ERROR_INVALID_DATA:
- sym = @symbol(ERROR_INVALID_DATA);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_INVALID_NAME:
- sym = @symbol(ERROR_INVALID_NAME);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_ARENA_TRASHED:
- sym = @symbol(ERROR_ARENA_TRASHED);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_OUTOFMEMORY:
- sym = @symbol(ERROR_OUTOFMEMORY);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_BROKEN_PIPE:
- sym = @symbol(ERROR_BROKEN_PIPE);
- typ = @symbol(peerFaultSignal);
- break;
-
- case ERROR_GEN_FAILURE:
- sym = @symbol(ERROR_GEN_FAILURE);
- break;
-
- case ERROR_WRITE_PROTECT:
- sym = @symbol(ERROR_WRITE_PROTECT);
- typ = @symbol(inappropriateOperationSignal);
- break;
-
- case ERROR_WRITE_FAULT:
- sym = @symbol(ERROR_WRITE_FAULT);
- typ = @symbol(transferFaultSignal);
- break;
-
- case ERROR_READ_FAULT:
- sym = @symbol(ERROR_READ_FAULT);
- typ = @symbol(transferFaultSignal);
- break;
-
- case ERROR_HANDLE_DISK_FULL:
- sym = @symbol(ERROR_HANDLE_DISK_FULL);
- typ = @symbol(volumeFullSignal);
- break;
-
- case ERROR_DISK_FULL:
- sym = @symbol(ERROR_DISK_FULL);
- typ = @symbol(volumeFullSignal);
- break;
-
- case ERROR_SHARING_VIOLATION:
- sym = @symbol(ERROR_SHARING_VIOLATION);
- typ = @symbol(noPermissionsSignal);
- break;
-
- case ERROR_LOCK_VIOLATION:
- sym = @symbol(ERROR_LOCK_VIOLATION);
- typ = @symbol(noPermissionsSignal);
- break;
-
- case ERROR_INVALID_PARAMETER:
- sym = @symbol(ERROR_INVALID_PARAMETER);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_NET_WRITE_FAULT:
- sym = @symbol(ERROR_NET_WRITE_FAULT);
- typ = @symbol(transferFaultSignal);
- break;
-
- case ERROR_NOT_SUPPORTED:
- sym = @symbol(ERROR_NOT_SUPPORTED);
- typ = @symbol(inappropriateOperationSignal);
- break;
-
- case ERROR_REM_NOT_LIST:
- sym = @symbol(ERROR_REM_NOT_LIST);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NETWORK_ACCESS_DENIED:
- sym = @symbol(ERROR_NETWORK_ACCESS_DENIED);
- typ = @symbol(noPermissionsSignal);
- break;
-
- case ERROR_DUP_NAME:
- sym = @symbol(ERROR_DUP_NAME);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_BAD_NETPATH:
- sym = @symbol(ERROR_BAD_NETPATH);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NETWORK_BUSY:
- sym = @symbol(ERROR_NETWORK_BUSY);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_DRIVE_LOCKED:
- sym = @symbol(ERROR_DRIVE_LOCKED);
- typ = @symbol(inappropriateOperationSignal);
- break;
-
- case ERROR_INVALID_DRIVE:
- sym = @symbol(ERROR_INVALID_DRIVE);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_WRONG_DISK:
- sym = @symbol(ERROR_WRONG_DISK);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_CURRENT_DIRECTORY:
- sym = @symbol(ERROR_CURRENT_DIRECTORY);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- /*
- * what a nice errorCode - thats the most "useful" one I ever
- * encountered ... (... those stupid micro-softies ...)
- */
- case ERROR_CANNOT_MAKE:
- sym = @symbol(ERROR_CANNOT_MAKE);
- typ = @symbol(inappropriateOperationSignal);
- break;
-
- case ERROR_NO_MORE_FILES:
- sym = @symbol(ERROR_NO_MORE_FILES);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NOT_READY:
- sym = @symbol(ERROR_NOT_READY);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_NOT_DOS_DISK:
- sym = @symbol(ERROR_NOT_DOS_DISK);
- typ = @symbol(invalidArgumentsSignal);
- break;
-
- case ERROR_OUT_OF_PAPER:
- sym = @symbol(ERROR_OUT_OF_PAPER);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_PRINTQ_FULL:
- sym = @symbol(ERROR_PRINTQ_FULL);
- typ = @symbol(noResourcesSignal);
- break;
-
- case ERROR_FILE_EXISTS:
- sym = @symbol(ERROR_FILE_EXISTS);
- typ = @symbol(existingReferentSignal);
- break;
-
- default:
- break;
- }
+ switch (__eno & 0xFFFF) {
+ /*
+ * WIN32 GetLastError returns
+ */
+ case ERROR_INVALID_FUNCTION:
+ sym = @symbol(ERROR_INVALID_FUNCTION);
+ typ = @symbol(illegalOperationSignal);
+ break;
+
+ case ERROR_BAD_FORMAT:
+ sym = @symbol(ERROR_BAD_FORMAT);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_FILE_NOT_FOUND:
+ sym = @symbol(ERROR_FILE_NOT_FOUND);
+ typ = @symbol(nonexistentSignal);
+ break;
+
+ case ERROR_PATH_NOT_FOUND:
+ sym = @symbol(ERROR_PATH_NOT_FOUND);
+ typ = @symbol(nonexistentSignal);
+ break;
+
+ case ERROR_TOO_MANY_OPEN_FILES:
+ sym = @symbol(ERROR_TOO_MANY_OPEN_FILES);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ /*
+ * what a nice errorCode - thats the most "useful" one I ever
+ * encountered ... (... those stupid micro-softies ...)
+ */
+ case ERROR_OPEN_FAILED:
+ sym = @symbol(ERROR_OPEN_FAILED);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_ACCESS_DENIED:
+ sym = @symbol(ERROR_ACCESS_DENIED);
+ typ = @symbol(noPermissionsSignal);
+ break;
+
+ case ERROR_INVALID_HANDLE:
+ sym = @symbol(ERROR_INVALID_HANDLE);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_NOT_ENOUGH_MEMORY:
+ sym = @symbol(ERROR_NOT_ENOUGH_MEMORY);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NO_SYSTEM_RESOURCES:
+ sym = @symbol(ERROR_NO_SYSTEM_RESOURCES);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NONPAGED_SYSTEM_RESOURCES:
+ sym = @symbol(ERROR_NONPAGED_SYSTEM_RESOURCES);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_PAGED_SYSTEM_RESOURCES:
+ sym = @symbol(ERROR_PAGED_SYSTEM_RESOURCES);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_INVALID_ACCESS:
+ sym = @symbol(ERROR_INVALID_ACCESS);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+
+ case ERROR_INVALID_DATA:
+ sym = @symbol(ERROR_INVALID_DATA);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_INVALID_NAME:
+ sym = @symbol(ERROR_INVALID_NAME);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_ARENA_TRASHED:
+ sym = @symbol(ERROR_ARENA_TRASHED);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_OUTOFMEMORY:
+ sym = @symbol(ERROR_OUTOFMEMORY);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_BROKEN_PIPE:
+ sym = @symbol(ERROR_BROKEN_PIPE);
+ typ = @symbol(peerFaultSignal);
+ break;
+
+ case ERROR_GEN_FAILURE:
+ sym = @symbol(ERROR_GEN_FAILURE);
+ break;
+
+ case ERROR_WRITE_PROTECT:
+ sym = @symbol(ERROR_WRITE_PROTECT);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+
+ case ERROR_WRITE_FAULT:
+ sym = @symbol(ERROR_WRITE_FAULT);
+ typ = @symbol(transferFaultSignal);
+ break;
+
+ case ERROR_READ_FAULT:
+ sym = @symbol(ERROR_READ_FAULT);
+ typ = @symbol(transferFaultSignal);
+ break;
+
+ case ERROR_HANDLE_DISK_FULL:
+ sym = @symbol(ERROR_HANDLE_DISK_FULL);
+ typ = @symbol(volumeFullSignal);
+ break;
+
+ case ERROR_DISK_FULL:
+ sym = @symbol(ERROR_DISK_FULL);
+ typ = @symbol(volumeFullSignal);
+ break;
+
+ case ERROR_SHARING_VIOLATION:
+ sym = @symbol(ERROR_SHARING_VIOLATION);
+ typ = @symbol(noPermissionsSignal);
+ break;
+
+ case ERROR_LOCK_VIOLATION:
+ sym = @symbol(ERROR_LOCK_VIOLATION);
+ typ = @symbol(noPermissionsSignal);
+ break;
+
+ case ERROR_INVALID_PARAMETER:
+ sym = @symbol(ERROR_INVALID_PARAMETER);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_NET_WRITE_FAULT:
+ sym = @symbol(ERROR_NET_WRITE_FAULT);
+ typ = @symbol(transferFaultSignal);
+ break;
+
+ case ERROR_NOT_SUPPORTED:
+ sym = @symbol(ERROR_NOT_SUPPORTED);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+
+ case ERROR_REM_NOT_LIST:
+ sym = @symbol(ERROR_REM_NOT_LIST);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NETWORK_ACCESS_DENIED:
+ sym = @symbol(ERROR_NETWORK_ACCESS_DENIED);
+ typ = @symbol(noPermissionsSignal);
+ break;
+
+ case ERROR_DUP_NAME:
+ sym = @symbol(ERROR_DUP_NAME);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_BAD_NETPATH:
+ sym = @symbol(ERROR_BAD_NETPATH);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NETWORK_BUSY:
+ sym = @symbol(ERROR_NETWORK_BUSY);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_DRIVE_LOCKED:
+ sym = @symbol(ERROR_DRIVE_LOCKED);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+
+ case ERROR_INVALID_DRIVE:
+ sym = @symbol(ERROR_INVALID_DRIVE);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_WRONG_DISK:
+ sym = @symbol(ERROR_WRONG_DISK);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_CURRENT_DIRECTORY:
+ sym = @symbol(ERROR_CURRENT_DIRECTORY);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ /*
+ * what a nice errorCode - thats the most "useful" one I ever
+ * encountered ... (... those stupid micro-softies ...)
+ */
+ case ERROR_CANNOT_MAKE:
+ sym = @symbol(ERROR_CANNOT_MAKE);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+
+ case ERROR_NO_MORE_FILES:
+ sym = @symbol(ERROR_NO_MORE_FILES);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NOT_READY:
+ sym = @symbol(ERROR_NOT_READY);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_NOT_DOS_DISK:
+ sym = @symbol(ERROR_NOT_DOS_DISK);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
+
+ case ERROR_OUT_OF_PAPER:
+ sym = @symbol(ERROR_OUT_OF_PAPER);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_PRINTQ_FULL:
+ sym = @symbol(ERROR_PRINTQ_FULL);
+ typ = @symbol(noResourcesSignal);
+ break;
+
+ case ERROR_FILE_EXISTS:
+ sym = @symbol(ERROR_FILE_EXISTS);
+ typ = @symbol(existingReferentSignal);
+ break;
+
+ case ERROR_ALREADY_EXISTS:
+ sym = @symbol(ERROR_ALREADY_EXISTS);
+ typ = @symbol(existingReferentSignal);
+ break;
+
+ default:
+ break;
+ }
} else {
- switch (__eno) {
- /*
- * POSIX errnos - these should be defined
- */
+ switch (__eno) {
+ /*
+ * POSIX errnos - these should be defined
+ */
#ifdef EPERM
- case EPERM:
- sym = @symbol(EPERM);
- typ = @symbol(noPermissionsSignal);
- break;
+ case EPERM:
+ sym = @symbol(EPERM);
+ typ = @symbol(noPermissionsSignal);
+ break;
#endif
#ifdef ENOENT
- case ENOENT:
- sym = @symbol(ENOENT);
- typ = @symbol(nonexistentSignal);
- break;
+ case ENOENT:
+ sym = @symbol(ENOENT);
+ typ = @symbol(nonexistentSignal);
+ break;
#endif
#ifdef ESRCH
- case ESRCH:
- sym = @symbol(ESRCH);
- typ = @symbol(unavailableReferentSignal);
- break;
+ case ESRCH:
+ sym = @symbol(ESRCH);
+ typ = @symbol(unavailableReferentSignal);
+ break;
#endif
#ifdef EINTR
- case EINTR:
- sym = @symbol(EINTR);
- typ = @symbol(transientErrorSignal);
- break;
+ case EINTR:
+ sym = @symbol(EINTR);
+ typ = @symbol(transientErrorSignal);
+ break;
#endif
#ifdef EIO
- case EIO:
- sym = @symbol(EIO);
- typ = @symbol(transferFaultSignal);
- break;
+ case EIO:
+ sym = @symbol(EIO);
+ typ = @symbol(transferFaultSignal);
+ break;
#endif
#ifdef ENXIO
- case ENXIO:
- sym = @symbol(ENXIO);
- typ = @symbol(unavailableReferentSignal);
- break;
+ case ENXIO:
+ sym = @symbol(ENXIO);
+ typ = @symbol(unavailableReferentSignal);
+ break;
#endif
#ifdef E2BIG
- case E2BIG:
- sym = @symbol(E2BIG);
- typ = @symbol(invalidArgumentsSignal);
- break;
+ case E2BIG:
+ sym = @symbol(E2BIG);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
#endif
#ifdef ENOEXEC
- case ENOEXEC:
- sym = @symbol(ENOEXEC);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOEXEC:
+ sym = @symbol(ENOEXEC);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EBADF
- case EBADF:
- sym = @symbol(EBADF);
- typ = @symbol(badAccessorSignal);
- break;
+ case EBADF:
+ sym = @symbol(EBADF);
+ typ = @symbol(badAccessorSignal);
+ break;
#endif
#ifdef ECHILD
- case ECHILD:
- sym = @symbol(ECHILD);
- typ = @symbol(informationSignal);
- break;
+ case ECHILD:
+ sym = @symbol(ECHILD);
+ typ = @symbol(informationSignal);
+ break;
#endif
#if !defined(EWOULDBLOCK) && defined(EAGAIN) && (EWOULDBLOCK != EAGAIN)
- case EAGAIN:
- sym = @symbol(EAGAIN);
- typ = @symbol(notReadySignal);
- break;
+ case EAGAIN:
+ sym = @symbol(EAGAIN);
+ typ = @symbol(notReadySignal);
+ break;
#endif
#ifdef ENOMEM
- case ENOMEM:
- sym = @symbol(ENOMEM);
- typ = @symbol(noMemorySignal);
- break;
+ case ENOMEM:
+ sym = @symbol(ENOMEM);
+ typ = @symbol(noMemorySignal);
+ break;
#endif
#ifdef EACCES
- case EACCES:
- sym = @symbol(EACCES);
- typ = @symbol(noPermissionsSignal);
- break;
+ case EACCES:
+ sym = @symbol(EACCES);
+ typ = @symbol(noPermissionsSignal);
+ break;
#endif
#ifdef EFAULT
- case EFAULT:
- sym = @symbol(EFAULT);
- typ = @symbol(invalidArgumentsSignal);
- break;
+ case EFAULT:
+ sym = @symbol(EFAULT);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
#endif
#ifdef EBUSY
- case EBUSY:
- sym = @symbol(EBUSY);
- typ = @symbol(unavailableReferentSignal);
- break;
+ case EBUSY:
+ sym = @symbol(EBUSY);
+ typ = @symbol(unavailableReferentSignal);
+ break;
#endif
#ifdef EEXIST
- case EEXIST:
- sym = @symbol(EEXIST);
- typ = @symbol(existingReferentSignal);
- break;
+ case EEXIST:
+ sym = @symbol(EEXIST);
+ typ = @symbol(existingReferentSignal);
+ break;
#endif
#ifdef EXDEV
- case EXDEV:
- sym = @symbol(EXDEV);
- typ = @symbol(inappropriateReferentSignal);
- break;
+ case EXDEV:
+ sym = @symbol(EXDEV);
+ typ = @symbol(inappropriateReferentSignal);
+ break;
#endif
#ifdef ENODEV
- case ENODEV:
- sym = @symbol(ENODEV);
- typ = @symbol(inaccessibleSignal);
- break;
+ case ENODEV:
+ sym = @symbol(ENODEV);
+ typ = @symbol(inaccessibleSignal);
+ break;
#endif
#ifdef ENOTDIR
- case ENOTDIR:
- sym = @symbol(ENOTDIR);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOTDIR:
+ sym = @symbol(ENOTDIR);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EISDIR
- case EISDIR:
- sym = @symbol(EISDIR);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case EISDIR:
+ sym = @symbol(EISDIR);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EINVAL
- case EINVAL:
- sym = @symbol(EINVAL);
- typ = @symbol(invalidArgumentsSignal);
- break;
+ case EINVAL:
+ sym = @symbol(EINVAL);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
#endif
#ifdef ENFILE
- case ENFILE:
- sym = @symbol(ENFILE);
- typ = @symbol(noResourcesSignal);
- break;
+ case ENFILE:
+ sym = @symbol(ENFILE);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef EMFILE
- case EMFILE:
- sym = @symbol(EMFILE);
- typ = @symbol(noResourcesSignal);
- break;
+ case EMFILE:
+ sym = @symbol(EMFILE);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef ENOTTY
- case ENOTTY:
- sym = @symbol(ENOTTY);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOTTY:
+ sym = @symbol(ENOTTY);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EFBIG
- case EFBIG:
- sym = @symbol(EFBIG);
- typ = @symbol(noResourcesSignal);
- break;
+ case EFBIG:
+ sym = @symbol(EFBIG);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef ENOSPC
- case ENOSPC:
- sym = @symbol(ENOSPC);
- typ = @symbol(noResourcesSignal);
- break;
+ case ENOSPC:
+ sym = @symbol(ENOSPC);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef ESPIPE
- case ESPIPE:
- sym = @symbol(ESPIPE);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ESPIPE:
+ sym = @symbol(ESPIPE);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EROFS
- case EROFS:
- sym = @symbol(EROFS);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case EROFS:
+ sym = @symbol(EROFS);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EMLINK
- case EMLINK:
- sym = @symbol(EMLINK);
- typ = @symbol(rangeErrorSignal);
- break;
+ case EMLINK:
+ sym = @symbol(EMLINK);
+ typ = @symbol(rangeErrorSignal);
+ break;
#endif
#ifdef EPIPE
- case EPIPE:
- sym = @symbol(EPIPE);
- typ = @symbol(peerFaultSignal);
- break;
+ case EPIPE:
+ sym = @symbol(EPIPE);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef EDOM
- case EDOM:
- sym = @symbol(EDOM);
- typ = @symbol(rangeErrorSignal);
- break;
+ case EDOM:
+ sym = @symbol(EDOM);
+ typ = @symbol(rangeErrorSignal);
+ break;
#endif
#ifdef ERANGE
- case ERANGE:
- sym = @symbol(ERANGE);
- typ = @symbol(rangeErrorSignal);
- break;
+ case ERANGE:
+ sym = @symbol(ERANGE);
+ typ = @symbol(rangeErrorSignal);
+ break;
#endif
#ifdef EDEADLK
# if EDEADLK != EWOULDBLOCK
- case EDEADLK:
- sym = @symbol(EDEADLK);
- typ = @symbol(noResourcesSignal);
- break;
+ case EDEADLK:
+ sym = @symbol(EDEADLK);
+ typ = @symbol(noResourcesSignal);
+ break;
# endif
#endif
#ifdef ENAMETOOLONG
- case ENAMETOOLONG:
- sym = @symbol(ENAMETOOLONG);
- typ = @symbol(rangeErrorSignal);
- break;
+ case ENAMETOOLONG:
+ sym = @symbol(ENAMETOOLONG);
+ typ = @symbol(rangeErrorSignal);
+ break;
#endif
#ifdef ENOLCK
- case ENOLCK:
- sym = @symbol(ENOLCK);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOLCK:
+ sym = @symbol(ENOLCK);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef ENOSYS
- case ENOSYS:
- sym = @symbol(ENOSYS);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOSYS:
+ sym = @symbol(ENOSYS);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#if defined(ENOTEMPTY) && (ENOTEMPTY != EEXIST)
- case ENOTEMPTY:
- sym = @symbol(ENOTEMPTY);
- typ = @symbol(inappropriateReferentSignal);
- break;
+ case ENOTEMPTY:
+ sym = @symbol(ENOTEMPTY);
+ typ = @symbol(inappropriateReferentSignal);
+ break;
#endif
#ifdef EILSEQ
- case EILSEQ:
- sym = @symbol(EILSEQ);
- typ = @symbol(transferFaultSignal);
- break;
-#endif
- /*
- * XPG3 errnos - defined on most systems
- */
+ case EILSEQ:
+ sym = @symbol(EILSEQ);
+ typ = @symbol(transferFaultSignal);
+ break;
+#endif
+ /*
+ * XPG3 errnos - defined on most systems
+ */
#ifdef ENOTBLK
- case ENOTBLK:
- sym = @symbol(ENOTBLK);
- typ = @symbol(inappropriateReferentSignal);
- break;
+ case ENOTBLK:
+ sym = @symbol(ENOTBLK);
+ typ = @symbol(inappropriateReferentSignal);
+ break;
#endif
#ifdef ETXTBSY
- case ETXTBSY:
- sym = @symbol(ETXTBSY);
- typ = @symbol(inaccessibleSignal);
- break;
-#endif
- /*
- * some others
- */
+ case ETXTBSY:
+ sym = @symbol(ETXTBSY);
+ typ = @symbol(inaccessibleSignal);
+ break;
+#endif
+ /*
+ * some others
+ */
#ifdef EWOULDBLOCK
- case EWOULDBLOCK:
- sym = @symbol(EWOULDBLOCK);
- typ = @symbol(notReadySignal);
- break;
+ case EWOULDBLOCK:
+ sym = @symbol(EWOULDBLOCK);
+ typ = @symbol(notReadySignal);
+ break;
#endif
#ifdef ENOMSG
- case ENOMSG:
- sym = @symbol(ENOMSG);
- typ = @symbol(noDataSignal);
- break;
+ case ENOMSG:
+ sym = @symbol(ENOMSG);
+ typ = @symbol(noDataSignal);
+ break;
#endif
#ifdef ELOOP
- case ELOOP:
- sym = @symbol(ELOOP);
- typ = @symbol(rangeErrorSignal);
- break;
-#endif
-
- /*
- * some stream errors
- */
+ case ELOOP:
+ sym = @symbol(ELOOP);
+ typ = @symbol(rangeErrorSignal);
+ break;
+#endif
+
+ /*
+ * some stream errors
+ */
#ifdef ETIME
- case ETIME:
- sym = @symbol(ETIME);
- typ = @symbol(peerFaultSignal);
- break;
+ case ETIME:
+ sym = @symbol(ETIME);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ENOSR
- case ENOSR:
- sym = @symbol(ENOSR);
- typ = @symbol(noResourcesSignal);
- break;
+ case ENOSR:
+ sym = @symbol(ENOSR);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef ENOSTR
- case ENOSTR:
- sym = @symbol(ENOSTR);
- typ = @symbol(inappropriateReferentSignal);
- break;
+ case ENOSTR:
+ sym = @symbol(ENOSTR);
+ typ = @symbol(inappropriateReferentSignal);
+ break;
#endif
#ifdef ECOMM
- case ECOMM:
- sym = @symbol(ECOMM);
- typ = @symbol(transferFaultSignal);
- break;
+ case ECOMM:
+ sym = @symbol(ECOMM);
+ typ = @symbol(transferFaultSignal);
+ break;
#endif
#ifdef EPROTO
- case EPROTO:
- sym = @symbol(EPROTO);
- typ = @symbol(inappropriateOperationSignal);
- break;
-#endif
- /*
- * nfs errors
- */
+ case EPROTO:
+ sym = @symbol(EPROTO);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
+#endif
+ /*
+ * nfs errors
+ */
#ifdef ESTALE
- case ESTALE:
- sym = @symbol(ESTALE);
- typ = @symbol(unavailableReferentSignal);
- break;
+ case ESTALE:
+ sym = @symbol(ESTALE);
+ typ = @symbol(unavailableReferentSignal);
+ break;
#endif
#ifdef EREMOTE
- case EREMOTE:
- sym = @symbol(EREMOTE);
- typ = @symbol(rangeErrorSignal);
- break;
-#endif
- /*
- * some networking errors
- */
+ case EREMOTE:
+ sym = @symbol(EREMOTE);
+ typ = @symbol(rangeErrorSignal);
+ break;
+#endif
+ /*
+ * some networking errors
+ */
#ifdef EINPROGRESS
- case EINPROGRESS:
- sym = @symbol(EINPROGRESS);
- typ = @symbol(operationStartedSignal);
- break;
+ case EINPROGRESS:
+ sym = @symbol(EINPROGRESS);
+ typ = @symbol(operationStartedSignal);
+ break;
#endif
#ifdef EALREADY
- case EALREADY:
- sym = @symbol(EALREADY);
- typ = @symbol(operationStartedSignal);
- break;
+ case EALREADY:
+ sym = @symbol(EALREADY);
+ typ = @symbol(operationStartedSignal);
+ break;
#endif
#ifdef ENOTSOCK
- case ENOTSOCK:
- sym = @symbol(ENOTSOCK);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case ENOTSOCK:
+ sym = @symbol(ENOTSOCK);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EDESTADDRREQ
- case EDESTADDRREQ:
- sym = @symbol(EDESTADDRREQ);
- typ = @symbol(underspecifiedSignal);
- break;
+ case EDESTADDRREQ:
+ sym = @symbol(EDESTADDRREQ);
+ typ = @symbol(underspecifiedSignal);
+ break;
#endif
#ifdef EMSGSIZE
- case EMSGSIZE:
- sym = @symbol(EMSGSIZE);
- typ = @symbol(rangeErrorSignal);
- break;
+ case EMSGSIZE:
+ sym = @symbol(EMSGSIZE);
+ typ = @symbol(rangeErrorSignal);
+ break;
#endif
#ifdef EPROTOTYPE
- case EPROTOTYPE:
- sym = @symbol(EPROTOTYPE);
- typ = @symbol(wrongSubtypeForOperationSignal);
- break;
+ case EPROTOTYPE:
+ sym = @symbol(EPROTOTYPE);
+ typ = @symbol(wrongSubtypeForOperationSignal);
+ break;
#endif
#ifdef ENOPROTOOPT
- case ENOPROTOOPT:
- sym = @symbol(ENOPROTOOPT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case ENOPROTOOPT:
+ sym = @symbol(ENOPROTOOPT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT:
- sym = @symbol(EPROTONOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case EPROTONOSUPPORT:
+ sym = @symbol(EPROTONOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef ESOCKTNOSUPPORT
- case ESOCKTNOSUPPORT:
- sym = @symbol(ESOCKTNOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case ESOCKTNOSUPPORT:
+ sym = @symbol(ESOCKTNOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef EOPNOTSUPP
- case EOPNOTSUPP:
- sym = @symbol(EOPNOTSUPP);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case EOPNOTSUPP:
+ sym = @symbol(EOPNOTSUPP);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef EPFNOSUPPORT
- case EPFNOSUPPORT:
- sym = @symbol(EPFNOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case EPFNOSUPPORT:
+ sym = @symbol(EPFNOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT:
- sym = @symbol(EAFNOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case EAFNOSUPPORT:
+ sym = @symbol(EAFNOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef EADDRINUSE
- case EADDRINUSE:
- sym = @symbol(EADDRINUSE);
- typ = @symbol(existingReferentSignal);
- break;
+ case EADDRINUSE:
+ sym = @symbol(EADDRINUSE);
+ typ = @symbol(existingReferentSignal);
+ break;
#endif
#ifdef WSAEADDRINUSE
- case WSAEADDRINUSE:
- sym = @symbol(WSAEADDRINUSE);
- typ = @symbol(existingReferentSignal);
- break;
+ case WSAEADDRINUSE:
+ sym = @symbol(WSAEADDRINUSE);
+ typ = @symbol(existingReferentSignal);
+ break;
#endif
#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL:
- sym = @symbol(EADDRNOTAVAIL);
- typ = @symbol(noPermissionsSignal);
- break;
+ case EADDRNOTAVAIL:
+ sym = @symbol(EADDRNOTAVAIL);
+ typ = @symbol(noPermissionsSignal);
+ break;
#endif
#ifdef ETIMEDOUT
- case ETIMEDOUT:
- sym = @symbol(ETIMEDOUT);
- typ = @symbol(peerFaultSignal);
- break;
+ case ETIMEDOUT:
+ sym = @symbol(ETIMEDOUT);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef WSAETIMEDOUT
- case WSAETIMEDOUT:
- sym = @symbol(ETIMEDOUT);
- typ = @symbol(peerFaultSignal);
- break;
+ case WSAETIMEDOUT:
+ sym = @symbol(ETIMEDOUT);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ECONNREFUSED
- case ECONNREFUSED:
- sym = @symbol(ECONNREFUSED);
- typ = @symbol(peerFaultSignal);
- break;
+ case ECONNREFUSED:
+ sym = @symbol(ECONNREFUSED);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef WSAECONNREFUSED
- case WSAECONNREFUSED:
- sym = @symbol(ECONNREFUSED);
- typ = @symbol(peerFaultSignal);
- break;
+ case WSAECONNREFUSED:
+ sym = @symbol(ECONNREFUSED);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ENETDOWN
- case ENETDOWN:
- sym = @symbol(ENETDOWN);
- typ = @symbol(peerFaultSignal);
- break;
+ case ENETDOWN:
+ sym = @symbol(ENETDOWN);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ENETUNREACH
- case ENETUNREACH:
- sym = @symbol(ENETUNREACH);
- typ = @symbol(peerFaultSignal);
- break;
+ case ENETUNREACH:
+ sym = @symbol(ENETUNREACH);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ENETRESET
- case ENETRESET:
- sym = @symbol(ENETRESET);
- typ = @symbol(peerFaultSignal);
- break;
+ case ENETRESET:
+ sym = @symbol(ENETRESET);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ECONNABORTED
- case ECONNABORTED:
- sym = @symbol(ECONNABORTED);
- typ = @symbol(peerFaultSignal);
- break;
+ case ECONNABORTED:
+ sym = @symbol(ECONNABORTED);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef ECONNRESET
- case ECONNRESET:
- sym = @symbol(ECONNRESET);
- typ = @symbol(peerFaultSignal);
- break;
+ case ECONNRESET:
+ sym = @symbol(ECONNRESET);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef EISCONN
- case EISCONN:
- sym = @symbol(EISCONN);
- typ = @symbol(unpreparedOperationSignal);
- break;
+ case EISCONN:
+ sym = @symbol(EISCONN);
+ typ = @symbol(unpreparedOperationSignal);
+ break;
#endif
#ifdef ENOTCONN
- case ENOTCONN:
- sym = @symbol(ENOTCONN);
- typ = @symbol(unpreparedOperationSignal);
- break;
+ case ENOTCONN:
+ sym = @symbol(ENOTCONN);
+ typ = @symbol(unpreparedOperationSignal);
+ break;
#endif
#ifdef ESHUTDOWN
- case ESHUTDOWN:
- sym = @symbol(ESHUTDOWN);
- typ = @symbol(unpreparedOperationSignal);
- break;
+ case ESHUTDOWN:
+ sym = @symbol(ESHUTDOWN);
+ typ = @symbol(unpreparedOperationSignal);
+ break;
#endif
#ifdef EHOSTDOWN
- case EHOSTDOWN:
- sym = @symbol(EHOSTDOWN);
- typ = @symbol(peerFaultSignal);
- break;
+ case EHOSTDOWN:
+ sym = @symbol(EHOSTDOWN);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef EHOSTUNREACH
- case EHOSTUNREACH:
- sym = @symbol(EHOSTUNREACH);
- typ = @symbol(peerFaultSignal);
- break;
+ case EHOSTUNREACH:
+ sym = @symbol(EHOSTUNREACH);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef WSAHOSTUNREACH
- case WSAHOSTUNREACH:
- sym = @symbol(EHOSTUNREACH);
- typ = @symbol(peerFaultSignal);
- break;
+ case WSAHOSTUNREACH:
+ sym = @symbol(EHOSTUNREACH);
+ typ = @symbol(peerFaultSignal);
+ break;
#endif
#ifdef WSAEFAULT
- case WSAEFAULT:
- sym = @symbol(WSAEFAULT);
- typ = @symbol(invalidArgumentsSignal);
- break;
+ case WSAEFAULT:
+ sym = @symbol(WSAEFAULT);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
#endif
#ifdef WSAEINTR
- case WSAEINTR:
- sym = @symbol(WSAEINTR);
- typ = @symbol(transientErrorSignal);
- break;
+ case WSAEINTR:
+ sym = @symbol(WSAEINTR);
+ typ = @symbol(transientErrorSignal);
+ break;
#endif
#ifdef WSAEBADF
- case WSAEBADF:
- sym = @symbol(WSAEBADF);
- typ = @symbol(badAccessorSignal);
- break;
+ case WSAEBADF:
+ sym = @symbol(WSAEBADF);
+ typ = @symbol(badAccessorSignal);
+ break;
#endif
#ifdef WSAEACCES
- case WSAEACCES:
- sym = @symbol(WSAEACCES);
- typ = @symbol(badAccessorSignal);
- break;
+ case WSAEACCES:
+ sym = @symbol(WSAEACCES);
+ typ = @symbol(badAccessorSignal);
+ break;
#endif
#ifdef WSAEINVAL
- case WSAEINVAL:
- sym = @symbol(WSAEINVAL);
- typ = @symbol(invalidArgumentsSignal);
- break;
+ case WSAEINVAL:
+ sym = @symbol(WSAEINVAL);
+ typ = @symbol(invalidArgumentsSignal);
+ break;
#endif
#ifdef WSAEMFILE
- case WSAEMFILE:
- sym = @symbol(WSAEMFILE);
- typ = @symbol(noResourcesSignal);
- break;
+ case WSAEMFILE:
+ sym = @symbol(WSAEMFILE);
+ typ = @symbol(noResourcesSignal);
+ break;
#endif
#ifdef WSAEWOULDBLOCK
- case WSAEWOULDBLOCK:
- sym = @symbol(WSAEWOULDBLOCK);
- typ = @symbol(notReadySignal);
- break;
+ case WSAEWOULDBLOCK:
+ sym = @symbol(WSAEWOULDBLOCK);
+ typ = @symbol(notReadySignal);
+ break;
#endif
#ifdef WSAEINPROGRESS
- case WSAEINPROGRESS:
- sym = @symbol(WSAEINPROGRESS);
- typ = @symbol(operationStartedSignal);
- break;
+ case WSAEINPROGRESS:
+ sym = @symbol(WSAEINPROGRESS);
+ typ = @symbol(operationStartedSignal);
+ break;
#endif
#ifdef WSAEALREADY
- case WSAEALREADY:
- sym = @symbol(WSAEALREADY);
- typ = @symbol(operationStartedSignal);
- break;
+ case WSAEALREADY:
+ sym = @symbol(WSAEALREADY);
+ typ = @symbol(operationStartedSignal);
+ break;
#endif
#ifdef WSAENOTSOCK
- case WSAENOTSOCK:
- sym = @symbol(WSAENOTSOCK);
- typ = @symbol(inappropriateOperationSignal);
- break;
+ case WSAENOTSOCK:
+ sym = @symbol(WSAENOTSOCK);
+ typ = @symbol(inappropriateOperationSignal);
+ break;
#endif
#ifdef WSAEPROTONOSUPPORT
- case WSAEPROTONOSUPPORT:
- sym = @symbol(WSAEPROTONOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case WSAEPROTONOSUPPORT:
+ sym = @symbol(WSAEPROTONOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef WSAESOCKTNOSUPPORT
- case WSAESOCKTNOSUPPORT:
- sym = @symbol(WSAESOCKTNOSUPPORT);
- typ = @symbol(unsupportedOperationSignal);
- break;
+ case WSAESOCKTNOSUPPORT:
+ sym = @symbol(WSAESOCKTNOSUPPORT);
+ typ = @symbol(unsupportedOperationSignal);
+ break;
#endif
#ifdef E_NOINTERFACE
- case E_NOINTERFACE:
- sym = @symbol(E_NOINTERFACE);
- typ = @symbol(noInterfaceSignal);
- break;
+ case E_NOINTERFACE:
+ sym = @symbol(E_NOINTERFACE);
+ typ = @symbol(noInterfaceSignal);
+ break;
#endif
#ifdef CO_E_NOTINITIALIZED
- case CO_E_NOTINITIALIZED:
- sym = @symbol(CO_E_NOTINITIALIZED);
- typ = @symbol(coNotInitializedSignal);
- break;
+ case CO_E_NOTINITIALIZED:
+ sym = @symbol(CO_E_NOTINITIALIZED);
+ typ = @symbol(coNotInitializedSignal);
+ break;
#endif
#ifdef REGDB_E_CLASSNOTREG
- case REGDB_E_CLASSNOTREG:
- sym = @symbol(REGDB_E_CLASSNOTREG);
- typ = @symbol(classNotRegisteredSignal);
- break;
+ case REGDB_E_CLASSNOTREG:
+ sym = @symbol(REGDB_E_CLASSNOTREG);
+ typ = @symbol(classNotRegisteredSignal);
+ break;
#endif
#ifdef CLASS_E_NOAGGREGATION
- case CLASS_E_NOAGGREGATION:
- sym = @symbol(CLASS_E_NOAGGREGATION);
- typ = @symbol(noAggregationSignal);
- break;
+ case CLASS_E_NOAGGREGATION:
+ sym = @symbol(CLASS_E_NOAGGREGATION);
+ typ = @symbol(noAggregationSignal);
+ break;
#endif
#ifdef DISP_E_UNKNOWNNAME
- case DISP_E_UNKNOWNNAME:
- sym = @symbol(DISP_E_UNKNOWNNAME);
- typ = @symbol(unknownNameSignal);
- break;
+ case DISP_E_UNKNOWNNAME:
+ sym = @symbol(DISP_E_UNKNOWNNAME);
+ typ = @symbol(unknownNameSignal);
+ break;
#endif
#ifdef OLEOBJ_E_NOVERBS
- case OLEOBJ_E_NOVERBS:
- sym = @symbol(OLEOBJ_E_NOVERBS);
- typ = @symbol(noVerbsSignal);
- break;
-#endif
-
- default:
- break;
- }
+ case OLEOBJ_E_NOVERBS:
+ sym = @symbol(OLEOBJ_E_NOVERBS);
+ typ = @symbol(noVerbsSignal);
+ break;
+#endif
+
+ default:
+ break;
+ }
}
}
%}.
holder := OSErrorHolder new.
sym isNil ifTrue:[
- sym := #ERROR_OTHER.
- errNr notNil ifTrue:[
- "keep symbols as symbols"
- holder parameter:(errNr isString ifTrue:[errNr] ifFalse:[errNr asString]).
- ].
+ sym := #ERROR_OTHER.
+ errNr notNil ifTrue:[
+ "keep symbols as symbols"
+ holder parameter:(errNr isString ifTrue:[errNr] ifFalse:[errNr asString]).
+ ].
].
holder errorSymbol:sym errorCategory:typ.
^ holder
@@ -2883,9 +2894,9 @@
RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_DISK_FULL)));
}
#endif
-#ifdef ERROR_ERROR_SHARING_VIOLATION
- if (sym == @symbol(ERROR_ERROR_SHARING_VIOLATION)) {
- RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_ERROR_SHARING_VIOLATION)));
+#ifdef ERROR_SHARING_VIOLATION
+ if (sym == @symbol(ERROR_SHARING_VIOLATION)) {
+ RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_SHARING_VIOLATION)));
}
#endif
#ifdef ERROR_LOCK_VIOLATION
@@ -2953,6 +2964,16 @@
RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_CURRENT_DIRECTORY)));
}
#endif
+#ifdef ERROR_FILE_EXISTS
+ if (sym == @symbol(ERROR_FILE_EXISTS)) {
+ RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_FILE_EXISTS)));
+ }
+#endif
+#ifdef ERROR_ALREADY_EXISTS
+ if (sym == @symbol(ERROR_FILE_EXISTS)) {
+ RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_ALREADY_EXISTS)));
+ }
+#endif
#ifdef ERROR_CANNOT_MAKE
if (sym == @symbol(ERROR_CANNOT_MAKE)) {
RETURN ( __mkSmallInteger(__WIN32_ERR(ERROR_CANNOT_MAKE)));
@@ -3691,65 +3712,65 @@
!
exec:aCommandPath withArguments:argString environment:environment fileDescriptors:fdArray fork:doFork
- newPgrp:newPgrp inDirectory:aDirectory
- showWindow:showWindowBooleanOrNil
+ newPgrp:newPgrp inDirectory:aDirectory
+ showWindow:showWindowBooleanOrNil
"Internal lowLevel entry for combined fork & exec for WIN32
If fork is false (chain a command):
- execute the OS command specified by the argument, aCommandPath, with
- arguments in argArray (no arguments, if nil).
- If successful, this method does not return and smalltalk is gone.
- If not successful, it does return.
- Normal use is with forkForCommand.
+ execute the OS command specified by the argument, aCommandPath, with
+ arguments in argArray (no arguments, if nil).
+ If successful, this method does not return and smalltalk is gone.
+ If not successful, it does return.
+ Normal use is with forkForCommand.
If fork is true (subprocess command execution):
- fork a child to do the above.
- The Win32ProcessHandle of the child process is returned; nil if the fork failed.
+ fork a child to do the above.
+ The Win32ProcessHandle of the child process is returned; nil if the fork failed.
fdArray contains the filedescriptors, to be used for the child (if fork is true).
- fdArray[1] = 15 -> use fd 15 as stdin.
- If an element of the array is set to nil, the corresponding filedescriptor
- will be closed for the child.
- fdArray[0] == StdIn for child
- fdArray[1] == StdOut for child
- fdArray[2] == StdErr for child
+ fdArray[1] = 15 -> use fd 15 as stdin.
+ If an element of the array is set to nil, the corresponding filedescriptor
+ will be closed for the child.
+ fdArray[0] == StdIn for child
+ fdArray[1] == StdOut for child
+ fdArray[2] == StdErr for child
NOTE that in WIN32 the fds are HANDLES.
If newPgrp is true, the subprocess will be established in a new process group.
- The processgroup will be equal to id.
- newPgrp is not used on WIN32 and VMS systems.
+ The processgroup will be equal to id.
+ newPgrp is not used on WIN32 and VMS systems.
showWindowOrBoolean may be:
- true - a window is shown on start of the command
- false - the command window is hidden
- nil - the nCmdShown parameter of the commans's winmain function determins,
- if a window is shown.
- #default
- - same as nil
+ true - a window is shown on start of the command
+ false - the command window is hidden
+ nil - the nCmdShown parameter of the commans's winmain function determins,
+ if a window is shown.
+ #default
+ - same as nil
"
|dirPath rslt|
aDirectory notNil ifTrue:[
- dirPath := aDirectory asFilename asAbsoluteFilename osNameForDirectory.
- (dirPath endsWith:':') ifTrue:[
- dirPath := dirPath , '\'.
- ].
+ dirPath := aDirectory asFilename asAbsoluteFilename osNameForDirectory.
+ (dirPath endsWith:':') ifTrue:[
+ dirPath := dirPath , '\'.
+ ].
].
rslt := self
- primExec:aCommandPath
- commandLine:argString
- environment:environment
- fileDescriptors:fdArray
- fork:doFork
- newPgrp:newPgrp
- inPath:dirPath
- createFlags:nil
- inheritHandles:true
- showWindow:showWindowBooleanOrNil.
+ primExec:aCommandPath
+ commandLine:argString
+ environment:environment
+ fileDescriptors:fdArray
+ fork:doFork
+ newPgrp:newPgrp
+ inPath:dirPath
+ createFlags:nil
+ inheritHandles:true
+ showWindow:showWindowBooleanOrNil.
"/ 'created ' print. cmdLine print. ' -> ' print. rslt printCR.
^ rslt
@@ -4276,18 +4297,6 @@
"Created: / 15-11-2016 / 19:39:49 / cg"
!
-primExec:commandPath commandLine:commandLine fileDescriptors:fdArray fork:doFork newPgrp:newPgrp
- inPath:dirName createFlags:flagsOrNil inheritHandles:inheritHandles
- showWindow:showWindowBooleanOrNil
- "obsolete internal lowLevel entry for combined fork & exec for WIN32"
-
- ^ self
- primExec:commandPath commandLine:commandLine environment:nil
- fileDescriptors:fdArray fork:doFork newPgrp:newPgrp
- inPath:dirName createFlags:flagsOrNil inheritHandles:inheritHandles
- showWindow:showWindowBooleanOrNil
-!
-
shellExecute:hwndArg lpOperation:lpOperationArg lpFile:lpFileArg lpParameters:lpParametersArg lpDirectory:lpDirectoryArg nShowCmd:nShowCmd
"Opens or prints the specified file, which can be an executable, document file, or directory.
If its a directory, an explorer window is opened (see example below).
@@ -4423,32 +4432,32 @@
shellAndArgs := self commandAndArgsForOSCommand:aCommandString.
(in := anExternalInStream) isNil ifTrue:[
- nullStream := Filename nullDevice readWriteStream.
- in := nullStream.
+ nullStream := Filename nullDevice readWriteStream.
+ in := nullStream.
].
(out := anExternalOutStream) isNil ifTrue:[
- nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
- out := nullStream.
+ nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
+ out := nullStream.
].
(err := anExternalErrStream) isNil ifTrue:[
- err := out
+ err := out
].
rslt := self
- exec:(shellAndArgs at:1)
- withArguments:(shellAndArgs at:2)
- environment:anEvironmentDictionary
- fileDescriptors:(Array with:in fileHandle
- with:out fileHandle
- with:err fileHandle
- with:(anAuxiliaryStream notNil ifTrue:[anAuxiliaryStream fileHandle] ifFalse:[nil]))
- fork:true
- newPgrp:newPgrp
- inDirectory:dir
- showWindow:(showWindowBooleanOrNil ? (shellAndArgs at:3)).
+ exec:(shellAndArgs at:1)
+ withArguments:(shellAndArgs at:2)
+ environment:anEvironmentDictionary
+ fileDescriptors:(Array with:in fileHandle
+ with:out fileHandle
+ with:err fileHandle
+ with:(anAuxiliaryStream notNil ifTrue:[anAuxiliaryStream fileHandle] ifFalse:[nil]))
+ fork:true
+ newPgrp:newPgrp
+ inDirectory:dir
+ showWindow:(showWindowBooleanOrNil ? (shellAndArgs at:3)).
nullStream notNil ifTrue:[
- nullStream close.
+ nullStream close.
].
^ rslt
@@ -4474,7 +4483,7 @@
The following will no longer work. monitorPid has disappeared
pid notNil ifTrue:[
- Processor monitorPid:pid action:[:OSstatus | sema signal ].
+ Processor monitorPid:pid action:[:OSstatus | sema signal ].
].
in close.
out close.
@@ -4489,10 +4498,10 @@
sema := Semaphore new.
Processor
- monitor:[
- pid := OperatingSystem startProcess:'dir > out 2>err'
- ]
- action:[:osStatus | sema signal ].
+ monitor:[
+ pid := OperatingSystem startProcess:'dir > out 2>err'
+ ]
+ action:[:osStatus | sema signal ].
sema wait.
Transcript showCR:'finished'
@@ -4504,10 +4513,10 @@
sema := Semaphore new.
Processor
- monitor:[
- pid := OperatingSystem startProcess:'(echo 1 & stx --eval "Delay waitForSeconds:100" & dir) >out' withCRs
- ]
- action:[:osStatus | sema signal ].
+ monitor:[
+ pid := OperatingSystem startProcess:'(echo 1 & stx --eval "Delay waitForSeconds:100" & dir) >out' withCRs
+ ]
+ action:[:osStatus | sema signal ].
Delay waitForSeconds:5.
OperatingSystem terminateProcessGroup:pid.
@@ -4520,10 +4529,10 @@
sema := Semaphore new.
Processor
- monitor:[
- pid := OperatingSystem startProcess:{ 'C:\Users\cg\work\stx\projects\smalltalk\stx.com' . '--eval' . '"Delay waitForSeconds:100"' }
- ]
- action:[:osStatus | sema signal ].
+ monitor:[
+ pid := OperatingSystem startProcess:{ 'C:\Users\cg\work\stx\projects\smalltalk\stx.com' . '--eval' . '"Delay waitForSeconds:100"' }
+ ]
+ action:[:osStatus | sema signal ].
Delay waitForSeconds:5.
OperatingSystem terminateProcess:pid.
@@ -4574,17 +4583,17 @@
sa.bInheritHandle = FALSE;
if (__isStringLike(aPathName)) {
- success = CreateDirectoryA(__stringVal(aPathName), &sa);
+ success = CreateDirectoryA(__stringVal(aPathName), &sa);
} else if (__isUnicode16String(aPathName)) {
- wchar_t _wPathName[MAXPATHLEN+1];
-
- _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
- success = CreateDirectoryW(_wPathName, &sa);
+ wchar_t _wPathName[MAXPATHLEN+1];
+
+ _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
+ success = CreateDirectoryW(_wPathName, &sa);
} else
- goto err;
+ goto err;
if (success == TRUE) {
- RETURN (nil);
+ RETURN (nil);
}
error = __mkSmallInteger(__WIN32_ERR(GetLastError()));
@@ -4593,8 +4602,8 @@
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -4620,7 +4629,7 @@
Return nil if successful, an OsErrorHolder if not."
(self executeCommand:('mklink/h "%1" "%2"' bindWith:newPath with:oldPath)) ifFalse:[
- ^ OSErrorHolder errorSymbol:'mklink/h failed' errorCategory:nil.
+ ^ OSErrorHolder errorSymbol:'mklink/h failed' errorCategory:nil.
].
^ nil.
@@ -4638,11 +4647,11 @@
dirFlag := ''.
(self isDirectory:oldPath) ifTrue:[
- dirFlag := '/d'.
+ dirFlag := '/d'.
].
(self executeCommand:('mklink %3 "%1" "%2"' bindWith:newPath with:oldPath with:dirFlag)) ifFalse:[
- ^ OSErrorHolder errorSymbol:'mklink failed' errorCategory:nil.
+ ^ OSErrorHolder errorSymbol:'mklink failed' errorCategory:nil.
].
^ nil.
@@ -4902,46 +4911,46 @@
if (__isStringLike(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- // do not cast to INT - will loose sign bit then!
- success = (int)STX_API_NOINT_CALL1( "RemoveDirectoryA", RemoveDirectoryA, _aPathName);
- } while ((success < 0) && (__threadErrno == EINTR));
- }
-#else
- success = RemoveDirectoryA((char *)__stringVal(fullPathName));
- if (!success) __threadErrno = __WIN32_ERR(GetLastError());
+ {
+ char _aPathName[MAXPATHLEN];
+
+ strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+ do {
+ // do not cast to INT - will loose sign bit then!
+ success = (int)STX_API_NOINT_CALL1( "RemoveDirectoryA", RemoveDirectoryA, _aPathName);
+ } while ((success < 0) && (__threadErrno == EINTR));
+ }
+#else
+ success = RemoveDirectoryA((char *)__stringVal(fullPathName));
+ if (!success) __threadErrno = __WIN32_ERR(GetLastError());
#endif
} else if (__isUnicode16String(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- wchar_t _wPathName[MAXPATHLEN+1];
-
- _makeWchar(fullPathName, _wPathName, sizeof(_wPathName));
- do {
- // do not cast to INT - will loose sign bit then!
- success = (int)STX_API_NOINT_CALL1( "RemoveDirectoryW", RemoveDirectoryW, _wPathName);
- } while ((success < 0) && (__threadErrno == EINTR));
- }
-#else
- success = RemoveDirectoryW((wchar_t *)__unicode16StringVal(fullPathName));
- if (!success) __threadErrno = __WIN32_ERR(GetLastError());
+ {
+ wchar_t _wPathName[MAXPATHLEN+1];
+
+ _makeWchar(fullPathName, _wPathName, sizeof(_wPathName));
+ do {
+ // do not cast to INT - will loose sign bit then!
+ success = (int)STX_API_NOINT_CALL1( "RemoveDirectoryW", RemoveDirectoryW, _wPathName);
+ } while ((success < 0) && (__threadErrno == EINTR));
+ }
+#else
+ success = RemoveDirectoryW((wchar_t *)__unicode16StringVal(fullPathName));
+ if (!success) __threadErrno = __WIN32_ERR(GetLastError());
#endif
}
if (success == TRUE) {
- RETURN (nil);
+ RETURN (nil);
}
error = __mkSmallInteger(__threadErrno);
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
"/
@@ -4967,46 +4976,46 @@
if (__isStringLike(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- // do not cast to INT - will loose sign bit then!
- success = (int)STX_API_NOINT_CALL1( "DeleteFileA", DeleteFileA, _aPathName);
- } while ((success < 0) && (__threadErrno == EINTR));
- }
-#else
- success = DeleteFileA((char *)__stringVal(fullPathName));
- if (!success) __threadErrno = __WIN32_ERR(GetLastError());
+ {
+ char _aPathName[MAXPATHLEN];
+
+ strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+ do {
+ // do not cast to INT - will loose sign bit then!
+ success = (int)STX_API_NOINT_CALL1( "DeleteFileA", DeleteFileA, _aPathName);
+ } while ((success < 0) && (__threadErrno == EINTR));
+ }
+#else
+ success = DeleteFileA((char *)__stringVal(fullPathName));
+ if (!success) __threadErrno = __WIN32_ERR(GetLastError());
#endif
} else if (__isUnicode16String(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- wchar_t _wPathName[MAXPATHLEN+1];
-
- _makeWchar(fullPathName, _wPathName, sizeof(_wPathName));
- do {
- // do not cast to INT - will loose sign bit then!
- success = (int)(STX_API_NOINT_CALL1( "DeleteFileW", DeleteFileW, _wPathName));
- } while ((success < 0) && (__threadErrno == EINTR));
- }
-#else
- success = DeleteFileW((wchar_t *)__unicode16StringVal(fullPathName));
- if (!success) __threadErrno = __WIN32_ERR(GetLastError());
+ {
+ wchar_t _wPathName[MAXPATHLEN+1];
+
+ _makeWchar(fullPathName, _wPathName, sizeof(_wPathName));
+ do {
+ // do not cast to INT - will loose sign bit then!
+ success = (int)(STX_API_NOINT_CALL1( "DeleteFileW", DeleteFileW, _wPathName));
+ } while ((success < 0) && (__threadErrno == EINTR));
+ }
+#else
+ success = DeleteFileW((wchar_t *)__unicode16StringVal(fullPathName));
+ if (!success) __threadErrno = __WIN32_ERR(GetLastError());
#endif
}
if (success == TRUE) {
- RETURN (nil);
+ RETURN (nil);
}
error = __mkSmallInteger(__threadErrno);
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -5027,42 +5036,42 @@
if (__isStringLike(oldPath) && __isStringLike(newPath)) {
#ifdef DO_WRAP_CALLS
- char _oldPath[MAXPATHLEN], _newPath[MAXPATHLEN];
-
- strncpy(_oldPath, __stringVal(oldPath), MAXPATHLEN-1); _oldPath[MAXPATHLEN-1] = '\0';
- strncpy(_newPath, __stringVal(newPath), MAXPATHLEN-1); _newPath[MAXPATHLEN-1] = '\0';
-
- do {
- success = STX_API_NOINT_CALL2("MoveFileA", MoveFileA, _oldPath, _newPath);
- } while (success < 0 && __threadErrno == EINTR);
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- success = MoveFileA((char *) __stringVal(oldPath), (char *) __stringVal(newPath));
- } while (success < 0 && __threadErrno == EINTR);
- __END_INTERRUPTABLE__
+ char _oldPath[MAXPATHLEN], _newPath[MAXPATHLEN];
+
+ strncpy(_oldPath, __stringVal(oldPath), MAXPATHLEN-1); _oldPath[MAXPATHLEN-1] = '\0';
+ strncpy(_newPath, __stringVal(newPath), MAXPATHLEN-1); _newPath[MAXPATHLEN-1] = '\0';
+
+ do {
+ success = STX_API_NOINT_CALL2("MoveFileA", MoveFileA, _oldPath, _newPath);
+ } while (success < 0 && __threadErrno == EINTR);
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ success = MoveFileA((char *) __stringVal(oldPath), (char *) __stringVal(newPath));
+ } while (success < 0 && __threadErrno == EINTR);
+ __END_INTERRUPTABLE__
#endif
} else {
- wchar_t _oldPathW[MAXPATHLEN], _newPathW[MAXPATHLEN];
-
- if (_makeWchar(oldPath, _oldPathW, sizeof(_oldPathW)) < 0
- || _makeWchar(newPath, _newPathW, sizeof(_newPathW)) < 0) {
- goto err;
- }
+ wchar_t _oldPathW[MAXPATHLEN], _newPathW[MAXPATHLEN];
+
+ if (_makeWchar(oldPath, _oldPathW, sizeof(_oldPathW)) < 0
+ || _makeWchar(newPath, _newPathW, sizeof(_newPathW)) < 0) {
+ goto err;
+ }
#ifdef DO_WRAP_CALLS
- do {
- success = STX_API_NOINT_CALL2( "MoveFileW", MoveFileW, _oldPathW, _newPathW);
- } while (success < 0 && __threadErrno == EINTR);
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- success = MoveFileW(_oldPathW, _newPathW);
- } while (success < 0 && __threadErrno == EINTR);
- __END_INTERRUPTABLE__
+ do {
+ success = STX_API_NOINT_CALL2( "MoveFileW", MoveFileW, _oldPathW, _newPathW);
+ } while (success < 0 && __threadErrno == EINTR);
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ success = MoveFileW(_oldPathW, _newPathW);
+ } while (success < 0 && __threadErrno == EINTR);
+ __END_INTERRUPTABLE__
#endif
}
if (success > 0) {
- RETURN (nil);
+ RETURN (nil);
}
error = __mkSmallInteger(__threadErrno);
@@ -5070,8 +5079,8 @@
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -5186,7 +5195,7 @@
"
this could have been implemented as:
- (self infoOf:aPathName) at:#mode
+ (self infoOf:aPathName) at:#mode
but for huge directory searches the code below is faster
"
@@ -5198,61 +5207,61 @@
if (__isStringLike(aPathName)) {
#ifdef DO_WRAP_CALLS
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
-
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = STX_C_NOINT_CALL2( "_stat", _stat, _aPathName, &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = _stat( (char *)__stringVal(aPathName), &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
+ char _aPathName[MAXPATHLEN];
+
+ strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+
+ do {
+ __threadErrno = 0;
+ // do not cast to INT - will loose sign bit then!
+ ret = STX_C_NOINT_CALL2( "_stat", _stat, _aPathName, &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ __threadErrno = 0;
+ ret = _stat( (char *)__stringVal(aPathName), &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+ __END_INTERRUPTABLE__
+ if (ret < 0) {
+ __threadErrno = __WIN32_ERR(GetLastError());
+ }
#endif
} else if (__isUnicode16String(aPathName)) {
#ifdef DO_WRAP_CALLS
- char _wPathName[MAXPATHLEN];
-
- _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
-
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = STX_C_NOINT_CALL2( "_wstat", _wstat, _wPathName, &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = _wstat((char *)__unicode16StringVal(aPathName), &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
+ char _wPathName[MAXPATHLEN];
+
+ _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
+
+ do {
+ __threadErrno = 0;
+ // do not cast to INT - will loose sign bit then!
+ ret = STX_C_NOINT_CALL2( "_wstat", _wstat, _wPathName, &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ __threadErrno = 0;
+ ret = _wstat((char *)__unicode16StringVal(aPathName), &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+ __END_INTERRUPTABLE__
+ if (ret < 0) {
+ __threadErrno = __WIN32_ERR(GetLastError());
+ }
#endif
} else
- goto out;
+ goto out;
if (ret >= 0) {
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
}
error = __mkSmallInteger(__threadErrno);
out:;
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
@@ -5274,7 +5283,7 @@
"
this could have been implemented as:
- (self infoOf:aPathName) at:#mode
+ (self infoOf:aPathName) at:#mode
but for huge directory searches the code below is faster
"
@@ -5286,45 +5295,45 @@
if (__isSmallInteger(aFileDescriptor)) {
#ifdef DO_WRAP_CALLS
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = STX_C_NOINT_CALL2( "fstat", fstat, __smallIntegerVal(aFileDescriptor), &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = fstat( __smallIntegerVal(aFileDescriptor), &buf);
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
+ do {
+ __threadErrno = 0;
+ // do not cast to INT - will loose sign bit then!
+ ret = STX_C_NOINT_CALL2( "fstat", fstat, __smallIntegerVal(aFileDescriptor), &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ __threadErrno = 0;
+ // do not cast to INT - will loose sign bit then!
+ ret = fstat( __smallIntegerVal(aFileDescriptor), &buf);
+ } while ((ret < 0) && (__threadErrno == EINTR));
+ __END_INTERRUPTABLE__
+ if (ret < 0) {
+ __threadErrno = __WIN32_ERR(GetLastError());
+ }
#endif
} else
- goto out;
+ goto out;
if (ret >= 0) {
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
}
error = __mkSmallInteger(__threadErrno);
out:;
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed
"
'c:\windows' asFilename readingFileDo:[:s|
- (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8.
+ (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8.
].
'Make.proto' asFilename readingFileDo:[:s|
- (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8.
+ (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8.
].
(OperatingSystem changeAccessModeOf:'Make.proto' to:8r644)
"
@@ -5342,55 +5351,55 @@
int ret;
if (__isSmallInteger(modeBits)) {
- if (__isStringLike(aPathName)) {
+ if (__isStringLike(aPathName)) {
#ifdef DO_WRAP_CALLS
- int _chmod();
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- // do not cast to INT - will loose sign bit then!
- ret = STX_C_NOINT_CALL2( "_chmod", _chmod, _aPathName, __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- ret = _chmod((char *)__stringVal(aPathName), __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
-#endif
- } else if (__isUnicode16String(aPathName)) {
+ int _chmod();
+ char _aPathName[MAXPATHLEN];
+
+ strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+ do {
+ // do not cast to INT - will loose sign bit then!
+ ret = STX_C_NOINT_CALL2( "_chmod", _chmod, _aPathName, __intVal(modeBits));
+ } while ((ret < 0) && (__threadErrno == EINTR));
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = _chmod((char *)__stringVal(aPathName), __intVal(modeBits));
+ } while ((ret < 0) && (__threadErrno == EINTR));
+ __END_INTERRUPTABLE__
+#endif
+ } else if (__isUnicode16String(aPathName)) {
#ifdef DO_WRAP_CALLS
- int _wchmod();
- char _wPathName[MAXPATHLEN];
-
- _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
- do {
- // do not cast to INT - will loose sign bit then!
- ret = STX_C_NOINT_CALL2( "_wchmod", _wchmod, _wPathName, __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- ret = _chmod((wchar_t *)__unicode16StringVal(fullPathName), __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
-#endif
- } else
- goto out;
-
- if (ret >= 0) {
- RETURN (nil);
- }
-
- error = __mkSmallInteger(__threadErrno);
+ int _wchmod();
+ char _wPathName[MAXPATHLEN];
+
+ _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
+ do {
+ // do not cast to INT - will loose sign bit then!
+ ret = STX_C_NOINT_CALL2( "_wchmod", _wchmod, _wPathName, __intVal(modeBits));
+ } while ((ret < 0) && (__threadErrno == EINTR));
+#else
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = _chmod((wchar_t *)__unicode16StringVal(fullPathName), __intVal(modeBits));
+ } while ((ret < 0) && (__threadErrno == EINTR));
+ __END_INTERRUPTABLE__
+#endif
+ } else
+ goto out;
+
+ if (ret >= 0) {
+ RETURN (nil);
+ }
+
+ error = __mkSmallInteger(__threadErrno);
}
out:;
%}.
error notNil ifTrue:[
- LastErrorNumber := error.
- ^ self errorHolderForNumber:error.
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
].
^ self primitiveFailed:#argumentError
@@ -7499,7 +7508,7 @@
pid := anOSProcess pid.
groupsToTerminate add:pid.
"/ Transcript show:'terminate '; showCR:pid.
- self terminateProcess:( pid ).
+ self terminateProcess:pid.
list remove:anOSProcess.
anyMore := true.
"/ need to restart: we have removed an element inside the loop
@@ -7635,7 +7644,7 @@
Process32First( hProcessSnap, & pe32 );
do {
- st_perProc = __SSEND0(@global(OSProcess), @symbol(new), 0);
+ st_perProc = __SSEND0(@global(Win32OperatingSystem::OSProcessDescriptor), @symbol(new), 0);
f = __MKSTRING(pe32.szExeFile);
__SSEND1(st_perProc, @symbol(commandLine:), 0, f );
__SSEND1(st_perProc, @symbol(pid:), 0, __mkSmallInteger(pe32.th32ProcessID) );
@@ -8323,31 +8332,31 @@
|strings assocString envDict|
strings := OrderedCollection new:128.
-%{
+%{
LPWSTR lpvEnv;
lpvEnv = GetEnvironmentStringsW();
if (lpvEnv != NULL) {
- static struct inlineCache add = _ILC1;
- LPWSTR cp = lpvEnv;
-
- while (*cp) {
- assocString = __MKU16STRING(cp);
- (*add.ilc_func)(strings, @symbol(add:), nil, &add, assocString);
- cp += wcslen(cp) + 1;
- }
+ static struct inlineCache add = _ILC1;
+ LPWSTR cp = lpvEnv;
+
+ while (*cp) {
+ assocString = __MKU16STRING(cp);
+ (*add.ilc_func)(strings, @symbol(add:), nil, &add, assocString);
+ cp += wcslen(cp) + 1;
+ }
}
%}.
envDict := Dictionary new.
strings do:[:each |
- |idx key value|
-
- idx := each indexOf:$= startingAt:2.
- self assert:(idx ~~ 0).
- key := each copyTo:idx-1.
- value := each copyFrom:idx+1.
- envDict at:key put:value.
+ |idx key value|
+
+ idx := each indexOf:$= startingAt:2.
+ self assert:(idx ~~ 0).
+ key := each copyTo:idx-1.
+ value := each copyFrom:idx+1.
+ envDict at:key put:value.
].
^ envDict
@@ -8370,35 +8379,35 @@
int i, l;
if (__isStringLike(aStringOrSymbol)) {
- l = __stringSize(aStringOrSymbol);
- if (l > ENV_BUFSIZE-1)
- goto badArgument;
- for (i=0; i<l; i++) {
- _varName[i] = __stringVal(aStringOrSymbol)[i];
- }
+ l = __stringSize(aStringOrSymbol);
+ if (l > ENV_BUFSIZE-1)
+ goto badArgument;
+ for (i=0; i<l; i++) {
+ _varName[i] = __stringVal(aStringOrSymbol)[i];
+ }
} else if (__isUnicode16String(aStringOrSymbol)) {
- l = __unicode16StringSize(aStringOrSymbol);
- if (l > ENV_BUFSIZE-1)
- goto badArgument;
- for (i=0; i<l; i++) {
- _varName[i] = __unicode16StringVal(aStringOrSymbol)[i];
- }
+ l = __unicode16StringSize(aStringOrSymbol);
+ if (l > ENV_BUFSIZE-1)
+ goto badArgument;
+ for (i=0; i<l; i++) {
+ _varName[i] = __unicode16StringVal(aStringOrSymbol)[i];
+ }
} else {
- goto badArgument;
+ goto badArgument;
}
_varName[l] = 0;
nNeeded = GetEnvironmentVariableW(_varName, buff, ENV_BUFSIZE);
if (nNeeded > sizeof(buff)) {
- WCHAR *buff2;
-
- buff2 = (char *)malloc(nNeeded * sizeof(WCHAR));
- GetEnvironmentVariableW(_varName, buff2, nNeeded);
- ret = __mkStringOrU16String_maxlen(buff2, nNeeded);
- free(buff2);
+ WCHAR *buff2;
+
+ buff2 = (char *)malloc(nNeeded * sizeof(WCHAR));
+ GetEnvironmentVariableW(_varName, buff2, nNeeded);
+ ret = __mkStringOrU16String_maxlen(buff2, nNeeded);
+ free(buff2);
} else if (nNeeded > 0) {
- ret = __mkStringOrU16String_maxlen(buff, nNeeded);
- // console_printf("getenv() -> %"_lx_"\n", (INT)ret);
+ ret = __mkStringOrU16String_maxlen(buff, nNeeded);
+ // console_printf("getenv() -> %"_lx_"\n", (INT)ret);
}
RETURN (ret);
@@ -8718,7 +8727,7 @@
|info nAdapters rawData entry
name description macAddress ipAddress ipAddressMask|
- rawData := Array new:50.
+ rawData := Array new:100.
%{
/*
* temporary undef String to avoid a #define-conflict
@@ -8727,7 +8736,7 @@
# undef String
# undef Context
- IP_ADAPTER_INFO AdapterInfo[32];
+ IP_ADAPTER_INFO AdapterInfo[99];
DWORD dwBufLen = sizeof(AdapterInfo);
DWORD dwStatus;
@@ -8804,7 +8813,7 @@
|info nAdapters rawData entry
name description macAddress ipAddress ipAddressMask|
- rawData := Array new:50.
+ rawData := Array new:100.
%{
/*
* temporary undef String to avoid a #define-conflict
@@ -8813,7 +8822,7 @@
# undef String
# undef Context
- IP_ADAPTER_INFO AdapterInfo[32];
+ IP_ADAPTER_INFO AdapterInfo[99];
DWORD dwBufLen = sizeof(AdapterInfo);
DWORD dwStatus;
@@ -9411,45 +9420,45 @@
DWORD exitCode;
if (__isExternalAddressLike(processHandleOrPid) ) {
- processHandle = _HANDLEVal(processHandleOrPid);
- if (processHandle == 0) {
- RETURN(false);
- // error = @symbol(invalidParameter);
- // goto out;
- }
+ processHandle = _HANDLEVal(processHandleOrPid);
+ if (processHandle == 0) {
+ RETURN(false);
+ // error = @symbol(invalidParameter);
+ // goto out;
+ }
} else if( __isSmallInteger(processHandleOrPid) ) {
- // assume, that synchronize needs less privilege...
- processHandle = processHandleToClose = OpenProcess(SYNCHRONIZE, FALSE, __smallIntegerVal(processHandleOrPid));
- if (!processHandle) {
- goto checkError;
- }
+ // assume, that synchronize needs less privilege...
+ processHandle = processHandleToClose = OpenProcess(SYNCHRONIZE, FALSE, __smallIntegerVal(processHandleOrPid));
+ if (!processHandle) {
+ goto checkError;
+ }
} else {
- error = @symbol(invalidParameter);
- goto out;
+ error = @symbol(invalidParameter);
+ goto out;
}
/* check if the handle still refers to a running process */
if (GetExitCodeProcess(processHandle, &exitCode) != 0) {
- if (processHandleToClose != 0)
- CloseHandle(processHandleToClose);
- if (exitCode == STILL_ACTIVE) {
- RETURN(true);
- } else {
- RETURN(false);
- }
+ if (processHandleToClose != 0)
+ CloseHandle(processHandleToClose);
+ if (exitCode == STILL_ACTIVE) {
+ RETURN(true);
+ } else {
+ RETURN(false);
+ }
} else if (processHandleToClose != 0) {
- CloseHandle(processHandleToClose);
+ CloseHandle(processHandleToClose);
}
checkError:
err = GetLastError();
// we do not have access to the process (so pid does exist ;-))
if (err == ERROR_ACCESS_DENIED) {
- RETURN(true);
+ RETURN(true);
}
// pid does not exist
if (err == ERROR_INVALID_PARAMETER) {
- RETURN(false);
+ RETURN(false);
}
// any other error - raise signal
@@ -9574,8 +9583,8 @@
osVersion := OperatingSystem osVersion.
^ 'Windows ',
- (#('2000' 'XP' 'Server2003' 'VISTA' '7' '8')
- at: (#('5.0' '5.1' '5.2' '6.0' '6.1' '6.2') indexOf:osVersion)
+ (#('2000' 'XP' 'Server2003' 'VISTA' '7' '8' '8.1' '10')
+ at: (#('5.0' '5.1' '5.2' '6.0' '6.1' '6.2' '6.3' '10.0') indexOf:osVersion)
ifAbsent:osVersion).
"
@@ -11082,9 +11091,22 @@
"
%{ /* NOCONTEXT */
-
- RETURN ( __mkSmallInteger(GetTickCount() & 0x1FFFFFFF) );
-%}
+#if POINTERSIZE == 8
+ RETURN ( __mkSmallInteger(GetTickCount64() & (_MAX_INT >> 1)) );
+#else
+ RETURN ( __mkSmallInteger(GetTickCount() & (_MAX_INT >> 1)) );
+#endif
+%}
+
+ "
+ self getMillisecondTime
+
+ |t1 t2|
+ t1 := self getMillisecondTime.
+ Delay waitForSeconds:1.
+ t2 := self getMillisecondTime.
+ t2 - t1.
+ "
!
getOSTime
@@ -11964,6 +11986,10 @@
^ OSProcessStatus pid:pid status:status code:code core:core
!
+isBlockingOn:fd
+ ^ true
+!
+
numAvailableForReadOn:fd
"return the number of bytes available for reading, without blocking."
@@ -12007,10 +12033,7 @@
//#define SELECTDEBUGWIN32
//#define SELECT3DEBUGWIN32
#define MAXHANDLE 128
- int i, idx;
- INT t;
- int numHandles;
- DWORD res;
+ int i;
HANDLE hArray[MAXHANDLE+1];
int retArray[MAXHANDLE];
int readCount, writeCount, exceptCount;
@@ -12020,8 +12043,7 @@
fd_set readFds;
fd_set writeFds;
fd_set exceptFds;
- int hasSockets;
- int hasPipes;
+ int numHandles, numSockets, numPipes;
int pass = 1; // perform up to 2 passes
if (readableResultFdArray != nil) {
@@ -12078,7 +12100,7 @@
FD_ZERO(&readFds);
FD_ZERO(&writeFds);
FD_ZERO(&exceptFds);
- numHandles = hasSockets = hasPipes = 0;
+ numHandles = numSockets = numPipes = 0;
for (i = 0; (i < readCount) && (numHandles < MAXHANDLE); i++) {
OBJ fd = __arrayVal(readFdArray)[i];
@@ -12086,7 +12108,7 @@
if (fd != nil) {
if (__Class(fd) == @global(Win32SocketHandle)) {
FD_SET (_HANDLEVal(fd), &readFds);
- hasSockets++;
+ numSockets++;
} else if (__isSmallInteger(fd)) {
DWORD canRead;
if (PeekNamedPipe(_get_osfhandle(__intVal(fd)), 0, 0, 0, &canRead, 0)) {
@@ -12100,7 +12122,7 @@
@global(LastErrorNumber) = __mkSmallInteger(EBADF);
RETURN (__mkSmallInteger(-1));
}
- hasPipes++;
+ numPipes++;
} else {
hArray [numHandles] = _HANDLEVal(fd);
retArray[numHandles] = i;
@@ -12115,7 +12137,7 @@
if (fd != nil) {
if (__Class(fd) == @global(Win32SocketHandle)) {
FD_SET (_HANDLEVal(fd), &writeFds);
- hasSockets++;
+ numSockets++;
} else if (__isSmallInteger(fd)) {
// kludge: assume that pipes can alway be written
if (*pcntW < resultSizeWritable) {
@@ -12137,7 +12159,7 @@
if (fdOrPid != nil) {
if (__Class(fdOrPid) == @global(Win32SocketHandle)) {
FD_SET (_HANDLEVal(fdOrPid), &exceptFds);
- hasSockets++;
+ numSockets++;
} else if (__isExternalAddressLike(fdOrPid)) {
// a PID
hArray [numHandles] = _HANDLEVal(fdOrPid);
@@ -12147,126 +12169,66 @@
}
}
- if (hasSockets) {
- struct timeval tv = {0, 0};
- int nReady;
+ // +++++ checking for Windows Handles +++++++++++++++++++++++++++++++++++++++++
+ if (numHandles != 0) {
+ DWORD res;
+ int idx;
+ INT t;
+
+ if (numSockets || pass > 1) {
+ // do not wait - wait when checking for sockets
+ t = 0;
+ } else if (__isSmallInteger(millis)) {
+ t = __intVal(millis);
+ } else {
+ t = INFINITE;
+ }
#ifdef SELECT3DEBUGWIN32
- console_printf("select hasSockets = %d\n", hasSockets);
-#endif
- nReady = select(1 , &readFds, &writeFds, &exceptFds, &tv); // first parameter to select is ignored in windows
- if (nReady < 0) {
-#ifdef SELECTDEBUGWIN32
- console_printf("error in select %d %d\n", nReady, GetLastError());
-#endif
- @global(LastErrorNumber) = __mkSmallInteger(EBADF);
- RETURN (__mkSmallInteger(-1));
- }
- if (nReady > 0) {
+ console_printf("wait numhandles = %d timeout = %d\n", numHandles, t);
+#endif
+
+ res = __vmWait(numHandles, hArray, MAXHANDLE, (int)t);
+
+ if (res == WAIT_TIMEOUT) {
+#ifdef SELECT3DEBUGWIN32
+ console_printf("- timeOut" );
+#endif
+ goto checkSockets;
+ }
+ if (res == __WAIT_INTERRUPTED) {
#ifdef SELECT3DEBUGWIN32
- console_printf("select nReady %d of %d\n", nReady, hasSockets);
-#endif
- for (i = 0; i < readCount; i++) {
- OBJ fd = __arrayVal(readFdArray)[i];
- if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &readFds)) {
- if (*pcntR < resultSizeReadable) {
- __arrayVal(readableResultFdArray)[*pcntR] = fd;
- __STORE(readableResultFdArray, fd);
- }
- (*pcntR)++; cntAll++;
- }
- }
- for (i = 0; i < writeCount; i++) {
- OBJ fd = __arrayVal(writeFdArray)[i];
- if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &writeFds)) {
- if (*pcntW < resultSizeWritable) {
- __arrayVal(writableResultFdArray)[*pcntW] = fd;
- __STORE(writableResultFdArray, fd);
- }
- (*pcntW)++; cntAll++;
- }
- }
- for (i = 0; i < exceptCount; i++) {
- OBJ fd = __arrayVal(exceptFdArray)[i];
- if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &exceptFds)) {
- if (*pcntE < resultSizeException) {
- __arrayVal(exceptionResultFdArray)[*pcntE] = fd;
- __STORE(exceptionResultFdArray, fd);
- }
- (*pcntE)++; cntAll++;
+ console_printf("- interrupted\n" );
+#endif
+ goto done;
+ }
+
+ if (res == WAIT_FAILED) {
+#ifdef SELECT2DEBUGWIN32
+ console_printf("- error %d (last %d); ret -1\n", __threadErrno, GetLastError());
+#endif
+ if (__threadErrno == EINTR) {
+ @global(LastErrorNumber) = nil;
+ RETURN (__mkSmallInteger(0));
+ } else {
+ if (@global(InfoPrinting) == true) {
+// console_fprintf(stderr, "Win32OS [info]: select errno = %d (last %d)\n", __threadErrno, GetLastError());
+ console_printf("Win32OS [info]: select errno = %d (last %d)\n", __threadErrno, GetLastError());
}
- }
-
- }
- }
- if (pass > 1) // perform maximum 2 passes
- goto done;
-
- if (cntAll) {
- // check for other handles and return immediately, no timeout
- t = 0;
- } else {
- if (__isSmallInteger(millis)) {
- t = __intVal(millis);
-
- if (t <= 0 && numHandles == 0) {
- RETURN (__mkSmallInteger(0));
- }
- } else {
- t = INFINITE;
- }
- }
-
- if (numHandles == 0 && t == 0) {
- // nothing to do and no wait
- goto done;
- }
-
-#ifdef SELECT3DEBUGWIN32
- console_printf("wait numhandles = %d timeout = %d\n", numHandles, t);
-#endif
-
- res = __vmWait(numHandles, hArray, MAXHANDLE, t);
-
- if (res == WAIT_TIMEOUT) {
-#ifdef SELECT3DEBUGWIN32
- console_printf("- timeOut; ret nil\n" );
-#endif
- if (t != 0 && (hasSockets || hasPipes)) {
- // if not a single handle is ready, poll sockets an pipes again
- pass = 2;
- goto pollAgain;
- }
- goto done;
- }
-
- if (res == WAIT_FAILED) {
-#ifdef SELECT2DEBUGWIN32
- console_printf("- error %d (last %d); ret -1\n", __threadErrno, GetLastError());
-#endif
- if (__threadErrno == EINTR) {
- @global(LastErrorNumber) = nil;
- RETURN (__mkSmallInteger(0));
- } else {
- if (@global(InfoPrinting) == true) {
-// console_fprintf(stderr, "Win32OS [info]: select errno = %d (last %d)\n", __threadErrno, GetLastError());
- console_printf("Win32OS [info]: select errno = %d (last %d)\n", __threadErrno, GetLastError());
- }
- @global(LastErrorNumber) = __mkSmallInteger(EBADF);
- RETURN (__mkSmallInteger(-1));
- }
- }
-
- if (numHandles) {
- if (res == numHandles) {
- // vmwait() added an IRQ event to the handles, and this one has been triggered
- if (1 /* @global(InfoPrinting) == true */) {
- console_fprintf(stderr, "Win32OS [info]: plugIn event has been handled\n");
- }
- goto done;
- }
+ @global(LastErrorNumber) = __mkSmallInteger(EBADF);
+ RETURN (__mkSmallInteger(-1));
+ }
+ }
+
if ((res < 0) || (res >= numHandles)) {
- console_printf("- res=%d error1 %d\n", res, GetLastError());
+ if (res == numHandles) {
+ // vmwait() added an IRQ event to the handles, and this one has been triggered
+ if (1 /* @global(InfoPrinting) == true */) {
+ console_fprintf(stderr, "Win32OS [info]: plugIn event has been handled\n");
+ }
+ } else {
+ console_printf("- res=%d error1 %d\n", res, GetLastError());
+ }
goto done;
}
@@ -12312,11 +12274,81 @@
#endif
}
}
- if (t != 0 && (hasSockets || hasPipes)) {
- // back after timeout, maybe some sockets or pipes did wake up
- // in the meantime?
- pass = 2;
- goto pollAgain;
+
+
+// ++++++++++ Check Sockets +++++++++++++++++++++++++++++++++++
+checkSockets:
+ if (pass > 1) // perform maximum 2 passes
+ goto done;
+
+ if (numSockets) {
+ struct timeval tv = {0, 0};
+ struct timeval *tvp = &tv;
+ int nReady;
+
+ // do not wait, if there are threads that can be resumed
+ if (!__vmTestIfAnyThreadMustBeResumed() && cntAll == 0) {
+ // no ready handles found yet - do wait
+ if (__isSmallInteger(millis)) {
+ tv.tv_usec = __intVal(millis) * 1000;
+ } else {
+ // no timeout
+ tvp = 0;
+ }
+ }
+
+#ifdef SELECT3DEBUGWIN32
+ console_printf("select numSockets = %d\n", numSockets);
+#endif
+ nReady = select(1 , &readFds, &writeFds, &exceptFds, tvp); // first parameter to select is ignored in windows
+ if (nReady < 0) {
+#ifdef SELECTDEBUGWIN32
+ console_printf("error in select %d %d\n", nReady, GetLastError());
+#endif
+ @global(LastErrorNumber) = __mkSmallInteger(EBADF);
+ RETURN (__mkSmallInteger(-1));
+ }
+ if (nReady > 0) {
+#ifdef SELECT3DEBUGWIN32
+ console_printf("select nReady %d of %d\n", nReady, numSockets);
+#endif
+ for (i = 0; i < readCount; i++) {
+ OBJ fd = __arrayVal(readFdArray)[i];
+ if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &readFds)) {
+ if (*pcntR < resultSizeReadable) {
+ __arrayVal(readableResultFdArray)[*pcntR] = fd;
+ __STORE(readableResultFdArray, fd);
+ }
+ (*pcntR)++; cntAll++;
+ }
+ }
+ for (i = 0; i < writeCount; i++) {
+ OBJ fd = __arrayVal(writeFdArray)[i];
+ if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &writeFds)) {
+ if (*pcntW < resultSizeWritable) {
+ __arrayVal(writableResultFdArray)[*pcntW] = fd;
+ __STORE(writableResultFdArray, fd);
+ }
+ (*pcntW)++; cntAll++;
+ }
+ }
+ for (i = 0; i < exceptCount; i++) {
+ OBJ fd = __arrayVal(exceptFdArray)[i];
+ if ((__Class(fd) == @global(Win32SocketHandle)) && FD_ISSET(_HANDLEVal(fd), &exceptFds)) {
+ if (*pcntE < resultSizeException) {
+ __arrayVal(exceptionResultFdArray)[*pcntE] = fd;
+ __STORE(exceptionResultFdArray, fd);
+ }
+ (*pcntE)++; cntAll++;
+ }
+ }
+ }
+ if (tvp && tv.tv_usec != 0 && (numHandles != 0 || numPipes != 0)) {
+ // back after timeout, maybe some handles or pipes did wake up
+ // in the meantime?
+ pass = 2;
+ goto pollAgain;
+ }
}
done:
@@ -12342,6 +12374,8 @@
or not supported by OS
"
^ self primitiveFailed
+
+ "Modified: / 15-01-2017 / 03:04:41 / stefan"
!
setBlocking:aBoolean on:fd
@@ -13075,6 +13109,32 @@
^ type notNil
! !
+!Win32OperatingSystem::OSProcessDescriptor methodsFor:'accessing'!
+
+commandLine
+ ^ commandLine
+!
+
+commandLine:something
+ commandLine := something.
+!
+
+parentPid
+ ^ parentPid
+!
+
+parentPid:something
+ parentPid := something.
+!
+
+pid
+ ^ pid
+!
+
+pid:something
+ pid := something.
+! !
+
!Win32OperatingSystem::OSProcessStatus class methodsFor:'documentation'!
documentation
@@ -13210,7 +13270,7 @@
couldNotExecute
"return true when a command could not be executed"
- ^ status == #exit and:[code = 127].
+ ^ status == #failure or:[status == #exit and:[code = 127]].
"Created: 28.12.1995 / 15:43:17 / stefan"
"Modified: 30.4.1996 / 18:27:03 / cg"
@@ -15790,27 +15850,43 @@
!
deleteSubKeyNamed:subKeyString flags:flags
- "delete a key below mySelf.
- Return true on success.
- flags may be one of:
+ "Delete a key below myself. return true on success.
+
+ `flags` may be one of:
#KEY_WOW64_64KEY to force access to the 64Bit Windows key,
#KEY_WOW64_32KEY to force access to the 32Bit Windows key,
or nil, to access the key (32/64) for the current application.
-
- CAVEAT: due to a missing library entry in the BCC system,
- the flags are currently ignored"
+ "
|subKeyStringZ errorNumber|
subKeyStringZ := subKeyString asUnicode16StringZ.
%{
-#ifndef KEY_WOW64_64KEY
-// this is missing in BCC header files
-# define KEY_WOW64_64KEY 0x0100
-# define KEY_WOW64_32KEY 0x0200
-#endif
-
+ /*
+ * Following is a little tricky. To be able to access 32bit / 64bit keys
+ * we need to use RegDeleteKeyExW() which not however available on (old)\
+ * 32bit Windows XP. Yet we'd like Smalltalk/X to run on those.
+ *
+ * To do so, call RegDeleteKeyExW() indirectly via a function pointer
+ * obtained by GetProcAddress(). If GetProcAddress() fails - meaning
+ * we're running on such old Windows - we call old RegDeleteKeyW().
+ */
+ static int initialized = 0;
+ static LONG (WINAPI *RegDeleteKeyExWPtr)(HKEY hKey, LPCTSTR lpSubKey, REGSAM samDesired, DWORD Reserved) = NULL;
+ if (!initialized) {
+ initialized = 1;
+ HMODULE advapi32 = LoadLibrary("advapi32.dll");
+ if (!advapi32) {
+ /*
+ * Hmm, failed to load Advapi32.dll, can this happen?
+ */
+ errorNumber = __MKSMALLINT(GetLastError());
+ goto out;
+ }
+ RegDeleteKeyExWPtr = GetProcAddress(advapi32, "RegDeleteKeyExW");
+ }
+
HKEY myKey, subKey = 0;
int _retVal;
int _flags = 0;
@@ -15829,14 +15905,27 @@
if (__isExternalAddressLike(__INST(handle))
&& __isUnicode16String(subKeyStringZ)) {
myKey = (HKEY)__externalAddressVal(__INST(handle));
-#ifdef __BORLANDC__
- _retVal = RegDeleteKeyW(myKey, __unicode16StringVal(subKeyStringZ));
-#else
- _retVal = RegDeleteKeyExW(myKey,
- __unicode16StringVal(subKeyStringZ),
- _flags,
- 0); // reserved
-#endif
+ if (RegDeleteKeyExWPtr) {
+ _retVal = RegDeleteKeyExWPtr(myKey,
+ __unicode16StringVal(subKeyStringZ),
+ _flags,
+ 0); // reserved
+ } else {
+ /*
+ * Some old Windows without RegDeleteKeyExW() such as
+ * 32bit Windows XP.
+ * In that case, try hard and call RegDeleteKeyW() - but only
+ * if no flags are passed, i.e., `flags` parameter is nil.
+ * This is to avoid silent failures when one explicitly asks
+ * for 32bit or 64bit view on Windows that does not support
+ * RegDeleteKeyExW().
+ */
+ if (flags != nil) {
+ errorNumber = __MKSMALLINT(-1); // really stupid, should do better
+ goto out;
+ }
+ _retVal = RegDeleteKeyW(myKey, __unicode16StringVal(subKeyStringZ));
+ }
if (_retVal == ERROR_SUCCESS) {
RETURN (true);
}
@@ -15849,7 +15938,11 @@
%}.
errorNumber notNil ifTrue:[
- (OperatingSystem errorHolderForNumber:errorNumber) reportError.
+ errorNumber == -1 ifTrue:[
+ self primitiveFailed: '32/64bit registry view requested but no RegDeleteKeyExW(). Windows too old?'
+ ] ifFalse:[
+ (OperatingSystem errorHolderForNumber:errorNumber) reportError.
+ ]
].
^ false
--- a/Win32Process.st Fri Dec 09 22:31:28 2016 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,234 +0,0 @@
-"
- COPYRIGHT (c) 1998 by eXept Software AG
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-"{ Package: 'stx:libbasic' }"
-
-"{ NameSpace: Smalltalk }"
-
-Object subclass:#Win32Process
- instanceVariableNames:'command environment directory inStream outStream errorStream pid
- exitStatus finishSema'
- classVariableNames:''
- poolDictionaries:''
- category:'OS-Windows'
-!
-
-!Win32Process class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1998 by eXept Software AG
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-! !
-
-!Win32Process methodsFor:'accessing'!
-
-command
- "return the value of the instance variable 'command' (automatically generated)"
-
- ^ command
-
- "Created: / 10.11.1998 / 21:27:07 / cg"
-!
-
-command:something
- "set the value of the instance variable 'command' (automatically generated)"
-
- command := something.
-
- "Created: / 10.11.1998 / 21:27:07 / cg"
-!
-
-directory
- "return the value of the instance variable 'directory' (automatically generated)"
-
- ^ directory
-
- "Created: / 10.11.1998 / 21:21:52 / cg"
-!
-
-directory:something
- "set the value of the instance variable 'directory' (automatically generated)"
-
- directory := something.
-
- "Created: / 10.11.1998 / 21:21:52 / cg"
-!
-
-environment
- "return the value of the instance variable 'environment' (automatically generated)"
-
- ^ environment
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-environment:something
- "set the value of the instance variable 'environment' (automatically generated)"
-
- environment := something.
-
- "Created: / 10.11.1998 / 21:27:07 / cg"
-!
-
-errorStream
- "return the value of the instance variable 'errorStream' (automatically generated)"
-
- ^ errorStream
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-errorStream:something
- "set the value of the instance variable 'errorStream' (automatically generated)"
-
- errorStream := something.
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-exitStatus
- "return the value of the instance variable 'exitStatus' (automatically generated)"
-
- ^ exitStatus
-
- "Created: / 10.11.1998 / 21:24:55 / cg"
-!
-
-exitStatus:something
- "set the value of the instance variable 'exitStatus' (automatically generated)"
-
- exitStatus := something.
-
- "Created: / 10.11.1998 / 21:24:55 / cg"
-!
-
-finishSema
- "return the value of the instance variable 'finishSema' (automatically generated)"
-
- ^ finishSema
-
- "Created: / 10.11.1998 / 21:21:53 / cg"
-!
-
-finishSema:something
- "set the value of the instance variable 'finishSema' (automatically generated)"
-
- finishSema := something.
-
- "Created: / 10.11.1998 / 21:21:53 / cg"
-!
-
-inStream
- "return the value of the instance variable 'inStream' (automatically generated)"
-
- ^ inStream
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-inStream:something
- "set the value of the instance variable 'inStream' (automatically generated)"
-
- inStream := something.
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-outStream
- "return the value of the instance variable 'outStream' (automatically generated)"
-
- ^ outStream
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-outStream:something
- "set the value of the instance variable 'outStream' (automatically generated)"
-
- outStream := something.
-
- "Created: / 10.11.1998 / 21:26:34 / cg"
-!
-
-pid
- "return the value of the instance variable 'pid' (automatically generated)"
-
- ^ pid
-
- "Created: / 10.11.1998 / 21:21:53 / cg"
-!
-
-pid:something
- "set the value of the instance variable 'pid' (automatically generated)"
-
- pid := something.
-
- "Created: / 10.11.1998 / 21:21:53 / cg"
-! !
-
-!Win32Process methodsFor:'starting'!
-
-startProcess
- finishSema := Semaphore new.
-
- pid := Processor
- monitor:[
- OperatingSystem
- startProcess:command
- inputFrom:inStream
- outputTo:outStream
- errorTo:errorStream
- auxFrom:nil
- environment:nil
- inDirectory:directory
- showWindow:false.
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
- "/ paranoia?
- OperatingSystem terminateProcessGroup:pid.
- OperatingSystem terminateProcess:pid.
- OperatingSystem closePid:pid.
- finishSema signal
- ].
- ].
-
- pid isNil ifTrue:[
- exitStatus := OperatingSystem osProcessStatusClass processCreationFailure.
- ^ false
- ].
-
- ^ true.
-
- "Created: / 10.11.1998 / 21:23:50 / cg"
- "Modified: / 10.11.1998 / 21:33:16 / cg"
-! !
-
-!Win32Process class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-!
-
-version_CVS
- ^ '$Header$'
-! !
-
--- a/WriteStream.st Fri Dec 09 22:31:28 2016 +0000
+++ b/WriteStream.st Mon Feb 13 21:29:46 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -256,6 +254,29 @@
!WriteStream methodsFor:'queries'!
+endsWith:aCollection
+ "Answer true, if the contents of the stream ends with aCollection.
+ Speedup for upToAll:, throughAll etc."
+
+ |sz start "{ Class: SmallInteger }"|
+
+ collection isNil ifTrue:[
+ "only supported for internal streams"
+ self shouldNotImplement.
+ ].
+
+ sz := aCollection size.
+ start := position + 1 - sz.
+ ^ start > 0 and:[(collection copyFrom:position+1-sz to:position) endsWith:aCollection].
+
+ "
+ (WriteStream with:'abcdef') endsWith:'def'
+ (WriteStream with:'def') endsWith:'def'
+ (WriteStream with:'abc') endsWith:'def'
+ (WriteStream with:'ef') endsWith:'def'
+false "
+!
+
size
"return the current size"
--- a/abbrev.stc Fri Dec 09 22:31:28 2016 +0000
+++ b/abbrev.stc Mon Feb 13 21:29:46 2017 +0000
@@ -33,7 +33,6 @@
Message Message stx:libbasic 'Kernel-Methods' 0
MiniDebugger MiniDebugger stx:libbasic 'System-Debugging-Support' 0
MiniInspector MiniInspector stx:libbasic 'System-Debugging-Support' 0
-MiniLogger MiniLogger stx:libbasic 'System-Debugging-Support' 0
NameSpace NameSpace stx:libbasic 'Kernel-Classes' 0
OSErrorHolder OSErrorHolder stx:libbasic 'OS-Support' 0
OSProcess OSProcess stx:libbasic 'System-Support' 0
@@ -54,9 +53,9 @@
Stream Stream stx:libbasic 'Streams' 0
SystemChangeNotifier SystemChangeNotifier stx:libbasic 'Kernel-Classes-Support' 0
UndefinedObject UndefinedObject stx:libbasic 'Kernel-Objects' 0
-VoidObject VoidObject stx:libbasic 'Kernel-Objects' 0
UserMessage UserMessage stx:libbasic 'Interface-Internationalization' 0
Visitor Visitor stx:libbasic 'System-Visiting' 0
+VoidObject VoidObject stx:libbasic 'Kernel-Objects' 0
AbstractTime AbstractTime stx:libbasic 'Magnitude-Time' 0
ApplicationDefinition ApplicationDefinition stx:libbasic 'System-Support-Projects' 3
ArithmeticValue ArithmeticValue stx:libbasic 'Magnitude-Numbers' 0
@@ -72,6 +71,7 @@
CompiledCode CompiledCode stx:libbasic 'Kernel-Methods' 0
ControlInterrupt ControlInterrupt stx:libbasic 'Kernel-Exceptions-Control' 1
Date Date stx:libbasic 'Magnitude-Time' 0
+EventSemaphore EventSemaphore stx:libbasic 'Kernel-Processes' 0
Exception Exception stx:libbasic 'Kernel-Exceptions' 1
ExternalFunction ExternalFunction stx:libbasic 'System-Support' 0
False False stx:libbasic 'Kernel-Objects' 0
@@ -83,6 +83,7 @@
LibraryDefinition LibraryDefinition stx:libbasic 'System-Support-Projects' 3
LookupKey LookupKey stx:libbasic 'Collections-Support' 0
MessageSend MessageSend stx:libbasic 'Kernel-Methods' 0
+MiniLogger MiniLogger stx:libbasic 'System-Debugging-Support' 0
NamespaceAwareLookup NamespaceAwareLookup stx:libbasic 'Kernel-Extensions' 0
NoHandlerError NoHandlerError stx:libbasic 'Kernel-Exceptions-Errors' 1
Notification Notification stx:libbasic 'Kernel-Exceptions' 1
@@ -175,6 +176,7 @@
AbstractSourceFileWriter AbstractSourceFileWriter stx:libbasic 'Kernel-Classes-Support' 0
ActivityNotification ActivityNotification stx:libbasic 'Kernel-Exceptions-Notifications' 1
Array Array stx:libbasic 'Collections-Arrayed' 0
+BitArray BitArray stx:libbasic 'Collections-Arrayed' 0
BreakPointInterrupt BreakPointInterrupt stx:libbasic 'Kernel-Exceptions-Control' 1
CharacterEncoderImplementations::ISO10646_to_UTF16LE CharacterEncoderImplementations__ISO10646_to_UTF16LE stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::ISO10646_to_UTF8_MAC CharacterEncoderImplementations__ISO10646_to_UTF8_MAC stx:libbasic 'Collections-Text-Encodings' 1
@@ -232,6 +234,7 @@
AbstractNumberVector AbstractNumberVector stx:libbasic 'Collections-Arrayed' 0
AllocationFailure AllocationFailure stx:libbasic 'System-Support' 1
AutoloadMetaclass AutoloadMetaclass stx:libbasic 'Kernel-Classes' 0
+BooleanArray BooleanArray stx:libbasic 'Collections-Arrayed' 0
ByteArray ByteArray stx:libbasic 'Collections-Arrayed' 0
CharacterArray CharacterArray stx:libbasic 'Collections-Text' 0
CharacterWriteStream CharacterWriteStream stx:libbasic 'Streams' 0
@@ -316,6 +319,7 @@
SubclassResponsibilityError SubclassResponsibilityError stx:libbasic 'Kernel-Exceptions-Errors' 1
TimeConversionError TimeConversionError stx:libbasic 'Magnitude-Time' 1
TwoByteString TwoByteString stx:libbasic 'Collections-Text' 0
+UnboxedIntegerArray UnboxedIntegerArray stx:libbasic 'Collections-Arrayed' 0
UnimplementedFunctionalityError UnimplementedFunctionalityError stx:libbasic 'Kernel-Exceptions-Errors' 1
UnprotectedExternalBytes UnprotectedExternalBytes stx:libbasic 'System-Support' 0
WeakDependencyDictionary WeakDependencyDictionary stx:libbasic 'Collections-Weak' 0
@@ -333,11 +337,13 @@
HandleRegistry HandleRegistry stx:libbasic 'System-Support' 0
ImmutableString ImmutableString stx:libbasic 'System-Compiler-Support' 0
IndexNotFoundError IndexNotFoundError stx:libbasic 'Kernel-Exceptions-Errors' 1
+IntegerArray IntegerArray stx:libbasic 'Collections-Arrayed' 0
InvalidByteCodeError InvalidByteCodeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
InvalidInstructionError InvalidInstructionError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
InvalidReadError InvalidReadError stx:libbasic 'Kernel-Exceptions-Errors' 1
InvalidWriteError InvalidWriteError stx:libbasic 'Kernel-Exceptions-Errors' 1
KeyNotFoundError KeyNotFoundError stx:libbasic 'Kernel-Exceptions-Errors' 1
+LongIntegerArray LongIntegerArray stx:libbasic 'Collections-Arrayed' 0
MissingClassInLiteralArrayErrorSignal MissingClassInLiteralArrayErrorSignal stx:libbasic 'Kernel-Exceptions-Errors' 1
NoByteCodeError NoByteCodeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
NonPositionableExternalStream NonPositionableExternalStream stx:libbasic 'Streams-External' 0
@@ -345,13 +351,19 @@
PTYOpenError PTYOpenError stx:libbasic 'Kernel-Exceptions-Errors' 1
PackageNotCompatibleError PackageNotCompatibleError stx:libbasic 'Kernel-Exceptions-Errors' 1
RangeError RangeError stx:libbasic 'Kernel-Exceptions-Errors' 1
+SignedIntegerArray SignedIntegerArray stx:libbasic 'Collections-Arrayed' 0
+SignedLongIntegerArray SignedLongIntegerArray stx:libbasic 'Collections-Arrayed' 0
+SignedWordArray SignedWordArray stx:libbasic 'Collections-Arrayed' 0
Symbol Symbol stx:libbasic 'Collections-Text' 0
+UnboundedExternalStream UnboundedExternalStream stx:libbasic 'Streams-External' 0
Unicode16String Unicode16String stx:libbasic 'Collections-Text' 0
UnorderedNumbersError UnorderedNumbersError stx:libbasic 'Kernel-Exceptions-Errors' 1
+WordArray WordArray stx:libbasic 'Collections-Arrayed' 0
WrongNumberOfArgumentsError WrongNumberOfArgumentsError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
WrongProceedabilityError WrongProceedabilityError stx:libbasic 'Kernel-Exceptions-Errors' 1
CharacterRangeError CharacterRangeError stx:libbasic 'Collections-Text-Encodings' 1
DirectoryStream DirectoryStream stx:libbasic 'Streams-External' 0
+ImaginaryResultError ImaginaryResultError stx:libbasic 'Kernel-Exceptions-Errors' 1
InvalidEncodingError InvalidEncodingError stx:libbasic 'Collections-Text-Encodings' 1
NonIntegerIndexError NonIntegerIndexError stx:libbasic 'Kernel-Exceptions-Errors' 1
OverflowError OverflowError stx:libbasic 'Kernel-Exceptions-Errors' 1
@@ -360,7 +372,7 @@
SubscriptOutOfBoundsError SubscriptOutOfBoundsError stx:libbasic 'Kernel-Exceptions-Errors' 1
UnderflowError UnderflowError stx:libbasic 'Kernel-Exceptions-Errors' 1
ZeroDivide ZeroDivide stx:libbasic 'Kernel-Exceptions-Errors' 1
-Win32Process Win32Process stx:libbasic 'unknownCategory' 0
+BadRomanNumberFormatError BadRomanNumberFormatError stx:libbasic 'Magnitude-Numbers' 1
PCFilename PCFilename stx:libbasic 'unknownCategory' 0
Win32Constants Win32Constants stx:libbasic 'unknownCategory' 0
Win32Handle Win32Handle stx:libbasic 'unknownCategory' 0
@@ -373,7 +385,6 @@
SimpleExternalLibraryFunction SimpleExternalLibraryFunction stx:libbasic 'System-Support' 0
QualifiedName QualifiedName stx:libbasic 'Kernel-Support' 0
AbstractDesktop AbstractDesktop stx:libbasic 'System-Desktop' 0
-BadRomanNumberFormatError BadRomanNumberFormatError stx:libbasic 'Magnitude-Numbers' 1
CharacterEncoderImplementations::BIG5 CharacterEncoderImplementations__BIG5 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::CNS11643 CharacterEncoderImplementations__CNS11643 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::GB2313_1980 CharacterEncoderImplementations__GB2313_1980 stx:libbasic 'Collections-Text-Encodings' 0
@@ -407,7 +418,6 @@
CharacterEncoderImplementations::NEXT CharacterEncoderImplementations__NEXT stx:libbasic 'Collections-Text-Encodings' 0
CmdLineParserTest CmdLineParserTest stx:libbasic 'System-Support-Command line' 1
GNOMEDesktop GNOMEDesktop stx:libbasic 'System-Desktop' 0
-ImaginaryResultError ImaginaryResultError stx:libbasic 'Kernel-Exceptions-Errors' 1
LargeFloat LargeFloat stx:libbasic 'Magnitude-Numbers' 0
MacFilename MacFilename stx:libbasic 'OS-Mac' 0
MappedExternalBytes MappedExternalBytes stx:libbasic 'System-Support' 0
@@ -415,16 +425,6 @@
SmalltalkDesktop SmalltalkDesktop stx:libbasic 'System-Desktop' 0
SystemNotification SystemNotification stx:libbasic 'Kernel-Exceptions-Notifications' 1
TextCollectorStream TextCollectorStream stx:libbasic 'Streams-Misc' 0
-UnboundedExternalStream UnboundedExternalStream stx:libbasic 'Streams-External' 0
UnixDesktop UnixDesktop stx:libbasic 'System-Desktop' 0
WindowsDesktop WindowsDesktop stx:libbasic 'System-Desktop' 0
XDGDesktop XDGDesktop stx:libbasic 'System-Desktop' 0
-UnboxedIntegerArray UnboxedIntegerArray stx:libbasic 'Collections-Arrayed' 0
-WordArray WordArray stx:libbasic 'Collections-Arrayed' 0
-IntegerArray IntegerArray stx:libbasic 'Collections-Arrayed' 0
-LongIntegerArray LongIntegerArray stx:libbasic 'Collections-Arrayed' 0
-SignedIntegerArray SignedIntegerArray stx:libbasic 'Collections-Arrayed' 0
-SignedLongIntegerArray SignedLongIntegerArray stx:libbasic 'Collections-Arrayed' 0
-SignedWordArray SignedWordArray stx:libbasic 'Collections-Arrayed' 0
-BitArray BitArray stx:libbasic 'Collections-Arrayed' 0
-BooleanArray BooleanArray stx:libbasic 'Collections-Arrayed' 0
--- a/bc.mak Fri Dec 09 22:31:28 2016 +0000
+++ b/bc.mak Mon Feb 13 21:29:46 2017 +0000
@@ -102,7 +102,6 @@
$(OUTDIR)Message.$(O) Message.$(C) Message.$(H): Message.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)MiniDebugger.$(O) MiniDebugger.$(C) MiniDebugger.$(H): MiniDebugger.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)MiniInspector.$(O) MiniInspector.$(C) MiniInspector.$(H): MiniInspector.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)MiniLogger.$(O) MiniLogger.$(C) MiniLogger.$(H): MiniLogger.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)NameSpace.$(O) NameSpace.$(C) NameSpace.$(H): NameSpace.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)OSErrorHolder.$(O) OSErrorHolder.$(C) OSErrorHolder.$(H): OSErrorHolder.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)OSProcess.$(O) OSProcess.$(C) OSProcess.$(H): OSProcess.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -141,6 +140,7 @@
$(OUTDIR)CompiledCode.$(O) CompiledCode.$(C) CompiledCode.$(H): CompiledCode.st $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ControlInterrupt.$(O) ControlInterrupt.$(C) ControlInterrupt.$(H): ControlInterrupt.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Date.$(O) Date.$(C) Date.$(H): Date.st $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)EventSemaphore.$(O) EventSemaphore.$(C) EventSemaphore.$(H): EventSemaphore.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Semaphore.$(H) $(STCHDR)
$(OUTDIR)Exception.$(O) Exception.$(C) Exception.$(H): Exception.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ExternalFunction.$(O) ExternalFunction.$(C) ExternalFunction.$(H): ExternalFunction.st $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)False.$(O) False.$(C) False.$(H): False.st $(INCLUDE_TOP)\stx\libbasic\Boolean.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -152,6 +152,7 @@
$(OUTDIR)LibraryDefinition.$(O) LibraryDefinition.$(C) LibraryDefinition.$(H): LibraryDefinition.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
$(OUTDIR)LookupKey.$(O) LookupKey.$(C) LookupKey.$(H): LookupKey.st $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)MessageSend.$(O) MessageSend.$(C) MessageSend.$(H): MessageSend.st $(INCLUDE_TOP)\stx\libbasic\Message.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)MiniLogger.$(O) MiniLogger.$(C) MiniLogger.$(H): MiniLogger.st $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)NamespaceAwareLookup.$(O) NamespaceAwareLookup.$(C) NamespaceAwareLookup.$(H): NamespaceAwareLookup.st $(INCLUDE_TOP)\stx\libbasic\Lookup.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)NoHandlerError.$(O) NoHandlerError.$(C) NoHandlerError.$(H): NoHandlerError.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Notification.$(O) Notification.$(C) Notification.$(H): Notification.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -437,7 +438,6 @@
$(OUTDIR)UnderflowError.$(O) UnderflowError.$(C) UnderflowError.$(H): UnderflowError.st $(INCLUDE_TOP)\stx\libbasic\ArithmeticError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutionError.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\RangeError.$(H) $(STCHDR)
$(OUTDIR)ZeroDivide.$(O) ZeroDivide.$(C) ZeroDivide.$(H): ZeroDivide.st $(INCLUDE_TOP)\stx\libbasic\ArithmeticError.$(H) $(INCLUDE_TOP)\stx\libbasic\DomainError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutionError.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)BadRomanNumberFormatError.$(O) BadRomanNumberFormatError.$(C) BadRomanNumberFormatError.$(H): BadRomanNumberFormatError.st $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\NumberConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\NumberFormatError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\RomanNumberFormatError.$(H) $(STCHDR)
-$(OUTDIR)Win32Process.$(O) Win32Process.$(C) Win32Process.$(H): Win32Process.st $(STCHDR)
$(OUTDIR)PCFilename.$(O) PCFilename.$(C) PCFilename.$(H): PCFilename.st $(STCHDR)
$(OUTDIR)Win32Constants.$(O) Win32Constants.$(C) Win32Constants.$(H): Win32Constants.st $(STCHDR)
$(OUTDIR)Win32Handle.$(O) Win32Handle.$(C) Win32Handle.$(H): Win32Handle.st $(STCHDR)
--- a/libInit.cc Fri Dec 09 22:31:28 2016 +0000
+++ b/libInit.cc Mon Feb 13 21:29:46 2017 +0000
@@ -48,7 +48,6 @@
extern void _Message_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _MiniDebugger_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _MiniInspector_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
-extern void _MiniLogger_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NameSpace_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _OSErrorHolder_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _OSProcess_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -87,6 +86,7 @@
extern void _CompiledCode_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ControlInterrupt_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Date_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _EventSemaphore_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Exception_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ExternalFunction_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _False_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -98,6 +98,7 @@
extern void _LibraryDefinition_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _LookupKey_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _MessageSend_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _MiniLogger_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NamespaceAwareLookup_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NoHandlerError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Notification_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -390,7 +391,6 @@
extern void _OSXOperatingSystem_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
#endif /* UNIX */
#ifdef WIN32
-extern void _Win32Process_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _PCFilename_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Win32Constants_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Win32Handle_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -447,7 +447,6 @@
_Message_Init(pass,__pRT__,snd);
_MiniDebugger_Init(pass,__pRT__,snd);
_MiniInspector_Init(pass,__pRT__,snd);
- _MiniLogger_Init(pass,__pRT__,snd);
_NameSpace_Init(pass,__pRT__,snd);
_OSErrorHolder_Init(pass,__pRT__,snd);
_OSProcess_Init(pass,__pRT__,snd);
@@ -486,6 +485,7 @@
_CompiledCode_Init(pass,__pRT__,snd);
_ControlInterrupt_Init(pass,__pRT__,snd);
_Date_Init(pass,__pRT__,snd);
+ _EventSemaphore_Init(pass,__pRT__,snd);
_Exception_Init(pass,__pRT__,snd);
_ExternalFunction_Init(pass,__pRT__,snd);
_False_Init(pass,__pRT__,snd);
@@ -497,6 +497,7 @@
_LibraryDefinition_Init(pass,__pRT__,snd);
_LookupKey_Init(pass,__pRT__,snd);
_MessageSend_Init(pass,__pRT__,snd);
+ _MiniLogger_Init(pass,__pRT__,snd);
_NamespaceAwareLookup_Init(pass,__pRT__,snd);
_NoHandlerError_Init(pass,__pRT__,snd);
_Notification_Init(pass,__pRT__,snd);
@@ -789,7 +790,6 @@
_OSXOperatingSystem_Init(pass,__pRT__,snd);
#endif /* UNIX */
#ifdef WIN32
- _Win32Process_Init(pass,__pRT__,snd);
_PCFilename_Init(pass,__pRT__,snd);
_Win32Constants_Init(pass,__pRT__,snd);
_Win32Handle_Init(pass,__pRT__,snd);
--- a/stx_libbasic.st Fri Dec 09 22:31:28 2016 +0000
+++ b/stx_libbasic.st Mon Feb 13 21:29:46 2017 +0000
@@ -210,7 +210,6 @@
Message
MiniDebugger
MiniInspector
- MiniLogger
NameSpace
OSErrorHolder
OSProcess
@@ -231,9 +230,9 @@
Stream
SystemChangeNotifier
UndefinedObject
- VoidObject
UserMessage
Visitor
+ VoidObject
AbstractTime
ApplicationDefinition
ArithmeticValue
@@ -249,6 +248,7 @@
CompiledCode
ControlInterrupt
Date
+ EventSemaphore
Exception
ExternalFunction
False
@@ -260,6 +260,7 @@
LibraryDefinition
LookupKey
MessageSend
+ MiniLogger
NamespaceAwareLookup
NoHandlerError
Notification
@@ -352,6 +353,7 @@
AbstractSourceFileWriter
ActivityNotification
Array
+ BitArray
BreakPointInterrupt
#'CharacterEncoderImplementations::ISO10646_to_UTF16LE'
#'CharacterEncoderImplementations::ISO10646_to_UTF8_MAC'
@@ -409,6 +411,7 @@
AbstractNumberVector
AllocationFailure
AutoloadMetaclass
+ BooleanArray
ByteArray
CharacterArray
CharacterWriteStream
@@ -493,6 +496,7 @@
SubclassResponsibilityError
TimeConversionError
TwoByteString
+ UnboxedIntegerArray
UnimplementedFunctionalityError
UnprotectedExternalBytes
WeakDependencyDictionary
@@ -510,11 +514,13 @@
HandleRegistry
ImmutableString
IndexNotFoundError
+ IntegerArray
InvalidByteCodeError
InvalidInstructionError
InvalidReadError
InvalidWriteError
KeyNotFoundError
+ LongIntegerArray
MissingClassInLiteralArrayErrorSignal
NoByteCodeError
NonPositionableExternalStream
@@ -522,13 +528,19 @@
PTYOpenError
PackageNotCompatibleError
RangeError
+ SignedIntegerArray
+ SignedLongIntegerArray
+ SignedWordArray
Symbol
+ UnboundedExternalStream
Unicode16String
UnorderedNumbersError
+ WordArray
WrongNumberOfArgumentsError
WrongProceedabilityError
CharacterRangeError
DirectoryStream
+ ImaginaryResultError
InvalidEncodingError
NonIntegerIndexError
OverflowError
@@ -537,7 +549,7 @@
SubscriptOutOfBoundsError
UnderflowError
ZeroDivide
- (Win32Process win32)
+ BadRomanNumberFormatError
(PCFilename win32)
(Win32Constants win32)
(Win32Handle win32)
@@ -550,7 +562,6 @@
(SimpleExternalLibraryFunction autoload)
(QualifiedName autoload)
(AbstractDesktop autoload)
- BadRomanNumberFormatError
(#'CharacterEncoderImplementations::BIG5' autoload)
(#'CharacterEncoderImplementations::CNS11643' autoload)
(#'CharacterEncoderImplementations::GB2313_1980' autoload)
@@ -584,7 +595,6 @@
(#'CharacterEncoderImplementations::NEXT' autoload)
(CmdLineParserTest autoload)
(GNOMEDesktop autoload)
- ImaginaryResultError
(LargeFloat autoload)
(MacFilename macos autoload)
(MappedExternalBytes autoload)
@@ -592,19 +602,9 @@
(SmalltalkDesktop autoload)
(SystemNotification autoload)
(TextCollectorStream autoload)
- UnboundedExternalStream
(UnixDesktop autoload)
(WindowsDesktop autoload)
(XDGDesktop autoload)
- UnboxedIntegerArray
- WordArray
- IntegerArray
- LongIntegerArray
- SignedIntegerArray
- SignedLongIntegerArray
- SignedWordArray
- BitArray
- BooleanArray
)
!
--- a/stx_libbasicWINrc.rc Fri Dec 09 22:31:28 2016 +0000
+++ b/stx_libbasicWINrc.rc Mon Feb 13 21:29:46 2017 +0000
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libbasic.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 7,1,1,165
+ FILEVERSION 7,1,1,171
PRODUCTVERSION 7,1,0,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -18,14 +18,14 @@
BEGIN
BLOCK "040904E4"
BEGIN
- VALUE "CompanyName", "eXept Software AG\0"
+ VALUE "CompanyName", "Claus Gittinger / eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Basic Classes (LIB)\0"
- VALUE "FileVersion", "7.1.1.165\0"
+ VALUE "FileVersion", "7.1.1.171\0"
VALUE "InternalName", "stx:libbasic\0"
- VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 2013\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988\nCopyright eXept Software AG 2013\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "7.1.0.0\0"
- VALUE "ProductDate", "Tue, 08 Nov 2016 23:35:29 GMT\0"
+ VALUE "ProductDate", "Tue, 27 Dec 2016 10:27:37 GMT\0"
END
END