--- a/AbstractNumberVector.st Wed Oct 19 09:22:53 2016 +0100
+++ b/AbstractNumberVector.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2011 by Claus Gittinger
All Rights Reserved
@@ -44,6 +42,11 @@
(float, double, integer arrays)
Mostly to share double dispatch code.
+
+ [see also:]
+ IntegerArray FloatArray DoubleArray
+ ByteArray
+ (and many others)
"
! !
--- a/AbstractOperatingSystem.st Wed Oct 19 09:22:53 2016 +0100
+++ b/AbstractOperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
@@ -641,6 +641,7 @@
self openApplicationForDocument: '..\..\doc\books\ArtOfSmalltalk\artMissing186187Fix1.pdf' asFilename operation:#open
self openApplicationForDocument: 'C:\WINDOWS\Help\clipbrd.chm' asFilename operation:#open
+ self openApplicationForDocument: 'http://www.exept.de' operation:#open mimeType:'text/html'
"
"Created: / 29-10-2010 / 12:16:38 / cg"
@@ -772,6 +773,7 @@
!
errorHolderForNumber:anInteger
+ "return an osErrorHolder for the given error number (as returned by a system call)."
^ self subclassResponsibility
!
@@ -962,7 +964,7 @@
startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment
- inDirectory:dir showWindow:showWindowBooleanOrNil
+ 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.
@@ -977,6 +979,30 @@
"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).
+ 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'!
@@ -1304,6 +1330,29 @@
"Modified: / 10.11.1998 / 20:54:37 / cg"
!
+executeCommand:aCommandString inDirectory:aDirectory showWindow:showWindow
+ "execute the unix command specified by the argument, aCommandString.
+ 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.
+ 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]
+
+ "Created: / 18-10-2016 / 15:55:29 / cg"
+!
+
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream
"execute the unix command specified by the argument, aCommandString.
If aCommandString is a String, the commandString is passed to a shell for execution
@@ -1384,83 +1433,7 @@
executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
- inDirectory:dirOrNil lineWise:lineWise onError:aBlock
-
- "execute the unix command specified by the argument, aCommandStringOrArray.
- 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.
- Return true if successful, or the value of aBlock if not.
- If not successfull, aBlock is called with an OsProcessStatus
- (containing the exit status) as argument.
- The given in, out and err streams may be arbitrary (Smalltalk-) streams;
- if any is not an external stream (which is required by the command),
- extra pipes and shuffler processes are created, which stuff the data into
- those internal stream(s).
- Nil stream args will execute the command connected to ST/X's standard input, output or
- error resp. - i.e. usually, i/o will be from/to the terminal.
-
- Set lineWise to true, if both error and output is sent to the same stream
- and you don't want lines to be mangled. Set lineWise = false to
- 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
- "
-
- "Modified: / 11-02-2007 / 20:54:39 / cg"
-!
-
-executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
- errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
- inDirectory:dirOrNil lineWise:lineWise showWindow:showWindowBooleanOrNil onError:aBlock
+ inDirectory:dirOrNil lineWise:lineWise newPgrp:newPgrp showWindow:showWindowBooleanOrNil onError:aBlock
"execute the unix command specified by the argument, aCommandStringOrArray.
If aCommandString is a String, the commandString is passed to a shell for execution
@@ -1666,6 +1639,7 @@
auxFrom:externalAuxStream
environment:environmentDictionary
inDirectory:dirOrNil
+ newPgrp:newPgrp
showWindow:showWindowBooleanOrNil
]
action:[:status |
@@ -1747,6 +1721,171 @@
"Modified: / 11-02-2007 / 20:54:39 / cg"
!
+executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+ errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+ inDirectory:dirOrNil lineWise:lineWise onError:aBlock
+
+ "execute the unix command specified by the argument, aCommandStringOrArray.
+ 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.
+ Return true if successful, or the value of aBlock if not.
+ If not successfull, aBlock is called with an OsProcessStatus
+ (containing the exit status) as argument.
+ The given in, out and err streams may be arbitrary (Smalltalk-) streams;
+ if any is not an external stream (which is required by the command),
+ extra pipes and shuffler processes are created, which stuff the data into
+ those internal stream(s).
+ Nil stream args will execute the command connected to ST/X's standard input, output or
+ error resp. - i.e. usually, i/o will be from/to the terminal.
+
+ Set lineWise to true, if both error and output is sent to the same stream
+ and you don't want lines to be mangled. Set lineWise = false to
+ 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
+ "
+
+ "Modified: / 11-02-2007 / 20:54:39 / cg"
+!
+
+executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+ errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+ inDirectory:dirOrNil lineWise:lineWise showWindow:showWindowBooleanOrNil onError:aBlock
+
+ "execute the unix command specified by the argument, aCommandStringOrArray.
+ 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.
+ Return true if successful, or the value of aBlock if not.
+ If not successfull, aBlock is called with an OsProcessStatus
+ (containing the exit status) as argument.
+ The given in, out and err streams may be arbitrary (Smalltalk-) streams;
+ if any is not an external stream (which is required by the command),
+ extra pipes and shuffler processes are created, which stuff the data into
+ those internal stream(s).
+ Nil stream args will execute the command connected to ST/X's standard input, output or
+ error resp. - i.e. usually, i/o will be from/to the terminal.
+
+ Set lineWise to true, if both error and output is sent to the same stream
+ and you don't want lines to be mangled. Set lineWise = false to
+ 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."
+
+ ^ 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
+ "
+
+ "Modified: / 08-11-2016 / 21:33:00 / cg"
+!
+
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream auxFrom:anAuxStream inDirectory:dirOrNil lineWise:lineWise onError:aBlock
^ self
executeCommand:aCommandString
@@ -2067,6 +2206,75 @@
"Created: / 10.11.1998 / 20:51:11 / cg"
!
+executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream inDirectory:dir showWindow:showWindow onError:aBlock
+ "execute the unix command specified by the argument, aCommandString.
+ 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.
+ Return true if successful, the value from aBlock if not.
+ If not successfull, aBlock is called with an OsProcessStatus
+ (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.
+ "
+
+ "Modified: / 10.11.1998 / 20:51:39 / cg"
+!
+
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream onError:aBlock
"execute the unix command specified by the argument, aCommandString.
If aCommandString is a String, the commandString is passed to a shell for execution
@@ -2367,6 +2575,7 @@
environment:nil
inDirectory:aDirectory
lineWise:false
+ newPgrp:true
showWindow:showWindowBooleanOrNil
onError:[:status| false]
@@ -2832,7 +3041,7 @@
createDirectory:aPathName
"create a new directory with name 'aPathName', which may be an absolute
path, or relative to the current directory.
- Return true if successful (or the directory existed already), false if failed.
+ Return nil if successful (or the directory existed already), an OsErrorHolder otherwise.
This is a low-level entry - use Filename protocol for compatibility."
self subclassResponsibility
@@ -2850,12 +3059,12 @@
createHardLinkFrom:oldPath to:newPath
"link the file 'oldPath' to 'newPath'. The link will be a hard link.
- Return true if successful, false if not."
+ Return nil if successful, an OsErrorHolder if not."
"/
"/ assume that this OperatingSystem does not support links
"/
- ^ self unsupportedOperationSignal raise
+ ^ OSErrorHolder unsupportedOperation
"Created: / 13.8.1998 / 21:37:12 / cg"
"Modified: / 13.8.1998 / 21:38:39 / cg"
@@ -2864,12 +3073,12 @@
createSymbolicLinkFrom:oldPath to:newPath
"make a link from the file 'oldPath' to the file 'newPath'.
The link will be a soft (symbolic) link.
- Return true if successful, false if not."
+ Return nil if successful, an OsErrorHolder if not."
"/
"/ assume that this OperatingSystem does not support symbolic links
"/
- ^ self unsupportedOperationSignal raise
+ ^ OSErrorHolder unsupportedOperation
"Created: / 13.8.1998 / 21:38:24 / cg"
"Modified: / 13.8.1998 / 21:38:43 / cg"
@@ -2943,20 +3152,28 @@
recursiveCreateDirectory:dirName
"create a directory - with all parent dirs if needed.
- Return true if successful, false otherwise. If false
- is returned, a partial created tree may be left,
- which is not cleaned-up here."
+ Return nil if successful, an OsErrorHolder otherwise.
+ On error, a partial created tree may be left, which is not cleaned-up here."
+
+ |osErrorHolder nextDirName|
self createDirectory:dirName.
(self isDirectory:dirName) ifFalse:[
- (self recursiveCreateDirectory:(dirName asFilename directoryName)) ifFalse:[^ false].
- ^ self createDirectory:dirName
+ nextDirName := dirName asFilename directoryName.
+ dirName ~= nextDirName ifTrue:[
+ osErrorHolder := self recursiveCreateDirectory:nextDirName.
+ osErrorHolder notNil ifTrue:[
+ ^ osErrorHolder.
+ ].
+ ].
+ ^ self createDirectory:dirName.
].
- ^ true
+ ^ nil.
"
OperatingSystem recursiveCreateDirectory:'foo/bar/baz'
OperatingSystem recursiveRemoveDirectory:'foo'
+ OperatingSystem recursiveCreateDirectory:'k:\bla\quark'
"
"Modified: 7.3.1996 / 15:26:22 / cg"
@@ -2986,14 +3203,14 @@
removeDirectory:fullPathName
"remove the directory named 'fullPathName'.
The directory must be empty and you must have appropriate access rights.
- Return true if successful, false if directory is not empty or no permission.
+ return nil if successful, an OSErrorHolder if directory is not empty or no permission.
This is a lowLevel entry - use Filename protocol for compatibility."
self subclassResponsibility
!
removeFile:fullPathName
- "remove the file named 'fullPathName'; return true if successful.
+ "remove the file named 'fullPathName'; return nil if successful, an OSErrorHolder on errror.
This is a lowLevel entry - use Filename protocol for compatibility."
self subclassResponsibility
@@ -3005,7 +3222,7 @@
correct for the OS used - therefore, this should not be called
directlt. Instead, use Filename protocol to rename; this cares for
any invalid names.
- Returns true if successful, false if not"
+ Returns nil if successful, an OsErrorHolder if not"
self subclassResponsibility
!
@@ -3022,7 +3239,7 @@
!
truncateFile:aPathName to:newSize
- "change a files size return true on success, false on failure.
+ "change a files size return nil on success, an OSErrorHolder on failure.
This may not be supported on all architectures.
This is a low-level entry - use Filename protocol."
@@ -3073,8 +3290,8 @@
changeAccessModeOf:aPathName to:modeBits
"change the access rights of aPathName to the OS dependent modeBits.
You should construct this mask using accessMaskFor, to be OS
- independent. Return true if changed,
- false if such a file does not exist or change was not allowd."
+ independent. Return nil if changed,
+ anOSErrorHolder if such a file does not exist or change was not allowd."
self subclassResponsibility
!
@@ -3296,15 +3513,15 @@
!
getObjectFileInfoFor: aStringOrFilename
- "Return and info object for given executable or shared object
+ "Return an info object for a given executable or shared object
or throw an error if given file is not a valid an executable now
shared object.
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
@@ -3740,7 +3957,7 @@
enableIOInterruptsOn:fd
"turn on IO interrupts for a filedescriptor"
- self subclassResonsibility
+ self subclassResponsibility
!
enableQuitInterrupts
@@ -3768,7 +3985,7 @@
enableTimer:milliSeconds
"setup for a timerInterrupt, to be signalled after some (real) time."
- self subclassResonsibility
+ self subclassResponsibility
!
enableUserInterrupts
@@ -4132,64 +4349,32 @@
!AbstractOperatingSystem class methodsFor:'os queries'!
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__';
- on windows, this is either '__MSC__' or '__BORLANDC__'"
-
-%{ /* NOCONTEXT */
-#ifndef CC_DEFINE
-# ifdef __win32__
-# if defined( __BORLANDC__ )
-# define CC_DEFINE "__BORLANDC__"
-# else
-# if defined( __VISUALC__ )
-# define CC_DEFINE "__VISUALC__"
-# else
-# if defined( __MINGW64__ )
-# define CC_DEFINE "__MINGW64__"
-# else
-# if defined( __MINGW32__ )
-# define CC_DEFINE "__MINGW32__"
-# else
-# define CC_DEFINE "__CC__"
-# endif
-# endif
-# endif
-# endif
-# else /* not __win32__ */
-# ifdef __CLANG__
-# define CC_DEFINE "__CLANG__"
-# else
-# ifdef __GNUC__
-# define CC_DEFINE "__GNUC__"
-# else
-# define CC_DEFINE "__CC__"
-# endif
-# endif
-# endif
-#endif
- RETURN ( __MKSTRING(CC_DEFINE));
-%}
+ on windows, this could be '__VISUALC__', '__BORLANDC__' or '__MINGW__'"
+
+ self obsoleteMethodWarning.
+ ^ STCCompilerInterface getCCDefine
+
"
OperatingSystem getCCDefine
"
!
getCPUDefine
+ <resource: #obsolete>
"return a string which was used to identify this CPU type when STX was
compiled, and which should be passed down when compiling methods.
- For example, on linux, this may be '-Di386'; on a vax, this would be '-Dvax'.
+ For example, on linux, this may be '-D__x86__'; on a vax, this would be '-D__vax__'.
This is normally not of interest to 'normal' users; however, it is passed
down to the c-compiler when methods are incrementally compiled to machine code."
-%{ /* NOCONTEXT */
-# ifndef CPU_DEFINE
-# define CPU_DEFINE "-DunknownCPU"
-# endif
-
- RETURN ( __MKSTRING(CPU_DEFINE));
-%}
+ self obsoleteMethodWarning.
+ ^ STCCompilerInterface getCPUDefine
+
"
OperatingSystem getCPUDefine
"
@@ -4296,6 +4481,14 @@
self subclassResponsibility
!
+getEnvironment
+ "get all environment variables as a key-value dictionary"
+
+ ^ self subclassResponsibility
+
+ "Created: / 15-11-2016 / 16:34:10 / cg"
+!
+
getEnvironment:aStringOrSymbol
"get an environment string"
@@ -4412,26 +4605,15 @@
!
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 '-DLINUX'."
-
-%{ /* NOCONTEXT */
-
-#ifndef OS_DEFINE
-# ifdef __win32__
-# define OS_DEFINE "-D__win32__"
-# endif
-
-# ifndef OS_DEFINE
-# define OS_DEFINE "-DunknownOS"
-# endif
-#endif
-
- RETURN ( __MKSTRING(OS_DEFINE));
-
-#undef OS_DEFINE
-%}
+ For example, on linux, this is '-D__linux__'."
+
+ self obsoleteMethodWarning.
+ ^ STCCompilerInterface getOSDefine
+
"
OperatingSystem getOSDefine
"
@@ -4593,6 +4775,8 @@
!
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'."
@@ -4702,7 +4886,7 @@
"return a string giving the type of system we're running on.
This is almost the same as getOSType, but the returned string
is slightly different for some systems (i.e. iris vs. irix).
- Do not depend on this - use getOSType. I dont really see a point
+ Do not depend on this - use getOSType. I don't really see a point
here ...
(except for slight differences between next/mach and other machs)"
@@ -5117,9 +5301,12 @@
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 have been UTF-8 encoded."
+ "/ fallback here: no encoding
^ encodedPathNameOrOutputLine
!
@@ -6515,19 +6702,17 @@
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).
- Fails 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:
- currently fails"
+ answer 0"
%{ /* NOCONTEXT */
unsigned INT low, high;
-#ifdef __x86_64__
-# if defined(__GCC__) || defined(__CLANG__) || defined(__MINGW64__)
+#if defined(__x86_64__) && (defined(__GNUC__) || defined(__CLANG__) || defined(__MINGW64__))
asm volatile("rdtsc" : "=a"(low), "=d"(high));
RETURN ( __MKUINT(low + (high << 32)) );
-# endif
#endif
#ifdef i386
@@ -6539,19 +6724,17 @@
_asm { mov low,eax };
_asm { mov high,edx };
_asm { pop edx };
-# else
-# if defined(__MINGW_H) || defined(__MINGW32__) || defined(__GNUC__)
+# elif defined(__MINGW_H) || defined(__MINGW32__) || defined(__GNUC__)
asm volatile("rdtsc" : "=a"(low), "=d"(high));
-# else
+# else
goto unsupported;
-# endif
# endif
RETURN ( __MKLARGEINT64(1, low, high) );
#endif /* i386 */
unsupported: ;
%}.
- self primitiveFailed:'no CPU cycle register on this architecture'
+ ^ 0
"
OperatingSystem getCPUCycleCount
--- a/AbstractTime.st Wed Oct 19 09:22:53 2016 +0100
+++ b/AbstractTime.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
@@ -314,7 +312,7 @@
"
Time fromSeconds:0 should return midnight
Timestamp fromSeconds:0 on UNIX: returns 1st. Jan 1970
- on others: dont know
+ on others: don't know
(Timestamp day:1 month:1 year:1970 hour:1 minutes:0 seconds:0)
getSeconds on UNIX: returns 0
on others: don't know
@@ -518,7 +516,6 @@
"
! !
-
!AbstractTime methodsFor:'abstract'!
hours
@@ -1040,7 +1037,6 @@
"/ ^ aTimestamp getSeconds - self getSeconds
! !
-
!AbstractTime methodsFor:'printing & storing'!
addBasicPrintBindingsTo:aDictionary language:languageOrNil
--- a/ApplicationDefinition.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ApplicationDefinition.st Fri Dec 09 22:31:28 2016 +0000
@@ -416,23 +416,14 @@
^ #()
!
-applicationIconFileName
- "answer the base-name of the application icon (i.e. 'app' in <app>.ico).
-
- Subclasses MUST redefine this to either return the name of the icon file or
- nil, if they do not have one.
- We NO LONGER SUPPORT THE PREVIOUS APPNAME-DEFAULT,
- because users tend to forget to add the icon file and then get a failing build. "
-
- ^ self subclassResponsibility.
-!
-
applicationInstallIconFileName
"answer the base-name of the installer icon (i.e. 'app' in <app>.ico).
Default is the same as the application icon"
- ^ self applicationIconFileName.
+ ^ self applicationIconFileNameWindows.
+
+ "Modified: / 26-10-2016 / 23:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
applicationName
@@ -752,7 +743,7 @@
at:self nsiFilename put:#'generate_packageName_dot_nsi';
at:self apspecFilename put:#'generate_autopackage_default_dot_apspec'; "/ for linux
at:'osx/Info.plist' put:#'generate_osx_info_dot_plist';
- at:'osx/PkgInfo' put:#'generate_osx_pkginfo';
+"/ at:'osx/PkgInfo' put:#'generate_osx_pkginfo';
at:'builder/baseline.rbspec' put:#'generate_builder_baseline_dot_rbspec';
at:'builder/package.deps.rake' put: #'generate_package_dot_deps_dot_rake'.
@@ -1063,14 +1054,14 @@
at: 'STARTUP_CLASS' put: (self startupClassName);
at: 'STARTUP_SELECTOR' put: (self startupSelector);
at: 'MAIN_DEFINES' put: (self mainDefines);
+ at: 'PREREQUISITES_LIBS' put: (self generatePreRequisiteLines_make_dot_proto);
at: 'REQUIRED_LIBS' put: (self generateRequiredLibs_make_dot_proto);
- at: 'PREREQUISITES_LIBS' put: (self generatePreRequisiteLines_make_dot_proto);
+ at: 'REQUIRED_LIBOBJS' put: (self generateRequiredLibobjs_make_dot_proto);
+ at: 'REQUIRED_LINK_LIBOBJS' put: (self generateRequiredLinkLibobjs_make_dot_proto);
+ at: 'REQUIRED_SUPPORT_DIRS' put: (self extraTargets asStringWith:' ');
+ at: 'DEPENDENCIES' put: (self generateDependencies_unix);
at: 'SUBPROJECTS_LINES' put: (self generateSubProjectLines_make_dot_proto);
at: 'SUBPROJECT_LIBS' put: (self generateSubProjectLibs_make_dot_proto);
- at: 'REQUIRED_LIBOBJS' put: (self generateRequiredLibobjs_make_dot_proto);
- at: 'REQUIRED_LINK_LIBOBJS' put: (self generateRequiredLinkLibobjs_make_dot_proto);
- at: 'DEPENDENCIES' put: (self generateDependencies_unix);
- at: 'REQUIRED_SUPPORT_DIRS' put: (self extraTargets asStringWith:' ');
at: 'PRODUCT_NAME' put: (self productName);
at: 'PRODUCT_FILENAME' put: (self productFilename);
at: 'PRODUCT_VERSION' put: (self productVersion);
@@ -2378,7 +2369,11 @@
# (SETUP_RULE is set to setup_linux)
setup_linux:
@if test -d autopackage; then \
- makepackage; \
+ if which autopackage; then \
+ makepackage; \
+ else \
+ echo "Warning: autopackage not found, installer NOT created"; \
+ fi \
else \
echo "Error: missing autopackage directory"; \
exit 1; \
@@ -2387,8 +2382,12 @@
# backward compatible fallback
setup::
@if test -d autopackage; then \
- makepackage; \
- else \
+ if which autopackage; then \
+ makepackage; \
+ else \
+ echo "Warning: autopackage not found, installer NOT created"; \
+ fi \
+ else \
echo "Error: make setup not yet available in this unix"; \
exit 1; \
fi
@@ -2801,7 +2800,7 @@
s tab; nextPutLine:('@-mkdir "%1"' bindWith:macOSDir). dirsMade add:macOSDir.
s tab; nextPutLine:('cp "',self applicationName,'" "',macOSDir,'/"').
s tab; nextPutLine:('@-cp osx/Info.plist "',contentsDir,'/"').
- s tab; nextPutLine:('@-cp osx/PkgInfo "',contentsDir,'/"').
+ "/ s tab; nextPutLine:('@-cp osx/PkgInfo "',contentsDir,'/"').
self commonFilesToInstall_unix do:[:eachPair | genLine value:s value:'MacOS' value:eachPair].
s tab; nextPutLine:('@-rm "%1/"*WINrc.rc' bindWith:macOSDir).
self additionalFilesToInstall_unix do:[:eachPair | genLine value:s value:'MacOS' value:eachPair].
--- a/ArithmeticValue.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ArithmeticValue.st Fri Dec 09 22:31:28 2016 +0000
@@ -251,7 +251,6 @@
^ self == ArithmeticValue
! !
-
!ArithmeticValue methodsFor:'arithmetic'!
* something
@@ -324,7 +323,7 @@
!
dist:arg
- "return the distance between arg and the receiver."
+ "return the distance between the arg and the receiver."
^ (arg - self) abs
--- a/Array.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Array.st Fri Dec 09 22:31:28 2016 +0000
@@ -278,7 +278,7 @@
Operatingsystem, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
new:anInteger
@@ -1901,10 +1901,10 @@
receiver refers to aLiteral (i.e. a deep search)"
self do:[:el |
- el == aLiteral ifTrue:[^true].
- el isArray ifTrue:[
- (el refersToLiteral: aLiteral) ifTrue: [^true]
- ]
+ el == aLiteral ifTrue:[^true].
+ el isArray ifTrue:[
+ (el refersToLiteral: aLiteral) ifTrue: [^true]
+ ]
].
^ false
@@ -1922,10 +1922,10 @@
receiver is symbolic and matches aMatchPattern (i.e. a deep search)"
self do:[ :el |
- (el isSymbol and:[ aMatchPattern match: el]) ifTrue:[^true].
- el isArray ifTrue:[
- (el refersToLiteralMatching: aMatchPattern) ifTrue: [^true]
- ]
+ (el isSymbol and:[ aMatchPattern match: el]) ifTrue:[^true].
+ el isArray ifTrue:[
+ (el refersToLiteralMatching: aMatchPattern) ifTrue: [^true]
+ ]
].
^ false
@@ -2021,93 +2021,93 @@
INT nInsts;
if (__isSmallInteger(start)) {
- index = __intVal(start) - 1;
- if (index >= 0) {
- nInsts = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
- index += nInsts;
- nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
- el = anElement;
- op = & (__InstPtr(self)->i_instvars[index]);
+ index = __intVal(start) - 1;
+ if (index >= 0) {
+ nInsts = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
+ index += nInsts;
+ nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
+ el = anElement;
+ op = & (__InstPtr(self)->i_instvars[index]);
#if defined(memsrch4)
- if (index < nIndex) {
- OBJ *p;
+ if (index < nIndex) {
+ OBJ *p;
- p = memsrch4(op, (INT)el, (nIndex - index));
- if (p) {
- index += (p - op + 1);
- RETURN ( __mkSmallInteger(index) );
- }
- }
+ p = memsrch4(op, (INT)el, (nIndex - index));
+ if (p) {
+ index += (p - op + 1);
+ RETURN ( __mkSmallInteger(index) );
+ }
+ }
#else
# ifdef __UNROLL_LOOPS__
- {
- /*
- * dont argue about those gotos below - they speed up that thing by 30%;
- * its better to exit the loops below with a goto,
- * since the generated code will then be:
- * compare
- * branch-on-equal found
- *
- * otherwise (with ret as if-statement), we get:
- * compare
- * branch-on-not-equal skipLabel
- * move-to-ret-register true
- * goto ret-label
- * skipLabel
- *
- * therefore, WITH the so-much-blamed goto, we only branch
- * when found; without the goto, we branch always.
- * Pipelined CPUs do usually not like taken branches.
- */
+ {
+ /*
+ * don't argue about those gotos below - they speed up that thing by 30%;
+ * its better to exit the loops below with a goto,
+ * since the generated code will then be:
+ * compare
+ * branch-on-equal found
+ *
+ * otherwise (with ret as if-statement), we get:
+ * compare
+ * branch-on-not-equal skipLabel
+ * move-to-ret-register true
+ * goto ret-label
+ * skipLabel
+ *
+ * therefore, WITH the so-much-blamed goto, we only branch
+ * when found; without the goto, we branch always.
+ * Pipelined CPUs do usually not like taken branches.
+ */
- unsigned INT i8;
+ unsigned INT i8;
- while ((i8 = index + 8) < nIndex) {
- if (op[0] == el) goto found1;
- if (op[1] == el) goto found2;
- if (op[2] == el) goto found3;
- if (op[3] == el) goto found4;
- if (op[4] == el) goto found5;
- if (op[5] == el) goto found6;
- if (op[6] == el) goto found7;
- if (op[7] == el) goto found8;
- index = i8;
- op += 8;
- }
- if (0) {
- found1:
- RETURN ( __mkSmallInteger(index + 1 - nInsts) );
- found2:
- RETURN ( __mkSmallInteger(index + 2 - nInsts) );
- found3:
- RETURN ( __mkSmallInteger(index + 3 - nInsts) );
- found4:
- RETURN ( __mkSmallInteger(index + 4 - nInsts) );
- found5:
- RETURN ( __mkSmallInteger(index + 5 - nInsts) );
- found6:
- RETURN ( __mkSmallInteger(index + 6 - nInsts) );
- found7:
- RETURN ( __mkSmallInteger(index + 7 - nInsts) );
- found8:
- RETURN ( __mkSmallInteger(index + 8 - nInsts) );
- }
- }
+ while ((i8 = index + 8) < nIndex) {
+ if (op[0] == el) goto found1;
+ if (op[1] == el) goto found2;
+ if (op[2] == el) goto found3;
+ if (op[3] == el) goto found4;
+ if (op[4] == el) goto found5;
+ if (op[5] == el) goto found6;
+ if (op[6] == el) goto found7;
+ if (op[7] == el) goto found8;
+ index = i8;
+ op += 8;
+ }
+ if (0) {
+ found1:
+ RETURN ( __mkSmallInteger(index + 1 - nInsts) );
+ found2:
+ RETURN ( __mkSmallInteger(index + 2 - nInsts) );
+ found3:
+ RETURN ( __mkSmallInteger(index + 3 - nInsts) );
+ found4:
+ RETURN ( __mkSmallInteger(index + 4 - nInsts) );
+ found5:
+ RETURN ( __mkSmallInteger(index + 5 - nInsts) );
+ found6:
+ RETURN ( __mkSmallInteger(index + 6 - nInsts) );
+ found7:
+ RETURN ( __mkSmallInteger(index + 7 - nInsts) );
+ found8:
+ RETURN ( __mkSmallInteger(index + 8 - nInsts) );
+ }
+ }
# endif /* __UNROLLED_LOOPS__ */
- while (index++ < nIndex) {
- if (*op++ == el) goto found0;
- }
+ while (index++ < nIndex) {
+ if (*op++ == el) goto found0;
+ }
- if (0) {
- found0:
- RETURN ( __mkSmallInteger(index - nInsts) );
- }
+ if (0) {
+ found0:
+ RETURN ( __mkSmallInteger(index - nInsts) );
+ }
#endif /* no memsrch */
- }
- RETURN ( __mkSmallInteger(0) );
+ }
+ RETURN ( __mkSmallInteger(0) );
}
%}.
^ super identityIndexOf:anElement startingAt:start
@@ -2517,23 +2517,23 @@
* (except if searching for nil - there is no need for equal compare ...)
*/
if (nIndex > 500) {
- if (o != nil)
- nIndex = 500;
+ if (o != nil)
+ nIndex = 500;
}
# ifdef memsrch4
if (index < nIndex) {
- OBJ *p;
+ OBJ *p;
- p = memsrch4(&(__InstPtr(self)->i_instvars[index]), (INT)o, (nIndex - index));
- if (p) {
- RETURN ( true );
- }
+ p = memsrch4(&(__InstPtr(self)->i_instvars[index]), (INT)o, (nIndex - index));
+ if (p) {
+ RETURN ( true );
+ }
}
# else
/*
- * dont argue those gotos below - they speed up that thing by 30%
+ * don't argue those gotos below - they speed up that thing by 30%
* its better to exit the loops below with a goto,
* since the generated code will then be:
* compare
@@ -2554,35 +2554,35 @@
*/
# ifdef __UNROLL_LOOPS__
{
- unsigned INT i8;
- REGISTER OBJ slf = self;
+ unsigned INT i8;
+ REGISTER OBJ slf = self;
- while ((i8 = index + 8) < nIndex) {
- if (__InstPtr(slf)->i_instvars[index] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+1] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+2] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+3] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+4] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+5] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+6] == o) goto found;
- if (__InstPtr(slf)->i_instvars[index+7] == o) goto found;
- index = i8;
- }
+ while ((i8 = index + 8) < nIndex) {
+ if (__InstPtr(slf)->i_instvars[index] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+1] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+2] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+3] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+4] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+5] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+6] == o) goto found;
+ if (__InstPtr(slf)->i_instvars[index+7] == o) goto found;
+ index = i8;
+ }
}
# endif /* __UNROLL_LOOPS__ */
while (index < nIndex) {
- if (__InstPtr(self)->i_instvars[index++] == o) goto found;
+ if (__InstPtr(self)->i_instvars[index++] == o) goto found;
}
if (0) {
- found:
- RETURN (true);
+ found:
+ RETURN (true);
}
# endif /* no memsrch */
if (o == nil) {
- RETURN ( false );
+ RETURN ( false );
}
%}.
@@ -2603,15 +2603,15 @@
index = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
while (index < nIndex) {
- element = __InstPtr(self)->i_instvars[index++];
- if (element != nil) {
- if ((*eq.ilc_func)(anObject,
- @symbol(=),
- nil,&eq,
- element)==true) {
- RETURN ( true );
- }
- }
+ element = __InstPtr(self)->i_instvars[index++];
+ if (element != nil) {
+ if ((*eq.ilc_func)(anObject,
+ @symbol(=),
+ nil,&eq,
+ element)==true) {
+ RETURN ( true );
+ }
+ }
}
RETURN (false);
%}.
--- a/Bag.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Bag.st Fri Dec 09 22:31:28 2016 +0000
@@ -38,30 +38,30 @@
documentation
"
- Bag implements collections whose elements are unordered and have no
- external key. Elements may occur more than once in a bag. There is no defined
- order within a bag.
- The default implementation uses a dictionary to store each objects occurrence
- count, using the object itself as key (i.e. using = and hash for inclusion
- tests).
+ Bags are collections where the elements are unordered and have no external key.
+ Elements may occur more than once in a bag.
+ There is no defined order within a bag.
+ The default implementation uses a dictionary to store each object's occurrence count,
+ using the object itself as key
+ (i.e. using = and hash for inclusion tests).
- There is also an instance creation variant (#identityNew:) creating a
+ There is also an instance creation variant (#identityNew:) which creats a
bag which compares using #== and hashes using #identityHash.
- (I'd say that an IdentityBag was a better thing to implement ...
+ (I'd say that instantiating an IdentityBag explicitly is better,
... but for compatibility ... we do it here as well)
[Instance variables:]
- contents <Dictionary> for each element, the number of occurrences
+ contents <Dictionary> for each element, the number of occurrences
[author:]
- Claus Gittinger
+ Claus Gittinger
[See also:]
- Set IdentitySet
- Dictionary IdentityDictionary
- OrderedCollection Array
+ Set IdentitySet
+ Dictionary IdentityDictionary
+ OrderedCollection Array
"
! !
--- a/Behavior.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Behavior.st Fri Dec 09 22:31:28 2016 +0000
@@ -1332,6 +1332,8 @@
!
theNonMetaClass
+ <resource: #obsolete>
+
"alias for theNonMetaclass (Squeak) - return the class.
sigh; in ST/X, it is called theNonMetaclass; please use that."
@@ -1440,30 +1442,30 @@
|oldMethod ns nsName selector newLookupObject|
(newSelector isMemberOf:Symbol) ifFalse:[
- self error:'invalid selector'.
+ self error:'invalid selector'.
].
ns := newMethod nameSpace.
(ns notNil and:[(nsName := ns name) ~= self programmingLanguage defaultSelectorNameSpacePrefix]) ifTrue:[
- selector := (':' , nsName , '::' , newSelector) asSymbol.
- newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
+ selector := (':' , nsName , '::' , newSelector) asSymbol.
+ newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
] ifFalse:[
- selector := newSelector
+ selector := newSelector
].
"/ Q (cg): isn't that something that the caller should decide?
oldMethod := self compiledMethodAt:selector.
oldMethod notNil ifTrue:[
- newMethod restricted:(oldMethod isRestricted).
- newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
+ newMethod restricted:(oldMethod isRestricted).
+ newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
].
(self primAddSelector:selector withMethod:newMethod) ifFalse:[^ false].
newLookupObject notNil ifTrue:[
- lookupObject ~= newLookupObject ifTrue:[
- self lookupObject: newLookupObject
- ]
+ lookupObject ~= newLookupObject ifTrue:[
+ self lookupObject: newLookupObject
+ ]
].
"
@@ -1473,12 +1475,12 @@
"
"
problem: this is slower; since looking for all subclasses is (currently)
- a bit slow :-(
- We need the hasSubclasses-info bit in Behavior; now
+ a bit slow :-(
+ We need the hasSubclasses-info bit in Behavior; now
self withAllSubclassesDo:[:aClass |
- ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
- ObjectMemory flushMethodCacheFor:aClass
+ ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+ ObjectMemory flushMethodCacheFor:aClass
].
"
@@ -1733,7 +1735,7 @@
!Behavior methodsFor:'cleanup'!
flushSubclasses
- "I dont keep my subclasses - but if anyone inherits from me,
+ "I don't keep my subclasses - but if anyone inherits from me,
it better knows how to ignore this"
!
@@ -2208,7 +2210,10 @@
"
UndefinedObject methodsDo:[:m | Transcript showCR:m whoString]
UndefinedObject selectorsDo:[:sym | Transcript showCR:sym]
- "
+ UndefinedObject methodDictionary
+ "
+
+ "Modified (comment): / 25-11-2016 / 15:42:43 / cg"
!
selectorsAndMethodsDo:aTwoArgBlock
@@ -2524,7 +2529,7 @@
Operatingsystem, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
basicNew:anInteger
@@ -2890,7 +2895,7 @@
Operatingsystem, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
decodeFromLiteralArray:anArray
@@ -3617,7 +3622,7 @@
nameWithArticle
"return a string consisting of classname preceeded by an article.
- (dont expect me to write national variants for this ... :-)
+ (don't expect me to write national variants for this ... :-)
If you have special preferences, redefine it..."
|classname|
@@ -4783,14 +4788,14 @@
This is semantically equivalent to includesSelector: (which is ST/80/Squeak compatibility).
Caveat:
- This simply checks for the selector being present in the classes
- selector table - therefore, it does not care for ignoredMethods.
- (but: you should not use this method for protocol-testing, anyway).
+ This simply checks for the selector being present in the classes
+ selector table - therefore, it does not care for ignoredMethods.
+ (but: you should not use this method for protocol-testing, anyway).
Hint:
- Dont use this method to check if someone responds to a message -
- use #canUnderstand: on the class or #respondsTo: on the instance
- to do this."
+ Don't use this method to check if someone responds to a message -
+ use #canUnderstand: on the class or #respondsTo: on the instance
+ to do this."
^ self includesSelector:aSelector
@@ -5160,15 +5165,17 @@
!
whichSelectorsAssign: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
-
- ^ self whichSelectorsWrite: instVarName
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
+
+ ^ self whichSelectorsWrite: instVarName
+
+ "Modified (comment): / 16-11-2016 / 20:16:53 / cg"
!
whichSelectorsRead: instVarName
- "Answer a set of selectors whose methods read the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods read the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict|
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
@@ -5176,12 +5183,13 @@
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ readsField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
+ | methodDict |
+
+ methodDict := self methodDictionary.
+ ^ methodDict keys select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
"Modified: / 23-07-2012 / 11:22:04 / cg"
+ "Modified (comment): / 16-11-2016 / 20:16:45 / cg"
!
whichSelectorsReferTo:someLiteralConstant
@@ -5238,20 +5246,21 @@
!
whichSelectorsWrite: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict |
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
"/ methodDict := self methodDictionary.
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ writesField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
+ | methodDict |
+
+ methodDict := self methodDictionary.
+ ^ methodDict keys select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
"Modified: / 23-07-2012 / 11:21:17 / cg"
+ "Modified (format): / 16-11-2016 / 20:17:17 / cg"
! !
!Behavior methodsFor:'snapshots'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/BitArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,519 @@
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ 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.
+
+ This is a demo example:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: Smalltalk }"
+
+ArrayedCollection variableByteSubclass:#BitArray
+ instanceVariableNames:'tally'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!BitArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ 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.
+
+ This is a demo example:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+"
+
+!
+
+documentation
+"
+ BitArrays are specially tuned to store bits, and are useful for bulk bit/boolean data.
+ They require only 1/32th (32bit machines) or 1/64th (64bit machines) of the memory
+ compared to an array of booleans.
+
+ They one stores 8 bits per byte. Since instances store bits in multiples
+ of 8, the real size of the collection is kept in an extra instance variable (tally).
+ It may be useful if huge boolean arrays are needed.
+
+ There are 10 types of people in this world:
+ Those who understand binary, & those who don't.
+
+ ATTENTION:
+ Bits 1 to 8 of the BooleanArray are stored in bits 8 to 1 of the
+ corresponding byte, to allow easy mapping to ASN.1 BIT STRING encoding
+ in the BER. (i.e. MSB-first)
+ Do not change this.
+
+ [memory requirements:]
+ OBJ-HEADER + ((size + 7) // 8)
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ BooleanArray ByteArray WordArray Array
+"
+!
+
+examples
+"
+ [exBegin]
+ (BitArray new:7) inspect
+ [exEnd]
+ [exBegin]
+ (BitArray new:7) basicInspect
+ [exEnd]
+ [exBegin]
+ |bits|
+
+ bits := BitArray new:1000000.
+ (bits at:9999) printCR.
+ bits at:9999 put:1.
+ (bits at:9999) printCR.
+ [exEnd]
+"
+! !
+
+!BitArray class methodsFor:'instance creation'!
+
+fromBytes:aByteArray
+ "return a new instance, capable of holding aByteArray size*8 bits, initialized from aByteArray"
+
+ |a|
+
+ a := self new: aByteArray size*8.
+ 1 to:aByteArray size do:[:i | a byteAt:i put:(aByteArray at:i)].
+ ^ a
+
+ "
+ BitArray fromBytes:#[ 2r00001111 2r10101010 2r01010101]
+ "
+!
+
+new
+ "return a new instance, capable of holding size bits"
+
+ ^ self new:0
+
+ "
+ BitArray new
+ "
+!
+
+new:size
+ "return a new instance, capable of holding size bits"
+
+ |nBytes|
+
+ nBytes := (size + 7) // 8.
+ ^ (super new:nBytes) setTally:size
+
+ "
+ BitArray new:10
+ "
+!
+
+uninitializedNew:size
+ ^ self new:size
+! !
+
+!BitArray class methodsFor:'queries'!
+
+maxVal
+ "the minimum value which can be stored in instances of me.
+ For BitArrays, this is 1"
+
+ ^ 1
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For BitArrays, this is 0"
+
+ ^ 0
+! !
+
+!BitArray methodsFor:'accessing'!
+
+at:index
+ "retrieve the bit at index (1..)"
+
+ |byte mask i0|
+
+ (index between:1 and:tally) ifFalse:[
+ ^ self subscriptBoundsError:index
+ ].
+ i0 := index - 1.
+ byte := super basicAt:(i0 // 8)+1.
+ mask := 1 bitShift:(7 - (i0 \\ 8)).
+ ^ (byte bitTest:mask) ifTrue:[1] ifFalse:[0]
+
+ "
+ (BitArray new:1000) at:555
+ (BitArray new:1000) at:400 put:1; at:400
+ "
+
+ "
+ |b|
+
+ b := BitArray new:1000.
+ b at:555 put:1.
+ b at:555
+ "
+!
+
+at:index put:aNumber
+ "store the argument, aNumber at index (1..);
+ return the argument, aNumber (sigh)."
+
+ |byte mask idx i0|
+
+ (index between:1 and:tally) ifFalse:[
+ ^ self subscriptBoundsError:index
+ ].
+
+ i0 := index - 1.
+ idx := (i0 // 8) + 1.
+ byte := super basicAt:idx.
+ mask := 1 bitShift:(7 - (i0 \\ 8)).
+ aNumber == 1 ifTrue:[
+ byte := byte bitOr:mask
+ ] ifFalse:[
+ aNumber == 0 ifTrue:[
+ byte := byte bitAnd:(mask bitInvert)
+ ] ifFalse:[
+ "/ not 0 or 1
+ ^ self elementBoundsError:aNumber
+ ]
+ ].
+ super basicAt:idx put:byte.
+ ^ aNumber.
+
+ "
+ |b|
+
+ b := BitArray new:1000.
+ b at:555 put:1.
+ b at:555
+ "
+!
+
+byteAt:index
+ "retrieve 8 bits at index; the index is 1 for the first 8 bits, 2 for the next 8 bits etc."
+
+ ^ self basicAt:index
+
+ "
+ ((BitArray new:8) at:1 put:1); byteAt:1
+ "
+!
+
+byteAt:index put:aByte
+ "store 8 bits at index; the index is 1 for the first 8 bits, 2 for the next 8 bits etc."
+
+ ^ self basicAt:index put:aByte
+
+ "
+ ((BitArray new:8) byteAt:1 put:128); at:1
+ "
+!
+
+occurrencesOf:anElement
+ "count the occurrences of the argument, anElement in the receiver"
+
+ |nOnes|
+
+ nOnes := self countOnes.
+ anElement == 1 ifTrue:[
+ ^ nOnes
+ ].
+ anElement == 0 ifTrue:[
+ ^ tally - nOnes
+ ].
+ ^ 0
+
+ "
+ (BitArray new:10)
+ at:4 put:1;
+ at:6 put:1;
+ at:7 put:1;
+ occurrencesOf:1
+
+ (BitArray new:10)
+ at:4 put:1;
+ at:6 put:1;
+ at:7 put:1;
+ occurrencesOf:0
+ "
+! !
+
+!BitArray methodsFor:'converting'!
+
+bytes
+ "answer myself as a ByteArray containing my bytes"
+
+ |size bytes|
+
+ size := self basicSize.
+ bytes := ByteArray new:size.
+ 1 to:size do:[:index|
+ bytes at:index put:(self byteAt:index)
+ ].
+ ^ bytes
+! !
+
+!BitArray methodsFor:'filling & replacing'!
+
+atAllPut:aNumber
+ "replace all elements of the collection by the argument, aNumber.
+ The argument, aBoolean must be 0 or 1.
+ Notice: This operation modifies the receiver, NOT a copy;
+ therefore the change may affect all others referencing the receiver."
+
+ |v lastIndex|
+
+ lastIndex := self basicSize.
+ lastIndex == 0 ifTrue:[^ self].
+
+ aNumber == 1 ifTrue:[
+ v := 255
+ ] ifFalse:[
+ aNumber == 0 ifTrue:[
+ v := 0
+ ] ifFalse:[
+ "/
+ "/ booleanArrays can only hold true and false
+ "/
+ ^ self elementBoundsError:aNumber
+ ]
+ ].
+ 1 to:lastIndex-1 do:[:i |
+ self basicAt:i put:v
+ ].
+
+ "/ ensure 0-bits above tally
+ v := #[ 2r11111111
+ 2r10000000
+ 2r11000000
+ 2r11100000
+ 2r11110000
+ 2r11111000
+ 2r11111100
+ 2r11111110 ] at:(tally\\8)+1.
+ self basicAt:lastIndex put:v.
+
+ "
+ ((self new:10) atAllPut:1) countOnes
+ ((self new:8) atAllPut:1) countOnes
+ "
+! !
+
+!BitArray methodsFor:'logical operations'!
+
+bitOr:aBitArray
+ |new mySize "{ Class: SmallInteger }" otherSize "{ Class: SmallInteger }"|
+
+ mySize := self basicSize.
+ otherSize := aBitArray basicSize.
+
+ new := self class basicNew:(mySize max:otherSize).
+ new setTally:(self size max:aBitArray size).
+
+ 1 to:mySize do:[:i|
+ new basicAt:i put:(self basicAt:i).
+ ].
+ 1 to:otherSize do:[:i|
+ new basicAt:i put:((new basicAt:i) bitOr:(aBitArray basicAt:i)).
+ ].
+
+ ^ new
+
+ "
+ ((BitArray new:5) at:3 put:1; yourself) bitOr:((BitArray new:8) at:5 put:1; yourself)
+ "
+! !
+
+!BitArray methodsFor:'private'!
+
+countOnes
+ "count the 1-bits in the receiver"
+
+ |sz bI count|
+
+ count := 0.
+
+ "/ because remaining bits in the highest byte are always 0,
+ "/ we can simply count the 1-bits in ALL bytes... (see lastByte handling in atAllPut:)
+ bI := 1.
+ sz := self basicSize.
+ [bI <= sz] whileTrue:[
+ count := count + (self basicAt:bI) bitCount.
+ bI := bI + 1.
+ ].
+ ^ count
+
+"/ |i nI bI bits count|
+"/ i := bI := 1.
+"/ [
+"/ nI := i + 8.
+"/ nI <= tally
+"/ ] whileTrue:[
+"/ bits := self basicAt:bI.
+"/ count := count + bits bitCount.
+"/ bI := bI + 1.
+"/ i := nI
+"/ ].
+"/ [i <= tally] whileTrue:[
+"/ (self at:i) ifTrue:[ count := count + 1].
+"/ i := i + 1.
+"/ ].
+"/ ^ count
+
+ "
+ (BooleanArray new:100)
+ at:14 put:true;
+ at:55 put:true;
+ countOnes
+
+ (BooleanArray new:100)
+ at:14 put:true;
+ at:55 put:true;
+ occurrencesOf:true
+
+ (BooleanArray new:100)
+ at:14 put:true;
+ at:55 put:true;
+ occurrencesOf:false
+ "
+!
+
+indexOfNth:n occurrenceOf:what
+ "return the index of the nTh occurrence of a value, or 0 if there are not that many"
+
+ |sz byteIndex count countInByte|
+
+ n > self size ifTrue:[^ 0].
+
+ count := 0.
+
+ byteIndex := 1.
+ sz := self basicSize.
+ [byteIndex <= sz] whileTrue:[
+ countInByte := (self basicAt:byteIndex) bitCount.
+ what = self defaultElement ifTrue:[
+ countInByte := 8-countInByte.
+ ].
+ count := count + countInByte.
+ count >= n ifTrue:[
+ count := count - countInByte.
+ (byteIndex-1)*8+1 to:(byteIndex-1)*8+8 do:[:bitIndex |
+ (self at:bitIndex) = what ifTrue:[
+ count := count + 1.
+ count = n ifTrue:[
+ ^ bitIndex.
+ ]
+ ].
+ ].
+ ^ 0
+ ].
+ byteIndex := byteIndex + 1.
+ ].
+ ^ 0
+
+ "
+ (BooleanArray new:100)
+ at:1 put:true;
+ at:2 put:true;
+ at:4 put:true;
+ at:5 put:true;
+ at:6 put:true;
+ at:7 put:true;
+ at:8 put:true;
+ at:10 put:true;
+ indexOfNth:8 occurrenceOf:false
+ "
+!
+
+setTally:size
+ "set my tally - that is the actual number of bits in me
+ (usually a little less than the number of bits in my byte array)"
+
+ tally := size
+! !
+
+!BitArray methodsFor:'queries'!
+
+defaultElement
+ ^ 0
+!
+
+isValidElement:anObject
+ "return true, if I can hold this kind of object"
+
+ ^ anObject == 0 or:[anObject == 1]
+!
+
+size
+ "return the size of the receiver"
+
+ ^ tally
+! !
+
+!BitArray methodsFor:'visiting'!
+
+acceptVisitor:aVisitor with:aParameter
+ "dispatch for visitor pattern; send #visitBitArray:with: to aVisitor"
+
+ ^ aVisitor visitBitArray:self with:aParameter
+! !
+
+!BitArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/Block.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Block.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -49,22 +51,52 @@
is done by the compilers, when some sourceCode is compiled to either
machine or byteCode.
+ In the code, blocks are written as:
+ [
+ expression1.
+ ...
+ expressionN
+ ]
+ It represents the computation inside the brackets,
+ and can be passed around as argument, assigned to variables or returned from a block or method.
+ Creation of a block does NOT evaluate its expressions. You have to give the block to someone,
+ who asks it to evaluate itself. This is done by sending #value to the block.
+ i.e.
+ foo := [ Transcript showCR:'Hello World'].
+ ...
+ foo value
+
+ Blocks are used in many many ways; one particular use is as callback:
+ |b|
+
+ b := Button label:'Press me'.
+ b action:[ Transcript showCR:'Hello'].
+ b open.
+
Blocks with arguments need a message of type ''value:arg1 ... value:argn''
for evaluation; the number of arguments passed when evaluating must match
the number of arguments the block was declared with otherwise an error is
- raised. Blocks without args need a ''value'' message for evaluation.
-
- Blocks keep a reference to the context where the block was declared -
+ raised.
+ Blocks without args need a ''value'' message for evaluation.
+
+ another use of blocks is in the enumeration protocols:
+ |coll|
+
+ coll := #( 'one' 'two' 'three').
+ coll do:[:eachElement | Transcript showCR:eachElement ].
+
+ Blocks keep a reference to the context where it was declared -
this allows blocks to access the methods arguments and/or variables.
This is still true after the method has returned - since the
block keeps this reference, the methods context will NOT die in this case.
- (i.e. Blocks are closures in Smalltalk/X)
+ (for experts: Smalltalk blocks are technically lambdas/closures)
A return (via ^-statement) out of a block will force a return from the
- blocks method context (if it is still living) - this make the implementation
- of long-jumps and control structures possible.
- (If the method is not alive (i.e. has already returned), a return out of the
- block will trigger an error)
+ block's method context (if it is still living).
+ This is effectively a kind of long-jumps out of the method which declared the block
+ and makes control structures and loops possible.
+ If the method is not alive (i.e. has already returned), a return out of the
+ block will trigger an error.
Long-jump is done by defining a catchBlock as ''[^ self]''
somewhere up in the calling-tree. Then, to do the long-jump from out of some
@@ -73,30 +105,30 @@
[Instance variables:]
home <Context> the context where this block was created (i.e. defined)
- this may be a blockContext or a methodContext
+ this may be a blockContext or a methodContext
nargs <SmallInteger> the number of arguments the block expects
sourcePos <SmallInteger> the character position of its source, in chars
- relative to methods source beginning
+ relative to methods source beginning
initialPC <SmallInteger> the start position within the byteCode
- for compiled blocks, this is nil.
+ for compiled blocks, this is nil.
[Class variables:]
InvalidNewSignal raised if a Block is tried to be created
- with new (which is not allowed).
- Only the VM is allowed to create Blocks.
+ with new (which is not allowed).
+ Only the VM is allowed to create Blocks.
NOTICE: layout known by runtime system and compiler - do not change
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Process Context
- Collection
- ( contexts. blocks & unwinding : programming/contexts.html)
+ Process Context
+ Collection
+ ( contexts. blocks & unwinding : programming/contexts.html)
"
!
@@ -679,6 +711,7 @@
! !
+
!Block methodsFor:'accessing'!
home
@@ -848,24 +881,32 @@
benchmark:anInfoString
"evaluate myseld and show the timing info on Transcript"
- |startTime endTime overhead micros millis|
+ |startTime endTime startCycles endCycles overhead overheadCycles
+ micros millis cycles|
startTime := OperatingSystem getMicrosecondTime.
+ startCycles := OperatingSystem getCPUCycleCount.
[123] value.
+ endCycles := OperatingSystem getCPUCycleCount.
endTime := OperatingSystem getMicrosecondTime.
overhead := endTime - startTime.
+ "/ just in case, the OS does not support cpu cycles
+ overheadCycles := endCycles - startCycles.
startTime := OperatingSystem getMicrosecondTime.
+ startCycles := OperatingSystem getCPUCycleCount.
self value.
+ endCycles := OperatingSystem getCPUCycleCount.
endTime := OperatingSystem getMicrosecondTime.
micros := (endTime - startTime - overhead) max:0.
-
+ cycles := (endCycles - startCycles - overheadCycles) max:0.
+
Transcript show:anInfoString.
micros < 1000 ifTrue:[
"/ too stupid: many fonts do not have a mu,
"/ so I output it as us here.
- Transcript show:micros; show:' us'.
+ Transcript show:micros; show:' µs'.
] ifFalse:[
micros < 100000 ifTrue:[
millis := (micros / 1000.0) asFixedPointRoundedToScale:2.
@@ -875,11 +916,23 @@
Transcript show:(TimeDuration milliseconds:millis).
].
].
+ cycles ~~ 0 ifTrue:[
+ Transcript show:' ('; show:cycles; show:' cycles)'.
+ ].
Transcript cr.
"
- [10 factorial] benchmark:'10 factorial:'
- [100 factorial] benchmark:'100 factorial:'
+ be aware that if you evaluate the following,
+ the blocks will be interpreted by the doIt.
+ Thus you will get on-realistic values.
+ Better compile those expressions into a method and call that
+ for realistic measurements.
+
+ [] benchmark:'empty block:' - this is a pre-compiled block
+ [123] benchmark:'empty block:' - the rest are interpreted blocks
+ [10 factorial] benchmark:'10 factorial:'
+ [10 factorial] benchmark:'11 factorial:'
+ [100 factorial] benchmark:'100 factorial:'
"
! !
@@ -1042,6 +1095,105 @@
"
!
+value:arg1 optionalArgument:arg2 and:arg3 and:arg4
+ "evaluate the receiver.
+ Optionally pass up one, two, three or four arguments
+ (if the receiver is a 1/2/3/4-arg block)."
+
+ nargs == 4 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4
+ ].
+ nargs == 3 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3
+ ].
+ nargs == 2 ifTrue:[
+ ^ self value:arg1 value:arg2
+ ].
+ ^ self value:arg1
+
+ "
+ |block|
+
+ block := [:arg | Transcript showCR:arg ].
+ block value:1 optionalArgument:2 and:3 and:4.
+
+ block := [:arg1 :arg2 | Transcript show:arg1; space; showCR:arg2 ].
+ block value:1 optionalArgument:2 and:3 and:4.
+
+ block := [:arg1 :arg2 :arg3 :arg4 | Transcript showCR:{arg1 . arg2 . arg3 . arg4}].
+ block value:1 optionalArgument:2 and:3 and:4.
+ "
+!
+
+value:arg1 optionalArgument:arg2 and:arg3 and:arg4 and:arg5
+ "evaluate the receiver.
+ Optionally pass up five arguments
+ (if the receiver is a 1..5-arg block)."
+
+ nargs == 5 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4 value:arg5
+ ].
+ nargs == 4 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4
+ ].
+ nargs == 3 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3
+ ].
+ nargs == 2 ifTrue:[
+ ^ self value:arg1 value:arg2
+ ].
+ ^ self value:arg1
+
+ "
+ |block|
+
+ block := [:arg | Transcript showCR:arg ].
+ block value:1 optionalArgument:2 and:3 and:4 and:5.
+
+ block := [:arg1 :arg2 | Transcript show:arg1; space; showCR:arg2 ].
+ block value:1 optionalArgument:2 and:3 and:4 and:5.
+
+ block := [:arg1 :arg2 :arg3 :arg4 :arg5 | Transcript showCR:{arg1 . arg2 . arg3 . arg4 . arg5}].
+ block value:1 optionalArgument:2 and:3 and:4 and:5.
+ "
+!
+
+value:arg1 optionalArgument:arg2 and:arg3 and:arg4 and:arg5 and:arg6
+ "evaluate the receiver.
+ Optionally pass up six arguments
+ (if the receiver is a 1..6-arg block)."
+
+ nargs == 6 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6
+ ].
+ nargs == 5 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4 value:arg5
+ ].
+ nargs == 4 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4
+ ].
+ nargs == 3 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3
+ ].
+ nargs == 2 ifTrue:[
+ ^ self value:arg1 value:arg2
+ ].
+ ^ self value:arg1
+
+ "
+ |block|
+
+ block := [:arg | Transcript showCR:arg ].
+ block value:1 optionalArgument:2 and:3 and:4 and:5 and:6.
+
+ block := [:arg1 :arg2 | Transcript show:arg1; space; showCR:arg2 ].
+ block value:1 optionalArgument:2 and:3 and:4 and:5 and:6.
+
+ block := [:arg1 :arg2 :arg3 :arg4 :arg5 :arg6 | Transcript showCR:{arg1 . arg2 . arg3 . arg4 . arg5 . arg6}].
+ block value:1 optionalArgument:2 and:3 and:4 and:5 and:6.
+ "
+!
+
value:arg1 value:arg2
"evaluate the receiver with two arguments.
The receiver must be a 2-arg block."
@@ -1142,6 +1294,16 @@
^ self wrongNumberOfArguments:3
!
+value:arg1 value:arg2 value:arg3 optionalArgument:arg4
+ "evaluate the receiver.
+ Optionally pass three or four arguments (if the receiver is a 3/4-arg block)."
+
+ nargs == 4 ifTrue:[
+ ^ self value:arg1 value:arg2 value:arg3 value:arg4
+ ].
+ ^ self value:arg1 value:arg2 value:arg3
+!
+
value:arg1 value:arg2 value:arg3 value:arg4
"evaluate the receiver with four arguments.
The receiver must be a 4-arg block."
@@ -3258,7 +3420,8 @@
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
executed regardless of error actions.
- Same as the more modern #ensure:"
+ Same as the more modern, ANSI standardized #ensure:,
+ which should be used instead for portability."
<exception: #unwind>
@@ -3280,10 +3443,10 @@
f := 'Makefile' asFilename readStream.
[
- l := f nextLine.
- l isNil ifTrue:[^ 'oops']
+ l := f nextLine.
+ l isNil ifTrue:[^ 'oops']
] valueNowOrOnUnwindDo:[
- f close
+ f close
]
"
@@ -3294,8 +3457,9 @@
"evaluate the receiver - when some method sent within unwinds (i.e. does
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
- executed regardless of error actions
- Same as the more modern #ifCurtailed:"
+ executed regardless of error actions.
+ Same as the more modern, ANSI standardized #ifCurtailed:,
+ which should be used instead for portability."
<exception: #unwind>
@@ -3311,23 +3475,23 @@
s := 'Makefile' asFilename readStream.
[
- ^ self
+ ^ self
] valueOnUnwindDo:[
- Transcript showCR:'closing the stream - even though a return occurred'.
- s close
+ Transcript showCR:'closing the stream - even though a return occurred'.
+ s close
]
"
"
[
- |s|
-
- s := 'Makefile' asFilename readStream.
- [
- Processor activeProcess terminate
- ] valueOnUnwindDo:[
- Transcript showCR:'closing the stream - even though process was terminated'.
- s close
- ]
+ |s|
+
+ s := 'Makefile' asFilename readStream.
+ [
+ Processor activeProcess terminate
+ ] valueOnUnwindDo:[
+ Transcript showCR:'closing the stream - even though process was terminated'.
+ s close
+ ]
] fork
"
! !
--- a/BlockContext.st Wed Oct 19 09:22:53 2016 +0100
+++ b/BlockContext.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -197,7 +195,18 @@
aStream nextPutAll:'[] (optimized) in ???'.
] ifFalse:[
aStream nextPutAll:'[] in '.
- m mclass name printOn:aStream.
+ cls := m mclass.
+ cls isNil ifTrue:[
+ cls := m getMclass.
+ cls isNil ifTrue:[
+ className := '*Unbound*'
+ ] ifFalse:[
+ className := '(previously in) ',cls name
+ ].
+ ] ifFalse:[
+ className := cls name.
+ ].
+ className printOn:aStream.
aStream nextPutAll:'>>'.
m selector printOn:aStream.
].
@@ -265,10 +274,10 @@
!BlockContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.40 2015-06-05 16:08:35 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.40 2015-06-05 16:08:35 stefan Exp $'
+ ^ '$Header$'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/BooleanArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,233 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ 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.
+
+ This is a demo example:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: Smalltalk }"
+
+BitArray variableByteSubclass:#BooleanArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!BooleanArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ 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.
+
+ This is a demo example:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+"
+!
+
+documentation
+"
+ BooleanArrays are specially tuned to store booleans (true and false),
+ and are useful for bulk bit/boolean data.
+
+ Instances require only 1/32th (32bit machines) or even 1/64th (64bit machines)
+ of memory compared to a regular array of booleans.
+
+ They store 8 booleans per byte.
+ Since instances store bits in multiples of 8,
+ the real size of the collection is kept in an extra instance variable (tally).
+ It may be useful if huge boolean arrays are to be used.
+
+ ATTENTION:
+ inheriting from BitArray, bits 1 to 8 of the BooleanArray are stored in bits 8 to 1
+ of the corresponding byte, to allow easy mapping to ASN.1 BIT STRING encoding
+ in the BER.
+ Do not change this.
+
+ [memory requirements:]
+ OBJ-HEADER + ((size + 7) // 8)
+
+ [see also:]
+ ByteArray WordArray Array
+
+ [author:]
+ Claus Gittinger
+"
+!
+
+examples
+"
+ [exBegin]
+ (BooleanArray new:7) inspect
+ [exEnd]
+ [exBegin]
+ (BooleanArray new:7) basicInspect
+ [exEnd]
+ [exBegin]
+ |flags|
+
+ flags := BooleanArray new:1000000.
+ (flags at:9999) printNL.
+ flags at:9999 put:true.
+ (flags at:9999) printNL.
+ [exEnd]
+"
+! !
+
+!BooleanArray methodsFor:'accessing'!
+
+at:index
+ "retrieve the boolean at index"
+
+ ^ (super at:index) == 1
+
+ "
+ (BooleanArray new:1000) at:555
+ "
+
+ "
+ |b|
+
+ b := BooleanArray new:1000.
+ b at:555 put:true.
+ b at:555
+ "
+
+ "Modified: / 31.7.1997 / 18:37:25 / cg"
+ "Modified: / 23.5.1999 / 20:02:57 / stefan"
+!
+
+at:index put:aBoolean
+ "store the argument, aBoolean at index; return aBoolean (sigh)."
+
+ |v|
+
+ aBoolean == true ifTrue:[
+ v := 1.
+ ] ifFalse:[
+ aBoolean == false ifTrue:[
+ v := 0.
+ ] ifFalse:[
+ "/ not true or false
+ ^ self elementBoundsError:aBoolean
+ ]
+ ].
+ super at:index put:v.
+ ^ aBoolean
+
+ "
+ |b|
+
+ b := BooleanArray new:1000.
+ b at:555 put:true.
+ b at:555
+ "
+!
+
+occurrencesOf:anElement
+ "count the occurrences of the argument, anElement in the receiver"
+
+ |nOnes|
+
+ nOnes := self countOnes.
+ anElement == true ifTrue:[
+ ^ nOnes
+ ].
+ anElement == false ifTrue:[
+ ^ tally - nOnes
+ ].
+ ^ 0
+
+ "
+ (BooleanArray new:10)
+ at:4 put:true;
+ at:6 put:true;
+ at:7 put:true;
+ occurrencesOf:true
+ "
+! !
+
+!BooleanArray methodsFor:'filling & replacing'!
+
+atAllPut:aBoolean
+ "replace all elements of the collection by the argument, aBoolean.
+ The argument, aBoolean must be true or false.
+ Notice: This operation modifies the receiver, NOT a copy;
+ therefore the change may affect all others referencing the receiver."
+
+ |v|
+
+ aBoolean == true ifTrue:[
+ v := 1
+ ] ifFalse:[
+ aBoolean == false ifTrue:[
+ v := 0
+ ] ifFalse:[
+ "/ booleanArrays can only hold true and false
+ ^ self elementBoundsError:aBoolean
+ ]
+ ].
+ super atAllPut:v
+! !
+
+!BooleanArray methodsFor:'queries'!
+
+defaultElement
+ ^ false
+!
+
+isValidElement:anObject
+ "return true, if I can hold this kind of object"
+
+ ^ anObject == true or:[anObject == false]
+! !
+
+!BooleanArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/ByteArray.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ByteArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -42,8 +40,8 @@
"
ByteArrays store integers in the range 0..255.
In contrast to normal arrays (which store pointers to their elements),
- byteArrays store the values in a dense & compact way. ByteArrays can
- be used to hold the data for bitmaps, images and other bulk data.
+ byteArrays store the values in a dense & compact way.
+ ByteArrays can be used to hold the data for bitmaps, images and other bulk data.
ByteArrays are also used to store the bytecode-instructions of an
interpreted method and are used as superclass for Strings.
@@ -53,22 +51,22 @@
As in: #( #[1 1 1] #[2 2 2] #[3 3 3])
If you have to communicate structure-data (in the C-sense) with external
- programs/data-bases, see a companion class (Structure) in the goodies directory.
+ programs/data-bases, see a companion class (Structure).
It allows the definition of subclasses of ByteArray, which transparently fetch
and store C-structure fields.
[memory requirements:]
- OBJ-HEADER + size
+ OBJ-HEADER + size
[warning:]
- read the warning about 'growing fixed size collection'
- in ArrayedCollection's documentation
+ read the warning about 'growing fixed size collection'
+ in ArrayedCollection's documentation
[author:]
- Claus Gittinger
+ Claus Gittinger
[See also:]
- Array CharacterArray String
+ Array CharacterArray String
"
! !
@@ -166,7 +164,6 @@
! !
-
!ByteArray class methodsFor:'queries'!
elementByteSize
@@ -201,7 +198,6 @@
^ 0
! !
-
!ByteArray methodsFor:'Compatibility-Squeak'!
bitXor:aByteArray
@@ -227,7 +223,6 @@
"
! !
-
!ByteArray methodsFor:'accessing'!
basicAt:index
@@ -3131,7 +3126,6 @@
"
! !
-
!ByteArray methodsFor:'searching'!
indexOf:aByte startingAt:start
@@ -3197,7 +3191,6 @@
"
! !
-
!ByteArray methodsFor:'testing'!
isByteArray
--- a/CachingRegistry.st Wed Oct 19 09:22:53 2016 +0100
+++ b/CachingRegistry.st Fri Dec 09 22:31:28 2016 +0000
@@ -51,7 +51,6 @@
This is kind of experimental.
-
[author:]
Claus Gittinger (cg@exept)
@@ -60,8 +59,6 @@
[instance variables:]
keptObjects Collection hard referenced objects
cacheSize Integer number of hard references
-
- [class variables:]
"
! !
@@ -96,13 +93,19 @@
].
"check the whole registry..."
- keyArray validElementsDo:[:obj |
- (obj ~~ DeletedEntry and:[aBlock value:obj]) ifTrue:[
- keptReferences size >= cacheSize ifTrue:[
- keptReferences removeFirst.
+ keyArray validElementsDo:[:eachElement |
+ eachElement ~~ DeletedEntry ifTrue:[
+ |realObject|
+
+ realObject := eachElement.
+ eachElement == NilEntry ifTrue:[realObject := nil].
+ (aBlock value:realObject) ifTrue:[
+ keptReferences size >= cacheSize ifTrue:[
+ keptReferences removeFirst.
+ ].
+ keptReferences addLast:realObject.
+ ^ realObject
].
- keptReferences addLast:obj.
- ^ obj
].
].
^ exceptionValue value
--- a/Character.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Character.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -62,11 +60,11 @@
Always compare using #= if there is any chance of a non-ascii character being involved.
Once again (because beginners sometimes make this mistake):
- This means: you may compare characters using #== ONLY IFF you are certain,
- that the characters ranges is 0..255.
- Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
- Sorry for this inconvenience, but it is (practically) impossible to keep
- the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
+ This means: you may compare characters using #== ONLY IFF you are certain,
+ that the characters ranges is 0..255.
+ Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
+ Sorry for this inconvenience, but it is (practically) impossible to keep
+ the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
In ST/X, N is (currently) 1024. This means that all the latin characters and some others are
kept as singleton in the CharacterTable class variable (which is also used by the VM when characters
@@ -79,7 +77,7 @@
Some of these have been modified a bit.
WARNING: characters are known by compiler and runtime system -
- do not change the instance layout.
+ do not change the instance layout.
Also, although you can create subclasses of Character, the compiler always
creates instances of Character for literals ...
@@ -88,43 +86,43 @@
Therefore, it may not make sense to create a character-subclass.
Case Mapping in Unicode:
- There are a number of complications to case mappings that occur once the repertoire
- of characters is expanded beyond ASCII.
-
- * Because of the inclusion of certain composite characters for compatibility,
- such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
- which is used where the first letter of a word is to be capitalized
- (e.g. Titlecase, vs. UPPERCASE, or lowercase).
- For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
-
- * Case mappings may produce strings of different length than the original.
- For example, the German character U+00DF small letter sharp s expands when uppercased to
- the sequence of two characters 'SS'.
- This also occurs where there is no precomposed character corresponding to a case mapping.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may also have different case mappings, depending on the context.
- For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
- by another letter, but lowercases to 03C2 small final sigma if it is.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may have case mappings that depend on the locale.
- For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
- *** This is not yet implemented (in 5.2) ***
-
- * Case mappings are not, in general, reversible.
- For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
- the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
+ There are a number of complications to case mappings that occur once the repertoire
+ of characters is expanded beyond ASCII.
+
+ * Because of the inclusion of certain composite characters for compatibility,
+ such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
+ which is used where the first letter of a word is to be capitalized
+ (e.g. Titlecase, vs. UPPERCASE, or lowercase).
+ For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
+
+ * Case mappings may produce strings of different length than the original.
+ For example, the German character U+00DF small letter sharp s expands when uppercased to
+ the sequence of two characters 'SS'.
+ This also occurs where there is no precomposed character corresponding to a case mapping.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may also have different case mappings, depending on the context.
+ For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
+ by another letter, but lowercases to 03C2 small final sigma if it is.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may have case mappings that depend on the locale.
+ For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Case mappings are not, in general, reversible.
+ For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
+ the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
Collation Sequence:
- *** This is not yet implemented (in 5.2) ***
+ *** This is not yet implemented (in 5.2) ***
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- String TwoByteString Unicode16String Unicode32String
- StringCollection Text
+ String TwoByteString Unicode16String Unicode32String
+ StringCollection Text
"
! !
@@ -518,11 +516,11 @@
int c;
for (;;) {
- c = getchar();
- if (c >= 0) break;
- if (errno != EINTR) {
- RETURN (nil);
- }
+ c = getchar();
+ if (c >= 0) break;
+ if (errno != EINTR) {
+ RETURN (nil);
+ }
}
RETURN ( __MKCHARACTER(c & 0xFF) );
%}.
@@ -601,7 +599,6 @@
"
! !
-
!Character methodsFor:'Compatibility-Dolphin'!
isAlphaNumeric
@@ -649,8 +646,6 @@
or:[ (asciivalue == 247 ) ]]]]]
! !
-
-
!Character methodsFor:'accessing'!
codePoint
@@ -846,16 +841,16 @@
"return a character with same letter as the receiver, but in lowercase.
Returns the receiver if it is already lowercase or if there is no lowercase equivalent.
CAVEAT:
- for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
- (which is more than mozilla does, btw. ;-)"
+ for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
+ (which is more than mozilla does, btw. ;-)"
%{
#ifdef __SCHTEAM__
{
- char ch = self.charValue("[asLowercase]");
-
- ch = java.lang.Character.toLowerCase(ch);
- return context._RETURN(STCharacter._new(ch));
+ char ch = self.charValue("[asLowercase]");
+
+ ch = java.lang.Character.toLowerCase(ch);
+ return context._RETURN(STCharacter._new(ch));
}
/* NOTREACHED */
#else
@@ -996,42 +991,42 @@
// comon ascii stuff first
if (__codePoint < 0x80) {
- if ((__codePoint >= 'A') && (__codePoint <= 'Z')) {
- unsigned int newCodePoint = __codePoint - 'A' + 'a';
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- RETURN (self);
+ if ((__codePoint >= 'A') && (__codePoint <= 'Z')) {
+ unsigned int newCodePoint = __codePoint - 'A' + 'a';
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ RETURN (self);
}
for (__p = __mapping; (char *)__p < ((char *)__mapping) + sizeof(__mapping); __p += 3) {
- unsigned rangeStart, rangeSize, rangeEnd, mod;
-
- rangeStart = (unsigned)__p[0];
- if (__codePoint < rangeStart) break;
-
- rangeSize = ((unsigned)__p[1]) >> 8;
- rangeEnd = rangeStart + rangeSize;
- if (__codePoint <= rangeEnd) {
- mod = __p[1] & 0xFF;
- if ((mod == 0) || (((__codePoint - rangeStart) % mod) == 0)) {
- OBJ newChar;
- unsigned newCodePoint;
-
- newCodePoint = __codePoint + __p[2];
- if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- newChar = __MKUCHARACTER(newCodePoint) ;
- if (newChar == nil) goto allocationError;
- RETURN (newChar) ;
- }
- }
+ unsigned rangeStart, rangeSize, rangeEnd, mod;
+
+ rangeStart = (unsigned)__p[0];
+ if (__codePoint < rangeStart) break;
+
+ rangeSize = ((unsigned)__p[1]) >> 8;
+ rangeEnd = rangeStart + rangeSize;
+ if (__codePoint <= rangeEnd) {
+ mod = __p[1] & 0xFF;
+ if ((mod == 0) || (((__codePoint - rangeStart) % mod) == 0)) {
+ OBJ newChar;
+ unsigned newCodePoint;
+
+ newCodePoint = __codePoint + __p[2];
+ if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ newChar = __MKUCHARACTER(newCodePoint) ;
+ if (newChar == nil) goto allocationError;
+ RETURN (newChar) ;
+ }
+ }
}
RETURN (self);
allocationError: ;
#endif /* ! __SCHTEAM__ */
%}.
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
$A asLowercase
@@ -1125,41 +1120,41 @@
__codePoint = __intVal(__INST(asciivalue));
if ((__codePoint > 0x01C0) && (__codePoint < 0x01FF)) {
- for (__p = __mapping; (char *)__p < ((char *)__mapping) + sizeof(__mapping); __p += 2) {
- if ((__codePoint == __p[0]) || (__codePoint == __p[1])) {
- short newCodePoint;
- OBJ newChar;
-
- newCodePoint = __p[1];
- if (newCodePoint == __codePoint) {
- RETURN (self);
- }
- if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- newChar = __MKUCHARACTER(newCodePoint) ;
- if (newChar == nil) goto getOutOfHere;
- RETURN (newChar) ;
- }
- }
+ for (__p = __mapping; (char *)__p < ((char *)__mapping) + sizeof(__mapping); __p += 2) {
+ if ((__codePoint == __p[0]) || (__codePoint == __p[1])) {
+ short newCodePoint;
+ OBJ newChar;
+
+ newCodePoint = __p[1];
+ if (newCodePoint == __codePoint) {
+ RETURN (self);
+ }
+ if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ newChar = __MKUCHARACTER(newCodePoint) ;
+ if (newChar == nil) goto getOutOfHere;
+ RETURN (newChar) ;
+ }
+ }
}
if (__codePoint < 0x80) {
- // do it here for common ascii characters
- if ((__codePoint >= 'a') && (__codePoint <= 'z')) {
- unsigned char newCodePoint = __codePoint - 'a' + 'A';
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- RETURN (self) ;
+ // do it here for common ascii characters
+ if ((__codePoint >= 'a') && (__codePoint <= 'z')) {
+ unsigned char newCodePoint = __codePoint - 'a' + 'A';
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ RETURN (self) ;
}
-
+
ch = self;
getOutOfHere: ;
%}.
ch notNil ifTrue:[
- ^ ch asUppercase.
+ ^ ch asUppercase.
].
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
$A asTitlecase
@@ -1183,16 +1178,16 @@
"return a character with same letter as the receiver, but in uppercase.
Returns the receiver if it is already uppercase or if there is no uppercase equivalent.
CAVEAT:
- for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
- (which is more than mozilla does, btw. ;-)"
+ for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
+ (which is more than mozilla does, btw. ;-)"
%{
#ifdef __SCHTEAM__
{
- char ch = self.charValue("[asUppercase]");
-
- ch = java.lang.Character.toUpperCase(ch);
- return context._RETURN(STCharacter._new(ch));
+ char ch = self.charValue("[asUppercase]");
+
+ ch = java.lang.Character.toUpperCase(ch);
+ return context._RETURN(STCharacter._new(ch));
}
/* NOTREACHED */
#else
@@ -1342,47 +1337,47 @@
REGISTER int *__p;
__codePoint = __intVal(__INST(asciivalue));
-
+
// comon ascii stuff first
if (__codePoint < 0x80) {
- if ((__codePoint >= 'a') && (__codePoint <= 'z')) {
- unsigned newCodePoint;
-
- newCodePoint = __codePoint - 'a' + 'A';
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- RETURN (self);
+ if ((__codePoint >= 'a') && (__codePoint <= 'z')) {
+ unsigned newCodePoint;
+
+ newCodePoint = __codePoint - 'a' + 'A';
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ RETURN (self);
}
for (__p = __mapping; (char *)__p < ((char *)__mapping) + sizeof(__mapping); __p += 3) {
- unsigned rangeStart, rangeSize, rangeEnd, mod;
-
- rangeStart = (unsigned)__p[0];
- if (rangeStart > __codePoint) break;
-
- rangeSize = ((unsigned)__p[1]) >> 8;
- rangeEnd = rangeStart + rangeSize;
- if (__codePoint <= rangeEnd) {
- mod = __p[1] & 0xFF;
- if ((mod == 0) || (((__codePoint - rangeStart) % mod) == 0)) {
- OBJ newChar;
- unsigned newCodePoint;
-
- newCodePoint = __codePoint + __p[2];
- if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
- RETURN (__MKCHARACTER(newCodePoint)) ;
- }
- newChar = __MKUCHARACTER(newCodePoint) ;
- if (newChar == nil) goto allocationError;
- RETURN (newChar) ;
- }
- }
+ unsigned rangeStart, rangeSize, rangeEnd, mod;
+
+ rangeStart = (unsigned)__p[0];
+ if (rangeStart > __codePoint) break;
+
+ rangeSize = ((unsigned)__p[1]) >> 8;
+ rangeEnd = rangeStart + rangeSize;
+ if (__codePoint <= rangeEnd) {
+ mod = __p[1] & 0xFF;
+ if ((mod == 0) || (((__codePoint - rangeStart) % mod) == 0)) {
+ OBJ newChar;
+ unsigned newCodePoint;
+
+ newCodePoint = __codePoint + __p[2];
+ if (newCodePoint <= MAX_IMMEDIATE_CHARACTER) {
+ RETURN (__MKCHARACTER(newCodePoint)) ;
+ }
+ newChar = __MKUCHARACTER(newCodePoint) ;
+ if (newChar == nil) goto allocationError;
+ RETURN (newChar) ;
+ }
+ }
}
RETURN (self);
allocationError: ;
#endif /* ! __SCHTEAM__ */
%}.
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
$A asLowercase
@@ -1491,7 +1486,7 @@
|s|
asciivalue <= 16r7F ifTrue:[
- ^ self asString.
+ ^ self asString.
].
s := WriteStream on:(String new:6).
@@ -1499,8 +1494,8 @@
^ s contents
"
- 'ä' utf8Encoded
- 'a' utf8Encoded
+ 'ä' utf8Encoded
+ 'a' utf8Encoded
"
! !
@@ -1665,7 +1660,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
self storeOn:aGCOrStream.
@@ -1691,8 +1686,8 @@
%{ /* NOCONTEXT */
if (@global(Stdout) == nil) {
- putchar(__intVal(__INST(asciivalue)));
- RETURN(self);
+ putchar(__intVal(__INST(asciivalue)));
+ RETURN(self);
}
%}.
super print
@@ -1761,7 +1756,9 @@
!Character methodsFor:'queries'!
bitsPerCharacter
- "return the number of bits I require for storage"
+ "return the number of bits I require for storage.
+ (i.e. am I an Ascii/ISO8859-1 Character or will I need more
+ bits for storage."
asciivalue <= 16rFF ifTrue:[^ 8].
asciivalue <= 16rFFFF ifTrue:[^ 16].
@@ -1885,7 +1882,7 @@
val = __intVal(__INST(asciivalue));
if (val < ' ' || val == 0xFF) {
- RETURN ( true );
+ RETURN ( true );
}
RETURN (false);
%}.
@@ -2288,13 +2285,13 @@
val = __intVal(__INST(asciivalue));
if (val <= ' ')
- if ((val == ' ')
- || (val == '\n')
- || (val == '\t')
- || (val == '\r')
- || (val == '\f')) {
- RETURN ( true );
- }
+ if ((val == ' ')
+ || (val == '\n')
+ || (val == '\t')
+ || (val == '\r')
+ || (val == '\f')) {
+ RETURN ( true );
+ }
RETURN (false);
%}.
^ (asciivalue == 16r20)
@@ -2638,9 +2635,9 @@
"
$e asNonDiacritical
- $é asNonDiacritical
- $ä asNonDiacritical
- $Ã¥ asNonDiacritical
+ $é asNonDiacritical
+ $ä asNonDiacritical
+ $å asNonDiacritical
"
!
@@ -2670,8 +2667,8 @@
isNationalLetter
"return true, if the receiver is a letter.
CAVEAT:
- for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
- (which is more than mozilla does, btw. ;-)"
+ for now, this method is only correct for unicode characters up to u+1d6ff (Unicode3.1).
+ (which is more than mozilla does, btw. ;-)"
%{ /* NOCONTEXT */
@@ -2680,470 +2677,470 @@
/* because used so often, this is open coded, instead of table driven */
val = __intVal(__INST(asciivalue));
switch (val >> 8) {
- case 0x00:
- if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
- RETURN ( true );
- }
- if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
- RETURN ( true );
- }
- if (val == 0xAA) { RETURN (true); }
- if (val == 0xB5) { RETURN (true); }
- if (val == 0xBA) { RETURN (true); }
- if (val < 0xC0) { RETURN (false); }
- if (val == 0xD7) { RETURN (false); }
- if (val == 0xF7) { RETURN (false); }
- RETURN (true);
-
- case 0x01:
- RETURN (true);
-
- case 0x02:
+ case 0x00:
+ if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
+ RETURN ( true );
+ }
+ if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
+ RETURN ( true );
+ }
+ if (val == 0xAA) { RETURN (true); }
+ if (val == 0xB5) { RETURN (true); }
+ if (val == 0xBA) { RETURN (true); }
+ if (val < 0xC0) { RETURN (false); }
+ if (val == 0xD7) { RETURN (false); }
+ if (val == 0xF7) { RETURN (false); }
+ RETURN (true);
+
+ case 0x01:
+ RETURN (true);
+
+ case 0x02:
#ifdef UNICODE_3_2
- if (val <= 0x2B8) { RETURN (true); }
- if (val == 0x2B9) { RETURN (false); }
- if (val == 0x2BA) { RETURN (false); }
+ if (val <= 0x2B8) { RETURN (true); }
+ if (val == 0x2B9) { RETURN (false); }
+ if (val == 0x2BA) { RETURN (false); }
#else
- if (val <= 0x2BA) { RETURN (true); }
+ if (val <= 0x2BA) { RETURN (true); }
#endif
- if (val <= 0x2C1) { RETURN (true); }
+ if (val <= 0x2C1) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val <= 0x2C5) { RETURN (false); }
- if (val <= 0x2CF) { RETURN (true); }
+ if (val <= 0x2C5) { RETURN (false); }
+ if (val <= 0x2CF) { RETURN (true); }
#endif
- if (val == 0x2D0) { RETURN (true); }
- if (val == 0x2D1) { RETURN (true); }
- if (val <= 0x2DF) { RETURN (false); }
- if (val <= 0x2E4) { RETURN (true); }
- if (val == 0x2EE) { RETURN (true); }
- RETURN (false);
-
- case 0x03:
- if (val == 0x37A) { RETURN (true); }
- if (val <= 0x385) { RETURN (false); }
- if (val == 0x387) { RETURN (false); }
+ if (val == 0x2D0) { RETURN (true); }
+ if (val == 0x2D1) { RETURN (true); }
+ if (val <= 0x2DF) { RETURN (false); }
+ if (val <= 0x2E4) { RETURN (true); }
+ if (val == 0x2EE) { RETURN (true); }
+ RETURN (false);
+
+ case 0x03:
+ if (val == 0x37A) { RETURN (true); }
+ if (val <= 0x385) { RETURN (false); }
+ if (val == 0x387) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0x3F6) { RETURN (false); }
+ if (val == 0x3F6) { RETURN (false); }
#endif
- RETURN (true);
-
- case 0x04:
- if (val <= 0x481) { RETURN (true); }
- if (val <= 0x486) { RETURN (false); }
- if (val == 0x487) { RETURN (true); }
+ RETURN (true);
+
+ case 0x04:
+ if (val <= 0x481) { RETURN (true); }
+ if (val <= 0x486) { RETURN (false); }
+ if (val == 0x487) { RETURN (true); }
#ifdef UNICODE_3_2
- if (val <= 0x48A) { RETURN (false); }
+ if (val <= 0x48A) { RETURN (false); }
#else
- if (val <= 0x489) { RETURN (false); }
+ if (val <= 0x489) { RETURN (false); }
#endif
- RETURN (true);
-
- case 0x05:
- if (val <= 0x50f) { RETURN (true); }
- if (val <= 0x530) { RETURN (false); }
- if (val <= 0x556) { RETURN (true); }
- if (val <= 0x558) { RETURN (false); }
- if (val <= 0x559) { RETURN (true); }
- if (val <= 0x55F) { RETURN (false); }
- if (val <= 0x587) { RETURN (true); }
- if (val <= 0x5cf) { RETURN (false); }
- if (val <= 0x5f2) { RETURN (true); }
- RETURN (false);
-
- case 0x06:
- if (val <= 0x620) { RETURN (false); }
- if (val <= 0x64A) { RETURN (true); }
- if (val <= 0x66D) { RETURN (false); }
- if (val == 0x670) { RETURN (false); }
- if (val <= 0x6D3) { RETURN (true); }
- if (val == 0x6D5) { RETURN (true); }
- if (val == 0x6E5) { RETURN (true); }
- if (val == 0x6E6) { RETURN (true); }
- if (val == 0x6EE) { RETURN (true); }
- if (val == 0x6EF) { RETURN (true); }
- if (val == 0x6FA) { RETURN (true); }
- if (val == 0x6FB) { RETURN (true); }
- if (val == 0x6FC) { RETURN (true); }
+ RETURN (true);
+
+ case 0x05:
+ if (val <= 0x50f) { RETURN (true); }
+ if (val <= 0x530) { RETURN (false); }
+ if (val <= 0x556) { RETURN (true); }
+ if (val <= 0x558) { RETURN (false); }
+ if (val <= 0x559) { RETURN (true); }
+ if (val <= 0x55F) { RETURN (false); }
+ if (val <= 0x587) { RETURN (true); }
+ if (val <= 0x5cf) { RETURN (false); }
+ if (val <= 0x5f2) { RETURN (true); }
+ RETURN (false);
+
+ case 0x06:
+ if (val <= 0x620) { RETURN (false); }
+ if (val <= 0x64A) { RETURN (true); }
+ if (val <= 0x66D) { RETURN (false); }
+ if (val == 0x670) { RETURN (false); }
+ if (val <= 0x6D3) { RETURN (true); }
+ if (val == 0x6D5) { RETURN (true); }
+ if (val == 0x6E5) { RETURN (true); }
+ if (val == 0x6E6) { RETURN (true); }
+ if (val == 0x6EE) { RETURN (true); }
+ if (val == 0x6EF) { RETURN (true); }
+ if (val == 0x6FA) { RETURN (true); }
+ if (val == 0x6FB) { RETURN (true); }
+ if (val == 0x6FC) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x6FF) { RETURN (true); }
+ if (val == 0x6FF) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x07:
- if (val <= 0x70F) { RETURN (false); }
- if (val == 0x711) { RETURN (false); }
- if (val <= 0x72F) { RETURN (true); }
+ RETURN (false);
+
+ case 0x07:
+ if (val <= 0x70F) { RETURN (false); }
+ if (val == 0x711) { RETURN (false); }
+ if (val <= 0x72F) { RETURN (true); }
#ifdef UNICODE_3_2
- if (val <= 0x74d) { RETURN (false); }
- if (val <= 0x74e) { RETURN (true); }
+ if (val <= 0x74d) { RETURN (false); }
+ if (val <= 0x74e) { RETURN (true); }
#else
- if (val <= 0x74c) { RETURN (false); }
- if (val <= 0x74f) { RETURN (true); }
+ if (val <= 0x74c) { RETURN (false); }
+ if (val <= 0x74f) { RETURN (true); }
#endif
- if (val <= 0x77F) { RETURN (false); }
- if (val <= 0x7a5) { RETURN (true); }
- if (val <= 0x7af) { RETURN (false); }
+ if (val <= 0x77F) { RETURN (false); }
+ if (val <= 0x7a5) { RETURN (true); }
+ if (val <= 0x7af) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0x7B1) { RETURN (true); }
+ if (val == 0x7B1) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x09:
+ RETURN (false);
+
+ case 0x09:
#ifdef UNICODE_3_2
- if (val <= 0x904) { RETURN (false); }
+ if (val <= 0x904) { RETURN (false); }
#else
- if (val <= 0x903) { RETURN (false); }
+ if (val <= 0x903) { RETURN (false); }
#endif
- if (val <= 0x93B) { RETURN (true); }
- if (val == 0x93D) { RETURN (true); }
- if (val == 0x950) { RETURN (true); }
- if (val <= 0x957) { RETURN (false); }
- if (val <= 0x961) { RETURN (true); }
- if (val <= 0x984) { RETURN (false); }
- if (val <= 0x9BB) { RETURN (true); }
+ if (val <= 0x93B) { RETURN (true); }
+ if (val == 0x93D) { RETURN (true); }
+ if (val == 0x950) { RETURN (true); }
+ if (val <= 0x957) { RETURN (false); }
+ if (val <= 0x961) { RETURN (true); }
+ if (val <= 0x984) { RETURN (false); }
+ if (val <= 0x9BB) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x9BD) { RETURN (true); }
+ if (val == 0x9BD) { RETURN (true); }
#endif
- if (val <= 0x9DB) { RETURN (false); }
- if (val <= 0x9E1) { RETURN (true); }
- if (val <= 0x9EF) { RETURN (false); }
- if (val <= 0x9F1) { RETURN (true); }
- RETURN (false);
-
- case 0x0A:
- if (val <= 0xa04) { RETURN (false); }
- if (val <= 0xa3B) { RETURN (true); }
- if (val <= 0xa58) { RETURN (false); }
- if (val <= 0xa65) { RETURN (true); }
- if (val <= 0xa71) { RETURN (false); }
- if (val <= 0xa80) { RETURN (true); }
- if (val <= 0xa84) { RETURN (false); }
- if (val <= 0xaBB) { RETURN (true); }
- if (val == 0xaBD) { RETURN (true); }
- if (val <= 0xaCF) { RETURN (false); }
+ if (val <= 0x9DB) { RETURN (false); }
+ if (val <= 0x9E1) { RETURN (true); }
+ if (val <= 0x9EF) { RETURN (false); }
+ if (val <= 0x9F1) { RETURN (true); }
+ RETURN (false);
+
+ case 0x0A:
+ if (val <= 0xa04) { RETURN (false); }
+ if (val <= 0xa3B) { RETURN (true); }
+ if (val <= 0xa58) { RETURN (false); }
+ if (val <= 0xa65) { RETURN (true); }
+ if (val <= 0xa71) { RETURN (false); }
+ if (val <= 0xa80) { RETURN (true); }
+ if (val <= 0xa84) { RETURN (false); }
+ if (val <= 0xaBB) { RETURN (true); }
+ if (val == 0xaBD) { RETURN (true); }
+ if (val <= 0xaCF) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0xAE2) { RETURN (false); }
- if (val == 0xAE3) { RETURN (false); }
+ if (val == 0xAE2) { RETURN (false); }
+ if (val == 0xAE3) { RETURN (false); }
#endif
- if (val <= 0xaE5) { RETURN (true); }
- RETURN (false);
-
- case 0x0B:
- if (val <= 0xB04) { RETURN (false); }
- if (val <= 0xb3B) { RETURN (true); }
- if (val == 0xb3d) { RETURN (true); }
- if (val <= 0xb5B) { RETURN (false); }
- if (val <= 0xb65) { RETURN (true); }
+ if (val <= 0xaE5) { RETURN (true); }
+ RETURN (false);
+
+ case 0x0B:
+ if (val <= 0xB04) { RETURN (false); }
+ if (val <= 0xb3B) { RETURN (true); }
+ if (val == 0xb3d) { RETURN (true); }
+ if (val <= 0xb5B) { RETURN (false); }
+ if (val <= 0xb65) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0xB71) { RETURN (true); }
- if (val == 0xB83) { RETURN (true); }
+ if (val == 0xB71) { RETURN (true); }
+ if (val == 0xB83) { RETURN (true); }
#endif
- if (val <= 0xb84) { RETURN (false); }
- if (val <= 0xbBB) { RETURN (true); }
- RETURN (false);
-
- case 0x0c:
- if (val <= 0xc04) { RETURN (false); }
- if (val <= 0xc3d) { RETURN (true); }
- if (val <= 0xc5f) { RETURN (false); }
- if (val <= 0xc65) { RETURN (true); }
- if (val <= 0xc84) { RETURN (false); }
+ if (val <= 0xb84) { RETURN (false); }
+ if (val <= 0xbBB) { RETURN (true); }
+ RETURN (false);
+
+ case 0x0c:
+ if (val <= 0xc04) { RETURN (false); }
+ if (val <= 0xc3d) { RETURN (true); }
+ if (val <= 0xc5f) { RETURN (false); }
+ if (val <= 0xc65) { RETURN (true); }
+ if (val <= 0xc84) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0xcbc) { RETURN (false); }
+ if (val == 0xcbc) { RETURN (false); }
#endif
- if (val <= 0xcbd) { RETURN (true); }
- if (val <= 0xcdc) { RETURN (false); }
- if (val <= 0xce5) { RETURN (true); }
- RETURN (false);
-
- case 0x0d:
- if (val <= 0xd04) { RETURN (false); }
- if (val <= 0xd3d) { RETURN (true); }
- if (val <= 0xd5f) { RETURN (false); }
- if (val <= 0xd65) { RETURN (true); }
- if (val <= 0xd84) { RETURN (false); }
- if (val <= 0xdc9) { RETURN (true); }
- RETURN (false);
-
- case 0x0E:
- if (val == 0xE31) { RETURN (false); }
- if (val <= 0xE33) { RETURN (true); }
- if (val <= 0xE3F) { RETURN (false); }
- if (val <= 0xE46) { RETURN (true); }
- if (val <= 0xE7f) { RETURN (false); }
- if (val <= 0xEb0) { RETURN (true); }
- if (val == 0xEb1) { RETURN (false); }
- if (val <= 0xEb3) { RETURN (true); }
- if (val <= 0xEbc) { RETURN (false); }
- if (val <= 0xEc7) { RETURN (true); }
- if (val <= 0xEdb) { RETURN (false); }
- RETURN (true);
-
- case 0x0F:
- if (val == 0xf00) { RETURN (true); }
- if (val <= 0xf3F) { RETURN (false); }
- if (val <= 0xf70) { RETURN (true); }
- if (val <= 0xf87) { RETURN (false); }
- if (val <= 0xf8f) { RETURN (true); }
- RETURN (false);
-
- case 0x10:
- if (val <= 0x102b) { RETURN (true); }
- if (val <= 0x104f) { RETURN (false); }
- if (val <= 0x1055) { RETURN (true); }
- if (val <= 0x109f) { RETURN (false); }
- if (val <= 0x10fa) { RETURN (true); }
- RETURN (false);
-
- case 0x11:
- case 0x12:
- RETURN (true);
-
- case 0x13:
- if (val <= 0x1360) { RETURN (true); }
- if (val <= 0x139f) { RETURN (false); }
- RETURN (true);
-
- case 0x14:
- case 0x15:
- RETURN (true);
-
- case 0x16:
- if (val == 0x166d) { RETURN (false); }
- if (val == 0x166e) { RETURN (false); }
- if (val == 0x1680) { RETURN (false); }
- if (val == 0x169b) { RETURN (false); }
- if (val == 0x169c) { RETURN (false); }
- if (val <= 0x16ea) { RETURN (true); }
- RETURN (false);
-
- case 0x17:
+ if (val <= 0xcbd) { RETURN (true); }
+ if (val <= 0xcdc) { RETURN (false); }
+ if (val <= 0xce5) { RETURN (true); }
+ RETURN (false);
+
+ case 0x0d:
+ if (val <= 0xd04) { RETURN (false); }
+ if (val <= 0xd3d) { RETURN (true); }
+ if (val <= 0xd5f) { RETURN (false); }
+ if (val <= 0xd65) { RETURN (true); }
+ if (val <= 0xd84) { RETURN (false); }
+ if (val <= 0xdc9) { RETURN (true); }
+ RETURN (false);
+
+ case 0x0E:
+ if (val == 0xE31) { RETURN (false); }
+ if (val <= 0xE33) { RETURN (true); }
+ if (val <= 0xE3F) { RETURN (false); }
+ if (val <= 0xE46) { RETURN (true); }
+ if (val <= 0xE7f) { RETURN (false); }
+ if (val <= 0xEb0) { RETURN (true); }
+ if (val == 0xEb1) { RETURN (false); }
+ if (val <= 0xEb3) { RETURN (true); }
+ if (val <= 0xEbc) { RETURN (false); }
+ if (val <= 0xEc7) { RETURN (true); }
+ if (val <= 0xEdb) { RETURN (false); }
+ RETURN (true);
+
+ case 0x0F:
+ if (val == 0xf00) { RETURN (true); }
+ if (val <= 0xf3F) { RETURN (false); }
+ if (val <= 0xf70) { RETURN (true); }
+ if (val <= 0xf87) { RETURN (false); }
+ if (val <= 0xf8f) { RETURN (true); }
+ RETURN (false);
+
+ case 0x10:
+ if (val <= 0x102b) { RETURN (true); }
+ if (val <= 0x104f) { RETURN (false); }
+ if (val <= 0x1055) { RETURN (true); }
+ if (val <= 0x109f) { RETURN (false); }
+ if (val <= 0x10fa) { RETURN (true); }
+ RETURN (false);
+
+ case 0x11:
+ case 0x12:
+ RETURN (true);
+
+ case 0x13:
+ if (val <= 0x1360) { RETURN (true); }
+ if (val <= 0x139f) { RETURN (false); }
+ RETURN (true);
+
+ case 0x14:
+ case 0x15:
+ RETURN (true);
+
+ case 0x16:
+ if (val == 0x166d) { RETURN (false); }
+ if (val == 0x166e) { RETURN (false); }
+ if (val == 0x1680) { RETURN (false); }
+ if (val == 0x169b) { RETURN (false); }
+ if (val == 0x169c) { RETURN (false); }
+ if (val <= 0x16ea) { RETURN (true); }
+ RETURN (false);
+
+ case 0x17:
#ifndef UNICODE_3_2
- if (val == 0x1712) { RETURN (false); }
- if (val == 0x1713) { RETURN (false); }
- if (val == 0x1714) { RETURN (false); }
- if (val == 0x1732) { RETURN (false); }
- if (val == 0x1733) { RETURN (false); }
- if (val == 0x1734) { RETURN (false); }
- if (val == 0x1735) { RETURN (false); }
- if (val == 0x1736) { RETURN (false); }
- if (val == 0x1752) { RETURN (false); }
- if (val == 0x1753) { RETURN (false); }
- if (val == 0x1772) { RETURN (false); }
- if (val == 0x1773) { RETURN (false); }
+ if (val == 0x1712) { RETURN (false); }
+ if (val == 0x1713) { RETURN (false); }
+ if (val == 0x1714) { RETURN (false); }
+ if (val == 0x1732) { RETURN (false); }
+ if (val == 0x1733) { RETURN (false); }
+ if (val == 0x1734) { RETURN (false); }
+ if (val == 0x1735) { RETURN (false); }
+ if (val == 0x1736) { RETURN (false); }
+ if (val == 0x1752) { RETURN (false); }
+ if (val == 0x1753) { RETURN (false); }
+ if (val == 0x1772) { RETURN (false); }
+ if (val == 0x1773) { RETURN (false); }
#endif
- if (val <= 0x17b3) { RETURN (true); }
+ if (val <= 0x17b3) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x17D7) { RETURN (true); }
- if (val == 0x17DC) { RETURN (true); }
+ if (val == 0x17D7) { RETURN (true); }
+ if (val == 0x17DC) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x18:
- if (val <= 0x181f) { RETURN (false); }
- if (val <= 0x18a8) { RETURN (true); }
- RETURN (false);
-
- case 0x19:
+ RETURN (false);
+
+ case 0x18:
+ if (val <= 0x181f) { RETURN (false); }
+ if (val <= 0x18a8) { RETURN (true); }
+ RETURN (false);
+
+ case 0x19:
#ifndef UNICODE_3_2
- if (val <= 0x191F) { RETURN (true); }
- if (val <= 0x194F) { RETURN (false); }
- if (val <= 0x197F) { RETURN (true); }
+ if (val <= 0x191F) { RETURN (true); }
+ if (val <= 0x194F) { RETURN (false); }
+ if (val <= 0x197F) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x1d:
- if (val <= 0x1d6B) { RETURN (true); }
- RETURN (false);
-
- case 0x1e:
- RETURN (true);
-
- case 0x1f:
- if (val <= 0x1fbc) { RETURN (true); }
- if (val == 0x1fbe) { RETURN (true); }
- if (val <= 0x1fc1) { RETURN (false); }
- if (val <= 0x1fcc) { RETURN (true); }
- if (val <= 0x1fcf) { RETURN (false); }
- if (val <= 0x1fdc) { RETURN (true); }
- if (val <= 0x1fdf) { RETURN (false); }
- if (val <= 0x1fec) { RETURN (true); }
- if (val <= 0x1ff1) { RETURN (false); }
- if (val <= 0x1ffc) { RETURN (true); }
- RETURN (false);
-
- case 0x20:
+ RETURN (false);
+
+ case 0x1d:
+ if (val <= 0x1d6B) { RETURN (true); }
+ RETURN (false);
+
+ case 0x1e:
+ RETURN (true);
+
+ case 0x1f:
+ if (val <= 0x1fbc) { RETURN (true); }
+ if (val == 0x1fbe) { RETURN (true); }
+ if (val <= 0x1fc1) { RETURN (false); }
+ if (val <= 0x1fcc) { RETURN (true); }
+ if (val <= 0x1fcf) { RETURN (false); }
+ if (val <= 0x1fdc) { RETURN (true); }
+ if (val <= 0x1fdf) { RETURN (false); }
+ if (val <= 0x1fec) { RETURN (true); }
+ if (val <= 0x1ff1) { RETURN (false); }
+ if (val <= 0x1ffc) { RETURN (true); }
+ RETURN (false);
+
+ case 0x20:
#ifndef UNICODE_3_2
- if (val == 0x2071) { RETURN (true); }
+ if (val == 0x2071) { RETURN (true); }
#endif
- if (val == 0x207f) { RETURN (true); }
- RETURN (false);
-
- case 0x21:
- if (val == 0x2102) { RETURN (true); }
- if (val == 0x2107) { RETURN (true); }
- if (val <= 0x2109) { RETURN (false); }
- if (val <= 0x2113) { RETURN (true); }
- if (val == 0x2115) { RETURN (true); }
- if (val <= 0x2118) { RETURN (false); }
- if (val <= 0x211d) { RETURN (true); }
- if (val <= 0x2123) { RETURN (false); }
- if (val == 0x2125) { RETURN (false); }
- if (val == 0x2127) { RETURN (false); }
- if (val == 0x2129) { RETURN (false); }
- if (val == 0x212E) { RETURN (false); }
- if (val == 0x2132) { RETURN (false); }
- if (val == 0x213A) { RETURN (false); }
+ if (val == 0x207f) { RETURN (true); }
+ RETURN (false);
+
+ case 0x21:
+ if (val == 0x2102) { RETURN (true); }
+ if (val == 0x2107) { RETURN (true); }
+ if (val <= 0x2109) { RETURN (false); }
+ if (val <= 0x2113) { RETURN (true); }
+ if (val == 0x2115) { RETURN (true); }
+ if (val <= 0x2118) { RETURN (false); }
+ if (val <= 0x211d) { RETURN (true); }
+ if (val <= 0x2123) { RETURN (false); }
+ if (val == 0x2125) { RETURN (false); }
+ if (val == 0x2127) { RETURN (false); }
+ if (val == 0x2129) { RETURN (false); }
+ if (val == 0x212E) { RETURN (false); }
+ if (val == 0x2132) { RETURN (false); }
+ if (val == 0x213A) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0x213B) { RETURN (false); }
- if (val <= 0x213F) { RETURN (true); }
- if (val <= 0x2144) { RETURN (false); }
- if (val == 0x214A) { RETURN (false); }
- if (val == 0x214B) { RETURN (false); }
+ if (val == 0x213B) { RETURN (false); }
+ if (val <= 0x213F) { RETURN (true); }
+ if (val <= 0x2144) { RETURN (false); }
+ if (val == 0x214A) { RETURN (false); }
+ if (val == 0x214B) { RETURN (false); }
#endif
- if (val <= 0x2152) { RETURN (true); }
- RETURN (false);
-
- case 0x30:
- if (val == 0x3005) { RETURN (true); }
- if (val == 0x3006) { RETURN (true); }
- if (val <= 0x3030) { RETURN (false); }
- if (val <= 0x3035) { RETURN (true); }
+ if (val <= 0x2152) { RETURN (true); }
+ RETURN (false);
+
+ case 0x30:
+ if (val == 0x3005) { RETURN (true); }
+ if (val == 0x3006) { RETURN (true); }
+ if (val <= 0x3030) { RETURN (false); }
+ if (val <= 0x3035) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x303B) { RETURN (true); }
- if (val == 0x303C) { RETURN (true); }
+ if (val == 0x303B) { RETURN (true); }
+ if (val == 0x303C) { RETURN (true); }
#endif
- if (val <= 0x3040) { RETURN (false); }
- if (val <= 0x3098) { RETURN (true); }
- if (val <= 0x309c) { RETURN (false); }
+ if (val <= 0x3040) { RETURN (false); }
+ if (val <= 0x3098) { RETURN (true); }
+ if (val <= 0x309c) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0x30A0) { RETURN (false); }
+ if (val == 0x30A0) { RETURN (false); }
#endif
- if (val == 0x30Fb) { RETURN (false); }
- RETURN ((true));
-
- case 0x31:
- if (val <= 0x318f) { RETURN (true); }
- if (val <= 0x319F) { RETURN (false); }
- RETURN ((true));
-
- case 0x34:
- RETURN ((true));
-
- case 0x4d:
- if (val <= 0x4DB4) { RETURN (false); }
+ if (val == 0x30Fb) { RETURN (false); }
+ RETURN ((true));
+
+ case 0x31:
+ if (val <= 0x318f) { RETURN (true); }
+ if (val <= 0x319F) { RETURN (false); }
+ RETURN ((true));
+
+ case 0x34:
+ RETURN ((true));
+
+ case 0x4d:
+ if (val <= 0x4DB4) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val <= 0x4DBF) { RETURN (true); }
- RETURN (false);
+ if (val <= 0x4DBF) { RETURN (true); }
+ RETURN (false);
#else
- RETURN (true);
+ RETURN (true);
#endif
- case 0x4e:
- RETURN ((true));
-
- case 0x9f:
- if (val <= 0x9fa4) { RETURN (false); }
- RETURN (true);
-
- case 0xA0:
- case 0xA1:
- case 0xA2:
- case 0xA3:
- RETURN (true);
-
- case 0xA4:
- if (val <= 0xa48f) { RETURN (true); }
- RETURN (false);
-
- case 0xA5:
- RETURN (true);
-
- case 0xAC:
- RETURN (true);
-
- case 0xD7:
- RETURN (true);
-
- case 0xF9:
- case 0xFA:
- RETURN (true);
-
- case 0xFB:
- if (val == 0xfb1e) { RETURN (false); }
- if (val == 0xfb29) { RETURN (false); }
- RETURN (true);
-
- case 0xFC:
- RETURN (true);
-
- case 0xFD:
- if (val <= 0xFD3d) { RETURN (true); }
- if (val <= 0xFD4F) { RETURN (false); }
+ case 0x4e:
+ RETURN ((true));
+
+ case 0x9f:
+ if (val <= 0x9fa4) { RETURN (false); }
+ RETURN (true);
+
+ case 0xA0:
+ case 0xA1:
+ case 0xA2:
+ case 0xA3:
+ RETURN (true);
+
+ case 0xA4:
+ if (val <= 0xa48f) { RETURN (true); }
+ RETURN (false);
+
+ case 0xA5:
+ RETURN (true);
+
+ case 0xAC:
+ RETURN (true);
+
+ case 0xD7:
+ RETURN (true);
+
+ case 0xF9:
+ case 0xFA:
+ RETURN (true);
+
+ case 0xFB:
+ if (val == 0xfb1e) { RETURN (false); }
+ if (val == 0xfb29) { RETURN (false); }
+ RETURN (true);
+
+ case 0xFC:
+ RETURN (true);
+
+ case 0xFD:
+ if (val <= 0xFD3d) { RETURN (true); }
+ if (val <= 0xFD4F) { RETURN (false); }
#ifndef UNICODE_3_2
- if (val == 0xFDFC) { RETURN (false); }
- if (val == 0xFDFD) { RETURN (false); }
+ if (val == 0xFDFC) { RETURN (false); }
+ if (val == 0xFDFD) { RETURN (false); }
#endif
- RETURN (true);
-
- case 0xFE:
+ RETURN (true);
+
+ case 0xFE:
#ifndef UNICODE_3_2
- if (val <= 0xFE0F) { RETURN (false); }
+ if (val <= 0xFE0F) { RETURN (false); }
#endif
- if (val <= 0xFE1f) { RETURN (true); }
- if (val <= 0xFE6F) { RETURN (false); }
- if (val <= 0xFEFE) { RETURN (true); }
- RETURN (false);
-
- case 0xFF:
- if (val <= 0xFF20) { RETURN (false); }
- if (val <= 0xFF3a) { RETURN (true); }
- if (val <= 0xFF40) { RETURN (false); }
- if (val <= 0xFF5a) { RETURN (true); }
- if (val <= 0xFF65) { RETURN (false); }
- if (val <= 0xFFdC) { RETURN (true); }
- RETURN (false);
-
- case 0x100:
+ if (val <= 0xFE1f) { RETURN (true); }
+ if (val <= 0xFE6F) { RETURN (false); }
+ if (val <= 0xFEFE) { RETURN (true); }
+ RETURN (false);
+
+ case 0xFF:
+ if (val <= 0xFF20) { RETURN (false); }
+ if (val <= 0xFF3a) { RETURN (true); }
+ if (val <= 0xFF40) { RETURN (false); }
+ if (val <= 0xFF5a) { RETURN (true); }
+ if (val <= 0xFF65) { RETURN (false); }
+ if (val <= 0xFFdC) { RETURN (true); }
+ RETURN (false);
+
+ case 0x100:
#ifndef UNICODE_3_2
- RETURN (true);
+ RETURN (true);
#else
- RETURN (false);
+ RETURN (false);
#endif
- case 0x103:
- if (val <= 0x1031f) { RETURN (true); }
- if (val <= 0x1032F) { RETURN (false); }
- if (val <= 0x10349) { RETURN (true); }
+ case 0x103:
+ if (val <= 0x1031f) { RETURN (true); }
+ if (val <= 0x1032F) { RETURN (false); }
+ if (val <= 0x10349) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val <= 0x1037F) { RETURN (false); }
- if (val <= 0x1039E) { RETURN (true); }
+ if (val <= 0x1037F) { RETURN (false); }
+ if (val <= 0x1039E) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x104:
+ RETURN (false);
+
+ case 0x104:
#ifndef UNICODE_3_2
- if (val <= 0x1049F) { RETURN (true); }
- if (val <= 0x104aF) { RETURN (false); }
+ if (val <= 0x1049F) { RETURN (true); }
+ if (val <= 0x104aF) { RETURN (false); }
#endif
- RETURN (true);
-
- case 0x108:
+ RETURN (true);
+
+ case 0x108:
#ifndef UNICODE_3_2
- RETURN (true);
+ RETURN (true);
#else
- RETURN (false);
+ RETURN (false);
#endif
- case 0x1D4:
- case 0x1D5:
- RETURN (true);
-
- case 0x1D6:
- if (val == 0x1d6c1) { RETURN (false); }
- if (val == 0x1d6db) { RETURN (false); }
- if (val == 0x1d6fb) { RETURN (false); }
- RETURN (true);
+ case 0x1D4:
+ case 0x1D5:
+ RETURN (true);
+
+ case 0x1D6:
+ if (val == 0x1d6c1) { RETURN (false); }
+ if (val == 0x1d6db) { RETURN (false); }
+ if (val == 0x1d6fb) { RETURN (false); }
+ RETURN (true);
}
RETURN (false);
%}
@@ -3175,4 +3172,3 @@
version_CVS
^ '$Header$'
! !
-
--- a/CharacterArray.st Wed Oct 19 09:22:53 2016 +0100
+++ b/CharacterArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -2,7 +2,7 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -17,9 +17,9 @@
UninterpretedBytes variableByteSubclass:#CharacterArray
instanceVariableNames:''
- classVariableNames:'PreviousMatch DecoderTables EncoderTables DecodingFailedSignal
- EncodingFailedSignal UnicodeNormalizationMap
- UnicodeDenormalizationMap'
+ classVariableNames:'DecoderTables DecodingFailedSignal EncoderTables
+ EncodingFailedSignal PreviousMatches UnicodeDenormalizationMap
+ UnicodeNormalizationMap'
poolDictionaries:''
category:'Collections-Text'
!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -84,11 +84,11 @@
initialize
DecodingFailedSignal isNil ifTrue:[
- DecodingFailedSignal := DecodingError.
- DecodingFailedSignal notifierString:'error during decode'.
-
- EncodingFailedSignal :=EncodingError.
- EncodingFailedSignal notifierString:'error during encode'.
+ DecodingFailedSignal := DecodingError.
+ DecodingFailedSignal notifierString:'error during decode'.
+
+ EncodingFailedSignal :=EncodingError.
+ EncodingFailedSignal notifierString:'error during encode'.
]
"
@@ -138,20 +138,20 @@
nBytes := aByteCollection size.
mySize := self basicNew bitsPerCharacter.
mySize == 16 ifTrue:[
- newString := self uninitializedNew:(nBytes // 2).
- dstIdx := 1.
- msb ifTrue:[
- aByteCollection pairWiseDo:[:hi :lo |
- newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
- dstIdx := dstIdx + 1
- ].
- ] ifFalse:[
- aByteCollection pairWiseDo:[:lo :hi |
- newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
- dstIdx := dstIdx + 1
- ].
- ].
- ^ newString.
+ newString := self uninitializedNew:(nBytes // 2).
+ dstIdx := 1.
+ msb ifTrue:[
+ aByteCollection pairWiseDo:[:hi :lo |
+ newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
+ dstIdx := dstIdx + 1
+ ].
+ ] ifFalse:[
+ aByteCollection pairWiseDo:[:lo :hi |
+ newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
+ dstIdx := dstIdx + 1
+ ].
+ ].
+ ^ newString.
].
^ (self uninitializedNew:nBytes) replaceFrom:1 with:aByteCollection
@@ -172,7 +172,7 @@
^ (self uninitializedNew:sz) replaceFrom:1 to:sz with:aString startingAt:1
"
- Unicode16String fromString:'hello'
+ Unicode16String fromString:'hello'
"
!
@@ -194,13 +194,13 @@
|stream|
aCollectionOfStrings do:[:eachString |
- stream isNil ifTrue:[
- stream := self writeStreamClass with:eachString.
- ] ifFalse:[
- stream
- nextPutAll:aSeparatorString;
- nextPutAll:eachString.
- ].
+ stream isNil ifTrue:[
+ stream := self writeStreamClass with:eachString.
+ ] ifFalse:[
+ stream
+ nextPutAll:aSeparatorString;
+ nextPutAll:eachString.
+ ].
].
stream isNil ifTrue:[^ ''].
^ stream contents
@@ -260,25 +260,25 @@
str skipSeparators.
(str peekOrNil == $') ifTrue:[
- str next.
- collected := self writeStream.
- [str atEnd] whileFalse:[
- char := str next.
- char == $' ifTrue:[
- "/ look for another quote
- str peekOrNil ~~ $' ifTrue:[
- "end of string reached"
- ^ collected contents.
- ].
- "eat doubled quote"
- str next.
- ].
- ((char ~~ Character return) or:[str peekOrNil ~~ Character lf]) ifTrue:[
- "compress CRLF to LF, but keep a single CR"
- collected nextPut:char.
- ].
- ].
- "if we come here, we reached the end without finding a closing $'"
+ str next.
+ collected := self writeStream.
+ [str atEnd] whileFalse:[
+ char := str next.
+ char == $' ifTrue:[
+ "/ look for another quote
+ str peekOrNil ~~ $' ifTrue:[
+ "end of string reached"
+ ^ collected contents.
+ ].
+ "eat doubled quote"
+ str next.
+ ].
+ ((char ~~ Character return) or:[str peekOrNil ~~ Character lf]) ifTrue:[
+ "compress CRLF to LF, but keep a single CR"
+ collected nextPut:char.
+ ].
+ ].
+ "if we come here, we reached the end without finding a closing $'"
].
^ exceptionBlock value
@@ -318,7 +318,7 @@
new := self new: anArray size.
1 to: anArray size do:[:index |
- new at: index put: (anArray at: index) asCharacter
+ new at: index put: (anArray at: index) asCharacter
].
^new
@@ -351,6 +351,7 @@
"Created: 3.8.1997 / 18:16:40 / cg"
! !
+
!CharacterArray class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -552,8 +553,17 @@
!
setupNormalizationMaps
- "returns a 2-stage map from ch2 -> ch1 -> mappedChar
- for unicode normalization (i.e. for making combining chars regular ones)"
+ "returns a 2-stage map from ch2 -> ch1 -> mappedChar.
+ for unicode normalization
+ (i.e. for replacing combining char-sequences with regular characters).
+ ch2 is the combining charCode (eg. 0x0308), ch1 is the previous character (eg. $A),
+ mappedChar is the result (eg. $Ä).
+ Caveat:
+ possibly incomplete: only COMBINING_DIACRITICAL_MARKS are cared for.
+ Does not care for COMBINING_DIACRITICAL_MARKS_EXTENDED
+ and COMBINING_DIACRITICAL_MARKS_SUPPLEMENT.
+ However; those are used for German dialectology, ancient Greek and other similar
+ exotic uses. Probably noone will ever even notice that they are missing..."
|def|
@@ -586,7 +596,13 @@
unicodeDenormalizationMap
"returns a 2-stage map from ch2 -> ch1 -> mappedChar
- for unicode normalization (i.e. for making combining chars regular ones)"
+ for unicode normalization (i.e. for making combining chars regular ones).
+ Caveat:
+ possibly incomplete: only COMBINING_DIACRITICAL_MARKS are cared for.
+ Does not care for COMBINING_DIACRITICAL_MARKS_EXTENDED
+ and COMBINING_DIACRITICAL_MARKS_SUPPLEMENT.
+ However; those are used for German dialectology, ancient Greek and other similar
+ exotic uses. Probably noone will ever even notice that they are missing..."
UnicodeDenormalizationMap isNil ifTrue:[
self setupNormalizationMaps
@@ -600,7 +616,13 @@
unicodeNormalizationMap
"returns a 2-stage map from ch2 -> ch1 -> mappedChar
- for unicode normalization (i.e. for making combining chars regular ones)"
+ for unicode normalization (i.e. for making combining chars regular ones).
+ Caveat:
+ possibly incomplete: only COMBINING_DIACRITICAL_MARKS are cared for.
+ Does not care for COMBINING_DIACRITICAL_MARKS_EXTENDED
+ and COMBINING_DIACRITICAL_MARKS_SUPPLEMENT.
+ However; those are used for German dialectology, ancient Greek and other similar
+ exotic uses. Probably noone will ever even notice that they are missing..."
UnicodeNormalizationMap isNil ifTrue:[
self setupNormalizationMaps
@@ -650,160 +672,160 @@
"/ Transcript showCR:('match: ''' , (aString copyFrom:sStart to:sStop) ,
"/ ''' against:' , (matchScanArray copyFrom:mStart to:mStop) printString).
- mSize := mStop - mStart + 1.
- sSize := sStop - sStart + 1.
-
- "empty strings match"
- (mSize == 0) ifTrue:[^ (sSize == 0)].
-
- matchEntry := matchScanArray at:mStart.
-
- "/ the most common case first:
- (sSize ~~ 0
- and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #any) ifTrue:[
- "restString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
- "# matches single character"
- ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #anyString) ifTrue:[
- "* alone matches anything"
- (mSize == 1) ifTrue:[^ true].
- "restString empty & matchString not empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- "
- try to avoid some of the recursion by checking last
- character and continue with shortened strings if possible
- "
- quickCheck := false.
- (mStop >= mStart) ifTrue:[
- matchLast := matchScanArray at:mStop.
- (matchLast ~~ #anyString) ifTrue:[
- (matchLast == #any) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast == (aString at:sStop) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast isString ifTrue:[
- quickCheck := matchLast includes:(aString at:sStop)
- ]
- ]
- ]
- ]
- ].
- quickCheck ifTrue:[
- "
- quickCheck ok, advance from the right
- "
- mStop := mStop - 1.
- sStop := sStop - 1
- ] ifFalse:[
- "/ no quick check;
- "/ look for the next character(s)
- "/ and try matching there
- "/ (to avoid recursion)
-
- mStart < mStop ifTrue:[
- nextMatchEntry := matchScanArray at:mStart+1.
- nextMatchEntry isCharacter ifTrue:[
- sStart <= sStop ifTrue:[
- [
- caseSensitive ifTrue:[
- index := aString indexOf:nextMatchEntry startingAt:sStart
- ] ifFalse:[
- index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
- startingAt:sStart.
- ].
- (index == 0 or:[index > sStop]) ifTrue:[
- ^ false
- ].
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- caseSensitive:caseSensitive
- ) ifTrue:[
- ^ true
- ].
- sStart := index + 1.
- ] loop.
- ]
- ]
- ].
-
- "
- no quick check possible;
- loop over all possible substrings
- "
- index := sStart.
- [index <= sStop] whileTrue:[
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- caseSensitive:caseSensitive
- ) ifTrue:[
- ^ true
- ].
- index := index + 1
- ].
- ^ false
- ].
- ] ifFalse:[
- (matchEntry isString) ifTrue:[
- "testString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- included := false.
- "/ checkChar := aString at:sStart.
- included := matchEntry includes:checkChar.
- included ifFalse:[
- caseSensitive ifFalse:[
- checkChar isUppercase ifTrue:[
- included := matchEntry includes:checkChar asLowercase.
- ] ifFalse:[
- included := matchEntry includes:checkChar asUppercase.
- ]
- ].
- ].
- mStart := mStart + 1.
- mSize := mSize - 1.
- included ifFalse:[^ false].
-
- ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
- ] ifFalse:[
- "/ must be single character
-
- "testString empty ?"
- (sSize == 0) ifTrue:[^ false].
-
- "first characters equal ?"
- "/ checkChar := aString at:sStart.
- caseSensitive ifTrue:[^ false].
- (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
-
- "advance and continue"
- mStart := mStart + 1.
- ].
- "cut off 1st char and continue"
- sStart := sStart + 1
- ]
- ]
- ]
+ mSize := mStop - mStart + 1.
+ sSize := sStop - sStart + 1.
+
+ "empty strings match"
+ (mSize == 0) ifTrue:[^ (sSize == 0)].
+
+ matchEntry := matchScanArray at:mStart.
+
+ "/ the most common case first:
+ (sSize ~~ 0
+ and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #any) ifTrue:[
+ "restString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+ "# matches single character"
+ ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #anyString) ifTrue:[
+ "* alone matches anything"
+ (mSize == 1) ifTrue:[^ true].
+ "restString empty & matchString not empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ "
+ try to avoid some of the recursion by checking last
+ character and continue with shortened strings if possible
+ "
+ quickCheck := false.
+ (mStop >= mStart) ifTrue:[
+ matchLast := matchScanArray at:mStop.
+ (matchLast ~~ #anyString) ifTrue:[
+ (matchLast == #any) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast == (aString at:sStop) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast isString ifTrue:[
+ quickCheck := matchLast includes:(aString at:sStop)
+ ]
+ ]
+ ]
+ ]
+ ].
+ quickCheck ifTrue:[
+ "
+ quickCheck ok, advance from the right
+ "
+ mStop := mStop - 1.
+ sStop := sStop - 1
+ ] ifFalse:[
+ "/ no quick check;
+ "/ look for the next character(s)
+ "/ and try matching there
+ "/ (to avoid recursion)
+
+ mStart < mStop ifTrue:[
+ nextMatchEntry := matchScanArray at:mStart+1.
+ nextMatchEntry isCharacter ifTrue:[
+ sStart <= sStop ifTrue:[
+ [
+ caseSensitive ifTrue:[
+ index := aString indexOf:nextMatchEntry startingAt:sStart
+ ] ifFalse:[
+ index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
+ startingAt:sStart.
+ ].
+ (index == 0 or:[index > sStop]) ifTrue:[
+ ^ false
+ ].
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ sStart := index + 1.
+ ] loop.
+ ]
+ ]
+ ].
+
+ "
+ no quick check possible;
+ loop over all possible substrings
+ "
+ index := sStart.
+ [index <= sStop] whileTrue:[
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ index := index + 1
+ ].
+ ^ false
+ ].
+ ] ifFalse:[
+ (matchEntry isString) ifTrue:[
+ "testString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ included := false.
+ "/ checkChar := aString at:sStart.
+ included := matchEntry includes:checkChar.
+ included ifFalse:[
+ caseSensitive ifFalse:[
+ checkChar isUppercase ifTrue:[
+ included := matchEntry includes:checkChar asLowercase.
+ ] ifFalse:[
+ included := matchEntry includes:checkChar asUppercase.
+ ]
+ ].
+ ].
+ mStart := mStart + 1.
+ mSize := mSize - 1.
+ included ifFalse:[^ false].
+
+ ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
+ ] ifFalse:[
+ "/ must be single character
+
+ "testString empty ?"
+ (sSize == 0) ifTrue:[^ false].
+
+ "first characters equal ?"
+ "/ checkChar := aString at:sStart.
+ caseSensitive ifTrue:[^ false].
+ (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
+
+ "advance and continue"
+ mStart := mStart + 1.
+ ].
+ "cut off 1st char and continue"
+ sStart := sStart + 1
+ ]
+ ]
+ ]
] loop.
"
@@ -812,13 +834,13 @@
scanArray := self matchScanArrayFrom:'*hello'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- caseSensitive:true
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
"
"
|scanArray s|
@@ -826,13 +848,13 @@
scanArray := self matchScanArrayFrom:'*hello*'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- caseSensitive:true
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
"
"Modified: / 24-07-2011 / 07:17:03 / cg"
@@ -850,7 +872,7 @@
pattern matching package should be added."
^ self
- matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:ignoreCase not
+ matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:ignoreCase not
"
|scanArray s|
@@ -858,13 +880,13 @@
scanArray := self matchScanArrayFrom:'*hello'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
"
"
|scanArray s|
@@ -872,13 +894,13 @@
scanArray := self matchScanArrayFrom:'*hello*'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
"
"Modified: / 24-07-2011 / 07:17:03 / cg"
@@ -923,61 +945,61 @@
coll := OrderedCollection new.
idx := 1. end := aString size.
[idx <= end] whileTrue:[
- |char this|
-
- char := aString at:idx.
- char == $* ifTrue:[
- previous ~~ #anyString ifTrue:[
- this := #anyString
- ]
- ] ifFalse:[
- char == $# ifTrue:[
- previous ~~ #anyString ifTrue:[
- this := #any
- ]
- ] ifFalse:[
- char == $[ ifTrue:[
- matchSet := IdentitySet new.
- idx := idx + 1.
- idx > end ifTrue:[^ nil].
- char := aString at:idx.
- c1 := nil.
- [char ~~ $]] whileTrue:[
- ((char == $-) and:[c1 notNil]) ifTrue:[
- idx := idx + 1.
- idx > end ifTrue:[^ nil].
- c2 := aString at:idx.
- c1 to:c2 do:[:c | matchSet add:c].
- c1 := nil.
- idx := idx + 1.
- ] ifFalse:[
- (char ~~ $]) ifTrue:[
- matchSet add:char.
- c1 := char.
- idx := idx + 1
- ]
- ].
- idx > end ifTrue:[^ nil].
- char := aString at:idx
- ].
- this := matchSet asString
- ] ifFalse:[
- char == escape ifTrue:[
- idx := idx + 1.
- idx > end ifTrue:[
- "/ mhmh - what should we do here ?
- this := char
- ] ifFalse:[
- this := aString at:idx.
- ]
- ] ifFalse:[
- this := char
- ]
- ]
- ]
- ].
- this notNil ifTrue:[coll add:this. previous := this].
- idx := idx + 1
+ |char this|
+
+ char := aString at:idx.
+ char == $* ifTrue:[
+ previous ~~ #anyString ifTrue:[
+ this := #anyString
+ ]
+ ] ifFalse:[
+ char == $# ifTrue:[
+ previous ~~ #anyString ifTrue:[
+ this := #any
+ ]
+ ] ifFalse:[
+ char == $[ ifTrue:[
+ matchSet := IdentitySet new.
+ idx := idx + 1.
+ idx > end ifTrue:[^ nil].
+ char := aString at:idx.
+ c1 := nil.
+ [char ~~ $]] whileTrue:[
+ ((char == $-) and:[c1 notNil]) ifTrue:[
+ idx := idx + 1.
+ idx > end ifTrue:[^ nil].
+ c2 := aString at:idx.
+ c1 to:c2 do:[:c | matchSet add:c].
+ c1 := nil.
+ idx := idx + 1.
+ ] ifFalse:[
+ (char ~~ $]) ifTrue:[
+ matchSet add:char.
+ c1 := char.
+ idx := idx + 1
+ ]
+ ].
+ idx > end ifTrue:[^ nil].
+ char := aString at:idx
+ ].
+ this := matchSet asString
+ ] ifFalse:[
+ char == escape ifTrue:[
+ idx := idx + 1.
+ idx > end ifTrue:[
+ "/ mhmh - what should we do here ?
+ this := char
+ ] ifFalse:[
+ this := aString at:idx.
+ ]
+ ] ifFalse:[
+ this := char
+ ]
+ ]
+ ]
+ ].
+ this notNil ifTrue:[coll add:this. previous := this].
+ idx := idx + 1
].
^ coll asArray
@@ -1040,18 +1062,18 @@
ds := WriteStream on:(self species new).
self do:[:eachChar |
- |repl|
-
- repl := expandTable at:eachChar ifAbsent:[nil].
- repl isNil ifTrue:[
- ds nextPut:eachChar
- ] ifFalse:[
- repl size == 0 ifTrue:[
- ds nextPut:repl
- ] ifFalse:[
- ds nextPutAll:repl
- ]
- ].
+ |repl|
+
+ repl := expandTable at:eachChar ifAbsent:[nil].
+ repl isNil ifTrue:[
+ ds nextPut:eachChar
+ ] ifFalse:[
+ repl size == 0 ifTrue:[
+ ds nextPut:repl
+ ] ifFalse:[
+ ds nextPutAll:repl
+ ]
+ ].
].
^ ds contents.
!
@@ -1101,10 +1123,10 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- % #('smalltalk' 'c++' 'c')
+ % #('smalltalk' 'c++' 'c')
'do you %(what) ?'
- % (Dictionary new at:#'what' put:'understand'; yourself)
+ % (Dictionary new at:#'what' put:'understand'; yourself)
"
! !
@@ -1124,7 +1146,7 @@
'1 one two three four 5 five' asArrayOfSubstrings
'1
one
- two three four 5 five' asArrayOfSubstrings
+ two three four 5 five' asArrayOfSubstrings
"
!
@@ -1179,11 +1201,11 @@
tmpStream := self species writeStream.
self do:[:element |
- element = oldChar ifTrue:[
- tmpStream nextPutAll:newString
- ] ifFalse:[
- tmpStream nextPut:element
- ].
+ element = oldChar ifTrue:[
+ tmpStream nextPutAll:newString
+ ] ifFalse:[
+ tmpStream nextPut:element
+ ].
].
^ tmpStream contents
@@ -1206,7 +1228,7 @@
'12345678901234567890' replString:'234' withString:'foo'
('a string with spaces' replChar:$ withString:' foo ')
- replString:'foo' withString:'bar'
+ replString:'foo' withString:'bar'
"
"Modified: / 12-05-2004 / 12:00:27 / cg"
@@ -1255,40 +1277,6 @@
"
!
-asOneByteString
- "return the receiver converted to a 'normal' string.
- Same as asSingleByteString - for Squeak/Pharo compatibility."
-
- ^ self asSingleByteString
-!
-
-asUrl
- "Same as asURL - for Squeak/Pharo compatibility."
-
- ^ self asURL
-!
-
-asWideString
- "return a two-byte string containing the same characters as the receiver.
- Same as asTwoByteString - for Squeak/Pharo compatibility."
-
- ^ self asTwoByteString
-
- "
- 'abc' asWideString
- "
-!
-
-capitalized
- "same as asUppercaseFirst for Squeak/Pharo compatibility"
-
- ^ self asUppercaseFirst
-
- "
- 'hello' capitalized
- "
-!
-
caseInsensitiveLessOrEqual:aString
"compare the receiver against the argument ignoring case differences
For Squeak/Pharo compatibility"
@@ -1311,10 +1299,10 @@
nMax :=(self size) min:(aString size).
idx := 1.
[idx <= nMax] whileTrue:[
- (self at:idx) = (aString at:idx) ifFalse:[
- ^ idx - 1
- ].
- idx := idx + 1.
+ (self at:idx) = (aString at:idx) ifFalse:[
+ ^ idx - 1
+ ].
+ idx := idx + 1.
].
^ nMax
@@ -1332,7 +1320,7 @@
|len|
- ^ (len := self size) > 0 and: [(self at:len) isDigit]
+ ^ (len := self size) ~~ 0 and:[(self at:len) isDigit]
!
findDelimiters:delimiters startingAt:start
@@ -1358,9 +1346,9 @@
"cg: I am not sure, if this is really the squeak semantics (w.r.t. empty fields)"
delimiterOrDelimiters size == 0 ifTrue:[
- ^ self asCollectionOfSubstringsSeparatedBy:delimiterOrDelimiters
+ ^ self asCollectionOfSubstringsSeparatedBy:delimiterOrDelimiters
] ifFalse:[
- ^ self asCollectionOfSubstringsSeparatedByAny:delimiterOrDelimiters
+ ^ self asCollectionOfSubstringsSeparatedByAny:delimiterOrDelimiters
].
"
@@ -1409,7 +1397,7 @@
"/ for now, a q&d hack ...
caseSensitive ifFalse:[
- ^ self asLowercase includesString:aString asLowercase
+ ^ self asLowercase includesString:aString asLowercase
].
^ self includesString:aString
@@ -1437,9 +1425,17 @@
"return the index of the last space character; 0 if there is none.
Added for Squeak/Pharo compatibility"
+ "/ CG: is this correct? separator or space only???
^ self lastIndexOfSeparator
!
+linesDo:aBlock
+ "evaluate the argument, aBlock for all lines,
+ up to the end"
+
+ ^ self readStream linesDo:aBlock
+!
+
padded:leftOrRight to:paddedSize with:padCharacter
"pad left (leftOrRight == #left) or right"
@@ -1463,7 +1459,7 @@
Assumes the delimiters to be a non-empty string."
start to:self size do:[:i |
- delimiters detect:[:delim | delim = (self at:i) ] ifNone:[ ^ i ]
+ delimiters detect:[:delim | delim = (self at:i) ] ifNone:[ ^ i ]
].
^ self size + 1
@@ -1538,31 +1534,31 @@
listOfLines _ OrderedCollection new.
currentLast _ 0.
[currentLast < self size] whileTrue:
- [currentStart _ currentLast + 1.
- putativeLast _ (currentStart + aNumber - 1) min: self size.
- putativeLine _ self copyFrom: currentStart to: putativeLast.
- (crPosition _ putativeLine indexOf: Character cr) > 0 ifTrue:
- [putativeLast _ currentStart + crPosition - 1.
- putativeLine _ self copyFrom: currentStart to: putativeLast].
- currentLast _ putativeLast == self size
- ifTrue:
- [putativeLast]
- ifFalse:
- [currentStart + putativeLine lastSpacePosition - 1].
- currentLast <= currentStart ifTrue:
- ["line has NO spaces; baleout!!"
- currentLast _ putativeLast].
- listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].
+ [currentStart _ currentLast + 1.
+ putativeLast _ (currentStart + aNumber - 1) min: self size.
+ putativeLine _ self copyFrom: currentStart to: putativeLast.
+ (crPosition _ putativeLine indexOf: Character cr) > 0 ifTrue:
+ [putativeLast _ currentStart + crPosition - 1.
+ putativeLine _ self copyFrom: currentStart to: putativeLast].
+ currentLast _ putativeLast == self size
+ ifTrue:
+ [putativeLast]
+ ifFalse:
+ [currentStart + putativeLine lastSpacePosition - 1].
+ currentLast <= currentStart ifTrue:
+ ["line has NO spaces; baleout!!"
+ currentLast _ putativeLast].
+ listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].
listOfLines size > 0 ifFalse: [^ ''].
resultString _ listOfLines first.
2 to: listOfLines size do:
- [:i | resultString _ resultString, Character cr asString, (listOfLines at: i)].
+ [:i | resultString _ resultString, Character cr asString, (listOfLines at: i)].
^ resultString
"
#(5 7 20) collect:
- [:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]
+ [:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]
"
!
@@ -1638,7 +1634,7 @@
"
'do you prefer %1 or rather %2 ?'
- bindWith:'smalltalk' with:'c++'
+ bindWith:'smalltalk' with:'c++'
"
!
@@ -1651,7 +1647,7 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- bindWith:'smalltalk' with:'c++' with:'c'
+ bindWith:'smalltalk' with:'c++' with:'c'
"
!
@@ -1664,7 +1660,7 @@
"
'do you prefer %1 or rather %2 (not talking about %3 or even %4) ?'
- bindWith:'smalltalk' with:'c++' with:'c' with:'assembler'
+ bindWith:'smalltalk' with:'c++' with:'c' with:'assembler'
"
!
@@ -1684,8 +1680,8 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6)
+ with:str3 with:str4
+ with:str5 with:str6)
!
bindWith:str1 with:str2 with:str3 with:str4 with:str5 with:str6 with:str7
@@ -1694,9 +1690,9 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7)
!
bindWith:str1 with:str2 with:str3 with:str4 with:str5 with:str6 with:str7 with:str8
@@ -1705,9 +1701,9 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7 with:str8)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7 with:str8)
"Created: / 06-02-2012 / 10:33:18 / cg"
!
@@ -1718,10 +1714,10 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7 with:str8
- with:str9)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7 with:str8
+ with:str9)
"Created: / 14-02-2012 / 17:42:31 / cg"
!
@@ -1736,10 +1732,10 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- bindWithArguments:#('smalltalk' 'c++' 'c')
+ bindWithArguments:#('smalltalk' 'c++' 'c')
'do you %(what) ?'
- bindWithArguments:(Dictionary new at:#'what' put:'understand'; yourself)
+ bindWithArguments:(Dictionary new at:#'what' put:'understand'; yourself)
"
!
@@ -1763,7 +1759,7 @@
and has been added for VisualAge compatibility."
separatorCharacterOrString isCharacter ifTrue:[
- ^ self asCollectionOfSubstringsSeparatedBy:separatorCharacterOrString
+ ^ self asCollectionOfSubstringsSeparatedBy:separatorCharacterOrString
].
^ self asCollectionOfSubstringsSeparatedByAny:separatorCharacterOrString
@@ -1866,94 +1862,94 @@
out := CharacterWriteStream on:(self species uninitializedNew:self size).
[in atEnd] whileFalse:[
- c := in next.
- c == $% ifTrue:[
- c := in next.
- out nextPut:c
- ] ifFalse:[c ~~ $< ifTrue:[
- out nextPut:c.
- ] ifFalse:[
- peekc := in peek.
- [peekc == $<] whileTrue:[
- out nextPut:$<.
- peekc := in nextPeek.
- ].
- peekc == $n ifTrue:[
- peekc := in nextPeek.
- peekc == $> ifTrue:[
- in next.
- out cr.
- ] ifFalse:[
- out nextPutAll:'<n'.
- ]
- ] ifFalse:[peekc == $t ifTrue:[
- peekc := in nextPeek.
- peekc == $> ifTrue:[
- in next.
- out tab.
- ] ifFalse:[
- out nextPutAll:'<t'.
- ]
- ] ifFalse:[
- peekc isDigit ifTrue:[
- "start an argument expansion ..."
- nr := Integer readFrom:in onError:nil.
- nr isNil ifTrue:[
- "this cannot happen (there is at least one digit)"
- self error:'invalid format' mayProceed:true.
- ^ self
- ].
- fmt := in next.
- (fmt ~~ $? and:[in peek ~~ $>]) ifTrue:[
- out nextPut:$<.
- nr printOn:out.
- out nextPut:fmt.
- ] ifFalse:[
- (nr between:1 and:argArray size) ifTrue:[
- arg := argArray at:nr.
- ] ifFalse:[
- arg := ''
- ].
-
- fmt == $p ifTrue:[
- "expand with args printString"
- arg printOn:out.
- ] ifFalse:[fmt == $s ifTrue:[
- "expand with arg itself"
- arg isText ifTrue:[
- out contentsSpecies isText ifFalse:[
- out := (TextStream ? CharacterWriteStream on:Text new) nextPutAll:out contents; yourself.
- ].
- out nextPutAll:arg.
- ] ifFalse:[
- out nextPutAll:arg asString string. "see method comment: arg must know #asString"
- ]
- ] ifFalse:[fmt == $? ifTrue:[
- s1 := in upTo:$:.
- s2 := in nextUpTo:$>.
- arg == true ifTrue:[
- out nextPutAll:s1
- ] ifFalse:[
- out nextPutAll:s2
- ].
- ] ifFalse:[
- "what does VW do here ?"
- self error:'invalid format' mayProceed:true.
- ^ self
- ]]].
- c := in next.
- c ~~ $> ifTrue:[
- "what does VW do here ?"
- self error:'invalid format' mayProceed:true.
- ^ self
- ]
-
- ].
- ] ifFalse:[
- out nextPut:$<.
- ].
- ]].
- ]].
+ c := in next.
+ c == $% ifTrue:[
+ c := in next.
+ out nextPut:c
+ ] ifFalse:[c ~~ $< ifTrue:[
+ out nextPut:c.
+ ] ifFalse:[
+ peekc := in peek.
+ [peekc == $<] whileTrue:[
+ out nextPut:$<.
+ peekc := in nextPeek.
+ ].
+ peekc == $n ifTrue:[
+ peekc := in nextPeek.
+ peekc == $> ifTrue:[
+ in next.
+ out cr.
+ ] ifFalse:[
+ out nextPutAll:'<n'.
+ ]
+ ] ifFalse:[peekc == $t ifTrue:[
+ peekc := in nextPeek.
+ peekc == $> ifTrue:[
+ in next.
+ out tab.
+ ] ifFalse:[
+ out nextPutAll:'<t'.
+ ]
+ ] ifFalse:[
+ peekc isDigit ifTrue:[
+ "start an argument expansion ..."
+ nr := Integer readFrom:in onError:nil.
+ nr isNil ifTrue:[
+ "this cannot happen (there is at least one digit)"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ].
+ fmt := in next.
+ (fmt ~~ $? and:[in peek ~~ $>]) ifTrue:[
+ out nextPut:$<.
+ nr printOn:out.
+ out nextPut:fmt.
+ ] ifFalse:[
+ (nr between:1 and:argArray size) ifTrue:[
+ arg := argArray at:nr.
+ ] ifFalse:[
+ arg := ''
+ ].
+
+ fmt == $p ifTrue:[
+ "expand with args printString"
+ arg printOn:out.
+ ] ifFalse:[fmt == $s ifTrue:[
+ "expand with arg itself"
+ arg isText ifTrue:[
+ out contentsSpecies isText ifFalse:[
+ out := (TextStream ? CharacterWriteStream on:Text new) nextPutAll:out contents; yourself.
+ ].
+ out nextPutAll:arg.
+ ] ifFalse:[
+ out nextPutAll:arg asString string. "see method comment: arg must know #asString"
+ ]
+ ] ifFalse:[fmt == $? ifTrue:[
+ s1 := in upTo:$:.
+ s2 := in nextUpTo:$>.
+ arg == true ifTrue:[
+ out nextPutAll:s1
+ ] ifFalse:[
+ out nextPutAll:s2
+ ].
+ ] ifFalse:[
+ "what does VW do here ?"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ]]].
+ c := in next.
+ c ~~ $> ifTrue:[
+ "what does VW do here ?"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ]
+
+ ].
+ ] ifFalse:[
+ out nextPut:$<.
+ ].
+ ]].
+ ]].
].
^ out contents
@@ -1991,9 +1987,9 @@
|mySize|
(mySize := self size) >= 2 ifTrue:[
- ((self first == quoteCharacter) and:[self last == quoteCharacter]) ifTrue:[
- ^ self copyFrom:2 to:mySize-1
- ].
+ ((self first == quoteCharacter) and:[self last == quoteCharacter]) ifTrue:[
+ ^ self copyFrom:2 to:mySize-1
+ ].
].
^ self
@@ -2048,16 +2044,16 @@
sz := self size.
specialChars := '*#[\'.
(escape := self class matchEscapeCharacter) ~~ $\ ifTrue:[
- specialChars := specialChars copy.
- specialChars at:specialChars size put:escape
+ specialChars := specialChars copy.
+ specialChars at:specialChars size put:escape
].
[
- idx := self indexOfAny:specialChars startingAt:idx.
- idx == 0 ifTrue:[^ false].
- (self at:idx) == escape ifFalse:[^ true].
- idx := idx + 2.
- idx > sz ifTrue:[^ false].
+ idx := self indexOfAny:specialChars startingAt:idx.
+ idx == 0 ifTrue:[^ false].
+ (self at:idx) == escape ifFalse:[^ true].
+ idx := idx + 2.
+ idx > sz ifTrue:[^ false].
] loop.
"
@@ -2089,7 +2085,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isControlCharacter ifTrue:[^ index]
+ (self at:index) isControlCharacter ifTrue:[^ index]
].
^ 0
@@ -2129,7 +2125,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isSeparator ifFalse:[^ index]
+ (self at:index) isSeparator ifFalse:[^ index]
].
^ 0
@@ -2199,7 +2195,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isSeparator ifTrue:[^ index]
+ (self at:index) isSeparator ifTrue:[^ index]
].
^ 0
@@ -2241,7 +2237,7 @@
start := startIndex.
start to:1 by:-1 do:[:index |
- (self at:index) isSeparator ifTrue:[^ index]
+ (self at:index) isSeparator ifTrue:[^ index]
].
^ 0
@@ -2271,9 +2267,9 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 < c2].
+ c1 := self at:index.
+ c2 := aString at:index.
+ (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 < c2].
].
^ mySize < otherSize
!
@@ -2289,13 +2285,13 @@
|mySize "{ Class: SmallInteger }"|
(aString isString or:[aString species == self species]) ifFalse:[
- ^ false
+ ^ false
].
mySize := self size.
mySize ~~ (aString size) ifTrue:[^ false].
1 to:mySize do:[:index |
- (self at:index) = (aString at:index) ifFalse:[^ false].
+ (self at:index) = (aString at:index) ifFalse:[^ false].
].
^ true
@@ -2327,9 +2323,9 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 > c2].
+ c1 := self at:index.
+ c2 := aString at:index.
+ (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 > c2].
].
^ mySize > otherSize
@@ -2341,12 +2337,12 @@
receiver should come after the argument in a sorted list.
Otherwise return false.
NOTE: The comparison should be language specific, depending on the value of
- LC_COLLATE, which is initialized from the environment.
-
- Currently it is for Strings, but not for UnicodeStrings...
+ LC_COLLATE, which is initialized from the environment.
+
+ Currently it is for Strings, but not for UnicodeStrings...
STUPID:
- #after has a completely different meaning in SeqColl ..."
+ #after has a completely different meaning in SeqColl ..."
^ (self compareCollatingWith:aString) > 0
!
@@ -2424,10 +2420,10 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := (self at:index) asLowercase.
- c2 := (aString at:index) asLowercase.
- c1 > c2 ifTrue:[^ 1].
- c1 < c2 ifTrue:[^ -1].
+ c1 := (self at:index) asLowercase.
+ c2 := (aString at:index) asLowercase.
+ c1 > c2 ifTrue:[^ 1].
+ c1 < c2 ifTrue:[^ -1].
].
mySize > otherSize ifTrue:[^ 1].
mySize < otherSize ifTrue:[^ -1].
@@ -2448,7 +2444,7 @@
|s|
(s := self string) ~~ self ifTrue:[
- ^ s compareCollatingWith:aString
+ ^ s compareCollatingWith:aString
].
^ self compareWith:aString
!
@@ -2465,7 +2461,7 @@
s := self string.
s ~~ self ifTrue:[
- ^ s compareWith:aString string.
+ ^ s compareWith:aString string.
].
^ super compareWith:aString string.
!
@@ -2477,10 +2473,10 @@
|s|
(s := self string) ~~ self ifTrue:[
- ^ s endsWith:aStringOrCharacter
- ].
- (self size > 0 and:[aStringOrCharacter isCharacter]) ifTrue:[
- ^ self last = aStringOrCharacter
+ ^ s endsWith:aStringOrCharacter
+ ].
+ (self size ~~ 0 and:[aStringOrCharacter isCharacter]) ifTrue:[
+ ^ self last = aStringOrCharacter
].
^ super endsWith:aStringOrCharacter
@@ -2532,41 +2528,41 @@
"
"
- |syms ms|
-
- syms := Symbol allInstances.
- Transcript show:'syms: '; showCR:syms size.
- Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
- Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'dragonBook: '; showCR:ms.
-
- syms := syms collect:[:each| each asUnicode16String].
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'unicode sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'unicode dragonBook:'; showCR:ms.
+ |syms ms|
+
+ syms := Symbol allInstances.
+ Transcript show:'syms: '; showCR:syms size.
+ Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
+ Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'dragonBook: '; showCR:ms.
+
+ syms := syms collect:[:each| each asUnicode16String].
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'unicode sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'unicode dragonBook:'; showCR:ms.
"
"Modified: / 26-12-2011 / 14:09:07 / cg"
@@ -2584,14 +2580,14 @@
self reverseDo:[:char |
"/ Sorry, stc cannot compile this (as of 10.9.2007)
"/ h := (h bitShift:4) + char asciiValue.
- h := (h bitShift:4).
- h := h + char codePoint.
- h := h bitAnd:16rFFFFFFFF.
- g := (h bitAnd: 16rF0000000).
- g ~~ 0 ifTrue:[
- h := h bitXor:(g bitShift:-24).
- h := h bitXor:g.
- ].
+ h := (h bitShift:4).
+ h := h + char codePoint.
+ h := h bitAnd:16rFFFFFFFF.
+ g := (h bitAnd: 16rF0000000).
+ g ~~ 0 ifTrue:[
+ h := h bitXor:(g bitShift:-24).
+ h := h bitXor:g.
+ ].
].
"/
"/ multiply by large prime to spread values
@@ -2660,8 +2656,8 @@
h := 0.
self do:[:eachChar |
- h := (h * 31) + (eachChar codePoint).
- h := h bitAnd:16rFFFFFFFF.
+ h := (h * 31) + (eachChar codePoint).
+ h := h bitAnd:16rFFFFFFFF.
].
^ h
@@ -2683,7 +2679,7 @@
"/
h := 0.
self do:[:char |
- h := (65599 times:h) plus:char codePoint.
+ h := (65599 times:h) plus:char codePoint.
].
^ h
@@ -2699,41 +2695,41 @@
"
"
- |syms ms|
-
- syms := Symbol allInstances.
- Transcript show:'syms: '; showCR:syms size.
- Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
- Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'dragonBook: '; showCR:ms.
-
- syms := syms collect:[:each| each asUnicode16String].
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'unicode sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'unicode dragonBook:'; showCR:ms.
+ |syms ms|
+
+ syms := Symbol allInstances.
+ Transcript show:'syms: '; showCR:syms size.
+ Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
+ Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'dragonBook: '; showCR:ms.
+
+ syms := syms collect:[:each| each asUnicode16String].
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'unicode sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'unicode dragonBook:'; showCR:ms.
"
"Modified: / 26-12-2011 / 14:09:07 / cg"
@@ -2749,18 +2745,18 @@
in the following, we assume that ommiting a character
is less of an error than inserting an extra character.
Therefore the different insertion (i) and deletion (d) values.
- s: substitution weight (4)
- k: keyboard weight (k) (typing a nearby key) - or nil (then use s)
- c: case weight (4) - or nil (then use s)
- e: exchange weight (8) - or nil (then use s*2)
- i: insertion of extra character weight (2)
- d: delete of a character weight (6)
+ s: substitution weight (4)
+ k: keyboard weight (k) (typing a nearby key) - or nil (then use s)
+ c: case weight (4) - or nil (then use s)
+ e: exchange weight (8) - or nil (then use s*2)
+ i: insertion of extra character weight (2)
+ d: delete of a character weight (6)
"
^ StringUtilities
- levenshteinDistanceFrom:self
- to:aString
- s:4 k:4 c:4 e:nil i:2 d:6
+ levenshteinDistanceFrom:self
+ to:aString
+ s:4 k:4 c:4 e:nil i:2 d:6
"
'computer' levenshteinTo:'computer'
@@ -2792,18 +2788,18 @@
this value corrensponds to the number of replacements that have to be
made to get aString from the receiver.
The arguments are the costs for
- s:substitution,
- k:keyboard type (substitution),
- c:case-change,
- i:insertion
- d:deletion
+ s:substitution,
+ k:keyboard type (substitution),
+ c:case-change,
+ i:insertion
+ d:deletion
of a character.
See IEEE transactions on Computers 1976 Pg 172 ff"
^ StringUtilities
- levenshteinDistanceFrom:self
- to:aString
- s:substWeight k:kbdTypoWeight c:caseWeight e:nil i:insrtWeight d:deleteWeight
+ levenshteinDistanceFrom:self
+ to:aString
+ s:substWeight k:kbdTypoWeight c:caseWeight e:nil i:insrtWeight d:deleteWeight
!
sameAs:aString
@@ -2820,11 +2816,11 @@
mySize ~~ otherSize ifTrue:[^ false].
1 to:mySize do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- c1 ~~ c2 ifTrue:[
- (c1 sameAs:c2) ifFalse:[^ false].
- ]
+ c1 := self at:index.
+ c2 := aString at:index.
+ c1 ~~ c2 ifTrue:[
+ (c1 sameAs:c2) ifFalse:[^ false].
+ ]
].
^ true
@@ -2843,7 +2839,7 @@
if false, this is the same as #=."
caseSensitive ifFalse:[
- ^ self sameAs:aString
+ ^ self sameAs:aString
].
^ self = aString
@@ -2860,7 +2856,7 @@
if false, this is the same as #=."
ignoreCase ifTrue:[
- ^ self sameAs:aString
+ ^ self sameAs:aString
].
^ self = aString
@@ -2883,12 +2879,12 @@
cnt := 0.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- ((c1 == c2)
- or:[c1 asLowercase = c2 asLowercase]) ifTrue:[
- cnt := cnt + 1
- ]
+ c1 := self at:index.
+ c2 := aString at:index.
+ ((c1 == c2)
+ or:[c1 asLowercase = c2 asLowercase]) ifTrue:[
+ cnt := cnt + 1
+ ]
].
^ cnt
@@ -2972,24 +2968,24 @@
score := 0.
i1 := i2 := 1.
[i1 <= size1 and: [i2 <= size2]] whileTrue:[
- next1 := i1 + 1.
- next2 := i2 + 1.
- (self at:i1) == (aString at:i2) ifTrue: [
- score := score+1.
- i1 := next1.
- i2 := next2
- ] ifFalse: [
- (i2 < size2 and: [(self at:i1) == (aString at:next2)]) ifTrue: [
- i2 := next2
- ] ifFalse: [
- (i1 < size1 and: [(self at:next1) == (aString at:i2)]) ifTrue: [
- i1 := next1
- ] ifFalse: [
- i1 := next1.
- i2 := next2
- ]
- ]
- ]
+ next1 := i1 + 1.
+ next2 := i2 + 1.
+ (self at:i1) == (aString at:i2) ifTrue: [
+ score := score+1.
+ i1 := next1.
+ i2 := next2
+ ] ifFalse: [
+ (i2 < size2 and: [(self at:i1) == (aString at:next2)]) ifTrue: [
+ i2 := next2
+ ] ifFalse: [
+ (i1 < size1 and: [(self at:next1) == (aString at:i2)]) ifTrue: [
+ i1 := next1
+ ] ifFalse: [
+ i1 := next1.
+ i2 := next2
+ ]
+ ]
+ ]
].
score == maxLen ifTrue: [^ 100].
@@ -3013,10 +3009,10 @@
|s|
aStringOrCharacter isCharacter ifTrue:[
- ^ (self size > 0) and:[ (self at:1) == aStringOrCharacter ]
+ ^ (self size ~~ 0) and:[ (self at:1) == aStringOrCharacter ]
].
(s := self string) ~~ self ifTrue:[
- ^ s startsWith:aStringOrCharacter
+ ^ s startsWith:aStringOrCharacter
].
^ super startsWith:aStringOrCharacter
@@ -3064,8 +3060,8 @@
str := self string.
str ~~ self ifTrue:[
- "/ for text and other wrappers
- ^ str asByteArray
+ "/ for text and other wrappers
+ ^ str asByteArray
].
"/ for real strings, a fallback
@@ -3074,19 +3070,19 @@
bytes := ByteArray new:(sz * bytesPerCharacter).
idx := 1.
self do:[:char |
- |code|
-
- code := char codePoint.
- bytesPerCharacter == 2 ifTrue:[
- bytes unsignedInt16At:idx put:code
- ] ifFalse:[
- bytesPerCharacter == 4 ifTrue:[
- bytes unsignedInt32At:idx put:code
- ] ifFalse:[
- bytes at:idx put:code
- ].
- ].
- idx := idx + bytesPerCharacter.
+ |code|
+
+ code := char codePoint.
+ bytesPerCharacter == 2 ifTrue:[
+ bytes unsignedInt16At:idx put:code
+ ] ifFalse:[
+ bytesPerCharacter == 4 ifTrue:[
+ bytes unsignedInt32At:idx put:code
+ ] ifFalse:[
+ bytes at:idx put:code
+ ].
+ ].
+ idx := idx + bytesPerCharacter.
].
^ bytes
@@ -3104,7 +3100,7 @@
ba := self asByteArray. "/ native order
UninterpretedBytes isBigEndian ~~ msb ifTrue:[
- ba swapBytes
+ ba swapBytes
].
^ ba
!
@@ -3167,7 +3163,7 @@
lines := self asCollectionOfSubstringsSeparatedBy:Character cr.
(lines notEmpty and:[lines last isEmpty]) ifTrue:[
- ^ lines copyButLast:1
+ ^ lines copyButLast:1
].
^ lines
@@ -3212,26 +3208,26 @@
startIndex := 1.
except := false.
[
- i := startIndex-1.
- [
- i := i+1.
- c := self at:i.
- c = ch ifTrue:[ except := except not. ].
- i < self size and:[except or:[c ~= aCharacter]]
- ] whileTrue.
-
- c = aCharacter ifTrue:[
- stopIndex := i -1.
- ] ifFalse: [
- stopIndex := i.
- ].
- (stopIndex < startIndex) ifTrue: [
- lines add:(myClass new:0)
- ] ifFalse: [
- lines add:(self copyFrom:startIndex to:stopIndex)
- ].
- startIndex := stopIndex + 2.
- startIndex <= self size
+ i := startIndex-1.
+ [
+ i := i+1.
+ c := self at:i.
+ c = ch ifTrue:[ except := except not. ].
+ i < self size and:[except or:[c ~= aCharacter]]
+ ] whileTrue.
+
+ c = aCharacter ifTrue:[
+ stopIndex := i -1.
+ ] ifFalse: [
+ stopIndex := i.
+ ].
+ (stopIndex < startIndex) ifTrue: [
+ lines add:(myClass new:0)
+ ] ifFalse: [
+ lines add:(self copyFrom:startIndex to:stopIndex)
+ ].
+ startIndex := stopIndex + 2.
+ startIndex <= self size
] whileTrue.
^ lines
@@ -3378,18 +3374,18 @@
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- start := self indexOfNonSeparatorStartingAt:start.
- start == 0 ifTrue:[
- ^ count
- ].
- stop := self indexOfSeparatorStartingAt:start.
- stop == 0 ifTrue:[
- aBlock value:(self copyFrom:start to:mySize).
- ^ count + 1
- ].
- aBlock value:(self copyFrom:start to:(stop - 1)).
- start := stop.
- count := count + 1
+ start := self indexOfNonSeparatorStartingAt:start.
+ start == 0 ifTrue:[
+ ^ count
+ ].
+ stop := self indexOfSeparatorStartingAt:start.
+ stop == 0 ifTrue:[
+ aBlock value:(self copyFrom:start to:mySize).
+ ^ count + 1
+ ].
+ aBlock value:(self copyFrom:start to:(stop - 1)).
+ start := stop.
+ count := count + 1
].
^ count
@@ -3478,10 +3474,10 @@
'-1234' asInteger
The following raises an error:
- '0.123' asInteger <- reader finds more after reading 0
+ '0.123' asInteger <- reader finds more after reading 0
whereas the less strict readFrom does not:
- Integer readFrom:'0.123' <- reader stops at ., returning 0
+ Integer readFrom:'0.123' <- reader stops at ., returning 0
'0.123' asInteger
'0.123' asNumber <- returns what you expect
@@ -3507,13 +3503,13 @@
"/ (there are only a few of them)
1 to:mySize do:[:i |
- c := (self at:i) asLowercase.
- (c bitsPerCharacter > bitsPerCharacter
- and:[c stringSpecies ~= newStr stringSpecies]) ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- bitsPerCharacter := newStr bitsPerCharacter.
- ].
- newStr at:i put:c
+ c := (self at:i) asLowercase.
+ (c bitsPerCharacter > bitsPerCharacter
+ and:[c stringSpecies ~= newStr stringSpecies]) ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ bitsPerCharacter := newStr bitsPerCharacter.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -3522,6 +3518,8 @@
'HelloWorld' asUnicode16String asLowercase
'HelloWorld' asLowercaseFirst
'HelloWorld' asUppercase
+ 'HelloWorldÿ' asUppercase
+ 'HelloWorldŸ' asLowercase - currently returns an U16 string; should this be u8?
"
!
@@ -3538,9 +3536,9 @@
firstChar == firstCharAsLowercase ifTrue:[ ^ self].
firstCharAsLowercase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsLowercase stringSpecies fromString:self.
+ newString := firstCharAsLowercase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsLowercase.
^ newString
@@ -3560,7 +3558,7 @@
sz := self size.
newString := self copyFrom:1 to:sz.
sz > 0 ifTrue:[
- newString at:sz put:(newString at:sz) asLowercase
+ newString at:sz put:(newString at:sz) asLowercase
].
^ newString
@@ -3574,7 +3572,7 @@
"return a corresponding setter method's selector.
I.e. #foo asMutator returns #foo:"
- ^ (self asOneByteString,':') asSymbol
+ ^ (self asSingleByteString,':') asSymbol
!
asNumber
@@ -3649,14 +3647,14 @@
newString := String new:(self size).
1 to:self size do:[:idx |
- |char|
-
- char := self at:idx.
- char codePoint <= 16rFF ifTrue:[
- newString at:idx put:char
- ] ifFalse:[
- newString at:idx put:replacementCharacter
- ].
+ |char|
+
+ char := self at:idx.
+ char codePoint <= 16rFF ifTrue:[
+ newString at:idx put:char
+ ] ifFalse:[
+ newString at:idx put:replacementCharacter
+ ].
].
^ newString
@@ -3693,7 +3691,7 @@
"If a symbol with the receiver's characters is already known, return it.
Otherwise, return nil.
This can be used to query for an existing symbol and is the same as:
- self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
+ self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
but slightly faster, since the symbol lookup operation is only performed once.
The receiver must be a singleByte-String.
TwoByte- and FourByteSymbols are (currently ?) not allowed."
@@ -3702,12 +3700,12 @@
str := self string.
str == self ifTrue:[
- "must be some kind of N-ByteString"
- str := self asSingleByteStringIfPossible.
- str == self ifTrue:[
- "single byte string conversion is not possible"
- ^ nil.
- ].
+ "must be some kind of N-ByteString"
+ str := self asSingleByteStringIfPossible.
+ str == self ifTrue:[
+ "single byte string conversion is not possible"
+ ^ nil.
+ ].
].
^ str asSymbolIfInterned
@@ -3761,7 +3759,7 @@
Notice, that errors may occur during the read,
so you better setup some exception handler when using this method."
- ^ Timestamp readFromString:self
+ ^ Timestamp readFrom:self
"
'2014-11-10 21:30:22.444' asTimestamp
@@ -3783,16 +3781,16 @@
bitsPerCharacter := newStr bitsPerCharacter.
1 to:mySize do:[:i |
- i == 1 ifTrue:[
- c := (self at:i) asTitlecase.
- ] ifFalse:[
- c := (self at:i) asLowercase.
- ].
- c bitsPerCharacter > bitsPerCharacter ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- bitsPerCharacter := newStr bitsPerCharacter.
- ].
- newStr at:i put:c
+ i == 1 ifTrue:[
+ c := (self at:i) asTitlecase.
+ ] ifFalse:[
+ c := (self at:i) asLowercase.
+ ].
+ c bitsPerCharacter > bitsPerCharacter ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ bitsPerCharacter := newStr bitsPerCharacter.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -3831,9 +3829,9 @@
firstChar == firstCharAsTitlecase ifTrue:[ ^ self].
firstCharAsTitlecase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsTitlecase stringSpecies fromString:self.
+ newString := firstCharAsTitlecase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsTitlecase.
^ newString
@@ -3898,11 +3896,11 @@
sz := self size.
^ (Unicode16String new:sz)
- replaceFrom:1 to:sz with:self startingAt:1;
- yourself.
-
- "
- 'abc' asUnicode16String
+ replaceFrom:1 to:sz with:self startingAt:1;
+ yourself.
+
+ "
+ 'abc' asUnicode16String
"
!
@@ -3917,17 +3915,17 @@
sz := self size.
(self at:sz) == (Character codePoint:0) ifTrue:[
- ^ self asUnicode16String.
+ ^ self asUnicode16String.
].
^ (Unicode16String new:sz+1)
- replaceFrom:1 to:sz with:self startingAt:1;
- at:sz+1 put:(Character codePoint:0);
- yourself.
+ replaceFrom:1 to:sz with:self startingAt:1;
+ at:sz+1 put:(Character codePoint:0);
+ yourself.
"
- 'abc' asUnicode16StringZ
- 'abc' asUnicode16String asUnicode16StringZ
+ 'abc' asUnicode16StringZ
+ 'abc' asUnicode16String asUnicode16StringZ
"
!
@@ -3976,12 +3974,12 @@
"/ (there are only a few of them)
1 to:mySize do:[:i |
- c := (self at:i) asUppercase.
- c bitsPerCharacter > bitsPerCharacter ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- bitsPerCharacter := newStr bitsPerCharacter.
- ].
- newStr at:i put:c
+ c := (self at:i) asUppercase.
+ c bitsPerCharacter > bitsPerCharacter ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ bitsPerCharacter := newStr bitsPerCharacter.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -4007,9 +4005,9 @@
"/ very seldom, the uppercase-char needs more bits than the lowercase one (turkish y-diaresis)
firstCharAsUppercase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsUppercase stringSpecies fromString:self.
+ newString := firstCharAsUppercase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsUppercase.
^ newString
@@ -4030,7 +4028,7 @@
sz := self size.
newString := self copyFrom:1 to:sz.
sz > 0 ifTrue:[
- newString at:sz put:(newString at:sz) asUppercase
+ newString at:sz put:(newString at:sz) asUppercase
].
^ newString
@@ -4045,7 +4043,7 @@
Notice, that errors may occur during the read,
so you better setup some exception handler when using this method."
- ^ UtcTimestamp readFromString:self
+ ^ UtcTimestamp readFrom:self
"
'2014-11-10 21:30:22.444' asUtcTimestamp
@@ -4079,18 +4077,18 @@
|myWidth otherWidth|
aStringOrCharacter isCharacter ifTrue:[
- ^ self copyWith:aStringOrCharacter
+ ^ self copyWith:aStringOrCharacter
].
aStringOrCharacter isText ifTrue:[
- ^ aStringOrCharacter concatenateFromString:self
+ ^ aStringOrCharacter concatenateFromString:self
].
aStringOrCharacter isString ifTrue:[
- (otherWidth := aStringOrCharacter bitsPerCharacter) ~~ (myWidth := self bitsPerCharacter) ifTrue:[
- otherWidth > myWidth ifTrue:[
- ^ (aStringOrCharacter species fromString:self) , aStringOrCharacter
- ].
- ^ self , (self species fromString:aStringOrCharacter)
- ].
+ (otherWidth := aStringOrCharacter bitsPerCharacter) ~~ (myWidth := self bitsPerCharacter) ifTrue:[
+ otherWidth > myWidth ifTrue:[
+ ^ (aStringOrCharacter species fromString:self) , aStringOrCharacter
+ ].
+ ^ self , (self species fromString:aStringOrCharacter)
+ ].
].
^ super , aStringOrCharacter
@@ -4102,7 +4100,7 @@
(JISEncodedString fromString:'hello') , ' world'
Transcript showCR:
- (Text string:'hello' emphasis:#italic) , (Text string:' world' emphasis:#bold)
+ (Text string:'hello' emphasis:#italic) , (Text string:' world' emphasis:#bold)
"
"Modified: 28.6.1997 / 00:13:17 / cg"
@@ -4131,7 +4129,7 @@
n1 := n2 := maxLen // 2.
maxLen odd ifTrue:[
- n2 := n1 + 1
+ n2 := n1 + 1
].
^ (self copyFrom:1 to:n1) , (self copyFrom:sz - n2 + 1)
@@ -4262,13 +4260,13 @@
"/ ANSI seems to allow a sequence to be replaced by another sequence,
"/ whereas the old ST80 meant replace all occurrences... - sigh.
oldElement isByteCollection ifTrue:[
- newElement isByteCollection ifTrue:[
- ^ self copyReplaceString:oldElement withString:newElement.
- ].
- self halt:'check if this is legal'.
+ newElement isByteCollection ifTrue:[
+ ^ self copyReplaceString:oldElement withString:newElement.
+ ].
+ self halt:'check if this is legal'.
].
newElement isByteCollection ifTrue:[
- self halt:'check if this is legal'.
+ self halt:'check if this is legal'.
].
^ super copyReplaceAll:oldElement with:newElement
!
@@ -4282,13 +4280,13 @@
tmpStream := self species writeStream.
idx := 1.
[idx ~~ 0] whileTrue:[
- idx1 := idx.
- idx := self indexOfSubCollection:subString startingAt:idx.
- idx ~~ 0 ifTrue:[
- tmpStream nextPutAll:(self copyFrom:idx1 to:idx-1).
- tmpStream nextPutAll:newString.
- idx := idx + subString size
- ]
+ idx1 := idx.
+ idx := self indexOfSubCollection:subString startingAt:idx.
+ idx ~~ 0 ifTrue:[
+ tmpStream nextPutAll:(self copyFrom:idx1 to:idx-1).
+ tmpStream nextPutAll:newString.
+ idx := idx + subString size
+ ]
].
tmpStream nextPutAll:(self copyFrom:idx1).
^ tmpStream contents
@@ -4299,7 +4297,7 @@
'12345678901234567890' copyReplaceString:'234' withString:'foo'
('a string with spaces' copyReplaceAll:$ withAll:' foo ')
- copyReplaceString:'foo' withString:'bar'
+ copyReplaceString:'foo' withString:'bar'
"
"Modified: / 31-05-1999 / 12:33:59 / cg"
@@ -4317,11 +4315,11 @@
|sz newString|
aCharacter bitsPerCharacter > self bitsPerCharacter ifTrue:[
- sz := self size.
- newString := aCharacter stringSpecies new:sz + 1.
- newString replaceFrom:1 to:sz with:self startingAt:1.
- newString at:sz+1 put:aCharacter.
- ^ newString.
+ sz := self size.
+ newString := aCharacter stringSpecies new:sz + 1.
+ newString replaceFrom:1 to:sz with:self startingAt:1.
+ newString at:sz+1 put:aCharacter.
+ ^ newString.
].
^ super copyWith:aCharacter
!
@@ -4331,7 +4329,7 @@
if it matches return the right.
Finally, if strip is true, remove whiteSpace.
This method is used to match and extract lines of the form:
- something: rest
+ something: rest
where we are interested in rest, but only if the receiver string
begins with something.
@@ -4344,11 +4342,11 @@
|rest|
(self startsWith:keyword) ifTrue:[
- rest := self copyFrom:(keyword size + 1).
- strip ifTrue:[
- rest := rest withoutSeparators
- ].
- ^ rest
+ rest := self copyFrom:(keyword size + 1).
+ strip ifTrue:[
+ rest := rest withoutSeparators
+ ].
+ ^ rest
].
^ nil
@@ -4365,20 +4363,20 @@
splitAtString:subString withoutSeparators:strip
"If the receiver is of the form:
- <left><subString><right>
+ <left><subString><right>
return a collection containing left and right only.
If strip is true, remove whiteSpace in the returned substrings."
|idx left right|
(idx := self indexOfSubCollection:subString) ~~ 0 ifTrue:[
- left := self copyTo:(idx - 1).
- right := self copyFrom:(idx + subString size).
- strip ifTrue:[
- left := left withoutSeparators.
- right := right withoutSeparators.
- ].
- ^ StringCollection with:left with:right
+ left := self copyTo:(idx - 1).
+ right := self copyFrom:(idx + subString size).
+ strip ifTrue:[
+ left := left withoutSeparators.
+ right := right withoutSeparators.
+ ].
+ ^ StringCollection with:left with:right
].
self error:'substring not present in receiver' mayProceed:true.
^ self
@@ -4409,9 +4407,9 @@
"q&d hack"
(start == 1 and:[stop == self size]) ifTrue:[
- self displayOn:aGC x:x y:y opaque:opaque.
+ self displayOn:aGC x:x y:y opaque:opaque.
] ifFalse:[
- (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:opaque.
+ (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:opaque.
].
!
@@ -4423,9 +4421,9 @@
s := self string.
opaque ifTrue:[
- aGc displayOpaqueString:s x:x y:y.
+ aGc displayOpaqueString:s x:x y:y.
] ifFalse:[
- aGc displayString:s x:x y:y.
+ aGc displayString:s x:x y:y.
].
"Modified: 11.5.1996 / 14:42:48 / cg"
@@ -4631,15 +4629,23 @@
!
withColor:aColorOrColorSymbol
- "return a text object representing the receiver, but all colorized"
-
+ "return a text object representing the receiver, but all colorized.
+ Usage of a colorSymbol is considered bad style (provided for backward compatibility);
+ please change to pass a proper color
+ (makes it easier to find color uses)"
+
+ |color|
+
aColorOrColorSymbol isSymbol ifTrue:[
- ^ self colorizeAllWith:(Color perform:aColorOrColorSymbol)
- ].
- ^ self colorizeAllWith:aColorOrColorSymbol
+ color := (Color perform:aColorOrColorSymbol)
+ ] ifFalse:[
+ color := aColorOrColorSymbol
+ ].
+ ^ self colorizeAllWith:color
"
Transcript showCR:('hello' withColor:#red)
+ Transcript showCR:('world' withColor:#blue)
Transcript showCR:('hello' withColor:Color red)
Transcript showCR:('world' withColor:Color green darkened)
"
@@ -4717,7 +4723,13 @@
asNormalizedUnicodeString
"return a new string containing the same characters, as a normalized Unicode string.
This replaces combination characters by corresponding single characters.
- (i.e. diaresis and other combining diacriticals in the 0x03xx range)"
+ (i.e. diaresis and other combining diacriticals in the 0x03xx range).
+ Caveat:
+ possibly incomplete: only COMBINING_DIACRITICAL_MARKS are cared for.
+ Does not care for COMBINING_DIACRITICAL_MARKS_EXTENDED
+ and COMBINING_DIACRITICAL_MARKS_SUPPLEMENT.
+ However; those are used for German dialectology, ancient Greek and other similar
+ exotic uses. Probably noone will ever even notice that they are missing..."
|outStream prevChar map mapEntries mappedChar|
@@ -4813,9 +4825,9 @@
is self-inverse, so the same code can be used for encoding and decoding."
^ self species
- streamContents:[:aStream |
- self do:[:char |
- aStream nextPut:(char rot:n) ]]
+ streamContents:[:aStream |
+ self do:[:char |
+ aStream nextPut:(char rot:n) ]]
"
'hello world' rot:13
@@ -4971,6 +4983,8 @@
! !
+
+
!CharacterArray methodsFor:'matching - glob expressions'!
compoundMatch:aString
@@ -4979,7 +4993,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5004,7 +5018,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5034,7 +5048,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5043,9 +5057,9 @@
matchers := self asCollectionOfSubstringsSeparatedBy:$;.
withoutSeparators ifTrue:[ matchers := matchers collect:[:each | each withoutSeparators] ].
^ matchers
- contains:[:aPattern |
- aPattern match:aString caseSensitive:caseSensitive escapeCharacter:nil
- ].
+ contains:[:aPattern |
+ aPattern match:aString caseSensitive:caseSensitive escapeCharacter:nil
+ ].
"
'f*' match:'foo'
@@ -5075,7 +5089,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5104,7 +5118,7 @@
if not found, return 0.
NOTICE: match-meta character interpretation is like in unix-matching,
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -5122,7 +5136,7 @@
if not found, return 0.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -5136,7 +5150,7 @@
This is a q&d hack - not very efficient.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -5151,41 +5165,41 @@
realMatchString := matchString.
(realMatchString endsWith:$*) ifFalse:[
- realMatchString := realMatchString , '*'.
- matchSize := matchSize + 1
+ realMatchString := realMatchString , '*'.
+ matchSize := matchSize + 1
].
mySize := self size.
firstChar := realMatchString at:1.
firstChar == self class matchEscapeCharacter ifTrue:[
- firstChar := realMatchString at:2.
+ firstChar := realMatchString at:2.
].
firstChar asString includesMatchCharacters ifTrue:[
- index to:mySize do:[:col |
- (realMatchString match:self from:col to:mySize caseSensitive:caseSensitive)
- ifTrue:[^ col]
- ].
- ^ exceptionBlock value.
+ index to:mySize do:[:col |
+ (realMatchString match:self from:col to:mySize caseSensitive:caseSensitive)
+ ifTrue:[^ col]
+ ].
+ ^ exceptionBlock value.
].
lcChar := firstChar asLowercase.
ucChar := firstChar asUppercase.
(caseSensitive not and:[ lcChar ~= ucChar ]) ifTrue:[
- firstSet := Array with:ucChar with:lcChar.
- startIndex := self indexOfAny:firstSet startingAt:index.
+ firstSet := Array with:ucChar with:lcChar.
+ startIndex := self indexOfAny:firstSet startingAt:index.
] ifFalse:[
- startIndex := self indexOf:firstChar startingAt:index.
+ startIndex := self indexOf:firstChar startingAt:index.
].
[startIndex == 0] whileFalse:[
- (realMatchString match:self from:startIndex to:mySize caseSensitive:caseSensitive)
- ifTrue:[^ startIndex].
-
- firstSet notNil ifTrue:[
- startIndex := self indexOfAny:firstSet startingAt:(startIndex + 1).
- ] ifFalse:[
- startIndex := self indexOf:firstChar startingAt:(startIndex + 1).
- ].
+ (realMatchString match:self from:startIndex to:mySize caseSensitive:caseSensitive)
+ ifTrue:[^ startIndex].
+
+ firstSet notNil ifTrue:[
+ startIndex := self indexOfAny:firstSet startingAt:(startIndex + 1).
+ ] ifFalse:[
+ startIndex := self indexOf:firstChar startingAt:(startIndex + 1).
+ ].
].
^ exceptionBlock value
@@ -5210,12 +5224,12 @@
This is a q&d hack - not very efficient.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
^ self
- findMatchString:matchString startingAt:index caseSensitive:ignoreCase not ifAbsent:exceptionBlock
+ findMatchString:matchString startingAt:index caseSensitive:ignoreCase not ifAbsent:exceptionBlock
"
'one two three four' findMatchString:'o[nu]'
@@ -5237,48 +5251,48 @@
in typical real life)"
^ self species streamContents:[:s |
- |addCharacter|
-
- addCharacter :=
- [:ch |
- ch isLetterOrDigit ifFalse:[
- s nextPut:$\.
- ].
- s nextPut:ch
- ].
-
- (String matchScanArrayFrom:self) do:[:matchEntry |
- matchEntry isCharacter ifTrue:[
- addCharacter value:matchEntry
- ] ifFalse:[
- matchEntry == #anyString ifTrue:[
- s nextPutAll:'.*'
- ] ifFalse:[
- matchEntry == #any ifTrue:[
- s nextPut:$.
- ] ifFalse:[
- matchEntry isString ifTrue:[
- |set min max|
-
- s nextPut:$[.
- set := matchEntry copy sort.
- min := set min.
- max := set max.
- set asSet = (min to:max) asSet ifTrue:[
- addCharacter value:min.
- s nextPut:$-.
- addCharacter value:max.
- ] ifFalse:[
- set do:addCharacter.
- ].
- s nextPut:$].
- ] ifFalse:[
- self halt.
- ].
- ].
- ].
- ]
- ].
+ |addCharacter|
+
+ addCharacter :=
+ [:ch |
+ ch isLetterOrDigit ifFalse:[
+ s nextPut:$\.
+ ].
+ s nextPut:ch
+ ].
+
+ (String matchScanArrayFrom:self) do:[:matchEntry |
+ matchEntry isCharacter ifTrue:[
+ addCharacter value:matchEntry
+ ] ifFalse:[
+ matchEntry == #anyString ifTrue:[
+ s nextPutAll:'.*'
+ ] ifFalse:[
+ matchEntry == #any ifTrue:[
+ s nextPut:$.
+ ] ifFalse:[
+ matchEntry isString ifTrue:[
+ |set min max|
+
+ s nextPut:$[.
+ set := matchEntry copy sort.
+ min := set min.
+ max := set max.
+ set asSet = (min to:max) asSet ifTrue:[
+ addCharacter value:min.
+ s nextPut:$-.
+ addCharacter value:max.
+ ] ifFalse:[
+ set do:addCharacter.
+ ].
+ s nextPut:$].
+ ] ifFalse:[
+ self halt.
+ ].
+ ].
+ ].
+ ]
+ ].
].
"
@@ -5303,7 +5317,7 @@
find matchstring; if found, return true, otherwise return false.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -5322,7 +5336,7 @@
find matchstring; if found, return true, otherwise return false.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -5353,7 +5367,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5386,7 +5400,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5405,14 +5419,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
].
"
@@ -5426,7 +5440,7 @@
If caseSensitive is false, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5445,14 +5459,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
].
"
@@ -5466,7 +5480,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5487,13 +5501,13 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
^ self
- match:aString from:start to:stop caseSensitive:caseSensitive
- escapeCharacter:(self class matchEscapeCharacter)
+ match:aString from:start to:stop caseSensitive:caseSensitive
+ escapeCharacter:(self class matchEscapeCharacter)
"
'*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
@@ -5511,7 +5525,7 @@
If caseSensitive is false, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5522,25 +5536,27 @@
avoids parsing the pattern over-and over if multiple searches
are done with the same pattern.
"
- (PreviousMatch notNil
- and:[PreviousMatch key = self]) ifTrue:[
- matchScanArray := PreviousMatch value
- ] ifFalse:[
- matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
- matchScanArray isNil ifTrue:[
- 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
- ^ self = aString
+
+ (PreviousMatches isNil
+ or:[(matchScanArray := PreviousMatches at: self ifAbsent:[nil]) isNil]) ifTrue:[
+ matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
+ matchScanArray isNil ifTrue:[
+ 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
+ ^ self = aString
"/ ^ false
- ].
- PreviousMatch := self -> matchScanArray.
+ ].
+ PreviousMatches isNil ifTrue:[
+ PreviousMatches := CacheDictionary new:10
+ ].
+ PreviousMatches at:self put:matchScanArray.
].
^ self class
- matchScan:matchScanArray
- from:1 to:matchScanArray size
- with:aString
- from:start to:stop
- caseSensitive:caseSensitive
+ matchScan:matchScanArray
+ from:1 to:matchScanArray size
+ with:aString
+ from:start to:stop
+ caseSensitive:caseSensitive
"
'*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
@@ -5560,13 +5576,13 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
^ self
- match:aString from:start to:stop caseSensitive:ignoreCase not
- escapeCharacter:(self class matchEscapeCharacter)
+ match:aString from:start to:stop caseSensitive:ignoreCase not
+ escapeCharacter:(self class matchEscapeCharacter)
"
'*ute*' match:'12345COMPUTER' from:1 to:5 ignoreCase:true
@@ -5585,14 +5601,14 @@
If ignoreCase is true, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
^ self
- match:aString from:start to:stop
- caseSensitive:ignoreCase not
- escapeCharacter:escape
+ match:aString from:start to:stop
+ caseSensitive:ignoreCase not
+ escapeCharacter:escape
"
'*ute*' match:'12345COMPUTER' from:1 to:5 ignoreCase:true
@@ -5611,7 +5627,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5631,14 +5647,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' ignoreCase:true
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym ignoreCase:false
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym ignoreCase:false
+ ]
].
"
@@ -5653,7 +5669,7 @@
If ignoreCase is true, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5672,14 +5688,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' ignoreCase:true
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym ignoreCase:false
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym ignoreCase:false
+ ]
].
"
@@ -5693,7 +5709,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5706,7 +5722,7 @@
or [...] to match a set of characters.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5721,7 +5737,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5737,13 +5753,13 @@
"Test if the receiver matches a regex.
May raise RxParser>>regexErrorSignal or child signals.
This is a part of the Regular Expression Matcher package,
- (c) 1996, 1999 Vassili Bykov.
+ (c) 1996, 1999 Vassili Bykov.
Refer to `documentation' protocol of RxParser class for details."
aBoolean ifFalse:[
- ^ self matchesRegexIgnoringCase:regexString
+ ^ self matchesRegexIgnoringCase:regexString
] ifTrue:[
- ^ self matchesRegex:regexString
+ ^ self matchesRegex:regexString
].
"
@@ -5783,9 +5799,9 @@
len := self size.
(len < size) ifTrue:[
- s := self species new:size withAll:padCharacter.
- s replaceFrom:(size - len) // 2 + 1 with:self.
- ^ s
+ s := self species new:size withAll:padCharacter.
+ s replaceFrom:(size - len) // 2 + 1 with:self.
+ ^ s
]
"
@@ -5809,11 +5825,11 @@
(sounds complicated ? -> see examples below)."
^ self
- decimalPaddedTo:size
- and:afterPeriod
- at:decimalCharacter
- withLeft:(Character space)
- right:$0
+ decimalPaddedTo:size
+ and:afterPeriod
+ at:decimalCharacter
+ withLeft:(Character space)
+ right:$0
"
'123' decimalPaddedTo:10 and:3 at:$. -> ' 123 '
@@ -5842,25 +5858,25 @@
idx := self indexOf:decimalCharacter.
idx == 0 ifTrue:[
- "/
- "/ no decimal point found; adjust string to the left of the period column
- "/
- rightPadChar isNil ifTrue:[
- s := self , (self species new:afterPeriod + 1 withAll:leftPadChar)
- ] ifFalse:[
- s:= self , decimalCharacter asString , (self species new:afterPeriod withAll:rightPadChar).
- ].
+ "/
+ "/ no decimal point found; adjust string to the left of the period column
+ "/
+ rightPadChar isNil ifTrue:[
+ s := self , (self species new:afterPeriod + 1 withAll:leftPadChar)
+ ] ifFalse:[
+ s:= self , decimalCharacter asString , (self species new:afterPeriod withAll:rightPadChar).
+ ].
] ifFalse:[
- "/ the number of after-decimalPoint characters
- n := self size - idx.
- rest := afterPeriod - n.
- rest > 0 ifTrue:[
- s := (self species new:rest withAll:(rightPadChar ? leftPadChar)).
- ] ifFalse:[
- s := ''
- ].
- s := self , s.
+ "/ the number of after-decimalPoint characters
+ n := self size - idx.
+ rest := afterPeriod - n.
+ rest > 0 ifTrue:[
+ s := (self species new:rest withAll:(rightPadChar ? leftPadChar)).
+ ] ifFalse:[
+ s := ''
+ ].
+ s := self , s.
].
^ s leftPaddedTo:size with:leftPadChar
@@ -5919,54 +5935,54 @@
firstChar := (self at:1) asLowercase.
((firstChar isVowel and:[firstChar ~~ $u]) or:[firstChar == $x]) ifTrue:[
- ^ 'an'
+ ^ 'an'
].
(self size >= 3) ifTrue:[
- secondChar := (self at:2) asLowercase.
-
- "/ may need more here...
- ( #('rb') includes:(String with:firstChar with:secondChar)) ifTrue:[
- ^ 'an'
- ].
-
- thirdChar := (self at:3) asLowercase.
-
- (firstChar isVowel not
- and:[(secondChar isVowel or:[secondChar == $y]) not
- and:[thirdChar isVowel not ]]) ifTrue:[
- "/ exceptions: 3 non-vowels in a row: looks like an abbreviation
- (self size > 4) ifTrue:[
- (firstChar == $s) ifTrue:[
- ((secondChar == $c and:[thirdChar == $r])
- or:[ (secondChar == $t and:[thirdChar == $r]) ]) ifTrue:[
- (self at:4) isVowel ifTrue:[
- ^ 'a'
- ]
- ]
- ].
- ].
- "/ an abbreviation; treat x, s as vowels
- (firstChar == $x or:[ firstChar == $s ]) ifTrue:[^ 'an'].
- ]
+ secondChar := (self at:2) asLowercase.
+
+ "/ may need more here...
+ ( #('rb') includes:(String with:firstChar with:secondChar)) ifTrue:[
+ ^ 'an'
+ ].
+
+ thirdChar := (self at:3) asLowercase.
+
+ (firstChar isVowel not
+ and:[(secondChar isVowel or:[secondChar == $y]) not
+ and:[thirdChar isVowel not ]]) ifTrue:[
+ "/ exceptions: 3 non-vowels in a row: looks like an abbreviation
+ (self size > 4) ifTrue:[
+ (firstChar == $s) ifTrue:[
+ ((secondChar == $c and:[thirdChar == $r])
+ or:[ (secondChar == $t and:[thirdChar == $r]) ]) ifTrue:[
+ (self at:4) isVowel ifTrue:[
+ ^ 'a'
+ ]
+ ]
+ ].
+ ].
+ "/ an abbreviation; treat x, s as vowels
+ (firstChar == $x or:[ firstChar == $s ]) ifTrue:[^ 'an'].
+ ]
].
^ 'a'
"
- 'uboot' article.
- 'xmas' article.
- 'alarm' article.
- 'baby' article.
- 'sql' article.
- 'scr' article.
- 'screen' article.
- 'scrollbar' article.
- 'scrs' article.
- 'cvs' article.
- 'cvssource' article.
- 'symbol' article.
- 'string' article.
- 'rbparser' article.
+ 'uboot' article.
+ 'xmas' article.
+ 'alarm' article.
+ 'baby' article.
+ 'sql' article.
+ 'scr' article.
+ 'screen' article.
+ 'scrollbar' article.
+ 'scrs' article.
+ 'cvs' article.
+ 'cvssource' article.
+ 'symbol' article.
+ 'string' article.
+ 'rbparser' article.
"
"Modified (comment): / 01-05-2016 / 10:57:25 / cg"
@@ -5979,19 +5995,19 @@
n := self occurrencesOf:$'.
n ~~ 0 ifTrue:[
- s := self species new:(n + 2 + self size).
- s at:1 put:$'.
- index := 2.
- self do:[:thisChar |
- (thisChar == $') ifTrue:[
- s at:index put:thisChar.
- index := index + 1.
- ].
- s at:index put:thisChar.
- index := index + 1.
- ].
- s at:index put:$'.
- ^ s
+ s := self species new:(n + 2 + self size).
+ s at:1 put:$'.
+ index := 2.
+ self do:[:thisChar |
+ (thisChar == $') ifTrue:[
+ s at:index put:thisChar.
+ index := index + 1.
+ ].
+ s at:index put:thisChar.
+ index := index + 1.
+ ].
+ s at:index put:$'.
+ ^ s
].
^ '''' , self , ''''
@@ -6015,8 +6031,8 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifTrue:[
- self storeOn:aGCOrStream.
- ^ self
+ self storeOn:aGCOrStream.
+ ^ self
].
^ super displayOn:aGCOrStream
!
@@ -6037,8 +6053,8 @@
"put the raw storeString of myself on aStream"
self do:[:thisChar |
- (thisChar == $') ifTrue:[aStream nextPut:thisChar].
- aStream nextPut:thisChar
+ (thisChar == $') ifTrue:[aStream nextPut:thisChar].
+ aStream nextPut:thisChar
]
"Modified: / 15.6.1998 / 17:21:17 / cg"
@@ -6051,26 +6067,26 @@
TODO: care for 16bit UNICODE string and escape chars ..."
self do:[:eachChar |
- eachChar == $< ifTrue:[
- aStream nextPutAll:'<' "mapping needed for xml text"
- ] ifFalse:[ eachChar == $& ifTrue:[
- aStream nextPutAll:'&' "mapping needed for all"
- ] ifFalse:[ eachChar == $> ifTrue:[
- aStream nextPutAll:'>' "mapping needed for comments"
- ] ifFalse:[ eachChar == $' ifTrue:[
- aStream nextPutAll:''' "mapping needed for attributes"
- ] ifFalse:[ eachChar == $" ifTrue:[
- aStream nextPutAll:'"' "mapping needed for attributes"
- ] ifFalse:[
- |codePoint|
- codePoint := eachChar codePoint.
- (codePoint < 16r20 or:[codePoint >= 16r7F]) ifTrue:[
- aStream nextPutAll:'&#'.
- codePoint printOn:aStream.
- aStream nextPut:$;.
- ] ifFalse:[
- aStream nextPut:eachChar
- ]]]]]]
+ eachChar == $< ifTrue:[
+ aStream nextPutAll:'<' "mapping needed for xml text"
+ ] ifFalse:[ eachChar == $& ifTrue:[
+ aStream nextPutAll:'&' "mapping needed for all"
+ ] ifFalse:[ eachChar == $> ifTrue:[
+ aStream nextPutAll:'>' "mapping needed for comments"
+ ] ifFalse:[ eachChar == $' ifTrue:[
+ aStream nextPutAll:''' "mapping needed for attributes"
+ ] ifFalse:[ eachChar == $" ifTrue:[
+ aStream nextPutAll:'"' "mapping needed for attributes"
+ ] ifFalse:[
+ |codePoint|
+ codePoint := eachChar codePoint.
+ (codePoint < 16r20 or:[codePoint >= 16r7F]) ifTrue:[
+ aStream nextPutAll:'&#'.
+ codePoint printOn:aStream.
+ aStream nextPut:$;.
+ ] ifFalse:[
+ aStream nextPut:eachChar
+ ]]]]]]
].
!
@@ -6081,27 +6097,27 @@
TODO: care for 16bit UNICODE string and escape chars ..."
self do:[:eachChar |
- eachChar == $< ifTrue:[
- aStream nextPutAll:'<' "mapping needed for xml text"
- ] ifFalse:[ eachChar == $& ifTrue:[
- aStream nextPutAll:'&' "mapping needed for all"
+ eachChar == $< ifTrue:[
+ aStream nextPutAll:'<' "mapping needed for xml text"
+ ] ifFalse:[ eachChar == $& ifTrue:[
+ aStream nextPutAll:'&' "mapping needed for all"
"/ ] ifFalse:[ eachChar == $> ifTrue:[
"/ aStream nextPutAll:'>' "mapping needed for comments"
"/ ] ifFalse:[ eachChar == $' ifTrue:[
"/ aStream nextPutAll:''' "mapping needed for attributes"
"/ ] ifFalse:[ eachChar == $" ifTrue:[
"/ aStream nextPutAll:'"' "mapping needed for attributes"
- ] ifFalse:[
- |codePoint|
- codePoint := eachChar codePoint.
- ((codePoint < 16r20 and:[codePoint ~~ 9 and:[codePoint ~~ 10 and:[codePoint ~~ 13]]])
- or:[codePoint >= 16r7F]) ifTrue:[
- aStream nextPutAll:'&#'.
- codePoint printOn:aStream.
- aStream nextPut:$;.
- ] ifFalse:[
- aStream nextPut:eachChar
- ]]]"/]]]
+ ] ifFalse:[
+ |codePoint|
+ codePoint := eachChar codePoint.
+ ((codePoint < 16r20 and:[codePoint ~~ 9 and:[codePoint ~~ 10 and:[codePoint ~~ 13]]])
+ or:[codePoint >= 16r7F]) ifTrue:[
+ aStream nextPutAll:'&#'.
+ codePoint printOn:aStream.
+ aStream nextPut:$;.
+ ] ifFalse:[
+ aStream nextPut:eachChar
+ ]]]"/]]]
].
!
@@ -6123,7 +6139,7 @@
TODO: care for 16bit UNICODE string and escape chars ..."
^ String streamContents:[:s|
- self printXmlQuotedOn:s
+ self printXmlQuotedOn:s
].
! !
@@ -6137,12 +6153,12 @@
|string max|
(string := self string) ~~ self ifTrue:[
- ^ string bitsPerCharacter
+ ^ string bitsPerCharacter
].
max := 8.
self do:[:eachCharacter |
- max := max max:(eachCharacter bitsPerCharacter)
+ max := max max:(eachCharacter bitsPerCharacter)
].
^ max
@@ -6160,12 +6176,12 @@
|string max|
(string := self string) ~~ self ifTrue:[
- ^ string bytesPerCharacter
+ ^ string bytesPerCharacter
].
max := 1.
self do:[:eachCharacter |
- max := max max:(eachCharacter bytesPerCharacter)
+ max := max max:(eachCharacter bytesPerCharacter)
].
^ max
@@ -6183,9 +6199,9 @@
sz := self size.
1 to:sz do:[:idx|
- (self at:idx) codePoint > 16rFF ifTrue:[
- ^ true.
- ].
+ (self at:idx) codePoint > 16rFF ifTrue:[
+ ^ true.
+ ].
].
^ false.
!
@@ -6201,8 +6217,8 @@
idx := startIndex.
1 to:sz do:[:i |
- (self at:idx) ~~ (aString at:i) ifTrue:[^ false].
- idx := idx + 1
+ (self at:idx) ~~ (aString at:i) ifTrue:[^ false].
+ idx := idx + 1
].
^ true
@@ -6227,17 +6243,17 @@
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- ch := self at:start.
- ch isSeparator ifTrue:[
- start := start + 1
- ] ifFalse:[
- stop := self indexOfSeparatorStartingAt:start.
- (stop == 0) ifTrue:[
- stop := mySize + 1
- ].
- tally := tally + 1.
- start := stop
- ]
+ ch := self at:start.
+ ch isSeparator ifTrue:[
+ start := start + 1
+ ] ifFalse:[
+ stop := self indexOfSeparatorStartingAt:start.
+ (stop == 0) ifTrue:[
+ stop := mySize + 1
+ ].
+ tally := tally + 1.
+ start := stop
+ ]
].
^ tally
@@ -6327,8 +6343,8 @@
coll := OrderedCollection new.
s := ReadStream on:self.
[s atEnd] whileFalse:[
- part := s through:$:.
- coll add:part
+ part := s through:$:.
+ coll add:part
].
^ coll asArray
@@ -6360,8 +6376,8 @@
index := 1.
end := self size.
[index <= end] whileTrue:[
- (self at:index) isSeparator ifFalse:[^ index - 1].
- index := index + 1
+ (self at:index) isSeparator ifFalse:[^ index - 1].
+ index := index + 1
].
^ end
@@ -6544,97 +6560,97 @@
stop := self size.
start := 1.
[start <= stop] whileTrue:[
- idx := self indexOf:escapeCharacter startingAt:start.
- (idx == 0 or:[idx == stop]) ifTrue:[
- aStream nextPutAll:self startingAt:start to:stop.
- ^ self.
- ].
- "found an escapeCharacter"
- aStream nextPutAll:self startingAt:start to:(idx - 1).
- next := self at:(idx + 1).
- (next == escapeCharacter) ifTrue:[
- aStream nextPut:escapeCharacter.
- ] ifFalse:[
- next == $< ifTrue:[
- idx2 := self indexOf:$> startingAt:idx+2.
- key := self copyFrom:idx+2 to:idx2-1.
- idx := idx2 - 1.
- key := key asSymbolIfInterned.
- (#(cr tab nl return lf ff null) includesIdentical:key) ifTrue:[
- aStream nextPut:(Character perform:key).
- ].
- ] ifFalse:[
- next isDigit ifTrue:[
- v := argArrayOrDictionary at:(next digitValue) ifAbsent:''
- ] ifFalse:[
- next == $( ifTrue:[
- idx2 := self indexOf:$) startingAt:idx+2.
- key := self copyFrom:idx+2 to:idx2-1.
- idx := idx2 - 1.
- (argArrayOrDictionary includesKey:key) ifTrue:[
- v := argArrayOrDictionary at:key
- ] ifFalse:[
- key := key asSymbolIfInterned ? key.
- (argArrayOrDictionary includesKey:key) ifTrue:[
- v := argArrayOrDictionary at:key
- ] ifFalse:[
- (key size == 1 and:[ argArrayOrDictionary includesKey:(key at:1)]) ifTrue:[
- v := argArrayOrDictionary at:(key at:1)
- ] ifFalse:[
- key isNumeric ifTrue:[
- key := Integer readFrom:key onError:nil.
- ].
- v := argArrayOrDictionary at:key ifAbsent:''
- ]
- ].
- ].
- ] ifFalse:[
- (next isLetter and:[argArrayOrDictionary isSequenceable not "is a Dictionary"]) ifTrue:[
- "so next is a non-numeric single character."
- v := argArrayOrDictionary
- at:next
- ifAbsent:[
- "try symbol instead of character"
- argArrayOrDictionary
- at:next asSymbol
- ifAbsent:[String with:escapeCharacter with:next].
- ].
- ] ifFalse:[
- v := String with:$% with:next.
- ].
- ]
- ].
- "/ v notNil ifTrue:[
- v isBlock ifTrue:[
- v := v value
- ].
-
- v printOn:aStream.
- "/ ].
- ]
- ].
- start := idx + 2
+ idx := self indexOf:escapeCharacter startingAt:start.
+ (idx == 0 or:[idx == stop]) ifTrue:[
+ aStream nextPutAll:self startingAt:start to:stop.
+ ^ self.
+ ].
+ "found an escapeCharacter"
+ aStream nextPutAll:self startingAt:start to:(idx - 1).
+ next := self at:(idx + 1).
+ (next == escapeCharacter) ifTrue:[
+ aStream nextPut:escapeCharacter.
+ ] ifFalse:[
+ next == $< ifTrue:[
+ idx2 := self indexOf:$> startingAt:idx+2.
+ key := self copyFrom:idx+2 to:idx2-1.
+ idx := idx2 - 1.
+ key := key asSymbolIfInterned.
+ (#(cr tab nl return lf ff null) includesIdentical:key) ifTrue:[
+ aStream nextPut:(Character perform:key).
+ ].
+ ] ifFalse:[
+ next isDigit ifTrue:[
+ v := argArrayOrDictionary at:(next digitValue) ifAbsent:''
+ ] ifFalse:[
+ next == $( ifTrue:[
+ idx2 := self indexOf:$) startingAt:idx+2.
+ key := self copyFrom:idx+2 to:idx2-1.
+ idx := idx2 - 1.
+ (argArrayOrDictionary includesKey:key) ifTrue:[
+ v := argArrayOrDictionary at:key
+ ] ifFalse:[
+ key := key asSymbolIfInterned ? key.
+ (argArrayOrDictionary includesKey:key) ifTrue:[
+ v := argArrayOrDictionary at:key
+ ] ifFalse:[
+ (key size == 1 and:[ argArrayOrDictionary includesKey:(key at:1)]) ifTrue:[
+ v := argArrayOrDictionary at:(key at:1)
+ ] ifFalse:[
+ key isNumeric ifTrue:[
+ key := Integer readFrom:key onError:nil.
+ ].
+ v := argArrayOrDictionary at:key ifAbsent:''
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ (next isLetter and:[argArrayOrDictionary isSequenceable not "is a Dictionary"]) ifTrue:[
+ "so next is a non-numeric single character."
+ v := argArrayOrDictionary
+ at:next
+ ifAbsent:[
+ "try symbol instead of character"
+ argArrayOrDictionary
+ at:next asSymbol
+ ifAbsent:[String with:escapeCharacter with:next].
+ ].
+ ] ifFalse:[
+ v := String with:$% with:next.
+ ].
+ ]
+ ].
+ "/ v notNil ifTrue:[
+ v isBlock ifTrue:[
+ v := v value
+ ].
+
+ v printOn:aStream.
+ "/ ].
+ ]
+ ].
+ start := idx + 2
].
"
String streamContents:[:s|
- 'hello %1' expandPlaceholders:$% with:#('world') on:s.
- s cr.
- 'hello $1; how is $2' expandPlaceholders:$$ with:#('world' 'this') on:s.
- s cr.
- 'hello %2; how is %1' expandPlaceholders:$% with:#('world' 'this') on:s.
- s cr.
- '%1 plus %2 gives %3 ' expandPlaceholders:$% with:#(4 5 9) on:s.
- s cr.
- '%%(1)0 gives %(1)0' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%10 gives %10' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%test gives %test' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '|%%<tab>|%%1|%%<cr>| gives |%<tab>|%1|%<cr>|' expandPlaceholders:$% with:#(foo) on:s.
+ 'hello %1' expandPlaceholders:$% with:#('world') on:s.
+ s cr.
+ 'hello $1; how is $2' expandPlaceholders:$$ with:#('world' 'this') on:s.
+ s cr.
+ 'hello %2; how is %1' expandPlaceholders:$% with:#('world' 'this') on:s.
+ s cr.
+ '%1 plus %2 gives %3 ' expandPlaceholders:$% with:#(4 5 9) on:s.
+ s cr.
+ '%%(1)0 gives %(1)0' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%10 gives %10' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%test gives %test' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '|%%<tab>|%%1|%%<cr>| gives |%<tab>|%1|%<cr>|' expandPlaceholders:$% with:#(foo) on:s.
]
"
@@ -6646,7 +6662,7 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
String streamContents:[:s|
- 'hello $1 $a $b' expandPlaceholders:$$ with:dict on:s.
+ 'hello $1 $a $b' expandPlaceholders:$$ with:dict on:s.
].
"
@@ -6657,7 +6673,7 @@
dict at:'time' put:[Time now printString].
dict at:'date' put:[Date today printString].
String streamContents:[:s|
- 'it is $(time) $(date)' expandPlaceholders:$$ with:dict on:s.
+ 'it is $(time) $(date)' expandPlaceholders:$$ with:dict on:s.
].
"
@@ -6699,9 +6715,9 @@
'bla %1 bla' expandPlaceholdersWith:{ 'hello' allBold }
'bla %1 bla' expandPlaceholdersWith:{ 'hello' }
('bla %1 bla' withColor:Color red)
- expandPlaceholdersWith:{ 'hello' }
+ expandPlaceholdersWith:{ 'hello' }
('bla %1 bla' withColor:Color red)
- expandPlaceholdersWith:{ 'hello' withColor:Color blue }
+ expandPlaceholdersWith:{ 'hello' withColor:Color blue }
"
"
@@ -6741,21 +6757,21 @@
"
String streamContents:[:s|
- 'hello %1' expandPlaceholdersWith:#('world') on:s.
- s cr.
- 'hello %1; how is %2' expandPlaceholdersWith:#('world' 'this') on:s.
- s cr.
- 'hello %2; how is %1' expandPlaceholdersWith:#('world' 'this') on:s.
- s cr.
- '%1 plus %2 gives %3 ' expandPlaceholdersWith:#(4 5 9) on:s.
- s cr.
- '%%(1)0 gives %(1)0' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%%10 gives %10' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%test gives %1' expandPlaceholdersWith:#(123) on:s.
+ 'hello %1' expandPlaceholdersWith:#('world') on:s.
+ s cr.
+ 'hello %1; how is %2' expandPlaceholdersWith:#('world' 'this') on:s.
+ s cr.
+ 'hello %2; how is %1' expandPlaceholdersWith:#('world' 'this') on:s.
+ s cr.
+ '%1 plus %2 gives %3 ' expandPlaceholdersWith:#(4 5 9) on:s.
+ s cr.
+ '%%(1)0 gives %(1)0' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%%10 gives %10' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%test gives %1' expandPlaceholdersWith:#(123) on:s.
]
"
@@ -6767,7 +6783,7 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
String streamContents:[:s|
- 'hello %1 %a %b' expandPlaceholdersWith:dict on:s.
+ 'hello %1 %a %b' expandPlaceholdersWith:dict on:s.
].
"
@@ -6788,7 +6804,7 @@
tokensBasedOn:aCharacter
"this is an ST-80 alias for the ST/X method
- asCollectionOfSubstringsSeparatedBy:"
+ asCollectionOfSubstringsSeparatedBy:"
^ self asCollectionOfSubstringsSeparatedBy:aCharacter
@@ -6806,20 +6822,20 @@
The resulting string will contain only 7-bit ascii characters.
Emphasis is not supported.
The following escapes are generated:
- \' single quote character
- \dQuote double quote character
- \r return character
- \r return character
- \n newline character
- \t tab character
- \\ the \ character itself
- \xnn two digit hex number defining the characters ascii value
- \unnnn four digit hex number defining the characters ascii value
- \Unnnnnnnn eight digit hex number defining the characters ascii value
+ \' single quote character
+ \dQuote double quote character
+ \r return character
+ \r return character
+ \n newline character
+ \t tab character
+ \\ the \ character itself
+ \xnn two digit hex number defining the characters ascii value
+ \unnnn four digit hex number defining the characters ascii value
+ \Unnnnnnnn eight digit hex number defining the characters ascii value
This is the opposite of withoutCEscapes.
Sigh: this is named completely wrong (opposite naming of withCRs/witoutCRs),
- but it cannot be changed easily, as these methods are already used heavily
+ but it cannot be changed easily, as these methods are already used heavily
"
|anyEscapeNeeded out seq|
@@ -6828,10 +6844,10 @@
first, check if any escape is needed and return the receiver unchanged if not
"
anyEscapeNeeded := self
- contains:[:ch |
- ((ch codePoint between:32 and:126) not
- or:[ch == $' or:[ch == $"]])
- ].
+ contains:[:ch |
+ ((ch codePoint between:32 and:126) not
+ or:[ch == $' or:[ch == $"]])
+ ].
anyEscapeNeeded ifFalse:[ ^ self ].
self hasChangeOfEmphasis ifTrue:[ self error:'emphasis not supported' ].
@@ -6839,38 +6855,38 @@
out := WriteStream on:(String uninitializedNew:self size-1).
self do:[:ch |
- |cp|
-
- (ch == $' or:[ch == $"]) ifTrue:[
- out nextPut:$\.
- out nextPut:ch.
- ] ifFalse:[
- (ch codePoint between:32 and:126) ifTrue:[
- out nextPut:ch
- ] ifFalse:[
- ch == Character return ifTrue:[
- seq := '\r'
- ] ifFalse:[ ch == Character nl ifTrue:[
- seq := '\n'
- ] ifFalse:[ ch == Character tab ifTrue:[
- seq := '\t'
- ] ifFalse:[ ch == $\ ifTrue:[
- seq := '\\'
- ] ifFalse:[
- cp := ch codePoint.
- cp <= 16rFF ifTrue:[
- seq := '\x' , (cp printStringRadix:16 padTo:2)
- ] ifFalse:[
- cp <= 16rFFFF ifTrue:[
- seq := '\u' , (cp printStringRadix:16 padTo:4)
- ] ifFalse:[
- seq := '\U',(cp printStringRadix:16 padTo:8)
- ]
- ]
- ]]]].
- out nextPutAll:seq
- ].
- ].
+ |cp|
+
+ (ch == $' or:[ch == $"]) ifTrue:[
+ out nextPut:$\.
+ out nextPut:ch.
+ ] ifFalse:[
+ (ch codePoint between:32 and:126) ifTrue:[
+ out nextPut:ch
+ ] ifFalse:[
+ ch == Character return ifTrue:[
+ seq := '\r'
+ ] ifFalse:[ ch == Character nl ifTrue:[
+ seq := '\n'
+ ] ifFalse:[ ch == Character tab ifTrue:[
+ seq := '\t'
+ ] ifFalse:[ ch == $\ ifTrue:[
+ seq := '\\'
+ ] ifFalse:[
+ cp := ch codePoint.
+ cp <= 16rFF ifTrue:[
+ seq := '\x' , (cp printStringRadix:16 padTo:2)
+ ] ifFalse:[
+ cp <= 16rFFFF ifTrue:[
+ seq := '\u' , (cp printStringRadix:16 padTo:4)
+ ] ifFalse:[
+ seq := '\U',(cp printStringRadix:16 padTo:8)
+ ]
+ ]
+ ]]]].
+ out nextPutAll:seq
+ ].
+ ].
].
^ out contents
@@ -6919,11 +6935,11 @@
in := self readStream.
out := WriteStream on:(self species new:self size).
[in atEnd] whileFalse:[
- c := in next.
- (c == escape or:['*[#' includes:c]) ifTrue:[
- out nextPut:$\.
- ].
- out nextPut:c.
+ c := in next.
+ (c == escape or:['*[#' includes:c]) ifTrue:[
+ out nextPut:$\.
+ ].
+ out nextPut:c.
].
^ out contents.
@@ -6946,23 +6962,23 @@
Preserves a leading/trailing space."
^ self species streamContents:[:s |
- |skipping|
-
- skipping := false.
- 1 to:self size do:[:idx |
- |char|
-
- char := self at:idx.
- char isSeparator ifFalse:[
- s nextPut:char.
- skipping := false.
- ] ifTrue:[
- skipping ifFalse:[
- s nextPut:(Character space).
- skipping := true
- ].
- ]
- ]
+ |skipping|
+
+ skipping := false.
+ 1 to:self size do:[:idx |
+ |char|
+
+ char := self at:idx.
+ char isSeparator ifFalse:[
+ s nextPut:char.
+ skipping := false.
+ ] ifTrue:[
+ skipping ifFalse:[
+ s nextPut:(Character space).
+ skipping := true
+ ].
+ ]
+ ]
]
"
@@ -6980,13 +6996,13 @@
Typically used with space as replacementCharacter"
^ self species streamContents:[:s |
- self do:[:ch |
- ch isSeparator ifTrue:[
- s nextPut:replacementCharacter
- ] ifFalse:[
- s nextPut:ch.
- ]
- ]
+ self do:[:ch |
+ ch isSeparator ifTrue:[
+ s nextPut:replacementCharacter
+ ] ifFalse:[
+ s nextPut:ch.
+ ]
+ ]
]
"
@@ -7006,8 +7022,8 @@
Notice: if the receiver does not contain any tabs, it is returned unchanged;
otherwise a new string is returned.
Limitation: only the very first spaces are replaced
- (i.e. if the receiver contains newLine characters,
- no tabs are inserted after those lineBreaks)"
+ (i.e. if the receiver contains newLine characters,
+ no tabs are inserted after those lineBreaks)"
|idx "{ SmallInteger }"
nTabs "{ SmallInteger }"
@@ -7051,19 +7067,19 @@
('123456789' , Character tab asString , 'x') withTabsExpanded
(String with:Character tab
- with:Character tab
- with:$1) withTabsExpanded
+ with:Character tab
+ with:$1) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character tab
+ with:$2) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character cr
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character cr
+ with:Character tab
+ with:$2) withTabsExpanded
"
"Modified: 12.5.1996 / 13:05:10 / cg"
@@ -7092,19 +7108,19 @@
col := 1. newSz := 0.
1 to:sz do:[:srcIdx |
- ch := self at:srcIdx.
- ch == Character tab ifFalse:[
- col := col + 1.
- newSz := newSz + 1.
- ch == Character cr ifTrue:[
- col := 1
- ].
- ] ifTrue:[
- (col \\ numSpaces) to:numSpaces do:[:ii |
- newSz := newSz + 1.
- col := col + 1
- ].
- ]
+ ch := self at:srcIdx.
+ ch == Character tab ifFalse:[
+ col := col + 1.
+ newSz := newSz + 1.
+ ch == Character cr ifTrue:[
+ col := 1
+ ].
+ ] ifTrue:[
+ (col \\ numSpaces) to:numSpaces do:[:ii |
+ newSz := newSz + 1.
+ col := col + 1
+ ].
+ ]
].
self isText ifTrue:[
@@ -7117,26 +7133,26 @@
col := 1. dstIdx := 1.
1 to:sz do:[:srcIdx |
- ch := self at:srcIdx.
-
- ch == Character tab ifFalse:[
- col := col + 1.
- ch == Character cr ifTrue:[
- col := 1
- ].
- hasEmphasis ifTrue:[
- e := self emphasisAt:srcIdx.
- str emphasisAt:dstIdx put:e
- ].
- str at:dstIdx put:ch.
- dstIdx := dstIdx + 1
- ] ifTrue:[
- (col \\ numSpaces) to:numSpaces do:[:ii |
- str at:dstIdx put:Character space.
- dstIdx := dstIdx + 1.
- col := col + 1
- ].
- ]
+ ch := self at:srcIdx.
+
+ ch == Character tab ifFalse:[
+ col := col + 1.
+ ch == Character cr ifTrue:[
+ col := 1
+ ].
+ hasEmphasis ifTrue:[
+ e := self emphasisAt:srcIdx.
+ str emphasisAt:dstIdx put:e
+ ].
+ str at:dstIdx put:ch.
+ dstIdx := dstIdx + 1
+ ] ifTrue:[
+ (col \\ numSpaces) to:numSpaces do:[:ii |
+ str at:dstIdx put:Character space.
+ dstIdx := dstIdx + 1.
+ col := col + 1
+ ].
+ ]
].
^ str
@@ -7150,19 +7166,19 @@
('123456789' , Character tab asString , 'x') withTabsExpanded
(String with:Character tab
- with:Character tab
- with:$1) withTabsExpanded
+ with:Character tab
+ with:$1) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character tab
+ with:$2) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character cr
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character cr
+ with:Character tab
+ with:$2) withTabsExpanded
"
"Modified: / 12-05-1996 / 13:05:10 / cg"
@@ -7195,18 +7211,18 @@
with all \X-character escapes replaced by corresponding-characters.
(similar to the way C-language Strings are converted).
The following escapes are supported:
- \r return character
- \n newline character
- \b backspace character
- \f formfeed character
- \t tab character
- \e escape character
- \\ the \ character itself
- \nnn three digit octal number defining the characters ascii value
- \xnn two digit hex number defining the characters ascii value
- \unnnn four digit hex number defining the characters unicode value
- \Unnnnnnnn eight digit hex number defining the characters unicode value
- \other other
+ \r return character
+ \n newline character
+ \b backspace character
+ \f formfeed character
+ \t tab character
+ \e escape character
+ \\ the \ character itself
+ \nnn three digit octal number defining the characters ascii value
+ \xnn two digit hex number defining the characters ascii value
+ \unnnn four digit hex number defining the characters unicode value
+ \Unnnnnnnn eight digit hex number defining the characters unicode value
+ \other other
Notice, that \' is NOT a valid escape, since the general syntax of
string constants is not affected by this method.
@@ -7221,7 +7237,7 @@
This is the opposite of withCEscapes.
Sigh: this is named completely wrong (opposite naming of withCRs/witoutCRs),
- but it cannot be changed easily, as these methods are already used heavily
+ but it cannot be changed easily, as these methods are already used heavily
"
|val "{ SmallInteger }"
@@ -7237,64 +7253,64 @@
in := ReadStream on:self.
[in atEnd] whileFalse:[
- nextChar := in next.
- nextChar == $\ ifTrue:[
- in atEnd ifTrue:[
- ] ifFalse:[
- nextChar := in next.
- nextChar == $r ifTrue:[
- nextChar := Character return
- ] ifFalse:[ nextChar == $n ifTrue:[
- nextChar := Character nl
- ] ifFalse:[ nextChar == $b ifTrue:[
- nextChar := Character backspace
- ] ifFalse:[ nextChar == $f ifTrue:[
- nextChar := Character newPage
- ] ifFalse:[ nextChar == $t ifTrue:[
- nextChar := Character tab
- ] ifFalse:[ nextChar == $e ifTrue:[
- nextChar := Character esc
- ] ifFalse:[
- nextChar == $0 ifTrue:[
- val := 0.
- nextChar := in peek.
- nDigits := 1.
- [nextChar notNil and:[nextChar isDigit and:[nDigits <= 3]]] whileTrue:[
- val := (val * 8) + nextChar digitValue.
- nextChar := in nextPeek.
- nDigits := nDigits + 1.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- val := 0.
- nextChar == $x ifTrue:[
- 2 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- nextChar == $u ifTrue:[
- 4 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- nextChar == $U ifTrue:[
- 8 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ]
- ]
- ]
- ]
- ]]]]]].
- ].
- ].
- out nextPut:nextChar.
+ nextChar := in next.
+ nextChar == $\ ifTrue:[
+ in atEnd ifTrue:[
+ ] ifFalse:[
+ nextChar := in next.
+ nextChar == $r ifTrue:[
+ nextChar := Character return
+ ] ifFalse:[ nextChar == $n ifTrue:[
+ nextChar := Character nl
+ ] ifFalse:[ nextChar == $b ifTrue:[
+ nextChar := Character backspace
+ ] ifFalse:[ nextChar == $f ifTrue:[
+ nextChar := Character newPage
+ ] ifFalse:[ nextChar == $t ifTrue:[
+ nextChar := Character tab
+ ] ifFalse:[ nextChar == $e ifTrue:[
+ nextChar := Character esc
+ ] ifFalse:[
+ nextChar == $0 ifTrue:[
+ val := 0.
+ nextChar := in peek.
+ nDigits := 1.
+ [nextChar notNil and:[nextChar isDigit and:[nDigits <= 3]]] whileTrue:[
+ val := (val * 8) + nextChar digitValue.
+ nextChar := in nextPeek.
+ nDigits := nDigits + 1.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ val := 0.
+ nextChar == $x ifTrue:[
+ 2 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ nextChar == $u ifTrue:[
+ 4 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ nextChar == $U ifTrue:[
+ 8 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ]
+ ]
+ ]
+ ]
+ ]]]]]].
+ ].
+ ].
+ out nextPut:nextChar.
].
^ out contents
@@ -7347,10 +7363,10 @@
index := self indexOfNonSeparatorStartingAt:1.
index ~~ 0 ifTrue:[
- index == 1 ifTrue:[
- ^ self
- ].
- ^ self copyFrom:index
+ index == 1 ifTrue:[
+ ^ self
+ ].
+ ^ self copyFrom:index
].
^ ''
@@ -7375,13 +7391,13 @@
in := self readStream.
out := self species writeStream.
[in atEnd] whileFalse:[
- c := in next.
- c == escape ifTrue:[
- in atEnd ifFalse:[
- c := in next.
- ]
- ].
- out nextPut:c.
+ c := in next.
+ c == escape ifTrue:[
+ in atEnd ifFalse:[
+ c := in next.
+ ]
+ ].
+ out nextPut:c.
].
^ out contents.
@@ -7404,7 +7420,7 @@
Otherwise return the receiver"
(self startsWith:aString) ifTrue:[
- ^ self copyFrom:aString size+1
+ ^ self copyFrom:aString size+1
].
^ self
@@ -7427,7 +7443,7 @@
((firstChar == $") or:[firstChar == $']) ifFalse:[^ self].
self last == firstChar ifTrue:[
- ^ self copyFrom:2 to:(self size-1)
+ ^ self copyFrom:2 to:(self size-1)
].
^ self
@@ -7674,45 +7690,45 @@
subSize := subString size.
subSize == 0 ifTrue:[
- subString isString ifFalse:[
- self error:'non string argument' mayProceed:true.
- ].
- "empty string does not match"
- ^ 0.
- "empty string matches"
+ subString isString ifFalse:[
+ self error:'non string argument' mayProceed:true.
+ ].
+ "empty string does not match"
+ ^ 0.
+ "empty string matches"
"/ ^ index
].
mySize := self size.
firstChar := subString at:1.
caseSensitive ifTrue:[
- tester := [:c1 :c2 | c1 = c2 ].
- startIndex := self indexOf:firstChar startingAt:index.
+ tester := [:c1 :c2 | c1 = c2 ].
+ startIndex := self indexOf:firstChar startingAt:index.
] ifFalse:[
- tester := [:c1 :c2 | c1 sameAs: c2 ].
- startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:index.
+ tester := [:c1 :c2 | c1 sameAs: c2 ].
+ startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:index.
].
[startIndex == 0] whileFalse:[
- runIdx := startIndex.
- found := true.
- 1 to:subSize do:[:i |
- runIdx > mySize ifTrue:[
- found := false
- ] ifFalse:[
- (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
- found := false
- ]
- ].
- runIdx := runIdx + 1
- ].
- found ifTrue:[
- ^ startIndex
- ].
- caseSensitive ifTrue:[
- startIndex := self indexOf:firstChar startingAt:(startIndex + 1)
- ] ifFalse:[
- startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:(startIndex + 1).
- ].
+ runIdx := startIndex.
+ found := true.
+ 1 to:subSize do:[:i |
+ runIdx > mySize ifTrue:[
+ found := false
+ ] ifFalse:[
+ (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
+ found := false
+ ]
+ ].
+ runIdx := runIdx + 1
+ ].
+ found ifTrue:[
+ ^ startIndex
+ ].
+ caseSensitive ifTrue:[
+ startIndex := self indexOf:firstChar startingAt:(startIndex + 1)
+ ] ifFalse:[
+ startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:(startIndex + 1).
+ ].
].
^ exceptionBlock value
@@ -7734,53 +7750,53 @@
subSize := subString size.
subSize == 0 ifTrue:[
- subString isString ifFalse:[
- self error:'non string argument' mayProceed:true.
- ].
- "empty string does not match"
- ^ 0.
- "empty string matches"
+ subString isString ifFalse:[
+ self error:'non string argument' mayProceed:true.
+ ].
+ "empty string does not match"
+ ^ 0.
+ "empty string matches"
"/ ^ index
].
mySize := self size.
firstChar := subString at:1.
ignoreDiacritics ifTrue:[
- caseSensitive ifTrue:[
- charMap := [:ch | ch asLowercase withoutDiacritics].
- ] ifFalse:[
- charMap := [:ch | ch withoutDiacritics].
- ].
- tester := [:c1 :c2 | (charMap value:c1) = (charMap value:c2) ].
- firstCharMapped := (charMap value:firstChar).
- findNextIndex := [:index | self findFirst:[:ch | (charMap value:ch) = firstCharMapped] startingAt:index].
+ caseSensitive ifTrue:[
+ charMap := [:ch | ch asLowercase withoutDiacritics].
+ ] ifFalse:[
+ charMap := [:ch | ch withoutDiacritics].
+ ].
+ tester := [:c1 :c2 | (charMap value:c1) = (charMap value:c2) ].
+ firstCharMapped := (charMap value:firstChar).
+ findNextIndex := [:index | self findFirst:[:ch | (charMap value:ch) = firstCharMapped] startingAt:index].
] ifFalse:[
- caseSensitive ifTrue:[
- tester := [:c1 :c2 | c1 = c2 ].
- findNextIndex := [:index | self indexOf:firstChar startingAt:index].
- ] ifFalse:[
- tester := [:c1 :c2 | c1 sameAs: c2 ].
- findNextIndex := [:index | self findFirst:[:c | c sameAs:firstChar] startingAt:index].
- ].
+ caseSensitive ifTrue:[
+ tester := [:c1 :c2 | c1 = c2 ].
+ findNextIndex := [:index | self indexOf:firstChar startingAt:index].
+ ] ifFalse:[
+ tester := [:c1 :c2 | c1 sameAs: c2 ].
+ findNextIndex := [:index | self findFirst:[:c | c sameAs:firstChar] startingAt:index].
+ ].
].
startIndex := findNextIndex value:index.
[startIndex == 0] whileFalse:[
- runIdx := startIndex.
- found := true.
- 1 to:subSize do:[:i |
- runIdx > mySize ifTrue:[
- found := false
- ] ifFalse:[
- (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
- found := false
- ]
- ].
- runIdx := runIdx + 1
- ].
- found ifTrue:[
- ^ startIndex
- ].
- startIndex := findNextIndex value:(startIndex + 1)
+ runIdx := startIndex.
+ found := true.
+ 1 to:subSize do:[:i |
+ runIdx > mySize ifTrue:[
+ found := false
+ ] ifFalse:[
+ (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
+ found := false
+ ]
+ ].
+ runIdx := runIdx + 1
+ ].
+ found ifTrue:[
+ ^ startIndex
+ ].
+ startIndex := findNextIndex value:(startIndex + 1)
].
^ exceptionBlock value
@@ -7855,7 +7871,7 @@
i := self indexOfSubCollection:subString startingAt:start ifAbsent:0 caseSensitive:caseSensitive.
i == 0 ifTrue:[
- ^ exceptionValue value
+ ^ exceptionValue value
].
^ i to:(i + subString size - 1)
@@ -7873,10 +7889,10 @@
|binopChars|
(self size <= Method maxBinarySelectorSize) ifTrue:[
- binopChars := Method binarySelectorCharacters.
- (self conform:[:eachChar | (binopChars includes:eachChar)]) ifTrue:[
- ^ 1
- ].
+ binopChars := Method binarySelectorCharacters.
+ (self conform:[:eachChar | (binopChars includes:eachChar)]) ifTrue:[
+ ^ 1
+ ].
].
^ self occurrencesOf:$:
@@ -7903,22 +7919,22 @@
sz "{ Class:SmallInteger}" |
(string := self string) ~~ self ifTrue:[
- ^ string characterSize.
+ ^ string characterSize.
].
sz := self size.
max := 7.
1 to:sz do:[:idx |
- |thisSize|
-
- thisSize := (self at:idx) characterSize.
- thisSize > max ifTrue:[
- max := thisSize.
- max == 32 ifTrue:[
- "shortcut: we know, that max size is 32"
- ^ 32.
- ].
- ].
+ |thisSize|
+
+ thisSize := (self at:idx) characterSize.
+ thisSize > max ifTrue:[
+ max := thisSize.
+ max == 32 ifTrue:[
+ "shortcut: we know, that max size is 32"
+ ^ 32.
+ ].
+ ].
].
^ max.
@@ -7945,13 +7961,13 @@
sz "{ Class:SmallInteger }"|
(string := self string) ~~ self ifTrue:[
- ^ string containsNon7BitAscii
+ ^ string containsNon7BitAscii
].
sz := self size.
1 to:sz do:[:idx|
- (self at:idx) codePoint > 16r7F ifTrue:[
- ^ true.
- ].
+ (self at:idx) codePoint > 16r7F ifTrue:[
+ ^ true.
+ ].
].
^ false.
@@ -7968,8 +7984,8 @@
i.e. consists of a letter followed by letters or digits."
self size == 0 ifTrue:[
- "mhmh what is this ?"
- ^ false
+ "mhmh what is this ?"
+ ^ false
].
(self at:1) isLetter ifFalse:[^ false].
^ self conform:[:char | char isLetterOrDigit].
@@ -8040,16 +8056,16 @@
state := #initial.
self do:[:char |
- (state == #initial or:[ state == #gotColon]) ifTrue:[
- (char isLetterOrUnderline) ifFalse:[^ false].
- state := #gotCharacter.
- ] ifFalse:[
- char == $: ifTrue:[
- state := #gotColon.
- ] ifFalse:[
- (char isLetterOrDigit or:[char == $_]) ifFalse:[^ false].
- ].
- ].
+ (state == #initial or:[ state == #gotColon]) ifTrue:[
+ (char isLetterOrUnderline) ifFalse:[^ false].
+ state := #gotCharacter.
+ ] ifFalse:[
+ char == $: ifTrue:[
+ state := #gotColon.
+ ] ifFalse:[
+ (char isLetterOrDigit or:[char == $_]) ifFalse:[^ false].
+ ].
+ ].
].
^ state == #gotColon.
@@ -8109,7 +8125,7 @@
i.e. consists only of digits."
self size == 0 ifTrue:[
- ^ false
+ ^ false
].
^ self conform:[:char | char isDigit]
@@ -8174,12 +8190,12 @@
scanner := Compiler new.
scanner source:(self readStream).
Parser parseErrorSignal handle:[:ex |
- tok := nil.
+ tok := nil.
] do:[
- tok := scanner nextToken.
+ tok := scanner nextToken.
].
tok ~~ #Identifier ifTrue:[
- ^ false
+ ^ false
].
scanner tokenPosition == 1 ifFalse:[^ false].
^ scanner sourceStream atEnd.
@@ -8200,7 +8216,7 @@
|string|
(string := self string) ~~ self ifTrue:[
- ^ string isWideString.
+ ^ string isWideString.
].
^ self contains:[:aCharacter | aCharacter codePoint > 16rFF].
!
@@ -8226,13 +8242,13 @@
idx1 := 1.
sz := self size.
[
- idx2 := self indexOf:$: startingAt:idx1.
- (idx2 == 0 or:[idx2 == sz]) ifTrue:[
- coll add:(self copyFrom:idx1).
- ^ coll
- ].
- coll add:(self copyFrom:idx1 to:idx2).
- idx1 := idx2 + 1
+ idx2 := self indexOf:$: startingAt:idx1.
+ (idx2 == 0 or:[idx2 == sz]) ifTrue:[
+ coll add:(self copyFrom:idx1).
+ ^ coll
+ ].
+ coll add:(self copyFrom:idx1 to:idx2).
+ idx1 := idx2 + 1
] loop.
"
@@ -8263,6 +8279,7 @@
^ aVisitor visitString:self with:aParameter
! !
+
!CharacterArray class methodsFor:'documentation'!
version
--- a/CharacterEncoder.st Wed Oct 19 09:22:53 2016 +0100
+++ b/CharacterEncoder.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2004 by eXept Software AG
All Rights Reserved
@@ -1133,7 +1131,7 @@
s := aFilename asFilename readStreamOrNil.
s isNil ifTrue:[^ nil].
- buffer := String new:64.
+ buffer := String new:512.
n := s nextBytes:buffer size into:buffer.
s close.
@@ -1158,7 +1156,10 @@
|oldPosition buffer n|
- buffer := String new:64.
+ "/ must be able to position back
+ aStream isPositionable ifFalse:[^ nil].
+
+ buffer := String new:512.
oldPosition := aStream position.
n := aStream nextBytes:buffer size into:buffer.
--- a/CheapBlock.st Wed Oct 19 09:22:53 2016 +0100
+++ b/CheapBlock.st Fri Dec 09 22:31:28 2016 +0000
@@ -47,7 +47,7 @@
machine or byteCode, and the generated block is found to neither access
any variables from its homeContext nor does a method-return.
CheapBlocks create less overhead to the runtime system, in that they
- do not keep the creating context from being reclaimed (but, dont expect
+ do not keep the creating context from being reclaimed (but, don't expect
too much of a difference ;-)
Since they have no reference to the home, they must store their
--- a/Class.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Class.st Fri Dec 09 22:31:28 2016 +0000
@@ -386,10 +386,10 @@
"/ care for standAlone apps which have no CVS (libbasic3) included
"/
mgr isNil ifTrue:[
- AbstractSourceCodeManager notNil ifTrue:[
- ^ CVSVersionInfo fromRCSString:aString
- ].
- ^ nil
+ AbstractSourceCodeManager notNil ifTrue:[
+ ^ AbstractSourceCodeManager revisionInfoFromRCSString:aString
+ ].
+ ^ nil
].
^ mgr revisionInfoFromString:aString.
@@ -2496,7 +2496,7 @@
"add a snapshot-record to aStream"
- self addInfoRecord:('snapshot ' , aFileName) to:aStream
+ self addInfoRecord:('snapshot ' , aFileName asString) to:aStream
"Modified: / 24.1.1997 / 19:11:08 / cg"
"Modified: / 18.3.1999 / 18:15:30 / stefan"
@@ -3160,9 +3160,9 @@
"append a binary representation of myself to aStream in
a portable binary format.
The argument controls how sources are to be saved:
- #keep - include the source
- #reference - include a reference to the sourceFile
- #discard - dont save sources.
+ #keep - include the source
+ #reference - include a reference to the sourceFile
+ #discard - don't save sources.
With #reference, the sourceFile needs to be present after reload
in order to be browsable."
@@ -3179,9 +3179,9 @@
"create a file 'class.cls' (in the current projects fileOut-directory),
consisting of all methods in myself in a portable binary format.
The argument controls how sources are to be saved:
- #keep - include the source
- #reference - include a reference to the sourceFile
- #discard - dont save sources.
+ #keep - include the source
+ #reference - include a reference to the sourceFile
+ #discard - don't save sources.
With #reference, the sourceFile needs to be present after reload
in order to be browsable."
@@ -3191,9 +3191,9 @@
fileName := (Smalltalk fileNameForClass:self name), '.cls'.
Project notNil ifTrue:[
- dirName := Project currentProjectDirectory
+ dirName := Project currentProjectDirectory
] ifFalse:[
- dirName := '.'
+ dirName := '.'
].
fileName := dirName asFilename construct:fileName.
fileName makeLegalFilename.
@@ -3207,9 +3207,9 @@
"create a file fileNameString,
consisting of all methods in myself in a portable binary format.
The argument controls how sources are to be saved:
- #keep - include the source
- #reference - include a reference to the sourceFile
- #discard - dont save sources.
+ #keep - include the source
+ #reference - include a reference to the sourceFile
+ #discard - don't save sources.
With #reference, the sourceFile needs to be present after reload
in order to be browsable."
@@ -3220,11 +3220,11 @@
fileName makeLegalFilename.
[
- aStream := fileName newReadWriteStream.
+ aStream := fileName newReadWriteStream.
] on:FileStream openErrorSignal do:[:ex|
- ^ FileOutErrorSignal
- raiseRequestWith:fileName name
- errorString:(' - cannot create file:', fileName name)
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName name
+ errorString:(' - cannot create file:', fileName name)
].
aStream binary.
@@ -4009,7 +4009,7 @@
canHaveExtensions
"return true, if this class allows extensions from other packages.
- Private classes, namespaces and projectDefinitions dont allow this"
+ Private classes, namespaces and projectDefinitions don't allow this"
^ self isPrivate not
--- a/ClassBuilder.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ClassBuilder.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2001 by eXept Software AG
All Rights Reserved
@@ -459,7 +457,7 @@
"NOTICE:
this method is too complex and should be splitted into managable pieces ...
- I dont like it anymore :-)
+ I don't like it anymore :-)
(well, at least, its a good test for the compilers ability
to handle big, complex methods ;-)
take it as an example of bad coding style ...
@@ -601,7 +599,7 @@
"/ - thus, once confirmed, the warnings will not come again and again.
"/ NOTICE:
- "/ I dont like the confirmers there - we need a notifying: argument, to give
+ "/ I don't like the confirmers there - we need a notifying: argument, to give
"/ the outer codeview a chance to highlight the error.
"/ (but that's how its defined in the book - maybe I will change anyway).
"/ - or use upQueries in future versions.
@@ -1245,7 +1243,7 @@
"/ recompile all methods accessing set of changed classvars
"/ here and also in all subclasses ...
- "/ dont update change file for the recompilation
+ "/ don't update change file for the recompilation
Class withoutUpdatingChangesDo:[
@@ -1324,7 +1322,7 @@
"/ "/ update superclass of immediate subclasses -
"/ "/ this forces recompilation (recursively) if needed
-"/ "/ (dont update change file for the subclass changes)
+"/ "/ (don't update change file for the subclass changes)
"/
"/ Class classRedefinitionNotification answer:#keep do:[
"/ Class withoutUpdatingChangesDo:[
@@ -1365,7 +1363,7 @@
"/ update superclass of immediate subclasses -
"/ this forces recompilation (recursively) if needed
- "/ (dont update change file for the subclass changes)
+ "/ (don't update change file for the subclass changes)
Class classRedefinitionNotification answer:#keep do:[
Class withoutUpdatingChangesDo:[
@@ -2349,7 +2347,7 @@
checkValidVarNamesFor:className subClassOf:aClass instVarNames:instVarNameString classVarNames:classVarNameString
"Check for some 'considered bad-style' things, like lower case names.
NOTICE:
- I dont like the confirmers below - we need a notifying: argument, or a
+ I don't like the confirmers below - we need a notifying: argument, or a
notifierSignal to give the outer codeview a chance to highlight the error.
(but that's how its defined in the book - maybe I will change it anyway).
"
@@ -2388,7 +2386,7 @@
self warn:('Class variable "%1"\conflicts with corresponding private classes name.\The name will refer to the class variable.'
bindWith:conflicts first) withCRs.
] ifFalse:[
- self warn:('Some class variables conflict with corresponding private classes name.\Names will refer to the class variable.').
+ self warn:('Some class variables conflict with corresponding private classes name.\Names will refer to the class variable.' withCRs).
].
^ true.
]
--- a/ClassDescription.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ClassDescription.st Fri Dec 09 22:31:28 2016 +0000
@@ -678,15 +678,6 @@
^ Dolphin::SourceManager default
! !
-!ClassDescription methodsFor:'Compatibility-ST/V'!
-
-variableByteSubclass:nameSymbol classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
- in which the subclass has indexable byte-sized nonpointer variables"
-
- ^ self variableByteSubclass:nameSymbol instanceVariableNames:'' classVariableNames:classVarString poolDictionaries:pool category:cat
-! !
-
!ClassDescription methodsFor:'Compatibility-ST80'!
addInstVarName:anotherInstVar
@@ -838,7 +829,6 @@
"Created: / 24-07-2015 / 19:28:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ClassDescription methodsFor:'Compatibility-V''Age'!
categoriesFor:aSelector are:listOfCategories
@@ -1078,19 +1068,16 @@
!
instVarOffsetOf:aVariableName
+ <resource: #obsolete>
"return the index (as used in instVarAt:/instVarAt:put:) of a named instance
variable (1..instSize) for valid variable names, nil for illegal names.
This was the original ST/X's method for this functionality; senders have been changed to use instVarIndexFor:.
Kept for backward compatibility; please use instVarIndexFor: for VW and Squeak compatibility"
+ self obsoleteMethodWarning.
+
^ self instVarIndexFor:aVariableName
- "
- Point instVarOffsetOf:'x'
- View instVarOffsetOf:'paint'
- Button instVarOffsetOf:'logo'
- "
-
"Modified: 23.8.1997 / 16:59:15 / cg"
!
@@ -2078,7 +2065,7 @@
methodsForUndefined:categoryString
"ST-80 compatibility.
- I dont yet know what this does - it was encountered by some tester.
+ I don't yet know what this does - it was encountered by some tester.
For now, simply forward it."
^ self methodsFor:categoryString
--- a/Collection.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Collection.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -259,9 +257,9 @@
!
withSize:n
- "obsolete: please use newWithSize:, for its better name
- Return a new collection which really provides space for n elements.
- Kludges around the stupid definition of OrderedCollection>>new:"
+ "obsolete: please use newWithSize:, for its better name"
+
+ <resource: #obsolete>
^ self newWithSize:n
! !
@@ -275,6 +273,7 @@
^ self newWithSize:n
! !
+
!Collection class methodsFor:'Signal constants'!
emptyCollectionSignal
@@ -549,6 +548,7 @@
"Created: / 22-10-2008 / 21:29:27 / cg"
! !
+
!Collection methodsFor:'accessing'!
anElement
@@ -703,7 +703,7 @@
firstIfEmpty:exceptionValue
"return the first element of the collection.
If its empty, return the exceptionValue.
- (i.e. dont trigger an error as done in #first)"
+ (i.e. don't trigger an error as done in #first)"
self isEmpty ifTrue:[^ exceptionValue value].
^ self first
@@ -714,7 +714,7 @@
firstOrNil
"return the first element of the collection.
If its empty, return nil.
- (i.e. dont trigger an error as done in #first)"
+ (i.e. don't trigger an error as done in #first)"
^ self firstIfEmpty:nil
@@ -1616,16 +1616,16 @@
asArrayOfType:arrayClass
"return a new instance of arrayClass with the collection's elements"
- |anIntegerArray
+ |anArrayInstance
index "{ Class: SmallInteger }" |
- anIntegerArray := arrayClass new:(self size).
+ anArrayInstance := arrayClass new:(self size).
index := 1.
self do:[:each |
- anIntegerArray at:index put:each.
+ anArrayInstance at:index put:each.
index := index + 1
].
- ^ anIntegerArray
+ ^ anArrayInstance
!
asBag
@@ -2517,12 +2517,13 @@
individualResult := aBlock value:element.
result isNil ifTrue:[
- result := individualResult speciesForAdding new.
+ result := individualResult speciesForCollecting new.
].
result addAll:individualResult.
].
- ^ result ? #()
+ "do not answer an empty - possibly immutable - Array"
+ ^ result ? self speciesForCollecting new.
"
#(1 2 3 4) collectAll:[:n | Array new:n withAll:n ]
@@ -2541,10 +2542,7 @@
result := collectionClass new.
self do:[:element |
- |individualResult|
-
- individualResult := aBlock value:element.
- result addAll:individualResult.
+ result addAll:(aBlock value:element).
].
^ result
@@ -4341,7 +4339,7 @@
aStream nextPut:$)
"
- #(1 2 3 'hello' $a $ü) printOn:Transcript
+ #(1 2 3 'hello' $a $ü) printOn:Transcript
(Array new:100000) printOn:Transcript
(Array new:100000) printOn:Stdout
(Array new:100000) printString size
@@ -5695,7 +5693,7 @@
includesAll:aCollection
"return true if the receiver includes all elements of
the argument, aCollection; false if any is missing.
- Notice: this method has O² runtime behavior and may be
+ Notice: this method has O² runtime behavior and may be
slow for big receivers/args.
Think about using a Set, or Dictionary."
@@ -5715,7 +5713,7 @@
Return false if it includes none.
Uses #= (value compare)
Notice:
- this method has O² runtime behavior for some subclasses and may be slow for big receivers/args.
+ this method has O² runtime behavior for some subclasses and may be slow for big receivers/args.
Think about using a Set or Dictionary.
Some speedup is also possible, by arranging highly
probable elements towards the beginning of aCollection, to avoid useless searches.
@@ -5785,7 +5783,7 @@
Return false if it includes none.
Use identity compare for comparing.
Notice:
- this method has O² runtime behavior for some subclasses and may be slow for big receivers/args.
+ this method has O² runtime behavior for some subclasses and may be slow for big receivers/args.
Think about using a Set or Dictionary.
Some speedup is also possible, by arranging highly
probable elements towards the beginning of aCollection, to avoid useless searches."
@@ -6001,6 +5999,7 @@
^ aVisitor visitCollection:self with:aParameter
! !
+
!Collection class methodsFor:'documentation'!
version
--- a/CompiledCode.st Wed Oct 19 09:22:53 2016 +0100
+++ b/CompiledCode.st Fri Dec 09 22:31:28 2016 +0000
@@ -338,7 +338,7 @@
flags
"return the flags (number of method variables, stacksize etc.).
- Dont depend on the values in the flag field - its interpretations
+ Don't depend on the values in the flag field - its interpretations
may change without notice."
^ flags
@@ -1551,16 +1551,16 @@
flags:newFlags
"set the flags (number of method variables, stacksize).
WARNING: for internal use by the compiler only.
- playing around here with incorrect values
- may crash smalltalk badly.
+ playing around here with incorrect values
+ may crash smalltalk badly.
- Dont depend on the values in the flag field - its interpretations
+ Don't depend on the values in the flag field - its interpretations
may change without notice."
"/ protect myself a bit - putting in an object would crash me ...
(newFlags isMemberOf:SmallInteger) ifTrue:[
- flags := newFlags
+ flags := newFlags
]
"Modified: 8.3.1996 / 13:26:05 / cg"
--- a/Complex.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Complex.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
This is a Manchester Goodie. It is distributed freely on condition
that you observe these conditions in respect of the whole Goodie, and on
@@ -449,6 +447,10 @@
^ self class real:r imaginary:i.
!
+differenceFromFixedPoint: aFixedPoint
+ ^ aFixedPoint asComplex - self
+!
+
differenceFromFloat:aFloat
"Return the difference of the argument, aFloat and the receiver."
@@ -496,6 +498,10 @@
^ self class real:r imaginary:i
!
+productFromFixedPoint: aFixedPoint
+ ^ aFixedPoint asComplex * self
+!
+
productFromFloat: aFloat
"Return the product of the receiver and the argument, aFloat."
@@ -559,6 +565,12 @@
"/ imaginary: ((aComplex imaginaryPart * quotient) - aComplex realPart) / denominator ]
!
+quotientFromFixedPoint:aFixedPoint
+ "Return the quotient of the argument, aFixedPoint and the receiver."
+
+ ^ aFixedPoint asComplex / self
+!
+
quotientFromFloat:aFloat
"Return the quotient of the argument, aFloat and the receiver."
@@ -588,6 +600,10 @@
^ self class real:r imaginary:i
!
+sumFromFixedPoint: aFixedPoint
+ ^ aFixedPoint asComplex + self
+!
+
sumFromFloat: aFloat
"Return the sum of the receiver and the argument, aFloat."
--- a/Context.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Context.st Fri Dec 09 22:31:28 2016 +0000
@@ -666,7 +666,7 @@
ntemp
"return the number of temporary variables of the Block/Method.
(for debugging only).
- I dont like the name of this method; its here for compatibility."
+ I don't like the name of this method; its here for compatibility."
^ self numTemps
@@ -709,7 +709,7 @@
nvars
"return the number of local variables of the Block/Method.
- I dont like the name of this method; its here for compatibility."
+ I don't like the name of this method; its here for compatibility."
^ self numVars
@@ -1029,13 +1029,13 @@
fullPrint
"print the receiver, selector and args of the context
- - used only for MiniDebuggers walkback print"
-
- self receiverPrintString errorPrint. ' ' errorPrint. selector errorPrint.
+ - used only for MiniDebugger's walkback print"
+
+ self receiverPrintString _errorPrint. ' ' _errorPrint. selector _errorPrint.
self argumentCount ~~ 0 ifTrue: [
- ' ' errorPrint. self argsDisplayString errorPrint
+ ' ' _errorPrint. self argsDisplayString _errorPrint
].
- ' [' errorPrint. self lineNumber errorPrint. ']' errorPrintCR
+ ' [' _errorPrint. self lineNumber _errorPrint. ']' _errorPrintCR
"
thisContext fullPrint
@@ -1046,7 +1046,7 @@
fullPrintAll
"print a full walkback starting at the receiver
- - used only for MiniDebuggers walkback print"
+ - used only for MiniDebugger's walkback print"
self withAllSendersDo:[:con | con fullPrint].
@@ -1057,18 +1057,18 @@
fullPrintAllLevels:nOrNil
"print a full walkback starting at the receiver, only print n levels
- - used only for MiniDebuggers walkback print"
+ - used only for MiniDebugger's walkback print"
|context count|
count := 0.
context := self.
[context notNil] whileTrue: [
- context fullPrint.
- context := context sender.
- nOrNil notNil ifTrue:[
- (count := count+1) > nOrNil ifTrue:[^self].
- ]
+ context fullPrint.
+ context := context sender.
+ nOrNil notNil ifTrue:[
+ (count := count+1) > nOrNil ifTrue:[^self].
+ ]
]
"
@@ -1080,7 +1080,7 @@
printAll
"print a full walkback starting at the receiver, only print n levels
- - used only for MiniDebuggers walkback print"
+ - used only for MiniDebugger's walkback print"
self printAllLevels:nil
@@ -1091,7 +1091,7 @@
printAllLevels:nOrNil
"print a full walkback starting at the receiver, only print n levels
- - used only for MiniDebuggers walkback print"
+ - used only for MiniDebugger's walkback print"
|context count|
@@ -1099,14 +1099,14 @@
context := self.
'--------------------------' errorPrintCR.
[context notNil] whileTrue: [
- context errorPrintCR.
- context := context sender.
- nOrNil notNil ifTrue:[
- (count := count+1) > nOrNil ifTrue:[
- '--------------------------' errorPrintCR.
- ^ self
- ].
- ]
+ context errorPrintCR.
+ context := context sender.
+ nOrNil notNil ifTrue:[
+ (count := count+1) > nOrNil ifTrue:[
+ '--------------------------' errorPrintCR.
+ ^ self
+ ].
+ ]
].
'--------------------------' errorPrintCR.
--- a/Date.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Date.st Fri Dec 09 22:31:28 2016 +0000
@@ -67,12 +67,12 @@
Compatibility notice:
due to historic reasons, there are some methods found twice
- with different names in this class. The old ST/X methods will vanish in
- one of the next releases, and kept for a while to support existing
- applications (the info on how these methods should be named came
- somewhat late from the testers...).
-
- Please do not use methods marked as obsolete in their comment.
+ with different names in this class. The old ST/X methods will vanish
+ over time, but kept for a while to support existing applications
+ (the info on how these methods should be named
+ came somewhat late from the testers...).
+
+ Please do not use methods marked as obsolete.
Most useful methods:
@@ -2099,7 +2099,7 @@
"return a date, representing the date given by the operatingSystem time.
This somewhat clumsy implementation hides the OS's date representation
(i.e. makes this class independent of what the OS starts its time values with).
- Dont use this method, the osTime representation is totally unportable."
+ Don't use this method, the osTime representation is totally unportable."
^ self basicNew fromOSTime:osTime
@@ -3319,7 +3319,7 @@
"return a new date representing 'days' before the receiver.
The argument should be some kind of integer.
Obsolete:
- Please dont use this method since it will vanish.
+ Please don't use this method since it will vanish.
Use #subtractDays: instead for ST-80 compatibility."
<resource: #obsolete>
@@ -3332,7 +3332,7 @@
"return a new date representing 'days' after the receiver.
The argument should be some kind of integer.
Obsolete:
- Please dont use this method since it will vanish.
+ Please don't use this method since it will vanish.
Use #addDays: instead for ST-80 compatibility."
<resource: #obsolete>
--- a/Dictionary.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Dictionary.st Fri Dec 09 22:31:28 2016 +0000
@@ -176,11 +176,10 @@
^ newDict
"
- Dictionary withAssociations:(Array
- with:#'one'->1
- with:#'two'->2
- with:#'three'->3
- with:#'four'->4)
+ Dictionary withAssociations:{ #'one'->1 .
+ #'two'->2 .
+ #'three'->3 .
+ #'four'->4 }
"
"Created: / 11.2.2000 / 10:05:54 / cg"
@@ -297,6 +296,8 @@
^ true
! !
+
+
!Dictionary methodsFor:'accessing'!
associationAt:aKey
@@ -1635,7 +1636,7 @@
<resource:#obsolete>
self obsoleteMethodWarning:'please use #keysDo:'.
- ^ super do:aBlock
+ ^ self keysDo:aBlock
"Modified: 20.4.1996 / 11:22:01 / cg"
!
@@ -2455,6 +2456,7 @@
^ aVisitor visitDictionary:self with:aParameter
! !
+
!Dictionary class methodsFor:'documentation'!
version
--- a/DoubleArray.st Wed Oct 19 09:22:53 2016 +0100
+++ b/DoubleArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -255,6 +253,7 @@
if (_v1 > _max) _max = _v1;
}
}
+
min = __MKFLOAT(_min);
__PROTECT__(min);
max = __MKFLOAT(_max);
--- a/Exception.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Exception.st Fri Dec 09 22:31:28 2016 +0000
@@ -60,6 +60,12 @@
"
! !
+!Exception class methodsFor:'testing'!
+
+isAbstract
+ ^ self == Exception
+! !
+
!Exception class methodsFor:'documentation'!
--- a/ExecutableFunction.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExecutableFunction.st Fri Dec 09 22:31:28 2016 +0000
@@ -45,7 +45,7 @@
and whatever there might be in the future.
Instances of ExecutableCode are not meant to be created by user code -
- the compilers create instances of Method & Block, while compiling.
+ the compilers create instances of subclasses, such as Method & Block
(the VM would not even know what to do with such an instance, and triggered
and exception, if ever encountered during block/method execution).
@@ -203,12 +203,12 @@
category
"return the category of this codeObject.
- Return nil here, to alow alien codeObjects to be handled by the
- browsers."
+ Return nil here, to allow alien codeObjects to be handled by the browsers."
^ nil
- "Created: 16.4.1996 / 16:31:15 / cg"
+ "Created: / 16-04-1996 / 16:31:15 / cg"
+ "Modified (comment): / 12-11-2016 / 11:46:00 / cg"
!
hasCanvasResource
@@ -298,12 +298,12 @@
isInvalid
"return true, if this codeObject is invalidated.
- Return false here, to alow alien codeObjects to be handled by the
- browsers."
+ Return false here, to allow alien codeObjects to be handled by the browsers."
^ false
- "Created: 16.4.1996 / 16:31:42 / cg"
+ "Created: / 16-04-1996 / 16:31:42 / cg"
+ "Modified (comment): / 12-11-2016 / 11:46:07 / cg"
!
isJavaMethod
@@ -386,7 +386,7 @@
referencesGlobal:aGlobalSymbol
"return true, if this method references the global
bound to aGlobalSymbol.
- Return false (we dont know) here, to allow alien code objects to be
+ Return false (we don't know) here, to allow alien code objects to be
handled by the browsers."
^ false
@@ -397,7 +397,7 @@
referencesGlobalMatching:aMatchPattern
"return true, if this method references a global
whose name matches aMatchPattern.
- Return false (we dont know) here, to allow alien code objects to be
+ Return false (we don't know) here, to allow alien code objects to be
handled by the browsers."
^ false
@@ -407,7 +407,7 @@
referencesLiteral:aLiteral
"return true, if this executable references the literal directly (i.e. a flat search).
- Return false (we dont know) here, to allow alien code objects to be
+ Return false (we don't know) here, to allow alien code objects to be
handled by the browsers."
^ false
@@ -428,7 +428,7 @@
refersToLiteralMatching:aMatchPattern
"return true if the receiver or recursively any array element in the
receiver is symbolic and matches aMatchPattern (i.e. a deep search).
- Return false (we dont know) here, to allow alien code objects to be
+ Return false (we don't know) here, to allow alien code objects to be
handled by the browsers."
^ false
--- a/ExternalAddress.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExternalAddress.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
@@ -107,7 +105,29 @@
!ExternalAddress class methodsFor:'instance creation'!
newAddress:addr
+ "return a new externalAddress (pointer), pointing to addr."
+
^ self new setAddress:addr
+
+ "Modified (comment): / 15-11-2016 / 11:57:34 / cg"
+!
+
+newAddressFromBytes:bytesContainingAddress
+ "return a new externalAddress (pointer), pointing to the addr contained in the argument.
+ The argument must be a byteArray-like object, whose first pointerSize bytes are extracted"
+
+ ^ (bytesContainingAddress pointerAt:1)
+
+ "
+ |bytes ptr|
+
+ bytes := ByteArray new:(ExternalAddress pointerSize).
+ bytes pointerAt:1 put:16r12345678.
+ ptr := ExternalAddress newAddressFromBytes:bytes.
+ self assert:(ptr address = 16r12345678).
+ "
+
+ "Created: / 15-11-2016 / 12:53:21 / cg"
! !
!ExternalAddress class methodsFor:'Compatibility-V''Age'!
@@ -128,18 +148,21 @@
isBuiltInClass
"return true if this class is known by the run-time-system.
- Here, true is returned."
+ Here, true is returned (but not for subclasses)."
^ self == ExternalAddress
- "Modified: / 11.6.1998 / 17:12:40 / cg"
+ "Modified: / 11-06-1998 / 17:12:40 / cg"
+ "Modified (comment): / 15-11-2016 / 11:56:55 / cg"
!
pointerSize
"answer the size in bytes of a pointer.
Notice: this is inlined by the compiler(s) as a constant,
- therefore, a query like 'ExternalAddress pointerSize == 8'
- costs nothing; it is compiled in as a constant."
+ therefore, queries like
+ 'ExternalAddress pointerSize == 8'
+ cost nothing; they are compiled in as a constant
+ (and even conditionals are eliminated)."
%{ /* NOCONTEXT */
RETURN(__mkSmallInteger(sizeof(void *)));
@@ -148,6 +171,27 @@
"
self pointerSize
"
+
+ "Modified (comment): / 15-11-2016 / 11:56:38 / cg"
+!
+
+sizeOfPointer
+ "answer the size in bytes of a pointer.
+ Notice: this is inlined by the compiler(s) as a constant,
+ therefore, queries like
+ 'ExternalAddress pointerSize == 8'
+ cost nothing; they are compiled in as a constant
+ (and even conditionals are eliminated)."
+
+%{ /* NOCONTEXT */
+ RETURN(__mkSmallInteger(sizeof(void *)));
+%}.
+
+ "
+ self sizeOfPointer
+ "
+
+ "Created: / 15-11-2016 / 11:40:52 / cg"
! !
@@ -267,7 +311,7 @@
asExternalBytes
"return an ExternalBytes object pointing to where the receiver points to.
Use of this is not recommended; primitives which return externalAddresses
- dont think that access to the memory is required/useful, while primitives
+ don't think that access to the memory is required/useful, while primitives
which do think so should return an externalBytes instance right away."
%{ /* NOCONTEXT */
@@ -311,9 +355,14 @@
addr = __intVal(anInteger);
} else {
addr = __unsignedLongIntVal(anInteger);
+ if (addr == 0) {
+ console_printf("invalid address argument in ExternalAddress>>setAddress\n");
+ }
}
__INST(address_) = (OBJ)addr;
%}
+
+ "Modified: / 15-11-2016 / 11:59:24 / cg"
!
setAddressFromBytes:aByteArray
--- a/ExternalBytes.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExternalBytes.st Fri Dec 09 22:31:28 2016 +0000
@@ -598,6 +598,20 @@
!ExternalBytes class methodsFor:'queries'!
+charTypeIsSigned
+ "return true, if the machine's native chars are signed"
+
+%{ /* NOCONTEXT */
+ char c;
+
+ c = (char)128;
+ RETURN ( (int)c < 0 ? true : false );
+%}
+ "
+ ExternalBytes charTypeIsSigned
+ "
+!
+
doubleAlignment
"return the alignement of longs in structs and unions"
--- a/ExternalFunction.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExternalFunction.st Fri Dec 09 22:31:28 2016 +0000
@@ -138,13 +138,13 @@
Instances of this class represent external (non-Smalltalk) functions.
(Obsolete) Custom Functions:
- This class also provides access to custom functions.
- These custom functions enable you to call c functions
- even if no stc compiler is available (they are kind of what user-primitives are in ST-80).
- You can register your own custom C-functions in a private main.c and relink ST/X from the binaries.
- (see the demo functions provided in main.c).
- Notice, that custom functions are ugly and inflexible.
- They are to be considered obsolete and support for them will vanish.
+ This class also provides access to custom functions.
+ These custom functions enable you to call c functions
+ even if no stc compiler is available (they are kind of what user-primitives are in ST-80).
+ You can register your own custom C-functions in a private main.c and relink ST/X from the binaries.
+ (see the demo functions provided in main.c).
+ Notice, that custom functions are ugly and inflexible.
+ They are to be considered obsolete and support for them will vanish.
If you have the stc compiler, we recommend using either inline primitive
code or the new external function call interface which is based upon libffi.
@@ -160,22 +160,22 @@
with the call / callWith: methods.
ST-arguments are converted to C as follows:
- ST class C argument
- ------------------------------
- SmallInteger int
- LargeInteger int (must be 4-byte unsigned largeInteger)
- String char *
- Symbol char *
- Character int
- ExternalBytes char *
- ExternalAddress char *
- ExternalFunction char *
- FloatArray float *
- DoubleArray double *
- ByteArray char *
- ShortFloat float
- true 1
- false 0
+ ST class C argument
+ ------------------------------
+ SmallInteger int
+ LargeInteger int (must be 4-byte unsigned largeInteger)
+ String char *
+ Symbol char *
+ Character int
+ ExternalBytes char *
+ ExternalAddress char *
+ ExternalFunction char *
+ FloatArray float *
+ DoubleArray double *
+ ByteArray char *
+ ShortFloat float
+ true 1
+ false 0
The returned value is converted to an unsigned integer (smallInteger or largeInteger).
@@ -191,11 +191,11 @@
general use. For now, use inline C-code.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- ExternalAddress ExternalBytes
- ( how to write primitive code :html: programming/primitive.html )
+ ExternalAddress ExternalBytes
+ ( how to write primitive code :html: programming/primitive.html )
"
!
--- a/ExternalLibraryFunction.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExternalLibraryFunction.st Fri Dec 09 22:31:28 2016 +0000
@@ -320,6 +320,25 @@
"Created: / 10-04-2012 / 12:21:45 / cg"
!
+dllMapping:aDictionary
+ "allows for dll's to be replaced,
+ for example, if you want to use the mozilla sqlite dll
+ C:\Program Files\Mozilla Firefox\mozsqlite3.dll
+ for the sqlite3, execute:
+ ExternalLibraryFunction
+ dllMapping at:'sqlite3'
+ put: 'C:\Program Files\Mozilla Firefox\mozsqlite3.dll'
+ for mingw:
+ ExternalLibraryFunction
+ dllMapping at:'sqlite3'
+ put:'C:\mingw64\opt\bin\libsqlite3-0.dll'
+ "
+
+ DllMapping := aDictionary
+
+ "Created: / 26-11-2016 / 04:06:14 / cg"
+!
+
dllMappingAt:baseLibname put:aNameOrPath
"allows for dll's to be replaced,
for example, if you want to use the mozilla sqlite dll
@@ -349,6 +368,30 @@
DLLPATH := aCollectionOfDirectoryPathNames
!
+flushModuleHandlesForLibrary:aLibraryName
+ self flushModuleHandlesForWhich:[:fn | fn moduleName = aLibraryName].
+
+ "
+ self flushModuleHandlesForLibrary:'ole32.dll'
+ "
+
+ "Created: / 12-11-2016 / 11:49:09 / cg"
+!
+
+flushModuleHandlesForWhich:aBlock
+ self allInstancesDo:[:fn |
+ (aBlock value:fn) ifTrue:[
+ fn setModuleHandle:nil.
+ ]
+ ].
+
+ "
+ self flushModuleHandlesForLibrary:'ole32.dll'
+ "
+
+ "Created: / 12-11-2016 / 11:48:32 / cg"
+!
+
initialize
"using inline access to corresponding c--defines to avoid duplicate places of knowledge"
@@ -700,9 +743,10 @@
isCallTypeOLE
"is this an OLE-object call ? (eg. a virtual c++ call; same as isCallTypeCPP)"
- ^ ((flags ? 0) bitTest: FLAG_VIRTUAL).
+ ^ (flags ? 0) bitTest: FLAG_VIRTUAL.
"Created: / 01-08-2006 / 15:21:23 / cg"
+ "Modified (format): / 12-11-2016 / 11:37:38 / cg"
!
isConstReturnValue
@@ -918,12 +962,15 @@
"/ speedup. in 95% of all calls, the same moduleName is resolved here
(LastModuleHandleHolder isNil
or:[ (handle := LastModuleHandleHolder at:1) isNil
- or:[ LastModuleHandleName ~= moduleNameUsed ]]) ifTrue:[
+ or:[ handle == -1
+ or:[ LastModuleHandleName ~= moduleNameUsed ]]]) ifTrue:[
handle := self loadLibrary:moduleNameUsed.
+ handle isNil ifTrue:[ self error:'Failed to load library: ',moduleNameUsed].
LastModuleHandleHolder := WeakArray with:handle.
LastModuleHandleName := moduleNameUsed.
].
+ self assert:(handle isInteger not).
moduleHandle := handle.
].
name isNumber ifFalse:[
@@ -937,7 +984,7 @@
].
].
- "Modified: / 26-08-2016 / 17:43:34 / cg"
+ "Modified: / 12-11-2016 / 11:40:03 / cg"
!
loadLibrary:dllName
@@ -946,10 +993,10 @@
This is useful, if some code has a hardcoded dll-name in it, which needs to be changed,
but you do not want or cannot recompile the methods (i.e. no source avail)"
- |handle nameString filename dllPathes|
+ |handle nameString filename dllPaths|
- (ObjectFileLoader isNil or:[ObjectFileLoader canLoadObjectFiles not]) ifTrue:[
- self error:('ObjectFileLoader class missing: cannot load dll/module: "%1"' bindWith:nameString).
+ (ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
+ self error:('ObjectFileLoader cannot load dll/module: "%1"' bindWith:nameString).
].
filename := dllName.
@@ -966,13 +1013,13 @@
filename isAbsolute ifFalse:[
"First ask the class defining the ExternalFunction for the location of the dlls ..."
- dllPathes := #().
+ dllPaths := #().
owningClass notNil ifTrue:[
- dllPathes := owningClass dllPath.
+ dllPaths := owningClass dllPath.
].
".. then ask the system"
- dllPathes := dllPathes, self class dllPath.
- dllPathes do:[:eachDirectory |
+ dllPaths := dllPaths, self class dllPath.
+ dllPaths do:[:eachDirectory |
|libraryName|
libraryName := eachDirectory asFilename construct:nameString.
@@ -986,12 +1033,12 @@
^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
].
- self
+ self
error:('Cannot find or load dll/module: "%1"' bindWith:nameString)
mayProceed:true.
^ nil
- "Modified: / 10-04-2012 / 12:21:06 / cg"
+ "Modified: / 12-11-2016 / 11:27:23 / cg"
!
prepareInvoke
--- a/ExternalStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ExternalStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -211,7 +211,7 @@
# define DEBUGBUFFER(buf) \
if (((char *)(buf) >= __survStartPtr) \
&& ((char *)(buf) < __survEndPtr)) { \
- __fatal0("read into survivor\n"); \
+ __fatal0("read into survivor\n"); \
}
#else
@@ -231,36 +231,34 @@
#endif
#ifdef __win32__
-// Win returns from ReadFile() with false and _threadErrno == 0 on end of pipe.
-// We don't know why
# define READ(ret, f, cp, n, handleType) { \
- if (handleType == @symbol(socketHandle)) { \
- (ret) = __STX_WSA_NOINT_CALL4("recv", recv, (f), (cp), (n), 0); \
- } else { \
- HANDLE h = _get_osfhandle(fileno(f)); \
- if (handleType == @symbol(socketFilePointer)) { \
- (ret) = __STX_WSA_NOINT_CALL4("recv", recv, h, (cp), (n), 0);\
- } else { \
- int __res; \
- (ret) = __STX_API_NOINT_CALL5("ReadFile", ReadFile, h, (cp), (n), &__res, 0);\
- (ret) = (ret) ? __res : ((__threadErrno == EPIPE || __threadErrno == 0) ? 0 : -1); \
- } \
- } \
+ if (handleType == @symbol(socketHandle)) { \
+ (ret) = __STX_WSA_NOINT_CALL4("recv", recv, (f), (cp), (n), 0); \
+ } else { \
+ HANDLE h = _get_osfhandle(fileno(f)); \
+ if (handleType == @symbol(socketFilePointer)) { \
+ (ret) = __STX_WSA_NOINT_CALL4("recv", recv, h, (cp), (n), 0);\
+ } else { \
+ int __res; \
+ (ret) = __STX_API_NOINT_CALL5("ReadFile", ReadFile, h, (cp), (n), &__res, 0);\
+ (ret) = (ret) > 0 ? __res : (__threadErrno == __WIN32_ERR(ERROR_BROKEN_PIPE) ? 0 : -1); \
+ } \
+ } \
}
# define WRITE(ret, f, cp, n, handleType) { \
- if (handleType == @symbol(socketHandle)) { \
- (ret) = __STX_WSA_NOINT_CALL4("send", send, (f), (cp), (n), 0); \
- } else {\
- HANDLE h = _get_osfhandle(fileno(f)); \
- if (handleType == @symbol(socketFilePointer)) { \
- (ret) = __STX_WSA_NOINT_CALL4("send", send, h, (cp), (n), 0);\
- } else {\
- int __res; \
- (ret) = __STX_API_NOINT_CALL5("WriteFile", WriteFile, h, (cp), (n), &__res, 0);\
- (ret) = (ret) ? __res : -1; \
- } \
- } \
+ if (handleType == @symbol(socketHandle)) { \
+ (ret) = __STX_WSA_NOINT_CALL4("send", send, (f), (cp), (n), 0); \
+ } else {\
+ HANDLE h = _get_osfhandle(fileno(f)); \
+ if (handleType == @symbol(socketFilePointer)) { \
+ (ret) = __STX_WSA_NOINT_CALL4("send", send, h, (cp), (n), 0);\
+ } else {\
+ int __res; \
+ (ret) = __STX_API_NOINT_CALL5("WriteFile", WriteFile, h, (cp), (n), &__res, 0);\
+ (ret) = (ret) ? __res : -1; \
+ } \
+ } \
}
# define FFLUSH(fp) fflush(fp)
@@ -271,56 +269,56 @@
# define __READING__(f) \
if ((__INST(didWrite) != false) \
&& (__INST(mode) == @symbol(readwrite))) { \
- __INST(didWrite) = false; \
- OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
+ __INST(didWrite) = false; \
+ OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
}
# define __WRITING__(f) \
if ((__INST(didWrite) != true) \
&& (__INST(mode) == @symbol(readwrite))) { \
- __INST(didWrite) = true; \
- OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
+ __INST(didWrite) = true; \
+ OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
}
# define __UNGETC__(c, f, isBuffered) \
if (isBuffered) { \
- ungetc((c), (f)); \
+ ungetc((c), (f)); \
} else { \
__INST(readAhead) = __mkSmallInteger((c)); \
}
# define __READBYTE__(ret, f, buf, isBuffered, handleType) \
if (isBuffered) { \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) >= 0) { \
- *(buf) = (ret); \
- (ret) = 1; \
- } else if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) >= 0) { \
+ *(buf) = (ret); \
+ (ret) = 1; \
+ } else if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
} else { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- *(buf) = (char)__intVal(rA); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- } else { \
- for (;;) { \
- CLEAR_ERRNO; \
- READ((ret), f, buf, 1, handleType); \
- if ((ret) >= 0 || __threadErrno != EINTR) \
- break; \
- } \
- } \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ *(buf) = (char)__intVal(rA); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ } else { \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ READ((ret), f, buf, 1, handleType); \
+ if ((ret) >= 0 || __threadErrno != EINTR) \
+ break; \
+ } \
+ } \
}
/*
@@ -330,110 +328,122 @@
# define __READBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
(ret) = 0; \
if (isBuffered) { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__offs++] = (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__offs++] = (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int __offs = 0; \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__offs] = __intVal(rA); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- } else { \
- CLEAR_ERRNO; \
- READ((ret), f, (buf)+__offs, (cnt)-__offs, handleType); \
- if ((ret) <= 0) { \
- if ((ret) < 0 && __threadErrno == EINTR) { \
- continue; \
- } \
- break; \
- } \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__offs] = __intVal(rA); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ } else { \
+ CLEAR_ERRNO; \
+ READ((ret), f, (buf)+__offs, (cnt)-__offs, handleType); \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR) { \
+ continue; \
+ } \
+ break; \
+ } \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
# define __READAVAILBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
{ \
int __offs = 0; \
int oldFlags; \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__offs++] = (ret); \
- } \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__offs++] = (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__offs] = __intVal(rA); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- __offs ++; \
- continue; \
- } \
- CLEAR_ERRNO; \
- { \
- int res = 0; \
- if ((handleType == @symbol(socketFilePointer) && (ioctlsocket((SOCKET)_get_osfhandle(fileno(f)),FIONREAD,&res), 1)) \
- || (handleType == @symbol(socketHandle) && (ioctlsocket((SOCKET)(f), FIONREAD, &res), 1)) \
- || (handleType == @symbol(pipeFilePointer) && (PeekNamedPipe((HANDLE)_get_osfhandle(fileno(f)),0, 0,0,&res,0), 1))) { \
- if (res > 0) { \
- if (res > ((cnt)-__offs)) \
- res = (cnt)-__offs; \
- READ((ret), f, (buf)+__offs, res, handleType); \
- } else { \
- (ret) = 0; \
- break; \
- } \
- } else { \
- READ((ret), f, (buf)+__offs, (cnt)-__offs, handleType); \
- } \
- } \
- if ((ret) <= 0) { \
- if (ret < 0 && __threadErrno == EINTR) \
- continue; \
- break; \
- } \
- __offs += (ret); \
- } \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__offs] = __intVal(rA); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ __offs ++; \
+ continue; \
+ } \
+ CLEAR_ERRNO; \
+ { \
+ int res = -1, ok = 0; \
+ SOCKET sock = 0; \
+ if ((handleType == @symbol(socketFilePointer) && ((ok = ioctlsocket(sock = (SOCKET)_get_osfhandle(fileno(f)),FIONREAD,&res) == 0), 1)) \
+ || (handleType == @symbol(socketHandle) && ((ok = ioctlsocket(sock = (SOCKET)(f), FIONREAD, &res) == 0), 1)) \
+ || (handleType == @symbol(pipeFilePointer) && ((ok = PeekNamedPipe((HANDLE)_get_osfhandle(fileno(f)),0, 0,0,&res,0)), 1))) { \
+ if (!ok) { \
+ __threadErrno = sock ? WSAGetLastError() : __WIN32_ERR(GetLastError()); \
+ (ret) = __threadErrno == __WIN32_ERR(ERROR_BROKEN_PIPE) ? 0 : -1; \
+ break; \
+ } \
+ if (res > 0) { \
+ if (res > ((cnt)-__offs)) \
+ res = (cnt)-__offs; \
+ READ((ret), f, (buf)+__offs, res, handleType); \
+ } else { \
+ if (sock && send(sock, NULL, 0, 0) == SOCKET_ERROR) { \
+ (ret) = -1; __threadErrno = WSAGetLastError(); \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ } else { \
+ READ((ret), f, (buf)+__offs, (cnt)-__offs, handleType); \
+ } \
+ } \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR)\
+ continue; \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
@@ -444,63 +454,63 @@
int __ooffs = obj_offs; \
int __offs = 0; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- /* refetch */ \
- buf = (char *)(obj); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__ooffs+__offs] = (ret); \
- __offs++; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__ooffs+__offs] = (ret); \
+ __offs++; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- while (__offs < (cnt)) { \
- char __buf[IO_BUFFER_SIZE]; \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__ooffs+__offs] = __intVal(rA); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- } else { \
- int l; \
- CLEAR_ERRNO; \
- l = (cnt)-__offs; \
- if ( l > IO_BUFFER_SIZE) \
- l = IO_BUFFER_SIZE; \
- READ((ret),f, __buf, l, handleType); \
- if ((ret) <= 0) { \
- if ((ret) < 0 && __threadErrno == EINTR) { \
- continue; \
- } \
- break; \
- } \
- } \
- if ((ret) > 0 ) { \
- /* refetch */ \
- buf = (char *)(obj); \
- memcpy((buf)+__ooffs+__offs,__buf,(ret)); \
- __offs += (ret); \
- } else { \
- (ret) = 0; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ char __buf[IO_BUFFER_SIZE]; \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__ooffs+__offs] = __intVal(rA); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ } else { \
+ int l; \
+ CLEAR_ERRNO; \
+ l = (cnt)-__offs; \
+ if ( l > IO_BUFFER_SIZE) \
+ l = IO_BUFFER_SIZE; \
+ READ((ret),f, __buf, l, handleType); \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR) { \
+ continue; \
+ } \
+ break; \
+ } \
+ } \
+ if ((ret) > 0 ) { \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ memcpy((buf)+__ooffs+__offs,__buf,(ret)); \
+ __offs += (ret); \
+ } else { \
+ (ret) = 0; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
@@ -509,141 +519,150 @@
int __ooffs = obj_offs; \
int __offs = 0; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- /* refetch */ \
- buf = (char *)(obj);\
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__ooffs+__offs] = (ret); \
- __offs++; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__ooffs+__offs] = (ret); \
+ __offs++; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- while (__offs < (cnt)) { \
- char __buf[IO_BUFFER_SIZE]; \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__ooffs+__offs] = __intVal(rA);\
- __INST(readAhead) = nil; \
- (ret) = 1; \
- __offs++; \
- continue; \
- } \
- { \
- int res = 0; \
- int l = (cnt)-__offs; \
- CLEAR_ERRNO; \
- if (l > IO_BUFFER_SIZE) \
- l = IO_BUFFER_SIZE; \
- if ((handleType == @symbol(socketFilePointer) && (ioctlsocket((SOCKET)_get_osfhandle(fileno(f)), FIONREAD, &res), 1)) \
- || (handleType == @symbol(socketHandle) && (ioctlsocket((SOCKET)(f), FIONREAD, &res), 1)) \
- || (handleType == @symbol(pipeFilePointer) && (PeekNamedPipe((HANDLE)_get_osfhandle(fileno(f)),0,0,0,&res,0), 1))) { \
- if (res > 0) { \
- if (res > l) res = l; \
- READ((ret), f, __buf, res, handleType); \
- } else { \
- (ret) = 0; \
- break; \
- } \
- } else { \
- READ((ret), f, __buf, l, handleType); \
- } \
- if ((ret) <= 0) { \
- if (ret < 0 && __threadErrno == EINTR) \
- continue; \
- break; \
- } \
- } \
- if ((ret) > 0) { \
- buf = (char *)(obj); \
- memcpy((buf)+__ooffs+__offs, __buf, (ret)); \
- __offs += (ret); \
- } else { \
- (ret) = 0; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ char __buf[IO_BUFFER_SIZE]; \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__ooffs+__offs] = __intVal(rA);\
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ __offs++; \
+ continue; \
+ } \
+ { \
+ int res = -1, ok = 0; \
+ SOCKET sock = 0; \
+ int l = (cnt)-__offs; \
+ CLEAR_ERRNO; \
+ if (l > IO_BUFFER_SIZE) l = IO_BUFFER_SIZE; \
+ if ((handleType == @symbol(socketFilePointer) && ((ok = ioctlsocket(sock = (SOCKET)_get_osfhandle(fileno(f)),FIONREAD,&res) == 0), 1)) \
+ || (handleType == @symbol(socketHandle) && ((ok = ioctlsocket(sock = (SOCKET)(f), FIONREAD, &res) == 0), 1)) \
+ || (handleType == @symbol(pipeFilePointer) && ((ok = PeekNamedPipe((HANDLE)_get_osfhandle(fileno(f)),0, 0,0,&res,0)), 1))) { \
+ if (!ok) { \
+ __threadErrno = sock ? WSAGetLastError() : __WIN32_ERR(GetLastError()); \
+ (ret) = __threadErrno == __WIN32_ERR(ERROR_BROKEN_PIPE) ? 0 : -1; \
+ break; \
+ } \
+ if (res > 0) { \
+ if (res > l) res = l; \
+ READ((ret), f, __buf, res, handleType); \
+ } else { \
+ if (sock && send(sock, NULL, 0, 0) == SOCKET_ERROR) { \
+ (ret) = -1; __threadErrno = WSAGetLastError(); \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ } else { \
+ READ((ret), f, __buf, l, handleType); \
+ } \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR) \
+ continue; \
+ break; \
+ } \
+ } \
+ if ((ret) > 0) { \
+ buf = (char *)(obj); \
+ memcpy((buf)+__ooffs+__offs, __buf, (ret)); \
+ __offs += (ret); \
+ } else { \
+ (ret) = 0; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
# define __WRITEBYTE__(ret, f, buf, isBuffered, handleType) \
if (isBuffered) { \
- for (;;) { \
- CLEAR_ERRNO; \
- ret = putc(*(buf), f); \
- if ((ret) >= 0) { \
- (ret) = 1; \
- } else if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- continue; \
- } \
- } else \
- (ret) = 0; \
- break; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ ret = putc(*(buf), f); \
+ if ((ret) >= 0) { \
+ (ret) = 1; \
+ } else if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ continue; \
+ } \
+ } else \
+ (ret) = 0; \
+ break; \
+ } \
} else { \
- for (;;) { \
- CLEAR_ERRNO; \
- WRITE(ret,f, buf, 1, handleType); \
- if ((ret) >= 0 || __threadErrno != EINTR) \
- break; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ WRITE(ret,f, buf, 1, handleType); \
+ if ((ret) >= 0 || __threadErrno != EINTR) \
+ break; \
+ } \
}
# define __WRITEBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
(ret) = 0; \
if (isBuffered) { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = fwrite((buf)+__offs, 1, (cnt)-__offs, f);\
- if ((ret) <= 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- clearerr(f); \
- continue; \
- } \
- break; \
- } else { \
- (ret) = 0; \
- } \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = fwrite((buf)+__offs, 1, (cnt)-__offs, f);\
+ if ((ret) <= 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ clearerr(f); \
+ continue; \
+ } \
+ break; \
+ } else { \
+ (ret) = 0; \
+ } \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- WRITE(ret,f, (buf)+__offs, (cnt)-__offs, handleType); \
- if (ret <= 0) { \
- if (ret < 0 && __threadErrno == EINTR) { \
- continue; \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ WRITE((ret),f, (buf)+__offs, (cnt)-__offs, handleType); \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR) { \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
# define __WRITEBYTES_OBJ__(ret, f, obj, obj_offs, cnt, isBuffered, handleType) \
@@ -651,51 +670,51 @@
int __ooffs = obj_offs; \
int __offs = 0; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- ret = fwrite((buf)+__ooffs+__offs, 1, (cnt)-__offs, f); \
- if ((ret) <= 0) { \
- if (ferror(f)) { \
- if (__threadErrno == EINTR) { \
- /* refetch */ \
- buf = (char *)(obj); \
- clearerr(f); \
- continue; \
- } \
- break; \
- } else { \
- (ret) = 0; \
- } \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ ret = fwrite((buf)+__ooffs+__offs, 1, (cnt)-__offs, f); \
+ if ((ret) <= 0) { \
+ if (ferror(f)) { \
+ if (__threadErrno == EINTR) { \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ clearerr(f); \
+ continue; \
+ } \
+ break; \
+ } else { \
+ (ret) = 0; \
+ } \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- while (__offs < (cnt)) { \
- char __buf[IO_BUFFER_SIZE]; \
- int l; \
- CLEAR_ERRNO; \
- l = (cnt)-__offs; \
- if ( l > IO_BUFFER_SIZE) \
- l = IO_BUFFER_SIZE; \
- /* refetch */ \
- buf = (char *)(obj); \
- memcpy(__buf,(buf)+__ooffs+__offs,l); \
- WRITE(ret,f, __buf, l, handleType); \
- if (ret <= 0) { \
- if (ret < 0 && __threadErrno == EINTR) { \
- continue; \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ char __buf[IO_BUFFER_SIZE]; \
+ int l; \
+ CLEAR_ERRNO; \
+ l = (cnt)-__offs; \
+ if ( l > IO_BUFFER_SIZE) \
+ l = IO_BUFFER_SIZE; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ memcpy(__buf,(buf)+__ooffs+__offs,l); \
+ WRITE(ret,f, __buf, l, handleType); \
+ if ((ret) <= 0) { \
+ if ((ret) < 0 && __threadErrno == EINTR) { \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
@@ -706,15 +725,15 @@
# define __READING__(f) \
if ((__INST(didWrite) != false) \
&& (__INST(mode) == @symbol(readwrite))) { \
- __INST(didWrite) = false; \
- OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
+ __INST(didWrite) = false; \
+ OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
}
# define __WRITING__(f) \
if ((__INST(didWrite) != true) \
&& (__INST(mode) == @symbol(readwrite))) { \
- __INST(didWrite) = true; \
- OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
+ __INST(didWrite) = true; \
+ OPT_FSEEK(f, 0L, SEEK_CUR); /* needed in stdio */ \
}
@@ -724,73 +743,73 @@
# else /* use STDIO */
# define __UNGETC__(c, f, isBuffered) \
if (isBuffered) { \
- ungetc((c), (f)); \
+ ungetc((c), (f)); \
} else { \
- __INST(readAhead) = __mkSmallInteger((c)); \
+ __INST(readAhead) = __mkSmallInteger((c)); \
}
# endif /* use STDIO */
# ifdef NO_STDIO
# define __READBYTE__(ret, f, buf, isBuffered, handleType) \
{ \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- *(buf) = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- } else { \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = READ(f, buf, 1, handleType); \
- DEBUGBUFFER(buf); \
- if ((ret) >= 0) break; \
- if (errno != EINTR) { \
- break; \
- } \
- __HANDLE_INTERRUPTS__; \
- } \
- } \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ *(buf) = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ } else { \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = READ(f, buf, 1, handleType); \
+ DEBUGBUFFER(buf); \
+ if ((ret) >= 0) break; \
+ if (errno != EINTR) { \
+ break; \
+ } \
+ __HANDLE_INTERRUPTS__; \
+ } \
+ } \
}
# else /* use STDIO */
# define __READBYTE__(ret, f, buf, isBuffered, handleType) \
if (isBuffered) { \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) >= 0) { \
- DEBUGBUFFER(buf); \
- *(buf) = (ret); \
- (ret) = 1; \
- } else if (ferror(f)) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- clearerr(f); \
- continue; \
- } \
- } else \
- (ret) = 0; \
- break; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) >= 0) { \
+ DEBUGBUFFER(buf); \
+ *(buf) = (ret); \
+ (ret) = 1; \
+ } else if (ferror(f)) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ clearerr(f); \
+ continue; \
+ } \
+ } else \
+ (ret) = 0; \
+ break; \
+ } \
} else { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- *(buf) = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- (ret) = 1; \
- } else { \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = read(fileno(f), buf, 1); \
- DEBUGBUFFER(buf); \
- if ((ret) >= 0) break; \
- if (errno != EINTR) { \
- break; \
- } \
- __HANDLE_INTERRUPTS__; \
- } \
- } \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ *(buf) = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ (ret) = 1; \
+ } else { \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = read(fileno(f), buf, 1); \
+ DEBUGBUFFER(buf); \
+ if ((ret) >= 0) break; \
+ if (errno != EINTR) { \
+ break; \
+ } \
+ __HANDLE_INTERRUPTS__; \
+ } \
+ } \
}
# endif /* use STDIO */
@@ -801,84 +820,84 @@
# ifdef NO_STDIO
# define __READBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
{ \
- int __offs = 0, __cnt; \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__offs] = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- __offs++; \
- } else { \
- CLEAR_ERRNO; \
- __cnt = READ(f, (buf)+__offs, (cnt)-__offs, handleType); \
- DEBUGBUFFER(buf); \
- if (__cnt <= 0) { \
- if (__cnt < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- continue; \
- } \
- break; \
- } \
- __offs += __cnt; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0, __cnt; \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__offs] = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ } else { \
+ CLEAR_ERRNO; \
+ __cnt = READ(f, (buf)+__offs, (cnt)-__offs, handleType); \
+ DEBUGBUFFER(buf); \
+ if (__cnt <= 0) { \
+ if (__cnt < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += __cnt; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
# else /* use STDIO */
# define __READBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
(ret) = 0; \
if (isBuffered) { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- clearerr(f); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- DEBUGBUFFER(buf); \
- (buf)[__offs++] = (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ clearerr(f); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ DEBUGBUFFER(buf); \
+ (buf)[__offs++] = (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int __offs = 0, __cnt; \
- int fd = fileno(f); \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- DEBUGBUFFER(buf); \
- (buf)[__offs] = __intVal(rA); \
- __INST(readAhead) = nil; \
- __offs++; \
- } else { \
- CLEAR_ERRNO; \
- __cnt = read(fd, (buf)+__offs, (cnt)-__offs); \
- DEBUGBUFFER(buf); \
- if (__cnt <= 0) { \
- if (__cnt < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- continue; \
- } \
- break; \
- } \
- __offs += __cnt; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0, __cnt; \
+ int fd = fileno(f); \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ DEBUGBUFFER(buf); \
+ (buf)[__offs] = __intVal(rA); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ } else { \
+ CLEAR_ERRNO; \
+ __cnt = read(fd, (buf)+__offs, (cnt)-__offs); \
+ DEBUGBUFFER(buf); \
+ if (__cnt <= 0) { \
+ if (__cnt < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += __cnt; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
@@ -888,7 +907,7 @@
# if defined(F_GETFL) && defined(F_SETFL) && (defined(O_NONBLOCK) || defined(O_NDELAY) || defined(FNDELAY))
# define SETFLAGS(fd, flags) \
- fcntl(fd, F_SETFL, flags)
+ fcntl(fd, F_SETFL, flags)
# if defined(O_NONBLOCK)
# define __STX_NONBLOCK_FLAG O_NONBLOCK
@@ -901,13 +920,13 @@
# endif
# define SETNONBLOCKING(fd, oldFlags) \
- { \
- int flags = fcntl(fd, F_GETFL, 0); \
- if (flags >= 0) { \
- fcntl(fd, F_SETFL, flags | __STX_NONBLOCK_FLAG); \
- } \
- oldFlags = flags; \
- }
+ { \
+ int flags = fcntl(fd, F_GETFL, 0); \
+ if (flags >= 0) { \
+ fcntl(fd, F_SETFL, flags | __STX_NONBLOCK_FLAG); \
+ } \
+ oldFlags = flags; \
+ }
# else
# define SETFLAGS(fd, flags) /* nothing */
# define SETNONBLOCKING(fd, oldFlags) /* nothing */
@@ -917,52 +936,52 @@
{ \
int __offs = 0, __cnt; \
int oldFlags; \
- \
+ \
(ret) = 0; \
SETNONBLOCKING(fileno(f), oldFlags); \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- (ret) = 0; \
- clearerr(f); \
- break; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__offs++] = (ret); \
- DEBUGBUFFER(buf); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ (ret) = 0; \
+ clearerr(f); \
+ break; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__offs++] = (ret); \
+ DEBUGBUFFER(buf); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int fd = fileno(f); \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__offs] = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- __offs++; \
- continue; \
- } \
- CLEAR_ERRNO; \
- __cnt = read(fd, (buf)+__offs, (cnt)-__offs); \
- DEBUGBUFFER(buf); \
- if (__cnt > 0) { \
- __offs += __cnt; \
- } \
- break; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int fd = fileno(f); \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__offs] = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ continue; \
+ } \
+ CLEAR_ERRNO; \
+ __cnt = read(fd, (buf)+__offs, (cnt)-__offs); \
+ DEBUGBUFFER(buf); \
+ if (__cnt > 0) { \
+ __offs += __cnt; \
+ } \
+ break; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
SETFLAGS(fileno(f), oldFlags); \
}
@@ -980,34 +999,34 @@
int __offs = 0; \
int __cnt; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
{ \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__ooffs+__offs] = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- __offs++; \
- } else { \
- CLEAR_ERRNO; \
- __cnt = READ(f, (buf)+__ooffs+__offs, (cnt)-__offs, handleType); \
- DEBUGBUFFER(buf); \
- if (__cnt <= 0) { \
- if (__cnt < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- /* refetch */ \
- buf = (char *)(obj); \
- continue; \
- } \
- break; \
- } \
- __offs += __cnt; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__ooffs+__offs] = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ } else { \
+ CLEAR_ERRNO; \
+ __cnt = READ(f, (buf)+__ooffs+__offs, (cnt)-__offs, handleType); \
+ DEBUGBUFFER(buf); \
+ if (__cnt <= 0) { \
+ if (__cnt < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += __cnt; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
@@ -1019,61 +1038,61 @@
int __offs = 0; \
int __cnt; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- clearerr(f); \
- /* refetch */ \
- buf = (char *)(obj); \
- DEBUGBUFFER(buf); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__ooffs+__offs] = (ret); \
- DEBUGBUFFER(buf); \
- __offs++; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ clearerr(f); \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ DEBUGBUFFER(buf); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__ooffs+__offs] = (ret); \
+ DEBUGBUFFER(buf); \
+ __offs++; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int fd = fileno(f); \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__ooffs+__offs] = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- __offs++; \
- } else { \
- CLEAR_ERRNO; \
- __cnt = read(fd, (buf)+__ooffs+__offs, (cnt)-__offs); \
- DEBUGBUFFER(buf); \
- if (__cnt <= 0) { \
- if (__cnt < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- /* refetch */ \
- buf = (char *)(obj); \
- continue; \
- } \
- break; \
- } \
- __offs += __cnt; \
- } \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int fd = fileno(f); \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__ooffs+__offs] = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ } else { \
+ CLEAR_ERRNO; \
+ __cnt = read(fd, (buf)+__ooffs+__offs, (cnt)-__offs); \
+ DEBUGBUFFER(buf); \
+ if (__cnt <= 0) { \
+ if (__cnt < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += __cnt; \
+ } \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
@@ -1084,56 +1103,56 @@
int __cnt; \
char *buf = (char *)(obj); \
int oldFlags; \
- \
+ \
(ret) = 0; \
SETNONBLOCKING(fileno(f), oldFlags); \
- \
+ \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = getc(f); \
- if ((ret) < 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- clearerr(f); \
- /* refetch */ \
- buf = (char *)(obj); \
- (ret) = 0; \
- break; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- (buf)[__ooffs+__offs] = (ret); \
- DEBUGBUFFER(buf); \
- __offs++; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = getc(f); \
+ if ((ret) < 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ clearerr(f); \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ (ret) = 0; \
+ break; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ (buf)[__ooffs+__offs] = (ret); \
+ DEBUGBUFFER(buf); \
+ __offs++; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int fd = fileno(f); \
- \
- while (__offs < (cnt)) { \
- OBJ rA = __INST(readAhead); \
- if (rA != nil) { \
- (buf)[__ooffs+__offs] = __intVal(rA); \
- DEBUGBUFFER(buf); \
- __INST(readAhead) = nil; \
- __offs++; \
- continue; \
- } \
- CLEAR_ERRNO; \
- __cnt = read(fd, (buf)+__ooffs+__offs, (cnt)-__offs); \
- DEBUGBUFFER(buf); \
- if (__cnt > 0) { \
- __offs += __cnt; \
- } \
- break; \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int fd = fileno(f); \
+ \
+ while (__offs < (cnt)) { \
+ OBJ rA = __INST(readAhead); \
+ if (rA != nil) { \
+ (buf)[__ooffs+__offs] = __intVal(rA); \
+ DEBUGBUFFER(buf); \
+ __INST(readAhead) = nil; \
+ __offs++; \
+ continue; \
+ } \
+ CLEAR_ERRNO; \
+ __cnt = read(fd, (buf)+__ooffs+__offs, (cnt)-__offs); \
+ DEBUGBUFFER(buf); \
+ if (__cnt > 0) { \
+ __offs += __cnt; \
+ } \
+ break; \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
SETFLAGS(fileno(f), oldFlags); \
}
@@ -1143,44 +1162,44 @@
# ifdef NO_STDIO
# define __WRITEBYTE__(ret, f, buf, isBuffered, handleType) \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = WRITE(f, buf, 1, handleType); \
- if ((ret) >= 0) break; \
- if (errno != EINTR) { \
- break; \
- } \
- __HANDLE_INTERRUPTS__; \
- }
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = WRITE(f, buf, 1, handleType); \
+ if ((ret) >= 0) break; \
+ if (errno != EINTR) { \
+ break; \
+ } \
+ __HANDLE_INTERRUPTS__; \
+ }
# else /* use STDIO */
# define __WRITEBYTE__(ret, f, buf, isBuffered, handleType) \
if (isBuffered) { \
- for (;;) { \
- CLEAR_ERRNO; \
- ret = putc(*(buf), f); \
- if ((ret) >= 0) { \
- (ret) = 1; \
- } else if (ferror(f)) { \
- /* SOLARIS/SPARC (2.6) generates spurious errors with errno = 0 */ \
- if (errno == EINTR || errno == 0) { \
- __HANDLE_INTERRUPTS__; \
- clearerr(f); \
- continue; \
- } \
- } else \
- (ret) = 0; \
- break; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ ret = putc(*(buf), f); \
+ if ((ret) >= 0) { \
+ (ret) = 1; \
+ } else if (ferror(f)) { \
+ /* SOLARIS/SPARC (2.6) generates spurious errors with errno = 0 */ \
+ if (errno == EINTR || errno == 0) { \
+ __HANDLE_INTERRUPTS__; \
+ clearerr(f); \
+ continue; \
+ } \
+ } else \
+ (ret) = 0; \
+ break; \
+ } \
} else { \
- for (;;) { \
- CLEAR_ERRNO; \
- (ret) = write(fileno(f), buf, 1); \
- if ((ret) >= 0) break; \
- if (errno != EINTR) { \
- break; \
- } \
- __HANDLE_INTERRUPTS__; \
- } \
+ for (;;) { \
+ CLEAR_ERRNO; \
+ (ret) = write(fileno(f), buf, 1); \
+ if ((ret) >= 0) break; \
+ if (errno != EINTR) { \
+ break; \
+ } \
+ __HANDLE_INTERRUPTS__; \
+ } \
}
# endif /* use STDIO */
@@ -1192,64 +1211,64 @@
# define __WRITEBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
(ret) = 0; \
{ \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- ret = WRITE(f, (buf)+__offs, (cnt)-__offs, handleType); \
- if (ret <= 0) { \
- if (ret < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- continue; \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ ret = WRITE(f, (buf)+__offs, (cnt)-__offs, handleType); \
+ if (ret <= 0) { \
+ if (ret < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
# else /* use STDIO */
# define __WRITEBYTES__(ret, f, buf, cnt, isBuffered, handleType) \
(ret) = 0; \
if (isBuffered) { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = fwrite((buf)+__offs, 1, (cnt)-__offs, f);\
- if ((ret) <= 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- clearerr(f); \
- continue; \
- } \
- } else { \
- (ret) = 0; \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = fwrite((buf)+__offs, 1, (cnt)-__offs, f);\
+ if ((ret) <= 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ clearerr(f); \
+ continue; \
+ } \
+ } else { \
+ (ret) = 0; \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} else { \
- int __offs = 0; \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = write(fileno(f), (buf)+__offs, (cnt)-__offs);\
- if ((ret) <= 0) { \
- if ((ret) < 0) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- continue; \
- } \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ int __offs = 0; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = write(fileno(f), (buf)+__offs, (cnt)-__offs);\
+ if ((ret) <= 0) { \
+ if ((ret) < 0) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ continue; \
+ } \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
}
# endif /* use STDIO */
@@ -1263,25 +1282,25 @@
int __ooffs = obj_offs; \
int __offs = 0; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
{ \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- ret = WRITE(f, (buf)+__ooffs+__offs, (cnt)-__offs, handleType); \
- if (ret <= 0) { \
- if (ret < 0 && errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- /* refetch */ \
- buf = (char *)(obj); \
- continue; \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
- if (__offs > 0) \
- (ret) = __offs; \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ ret = WRITE(f, (buf)+__ooffs+__offs, (cnt)-__offs, handleType); \
+ if (ret <= 0) { \
+ if (ret < 0 && errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
+ if (__offs > 0) \
+ (ret) = __offs; \
} \
}
# else /* use STDIO */
@@ -1290,48 +1309,48 @@
int __ooffs = obj_offs; \
int __offs = 0; \
char *buf = (char *)(obj); \
- \
+ \
(ret) = 0; \
if (isBuffered) { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = fwrite((buf)+__ooffs+__offs, 1, (cnt)-__offs, f); \
- if ((ret) <= 0) { \
- if (ferror(f)) { \
- if (errno == EINTR) { \
- __HANDLE_INTERRUPTS__; \
- /* refetch */ \
- buf = (char *)(obj); \
- clearerr(f); \
- continue; \
- } \
- break; \
- } else { \
- (ret) = 0; \
- } \
- } \
- __offs += (ret); \
- } \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = fwrite((buf)+__ooffs+__offs, 1, (cnt)-__offs, f); \
+ if ((ret) <= 0) { \
+ if (ferror(f)) { \
+ if (errno == EINTR) { \
+ __HANDLE_INTERRUPTS__; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ clearerr(f); \
+ continue; \
+ } \
+ break; \
+ } else { \
+ (ret) = 0; \
+ } \
+ } \
+ __offs += (ret); \
+ } \
} else { \
- while (__offs < (cnt)) { \
- CLEAR_ERRNO; \
- (ret) = write(fileno(f), (buf)+__ooffs+__offs, (cnt)-__offs); \
- if ((ret) <= 0) { \
- if ((ret) < 0) { \
- if (errno == EINTR){ \
- __HANDLE_INTERRUPTS__; \
- /* refetch */ \
- buf = (char *)(obj); \
- continue; \
- } \
- } \
- break; \
- } \
- __offs += (ret); \
- } \
+ while (__offs < (cnt)) { \
+ CLEAR_ERRNO; \
+ (ret) = write(fileno(f), (buf)+__ooffs+__offs, (cnt)-__offs); \
+ if ((ret) <= 0) { \
+ if ((ret) < 0) { \
+ if (errno == EINTR){ \
+ __HANDLE_INTERRUPTS__; \
+ /* refetch */ \
+ buf = (char *)(obj); \
+ continue; \
+ } \
+ } \
+ break; \
+ } \
+ __offs += (ret); \
+ } \
} \
if (__offs > 0) \
- (ret) = __offs; \
+ (ret) = __offs; \
}
# endif /* use STDIO */
#endif /* unix */
@@ -1897,6 +1916,15 @@
^ false
! !
+!ExternalStream class methodsFor:'finalization'!
+
+finalizationLobby
+ "answer the registry used for finalization.
+ ExternalStreams have their own Registry"
+
+ ^ Lobby
+! !
+
!ExternalStream class methodsFor:'obsolete'!
makePTYPair
@@ -1917,6 +1945,12 @@
^ NonPositionableExternalStream makePipe.
! !
+!ExternalStream class methodsFor:'testing'!
+
+isAbstract
+ ^ self == ExternalStream
+! !
+
!ExternalStream methodsFor:'Compatibility-Dolphin'!
beText
@@ -2121,23 +2155,22 @@
OBJ _handle = __INST(handle);
if (_handle != nil) {
- if ((__INST(handleType) == @symbol(fileHandle))
- || (__INST(handleType) == @symbol(socketHandle))) {
- RETURN (_handle);
- }
- if ((__INST(handleType) == nil)
- || (__INST(handleType) == @symbol(filePointer))
- || (__INST(handleType) == @symbol(socketFilePointer))
- || (__INST(handleType) == @symbol(pipeFilePointer))) {
+ if ((__INST(handleType) == @symbol(fileHandle))
+ || (__INST(handleType) == @symbol(socketHandle))) {
+ RETURN (_handle);
+ }
+ if ((__INST(handleType) == nil)
+ || (__INST(handleType) == @symbol(filePointer))
+ || (__INST(handleType) == @symbol(socketFilePointer))
+ || (__INST(handleType) == @symbol(pipeFilePointer))) {
#ifdef __win32__
- RETURN(__MKEXTERNALADDRESS(_get_osfhandle(fileno(__FILEVal(_handle)))));
+ RETURN(__MKEXTERNALADDRESS(_get_osfhandle(fileno(__FILEVal(_handle)))));
#else
- RETURN (__MKINT(fileno(__FILEVal(_handle))));
+ RETURN (__MKINT(fileno(__FILEVal(_handle))));
#endif
- }
+ }
}
%}.
- handle isNil ifTrue:[^ self errorNotOpen].
^ handle
!
@@ -2217,6 +2250,15 @@
!ExternalStream methodsFor:'closing'!
+abortAndClose
+ "close the stream - added for protocol compatibility with Socket and PipeStream.
+ see comment there"
+
+ self close.
+
+ "Modified: 30.8.1996 / 00:39:21 / cg"
+!
+
close
"Close the stream.
No error if the stream is not open."
@@ -2230,7 +2272,7 @@
!
shutDown
- "close the stream - added for protocol compatibility with PipeStream.
+ "close the stream - added for protocol compatibility with Socket.
see comment there"
self close.
@@ -2511,20 +2553,10 @@
^ self class basicNew setAccessor:handleType to:handle
!
-finalizationLobby
- "answer the registry used for finalization.
- ExternalStreams have their own Registry"
-
- ^ Lobby
-!
-
finalize
"some Stream has been collected - close the file if not already done"
- "/ with timeout to avoid blocking in a bad pty/socket
- [
- self closeFile
- ] valueWithTimeout:30 seconds.
+ self closeFile
!
reRegisterForFinalization
@@ -2589,129 +2621,133 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- && (__INST(binary) != true)
- ) {
- f = __FILEVal(fp);
- buffer[0] = '\0';
-
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f);
- }
-
- rslt = nextPtr = buffer;
- limit = buffer + sizeof(buffer) - 2;
-
- for (;;) {
- __READBYTE__(ret, f, nextPtr, _buffered, __INST(handleType));
- if (ret <= 0) {
- if (nextPtr == buffer)
- rslt = NULL;
- if (ret == 0) {
- __INST(hitEOF) = true;
- break;
- } else {
- error = __mkSmallInteger(__threadErrno);
- goto err;
- }
- }
-
- if (*nextPtr == '\n') {
- cutOff = 1;
- *nextPtr = '\0';
- break;
- }
- if (*nextPtr == '\r') {
- char peekChar;
-
- /*
- * peek ahead for a newLine ...
- */
- __READBYTE__(ret, f, &peekChar, _buffered, __INST(handleType));
- if (ret <= 0) {
- cutOff = 1;
- *nextPtr = '\0';
- if (ret == 0) {
- __INST(hitEOF) = true;
- break;
- }
- error = __mkSmallInteger(__threadErrno);
- goto err;
- }
-
- if (peekChar == '\n') {
- cutOff = 2;
- *nextPtr = '\0';
- break;
- }
-
- __UNGETC__(peekChar, f, _buffered);
-
- cutOff = 1;
- *nextPtr = '\0';
- break;
- }
-
- nextPtr++;
- if (nextPtr >= limit) {
- *nextPtr = '\0';
- lineTooLong = 1;
- if (@global(InfoPrinting) == true) {
- fprintf(stderr, "ExtStream [warning]: line truncated in nextLine\n");
- }
- break;
- }
- }
-
- if (rslt != NULL) {
- len = nextPtr-buffer;
-
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + len + cutOff;
- OBJ t;
-
- t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- /* remove any EOL character */
- if (len != 0) {
- if (buffer[len-1] == '\n') {
- buffer[--len] = '\0';
- }
- if ((len != 0) && (buffer[len-1] == '\r')) {
- buffer[--len] = '\0';
- }
- }
- line = __MKSTRING_L(buffer, len);
- if (! lineTooLong) {
- RETURN ( line );
- }
- }
- }
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ && (__INST(binary) != true)
+ ) {
+ f = __FILEVal(fp);
+ buffer[0] = '\0';
+
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f);
+ }
+
+ rslt = nextPtr = buffer;
+ limit = buffer + sizeof(buffer) - 2;
+
+ for (;;) {
+ __READBYTE__(ret, f, nextPtr, _buffered, __INST(handleType));
+ if (ret <= 0) {
+ if (nextPtr == buffer)
+ rslt = NULL;
+ if (ret == 0) {
+ __INST(hitEOF) = true;
+ break;
+ } else {
+ error = __mkSmallInteger(__threadErrno);
+ goto err;
+ }
+ }
+
+ if (*nextPtr == '\n') {
+ cutOff = 1;
+ *nextPtr = '\0';
+ break;
+ }
+ if (*nextPtr == '\r') {
+ char peekChar;
+
+ /*
+ * peek ahead for a newLine ...
+ */
+ __READBYTE__(ret, f, &peekChar, _buffered, __INST(handleType));
+ if (ret <= 0) {
+ cutOff = 1;
+ *nextPtr = '\0';
+ if (ret == 0) {
+ __INST(hitEOF) = true;
+ break;
+ }
+ error = __mkSmallInteger(__threadErrno);
+ goto err;
+ }
+
+ if (peekChar == '\n') {
+ cutOff = 2;
+ *nextPtr = '\0';
+ break;
+ }
+
+ __UNGETC__(peekChar, f, _buffered);
+
+ cutOff = 1;
+ *nextPtr = '\0';
+ break;
+ }
+
+ nextPtr++;
+ if (nextPtr >= limit) {
+ *nextPtr = '\0';
+ lineTooLong = 1;
+ // signalled below anyway; so no need to print on stderr
+#if 0
+ if (@global(InfoPrinting) == true) {
+ fprintf(stderr, "ExtStream [warning]: line truncated in nextLine\n");
+ }
+#endif
+ break;
+ }
+ }
+
+ if (rslt != NULL) {
+ len = nextPtr-buffer;
+
+ if (__isSmallInteger(__INST(position))) {
+ INT np = __intVal(__INST(position)) + len + cutOff;
+ OBJ t;
+
+ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ /* remove any EOL character */
+ if (len != 0) {
+ if (buffer[len-1] == '\n') {
+ buffer[--len] = '\0';
+ }
+ if ((len != 0) && (buffer[len-1] == '\r')) {
+ buffer[--len] = '\0';
+ }
+ }
+ line = __MKSTRING_L(buffer, len);
+ if (! lineTooLong) {
+ RETURN ( line );
+ }
+ }
+ }
}
err: ;
%}.
line notNil ifTrue:[
- "/ the line as read is longer than 32k characters (boy - what a line)
- "/ The exception could be handled by reading more and returning the
- "/ concatenation in your exception handler (the receiver and the partial
- "/ line are passed as parameter)
-
- LineTooLongErrorSignal isHandled ifTrue:[
- ^ LineTooLongErrorSignal
- raiseRequestWith:(Array with:self with:line)
- errorString:('line too long read error')
- ].
- ^ line , self nextLine
+ "/ the line as read is longer than 32k characters (boy - what a line)
+ "/ The exception could be handled by reading more and returning the
+ "/ concatenation in your exception handler (the receiver and the partial
+ "/ line are passed as parameter)
+
+ LineTooLongErrorSignal isHandled ifTrue:[
+ ^ LineTooLongErrorSignal
+ raiseRequestWith:(Array with:self with:line)
+ errorString:('line too long read error')
+ ].
+ 'ExternalStream [warning]: line truncated in nextLine' infoPrintCR.
+ ^ line , self nextLine
].
(hitEOF == true) ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error
+ lastErrorNumber := error.
+ ^ self readError:error
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
@@ -4627,7 +4663,7 @@
"
(FileStream newTemporary
nextPutUtf16:$B;
- nextPutUtf16:$Ä;
+ nextPutUtf16:$;
nextPutUtf16:(Character codePoint:16r10CCCC);
reset;
binary;
@@ -4674,81 +4710,79 @@
|fp error|
+ handle isNil ifTrue:[
+ ^ self.
+ ].
fp := handle.
"/ (didWrite==true and:[binary ~~ true and:[eolMode = #crlf]]) ifTrue: [ self breakPoint:#sr ].
%{
int rslt;
- if (fp == nil) {
- error = @symbol(errorNotOpen);
- goto out;
- }
-
if (__INST(handleType) == @symbol(socketHandle)) {
- SOCKET sock = (SOCKET)(__FILEVal(fp));
-
- if (@global(FileOpenTrace) == true) {
- fprintf(stderr, "close socket [ExternalStream] %"_lx_"\n", (INT)sock);
- }
-
- // whether the close() will be successful or not - the handle is invalid now!
- __INST(handle) = nil;
- do {
+ SOCKET sock = (SOCKET)(__FILEVal(fp));
+
+ if (@global(FileOpenTrace) == true) {
+ fprintf(stderr, "close socket [ExternalStream] %"_lx_"\n", (INT)sock);
+ }
+
+ // whether the close() will be successful or not - the handle is invalid now!
+ __INST(handle) = nil;
+ do {
#ifdef __win32__
- rslt = __STX_WSA_NOINT_CALL1("closesocket", closesocket, sock);
+ rslt = __STX_WSA_NOINT_CALL1("closesocket", closesocket, sock);
#else
- rslt = close(sock);
+ rslt = close(sock);
#endif
- } while((rslt < 0) && (__threadErrno == EINTR));
+ } while((rslt < 0) && (__threadErrno == EINTR));
} else if ((__INST(handleType) == nil)
- || (__INST(handleType) == @symbol(filePointer))
- || (__INST(handleType) == @symbol(socketFilePointer))
- || (__INST(handleType) == @symbol(pipeFilePointer)))
+ || (__INST(handleType) == @symbol(filePointer))
+ || (__INST(handleType) == @symbol(socketFilePointer))
+ || (__INST(handleType) == @symbol(pipeFilePointer)))
{
- FILEPOINTER f = __FILEVal(fp);
-
- if (@global(FileOpenTrace) == true) {
- fprintf(stderr, "fclose [ExternalStream] %"_lx_"\n", (INT)f);
- }
- // whether the close() will be successful or not - the handle is invalid now!
- __INST(handle) = nil;
+ FILEPOINTER f = __FILEVal(fp);
+
+ if (@global(FileOpenTrace) == true) {
+ fprintf(stderr, "fclose [ExternalStream] %"_lx_"\n", (INT)f);
+ }
+ // whether the close() will be successful or not - the handle is invalid now!
+ __INST(handle) = nil;
#ifdef __win32__
- if (__INST(mode) != @symbol(readonly) && __INST(buffered) != false) {
- // do a fflush() first, so that fclose() doesn't block
- // we suspect, that EINTR causes problems in fclose()
- do {
- __threadErrno = 0;
- rslt = __STX_C_CALL1("fflush", fflush, f);
- } while((rslt < 0) && (__threadErrno == EINTR));
- }
- do {
- __threadErrno = 0;
- rslt = __STX_C_NOINT_CALL1("fclose", fclose, f);
- } while((rslt < 0) && (__threadErrno == EINTR));
+ if (__INST(mode) != @symbol(readonly) && __INST(buffered) != false) {
+ // do a fflush() first, so that fclose() doesn't block
+ // we suspect, that EINTR causes problems in fclose()
+ do {
+ __threadErrno = 0;
+ rslt = __STX_C_CALL1("fflush", fflush, f);
+ } while((rslt < 0) && (__threadErrno == EINTR));
+ }
+ do {
+ __threadErrno = 0;
+ rslt = __STX_C_NOINT_CALL1("fclose", fclose, f);
+ } while((rslt < 0) && (__threadErrno == EINTR));
#else
- // cg: the pre Nov2014 code always did the fclose interruptable;
- // I am not sure, if fclose is actually prepared to do this;
- // at least when only reading, this should not block, and we
- // should be ableto do it without being interruptable.
- // Must watch this - if it leads to blockings, change and think about it.
- if (__INST(mode) != @symbol(readonly)) {
- __BEGIN_INTERRUPTABLE__
- rslt = fclose(f);
- __END_INTERRUPTABLE__
- } else {
- rslt = fclose(f);
- }
+ // cg: the pre Nov2014 code always did the fclose interruptable;
+ // I am not sure, if fclose is actually prepared to do this;
+ // at least when only reading, this should not block, and we
+ // should be able to do it without being interruptable.
+ // Must watch this - if it leads to blockings, change and think about it.
+ if (__INST(mode) == @symbol(readonly)) {
+ rslt = fclose(f);
+ } else {
+ __BEGIN_INTERRUPTABLE__
+ rslt = fclose(f);
+ __END_INTERRUPTABLE__
+ }
#endif
} else {
- error = @symbol(badHandleType);
- goto out;
+ error = @symbol(badHandleType);
+ goto out;
}
if (rslt < 0) {
- error = __mkSmallInteger(__threadErrno);
- goto out;
+ error = __mkSmallInteger(__threadErrno);
+ goto out;
}
RETURN (self);
@@ -4756,28 +4790,25 @@
%}.
error notNil ifTrue:[
- error == #errorNotOpen ifTrue:[
- self errorNotOpen.
- ].
- error isInteger ifTrue:[
- lastErrorNumber := error.
- mode == #readonly ifTrue:[
- self ioError:error.
- ] ifFalse:[
- self writeError:error.
- ].
- ^ self.
- ].
- self primitiveFailed:error.
- ^ self.
+ error isInteger ifTrue:[
+ lastErrorNumber := error.
+ mode == #readonly ifTrue:[
+ self ioError:error.
+ ] ifFalse:[
+ self writeError:error.
+ ].
+ ^ self.
+ ].
+ self primitiveFailed:error.
+ ^ self.
].
"/ fallback for rel5
fp := handle.
fp notNil ifTrue:[
- handle := nil.
- self closeFile:fp
+ handle := nil.
+ self closeFile:fp
]
!
@@ -4870,6 +4901,9 @@
|fd dupFd|
fd := self fileHandle.
+ fd isNil ifTrue:[
+ ^ self errorNotOpen.
+ ].
dupFd := OperatingSystem dup:fd.
self setFileHandle:dupFd mode:self fopenMode.
!
@@ -5150,18 +5184,18 @@
STObject handle = self.instVarAt(I_handle);
if (handle != STObject.Nil) {
- STObject next;
-
- if (self.instVarAt(I_binary) == STObject.True) {
- next = handle.nextByte();
- } else {
- next = handle.nextChar();
- }
- if (next != STObject.EOF) {
- self.instVarAt_put(I_position, STObject.Nil);
- return __c__._RETURN( next );
- }
- self.instVarAt_put(I_hitEOF, STObject.True);
+ STObject next;
+
+ if (self.instVarAt(I_binary) == STObject.True) {
+ next = handle.nextByte();
+ } else {
+ next = handle.nextChar();
+ }
+ if (next != STObject.EOF) {
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN( next );
+ }
+ self.instVarAt_put(I_hitEOF, STObject.True);
}
#else
FILEPOINTER f;
@@ -5175,65 +5209,63 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- ) {
- f = __FILEVal(fp);
-
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f)
- }
- __READBYTE__(ret, f, &ch, _buffered, __INST(handleType));
-
- if (ret > 0) {
- pos = __INST(position);
- if (__isSmallInteger(pos)) {
- OBJ t;
-
- t = __MKINT(__intVal(pos) + 1); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- if (__INST(binary) == true) {
- RETURN ( __mkSmallInteger(ch) );
- }
- RETURN ( __MKCHARACTER(ch) );
- }
-
- __INST(position) = nil;
- if ((ret < 0)
-# ifdef ECONNRESET
- && (__threadErrno != ECONNRESET)
-# endif
- ){
- error = __mkSmallInteger(__threadErrno);
- } else /* ret == 0 */ {
- __INST(hitEOF) = true;
- }
- }
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ ) {
+ f = __FILEVal(fp);
+
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f)
+ }
+ __READBYTE__(ret, f, &ch, _buffered, __INST(handleType));
+
+ if (ret > 0) {
+ pos = __INST(position);
+ if (__isSmallInteger(pos)) {
+ OBJ t;
+
+ t = __MKINT(__intVal(pos) + 1); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ if (__INST(binary) == true) {
+ RETURN ( __mkSmallInteger(ch) );
+ }
+ RETURN ( __MKCHARACTER(ch) );
+ }
+
+ __INST(position) = nil;
+ if (ret < 0) {
+ error = __mkSmallInteger(__threadErrno);
+ } else /* ret == 0 */ {
+ __INST(hitEOF) = true;
+ }
+ }
}
#endif /* not SCHTEAM */
%}.
hitEOF == true ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error
+ lastErrorNumber := error.
+ ^ self readError:error
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
readAhead notNil ifTrue:[
- c := readAhead.
- readAhead := nil.
- ^ c.
+ c := readAhead.
+ readAhead := nil.
+ ^ c.
].
+
+ "unknown handleType - future"
c := self nextByteFromFile:handle.
c isNil ifTrue:[
- ^ self pastEndRead.
+ ^ self pastEndRead.
].
binary == true ifTrue:[
- ^ c
+ ^ c
].
^ Character value:c
!
@@ -5276,64 +5308,62 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- ) {
- f = __FILEVal(fp);
-
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f)
- }
- __READBYTE__(ret, f, &ch, _buffered, __INST(handleType));
-
- if (ret > 0) {
- pos = __INST(position);
- if (__isSmallInteger(pos)) {
- OBJ t;
-
- t = __MKINT(__intVal(pos) + 1); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- if (__INST(binary) == true) {
- RETURN ( __mkSmallInteger(ch) );
- }
- RETURN ( __MKCHARACTER(ch) );
- }
-
- __INST(position) = nil;
- if ((ret < 0)
-#ifdef ECONNRESET
- && (__threadErrno != ECONNRESET)
-#endif
- ){
- error = __mkSmallInteger(__threadErrno);
- } else /* ret == 0 */ {
- __INST(hitEOF) = true;
- }
- }
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ ) {
+ f = __FILEVal(fp);
+
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f)
+ }
+ __READBYTE__(ret, f, &ch, _buffered, __INST(handleType));
+
+ if (ret > 0) {
+ pos = __INST(position);
+ if (__isSmallInteger(pos)) {
+ OBJ t;
+
+ t = __MKINT(__intVal(pos) + 1); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ if (__INST(binary) == true) {
+ RETURN ( __mkSmallInteger(ch) );
+ }
+ RETURN ( __MKCHARACTER(ch) );
+ }
+
+ __INST(position) = nil;
+ if (ret < 0) {
+ error = __mkSmallInteger(__threadErrno);
+ } else /* ret == 0 */ {
+ __INST(hitEOF) = true;
+ }
+ }
}
%}.
hitEOF == true ifTrue:[^ nil].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error.
+ lastErrorNumber := error.
+ ^ self readError:error.
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
readAhead notNil ifTrue:[
- c := readAhead.
- readAhead := nil.
- ^ c.
+ c := readAhead.
+ readAhead := nil.
+ ^ c.
].
+
+ "unknown handleType - future"
c := self nextByteFromFile:handle.
c isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
binary == true ifTrue:[
- ^ c
+ ^ c
].
^ Character value:c
!
@@ -5353,11 +5383,11 @@
OBJ ra;
if ((ra = __INST(readAhead)) != nil) {
- if (__INST(binary) == true) {
- RETURN ( ra );
- }
- c = __intVal(ra);
- RETURN ( __MKCHARACTER(c) );
+ if (__INST(binary) == true) {
+ RETURN ( ra );
+ }
+ c = __intVal(ra);
+ RETURN ( __MKCHARACTER(c) );
}
__INST(lastErrorNumber) = nil;
@@ -5367,49 +5397,45 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- ) {
- f = __FILEVal(fp);
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f)
- }
- __READBYTE__(ret, f, &c, _buffered, __INST(handleType));
-
- if (ret > 0) {
- __UNGETC__(c, f, _buffered);
-
- if (__INST(binary) == true) {
- RETURN ( __mkSmallInteger(c) );
- }
- RETURN ( __MKCHARACTER(c) );
- }
- if ((ret < 0)
-#ifdef ECONNRESET
- && (__threadErrno != ECONNRESET)
-#endif
- ){
- error = __mkSmallInteger(__threadErrno);
- } else /* ret == 0 */ {
- __INST(hitEOF) = true;
- }
- }
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ ) {
+ f = __FILEVal(fp);
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f)
+ }
+ __READBYTE__(ret, f, &c, _buffered, __INST(handleType));
+
+ if (ret > 0) {
+ __UNGETC__(c, f, _buffered);
+
+ if (__INST(binary) == true) {
+ RETURN ( __mkSmallInteger(c) );
+ }
+ RETURN ( __MKCHARACTER(c) );
+ }
+ if (ret < 0) {
+ error = __mkSmallInteger(__threadErrno);
+ } else /* ret == 0 */ {
+ __INST(hitEOF) = true;
+ }
+ }
}
%}.
hitEOF == true ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error.
+ lastErrorNumber := error.
+ ^ self readError:error.
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
readAhead isNil ifTrue:[
- readAhead := self nextOrNil.
- readAhead isNil ifTrue:[
- ^ self pastEndRead.
- ].
+ readAhead := self nextOrNil.
+ readAhead isNil ifTrue:[
+ ^ self pastEndRead.
+ ].
].
^ readAhead
!
@@ -5429,11 +5455,11 @@
OBJ ra;
if ((ra = __INST(readAhead)) != nil) {
- if (__INST(binary) == true) {
- RETURN ( ra );
- }
- c = __intVal(ra);
- RETURN ( __MKCHARACTER(c) );
+ if (__INST(binary) == true) {
+ RETURN ( ra );
+ }
+ c = __intVal(ra);
+ RETURN ( __MKCHARACTER(c) );
}
__INST(lastErrorNumber) = nil;
@@ -5443,46 +5469,42 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- ) {
- f = __FILEVal(fp);
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f)
- }
- __READBYTE__(ret, f, &c, _buffered, __INST(handleType));
-
- if (ret > 0) {
- __UNGETC__(c, f, _buffered);
-
- if (__INST(binary) == true) {
- RETURN ( __mkSmallInteger(c) );
- }
- RETURN ( __MKCHARACTER(c) );
- }
- if ((ret < 0)
-#ifdef ECONNRESET
- && (__threadErrno != ECONNRESET)
-#endif
- ){
- error = __mkSmallInteger(__threadErrno);
- } else /* ret == 0 */ {
- __INST(hitEOF) = true;
- }
- }
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ ) {
+ f = __FILEVal(fp);
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f)
+ }
+ __READBYTE__(ret, f, &c, _buffered, __INST(handleType));
+
+ if (ret > 0) {
+ __UNGETC__(c, f, _buffered);
+
+ if (__INST(binary) == true) {
+ RETURN ( __mkSmallInteger(c) );
+ }
+ RETURN ( __MKCHARACTER(c) );
+ }
+ if (ret < 0) {
+ error = __mkSmallInteger(__threadErrno);
+ } else /* ret == 0 */ {
+ __INST(hitEOF) = true;
+ }
+ }
}
%}.
hitEOF == true ifTrue:[^ nil].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error.
+ lastErrorNumber := error.
+ ^ self readError:error.
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
readAhead isNil ifTrue:[
- readAhead := self nextOrNil.
+ readAhead := self nextOrNil.
].
^ readAhead
!
@@ -5565,7 +5587,11 @@
!ExternalStream methodsFor:'testing'!
atEnd
- "return true, if position is at end"
+ "return true, if position is at end.
+ If a stream is at the end, the next read operation
+ would return or raise an exception immediately without waiting.
+ If a stream is not at the end, this may be a blocking operation
+ (see NonPositionableExternalStream)"
%{
OBJ fp, pos, lim;
@@ -5612,21 +5638,13 @@
*/
do {
#ifdef __win32__
-# if 1
__READBYTE__(ret, f, &c, _buffered, __INST(handleType));
-
-# else
- __BEGIN_INTERRUPTABLE__
- __READBYTE__(ret, f, &c, _buffered, __INST(handleType));
- __END_INTERRUPTABLE__
-# endif
#else /* not __win32__ */
__BEGIN_INTERRUPTABLE__
__READBYTE__(ret, f, &c, _buffered, __INST(handleType));
__END_INTERRUPTABLE__
#endif
} while ((ret < 0) && (__threadErrno == EINTR));
-
if (ret > 0) {
__UNGETC__(c&0xff, f, _buffered);
RETURN (false);
@@ -5635,26 +5653,17 @@
__INST(hitEOF) = true;
RETURN (true);
}
-#ifdef ECONNRESET
- // connection reset by peer is also an EOF
- if (__threadErrno == ECONNRESET) {
- __INST(hitEOF) = true;
- RETURN (true);
- }
-#endif
- /* ret < 0 */
+ /* ret < 0 -> error */
__INST(lastErrorNumber) = __mkSmallInteger(__threadErrno);
}
+ // we do not raise an error here - the next read operation will raise the error.
+ RETURN(false);
}
%}.
- lastErrorNumber notNil ifTrue:[^ self readError].
- handle isNil ifTrue:[^ self errorNotOpen].
- mode == #writeonly ifTrue:[^ self errorWriteOnly].
- readAhead notNil ifTrue:[^ false].
-
+
+ "/ we come here if the handle type is unknown
"/ migration support
- ^ self
- atEndFile:handle
+ ^ self atEndFile:handle
"Modified: / 30.10.1998 / 20:16:06 / cg"
!
@@ -5695,7 +5704,7 @@
!
gotErrorOrEOF
- "answerv true, if amn error or eof has been occurred on the stream"
+ "answer true, if amn error or eof has been occurred on the stream"
^ hitEOF == true or:[lastErrorNumber notNil]
!
@@ -5943,57 +5952,57 @@
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- OBJ fp;
-
- __INST(lastErrorNumber) = nil;
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(readonly))
- && (__INST(binary) != true)
- ) {
- FILEPOINTER f = __FILEVal(fp);
- int _buffered = (__INST(buffered) == true);
- int len, cnt;
- char *cp;
-
- if (_buffered) {
- __WRITING__(f)
- }
- {
- OBJ mode = __INST(eolMode);
-
- if (mode == @symbol(cr)) {
- cp = "\r"; len = 1;
- } else if (mode == @symbol(crlf)) {
- cp = "\r\n"; len = 2;
- } else if (mode == @symbol(eot)) {
- cp = "\004"; len = 1;
- } else if (mode == @symbol(etx)) {
- cp = "\003"; len = 1;
- } else {
- cp = "\n"; len = 1;
- }
- }
+ OBJ fp;
+
+ __INST(lastErrorNumber) = nil;
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(readonly))
+ && (__INST(binary) != true)
+ ) {
+ FILEPOINTER f = __FILEVal(fp);
+ int _buffered = (__INST(buffered) == true);
+ int len, cnt;
+ char *cp;
+
+ if (_buffered) {
+ __WRITING__(f)
+ }
+ {
+ OBJ mode = __INST(eolMode);
+
+ if (mode == @symbol(cr)) {
+ cp = "\r"; len = 1;
+ } else if (mode == @symbol(crlf)) {
+ cp = "\r\n"; len = 2;
+ } else if (mode == @symbol(eot)) {
+ cp = "\004"; len = 1;
+ } else if (mode == @symbol(etx)) {
+ cp = "\003"; len = 1;
+ } else {
+ cp = "\n"; len = 1;
+ }
+ }
#if defined(WIN32) && !defined(__MINGW__)
- if ((f == __win32_stdout()) || (f == __win32_stderr())) {
- cnt = __win32_fwrite(cp, 1, len, f);
- } else
+ if ((f == __win32_stdout()) || (f == __win32_stderr())) {
+ cnt = __win32_fwrite(cp, 1, len, f);
+ } else
#endif
- {
- __WRITEBYTES__(cnt, f, cp, len, _buffered, __INST(handleType));
- }
- if (cnt == len) {
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + len;
- OBJ t;
-
- t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e: dont know */
- }
- RETURN ( self );
- }
- __INST(lastErrorNumber) = __mkSmallInteger(__threadErrno);
- }
+ {
+ __WRITEBYTES__(cnt, f, cp, len, _buffered, __INST(handleType));
+ }
+ if (cnt == len) {
+ if (__isSmallInteger(__INST(position))) {
+ INT np = __intVal(__INST(position)) + len;
+ OBJ t;
+
+ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e: don't know */
+ }
+ RETURN ( self );
+ }
+ __INST(lastErrorNumber) = __mkSmallInteger(__threadErrno);
+ }
}
%}.
lastErrorNumber notNil ifTrue:[self writeError. ^ self].
@@ -6002,11 +6011,11 @@
(binary==true) ifTrue:[self errorBinary. ^ self].
(eolMode == #cr) ifTrue:[
- self nextPut:(Character return).
- ^ self
+ self nextPut:(Character return).
+ ^ self
].
(eolMode == #crlf) ifTrue:[
- self nextPut:(Character return).
+ self nextPut:(Character return).
].
self nextPut:(Character nl).
^ self
@@ -6579,7 +6588,7 @@
].
"
- 'Bönnigheim' asUnicode16String errorPrintCR
+ 'Bnnigheim' asUnicode16String errorPrintCR
"
!
--- a/FileDoesNotExistException.st Wed Oct 19 09:22:53 2016 +0100
+++ b/FileDoesNotExistException.st Fri Dec 09 22:31:28 2016 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
OpenError subclass:#FileDoesNotExistException
instanceVariableNames:''
classVariableNames:''
@@ -35,13 +37,29 @@
"
! !
+!FileDoesNotExistException methodsFor:'accessing'!
+
+description
+ |pathName|
+
+ (pathName := self pathName) notNil ifTrue:[
+ pathName isFilename ifTrue:[
+ pathName := pathName pathName.
+ ].
+ pathName isString ifTrue:[
+ ^ super description,': "',pathName,'"'
+ ].
+ ].
+ ^ super description
+! !
+
!FileDoesNotExistException class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/FileDoesNotExistException.st,v 1.2 2013-03-06 17:07:42 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/FileDoesNotExistException.st,v 1.2 2013-03-06 17:07:42 cg Exp $'
+ ^ '$Header$'
! !
--- a/FileStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/FileStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -1325,7 +1325,7 @@
createForReadWrite
"create/truncate the file for read/write.
- If the file existed, its truncated; otherwise its created."
+ If the file existed, it's truncated; otherwise it's created."
mode := #readwrite.
^ self openWithMode:CreateReadWriteMode
@@ -1333,7 +1333,7 @@
createForWriting
"create/truncate the file for writeonly.
- If the file existed, its truncated; otherwise its created."
+ If the file existed, it's truncated; otherwise it's created."
mode := #writeonly.
didWrite := true.
@@ -1678,11 +1678,13 @@
// ignore
} else if (attrSym == @symbol(GENERIC_READ)) {
flags |= O_RDONLY;
+ __openmode = "r";
} else if (attrSym == @symbol(GENERIC_WRITE)) {
flags |= O_WRONLY;
+ __openmode = "w";
} else if (attrSym == @symbol(GENERIC_READ_WRITE)) {
flags |= O_RDWR;
-
+ __openmode = "r+";
} else if (attrSym == @symbol(CREATE_NEW)) {
flags |= O_CREAT|O_EXCL;
accessMode = 0600; // simulate mkstemp()
@@ -1821,7 +1823,7 @@
openForAppending
"open the file for writeonly appending to the end.
- If the file does not exist its an error, raise OpenError;
+ If the file does not exist, raise OpenError;
otherwise return the receiver."
mode := #writeonly.
@@ -1831,7 +1833,7 @@
openForReadWrite
"open the file for read/write.
- If the file does not exist its an error, raise OpenError;
+ If the file does not exist, raise OpenError;
otherwise return the receiver."
mode := #readwrite.
@@ -1840,7 +1842,7 @@
openForReading
"open the file for readonly.
- If the file does not exist its an error, raise OpenError;
+ If the file does not exist, raise OpenError;
otherwise return the receiver."
mode := #readonly.
@@ -1850,7 +1852,7 @@
openForWriting
"open the file writeonly. The contents of the file is preserved.
- If the file does not exist its an error, raise OpenError;
+ If the file does not exist, raise OpenError;
otherwise return the receiver."
mode := #writeonly.
--- a/Filename.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Filename.st Fri Dec 09 22:31:28 2016 +0000
@@ -827,22 +827,22 @@
otherwise, '/tmp' is used. (at least on unix ...).
Notice: do not hardcode '/tmp' into your programs - things may be
- different on other operating systems. Also, the user may want to set the
- TMPDIR environment variable to have her temp files somewhere else."
+ different on other operating systems. Also, the user may want to set the
+ TMPDIR environment variable to have her temp files somewhere else."
|tempDir|
TempDirectory isNil ifTrue:[
- tempDir := self named:(self defaultTempDirectoryName pathName).
- tempDir exists ifFalse:[
- tempDir
- makeDirectory;
- addAccessRights:#(readUser readGroup readOthers
- writeUser writeGroup writeOthers
- executeUser executeGroup executeOthers
- removeOnlyByOwner).
- ].
- TempDirectory := DefaultTempDirectory := tempDir construct:'stx_tmp'.
+ tempDir := self named:(self defaultTempDirectoryName pathName).
+ tempDir exists ifFalse:[
+ tempDir
+ makeDirectory;
+ addAccessRights:#(readUser readGroup readOthers
+ writeUser writeGroup writeOthers
+ executeUser executeGroup executeOthers
+ removeOnlyByOwner).
+ ].
+ TempDirectory := DefaultTempDirectory := tempDir construct:('stx_tmp_' , OperatingSystem getLoginName)
].
"Make sure, that the TempDirectory exists - it might have been removed
@@ -850,12 +850,12 @@
Since it is shared between users, it must be accessible by all users."
TempDirectory exists ifFalse:[
- TempDirectory
- makeDirectory;
- addAccessRights:#(readUser readGroup readOthers
- writeUser writeGroup writeOthers
- executeUser executeGroup executeOthers
- removeOnlyByOwner).
+ TempDirectory
+ makeDirectory;
+ addAccessRights:#(readUser readGroup readOthers
+ writeUser writeGroup writeOthers
+ executeUser executeGroup executeOthers
+ removeOnlyByOwner).
].
^ TempDirectory
@@ -870,6 +870,7 @@
"Created: / 07-03-1996 / 14:51:18 / cg"
"Modified: / 07-10-2011 / 18:39:25 / cg"
+ "Modified: / 27-10-2016 / 23:06:51 / jv"
!
tempDirectory:aFilename
@@ -1017,30 +1018,30 @@
^ dir , (aString copyFrom:cutIdx)
"
- Filename new nameWithSpecialExpansions:'~'
- Filename new nameWithSpecialExpansions:'~\work'
- Filename new nameWithSpecialExpansions:'~stefan'
- Filename new nameWithSpecialExpansions:'~stefan\work'
- Filename new nameWithSpecialExpansions:'~foo'
- Filename new nameWithSpecialExpansions:'~foo\bar'
- "
-
- "
- UnixFilename new nameWithSpecialExpansions:'~'
- UnixFilename new nameWithSpecialExpansions:'~/work'
- UnixFilename new nameWithSpecialExpansions:'~stefan'
- UnixFilename new nameWithSpecialExpansions:'~stefan/work'
- UnixFilename new nameWithSpecialExpansions:'~foo'
- UnixFilename new nameWithSpecialExpansions:'~foo/bar'
- "
-
- "
- PCFilename new nameWithSpecialExpansions:'~'
- PCFilename new nameWithSpecialExpansions:'~\work'
- PCFilename new nameWithSpecialExpansions:'~stefan'
- PCFilename new nameWithSpecialExpansions:'~stefan\work'
- PCFilename new nameWithSpecialExpansions:'~foo'
- PCFilename new nameWithSpecialExpansions:'~foo\bar'
+ Filename nameWithSpecialExpansions:'~'
+ Filename nameWithSpecialExpansions:'~\work'
+ Filename nameWithSpecialExpansions:'~stefan'
+ Filename nameWithSpecialExpansions:'~stefan\work'
+ Filename nameWithSpecialExpansions:'~foo'
+ Filename nameWithSpecialExpansions:'~foo\bar'
+ "
+
+ "
+ UnixFilename nameWithSpecialExpansions:'~'
+ UnixFilename nameWithSpecialExpansions:'~/work'
+ UnixFilename nameWithSpecialExpansions:'~stefan'
+ UnixFilename nameWithSpecialExpansions:'~stefan/work'
+ UnixFilename nameWithSpecialExpansions:'~foo'
+ UnixFilename nameWithSpecialExpansions:'~foo/bar'
+ "
+
+ "
+ PCFilename nameWithSpecialExpansions:'~'
+ PCFilename nameWithSpecialExpansions:'~\work'
+ PCFilename nameWithSpecialExpansions:'~stefan'
+ PCFilename nameWithSpecialExpansions:'~stefan\work'
+ PCFilename nameWithSpecialExpansions:'~foo'
+ PCFilename nameWithSpecialExpansions:'~foo\bar'
"
!
@@ -1565,12 +1566,16 @@
components at:1 put:sep asString.
].
].
- components := components select:[:each| each notEmpty].
"/ prepend volume to first component (the root directory)
vol size ~~ 0 ifTrue:[
- components at:1 put:(vol , (components at:1)).
- ].
+ vol last = $: ifTrue:[
+ vol := vol, (components at:1).
+ ].
+ components at:1 put:vol.
+ ].
+ components := components select:[:each| each notEmpty].
+
^ components
"
@@ -2522,6 +2527,30 @@
"Modified: / 12-09-2010 / 15:43:22 / cg"
!
+recursiveDirectoryContentsAsFilenamesDo:aBlock filterForVisitingDirectories:filterOrNil
+ "evaluate aBlock for all files and directories found under the receiver.
+ The block is invoked with the filenames as argument.
+ The walk is bread-first.
+ This excludes any entries for '.' or '..'.
+ Subdirectory files are included with a relative pathname.
+ If filterOrNil is nonNil, it is passed every directory about to be walked into;
+ if it returns false, that directory is not entered.
+ Warning: this may take a long time to execute
+ (especially with deep and/or remote fileSystems)."
+
+ self
+ recursiveDirectoryContentsDo:[:relFn |
+ aBlock value:(self construct:relFn)
+ ]
+ filterForVisitingDirectories:filterOrNil.
+
+ "
+ '.' asFilename recursiveDirectoryContentsAsFilenamesDo:[:f | Transcript showCR:f]
+ "
+
+ "Modified: / 12-09-2010 / 15:43:22 / cg"
+!
+
recursiveDirectoryContentsDo:aBlock
"evaluate aBlock for all files and directories found under the receiver.
The block is invoked with the relative filenames as string-argument.
@@ -2562,13 +2591,64 @@
"
!
+recursiveDirectoryContentsDo:aBlock filterForVisitingDirectories:filterOrNil
+ "evaluate aBlock for all files and directories found under the receiver.
+ The block is invoked with the relative filenames as string-argument.
+ The walk is bread-first.
+ This excludes any entries for '.' or '..'.
+ Subdirectory files are included with a relative pathname.
+ If filterOrNil is nonNil, it is passed every directory about to be walked into;
+ if it returns false, that directory is not entered.
+ Warning: this may take a long time to execute
+ (especially with deep and/or remote fileSystems)."
+
+ self
+ recursiveDirectoryContentsWithPrefix:''
+ filesDo:aBlock
+ directoriesDo:aBlock
+ filterForVisitingDirectories:filterOrNil
+
+ "
+ '.' asFilename recursiveDirectoryContentsDo:[:f | Transcript showCR:f]
+ "
+
+ "Modified: / 12-09-2010 / 15:43:22 / cg"
+!
+
recursiveDirectoryContentsWithPrefix:aPrefix filesDo:fileBlock directoriesDo:dirBlock
"evaluate aBlock for all files and directories found under the receiver.
The blocks are invoked with a relative pathname as string-argument.
The walk is breadth-first (first files, then directories).
This excludes any entries for '.' or '..'.
A proceedable exception is raised for non-accessible directories.
- Warning: this may take a long time to execute (especially with deep and/or remote fileSystems)."
+ Warning: this may take a long time to execute
+ (especially with deep and/or remote fileSystems)."
+
+ self
+ recursiveDirectoryContentsWithPrefix:aPrefix
+ filesDo:fileBlock
+ directoriesDo:dirBlock
+ filterForVisitingDirectories:nil
+
+ "
+ '.' asFilename
+ recursiveDirectoryContentsWithPrefix:'bla'
+ filesDo:[:f | Transcript show:'file: '; showCR:f]
+ directoriesDo:[:f | Transcript show:'dir: '; showCR:f]
+ "
+!
+
+recursiveDirectoryContentsWithPrefix:aPrefix filesDo:fileBlock directoriesDo:dirBlock filterForVisitingDirectories:filterOrNil
+ "evaluate aBlock for all files and directories found under the receiver.
+ The blocks are invoked with a relative pathname as string-argument.
+ The walk is breadth-first (first files, then directories).
+ This excludes any entries for '.' or '..'.
+ A proceedable exception is raised for non-accessible directories.
+ If filterOrNil is nonNil, it is passed every directory about to be walked into;
+ if it returns false, that directory is not entered.
+ Warning: this may take a long time to execute
+ (especially with deep and/or remote fileSystems).
+ "
|fileNames dirNames p|
@@ -2579,9 +2659,11 @@
self directoryContentsDo:[:f | |t|
t := self construct:f.
t isDirectory ifTrue:[
- dirBlock notNil ifTrue:[
- t isSymbolicLink ifFalse:[
- dirNames add:f
+ (filterOrNil isNil or:[filterOrNil value:t]) ifTrue:[
+ dirBlock notNil ifTrue:[
+ t isSymbolicLink ifFalse:[
+ dirNames add:f
+ ]
]
]
] ifFalse:[
@@ -2602,10 +2684,15 @@
].
dirBlock notNil ifTrue:[
dirNames do:[:dN |
- dirBlock value:(p , dN).
- (self construct:dN)
- recursiveDirectoryContentsWithPrefix:(p , dN)
- filesDo:fileBlock directoriesDo:dirBlock
+ |subDir|
+
+ subDir := (self construct:dN).
+ (filterOrNil isNil or:[filterOrNil value:subDir]) ifTrue:[
+ dirBlock value:(p , dN).
+ subDir
+ recursiveDirectoryContentsWithPrefix:(p , dN)
+ filesDo:fileBlock directoriesDo:dirBlock
+ ].
].
].
@@ -2640,28 +2727,6 @@
!Filename methodsFor:'error handling'!
-accessDeniedError:filename
- "{ Pragma: +optSpace }"
-
- "report an error that access to some file was denied"
-
- |errNo errString|
-
- errNo := OperatingSystem lastErrorNumber.
- errString := OperatingSystem lastErrorString.
- errString size == 0 ifTrue:[
- errString := ''.
- ] ifFalse:[
- errString := ' (' , errString , ')'
- ].
-
- ^ OperatingSystem accessDeniedErrorSignal
- raiseRequestWith:filename ? self
- errorString:(' : ' , (filename ? self) asString , errString)
-
- "Modified: / 26.9.1999 / 16:11:44 / cg"
-!
-
fileCreationError:filename
"{ Pragma: +optSpace }"
@@ -2672,26 +2737,6 @@
errorString:(' - cannot create/write file: "%1"' bindWith:(filename ? self) asString)
!
-fileNotFoundError:filename
- "{ Pragma: +optSpace }"
-
- "report an error that some file was not found"
-
- ^ OperatingSystem fileNotFoundErrorSignal
- raiseRequestWith:filename?self
- errorString:('file not found: ' , (filename ? self) asString)
-!
-
-removeError:filename
- "{ Pragma: +optSpace }"
-
- "report an error that some file could not be removed"
-
- ^ OperatingSystem accessDeniedErrorSignal
- raiseRequestWith:filename?self
- errorString:('cannot remove: ' , (filename?self) asString)
-!
-
reportError:string with:filename
"{ Pragma: +optSpace }"
@@ -2944,10 +2989,17 @@
"return the access rights of the file as opaque data
(SmallInteger in unix/linux)"
- ^ OperatingSystem accessModeOf:self osNameForFile.
+ |access|
+
+ access := OperatingSystem accessModeOf:self osName.
+ access isOSErrorHolder ifTrue:[
+ access reportProceedableError:'get access rights failed'.
+ ].
+ ^ access.
"
'Make.proto' asFilename accessRights
+ 'foo' asFilename accessRights
"
!
@@ -2955,9 +3007,13 @@
"set the access rights of the file to opaqueData,
which is normally retrieved by Filename>>#accessRights."
- (OperatingSystem changeAccessModeOf:self osNameForFile to:opaqueData) ifFalse:[
- ^ self accessDeniedError:self
- ].
+ |osErrorHolder|
+
+ osErrorHolder := OperatingSystem changeAccessModeOf:self osNameForFile to:opaqueData.
+ osErrorHolder notNil ifTrue:[
+ osErrorHolder reportProceedableError:'change access rights failed'.
+ ].
+
"
|rights|
@@ -2974,16 +3030,21 @@
by the receiver. The argument must be a collection of symbols,
such as #readUser, #writeGroup etc."
- |access osName|
+ |access osName osErrorHolder|
osName := self osNameForFile.
access := OperatingSystem accessModeOf:osName.
+ access isOSErrorHolder ifTrue:[
+ access reportProceedableError:'get access rights failed'.
+ ].
+
aCollection do:[:accessSymbol |
- access := access bitOr:(OperatingSystem accessMaskFor:accessSymbol).
- ].
- (OperatingSystem changeAccessModeOf:osName to:access) ifFalse:[
- ^ self accessDeniedError:self
- ]
+ access := access bitOr:(OperatingSystem accessMaskFor:accessSymbol).
+ ].
+ osErrorHolder := OperatingSystem changeAccessModeOf:osName to:access.
+ osErrorHolder notNil ifTrue:[
+ osErrorHolder reportProceedableError:'change access rights failed'.
+ ].
"
'foo' asFilename writeStream close.
@@ -3068,15 +3129,20 @@
such as #readUser, #writeGroup etc.
Raises an exception if not successful."
- |access osName|
+ |access osName osErrorHolder|
osName := self osNameForFile.
access := OperatingSystem accessModeOf:osName.
+ access isOSErrorHolder ifTrue:[
+ access reportProceedableError:'get access rights failed'.
+ ].
+
aCollection do:[:accessSymbol |
- access := access bitAnd:(OperatingSystem accessMaskFor:accessSymbol) bitInvert.
- ].
- (OperatingSystem changeAccessModeOf:osName to:access) ifFalse:[
- ^ self accessDeniedError:self
+ access := access bitAnd:(OperatingSystem accessMaskFor:accessSymbol) bitInvert.
+ ].
+ osErrorHolder := OperatingSystem changeAccessModeOf:osName to:access.
+ osErrorHolder notNil ifTrue:[
+ osErrorHolder reportProceedableError:'change access rights failed'.
].
"
@@ -3092,23 +3158,26 @@
symbolicAccessRights
"return the access rights of the file as a aCollection of access symbols.
The returned collection consists of symbols like:
- #readUser, #writeGroup etc."
+ #readUser, #writeGroup etc."
|access osName|
osName := self osNameForFile.
access := OperatingSystem accessModeOf:osName.
+ access isOSErrorHolder ifTrue:[
+ access reportProceedableError:'get access rights failed'.
+ ].
^
- #( readUser writeUser executeUser
- readGroup writeGroup executeGroup
- readOthers writeOthers executeOthers
- ) select:[:eachSymbolicAccessSymbol |
- access bitTest:(OperatingSystem accessMaskFor:eachSymbolicAccessSymbol).
- ].
-
- "
- 'Makefile' asFilename symbolicAccessRights
+ #( readUser writeUser executeUser
+ readGroup writeGroup executeGroup
+ readOthers writeOthers executeOthers
+ ) select:[:eachSymbolicAccessSymbol |
+ access bitTest:(OperatingSystem accessMaskFor:eachSymbolicAccessSymbol).
+ ].
+
+ "
+ 'Make.proto' asFilename symbolicAccessRights
"
"Modified: / 5.5.1999 / 13:41:21 / cg"
@@ -3117,24 +3186,25 @@
symbolicAccessRights:aCollectionOfSymbols
"set the access rights of the file given a aCollection of access symbols.
The collection must consist of symbols like:
- #readUser, #writeGroup etc."
-
- |access osName|
+ #readUser, #writeGroup etc."
+
+ |access osName osErrorHolder|
osName := self osNameForFile.
access := aCollectionOfSymbols inject:0 into:[:bitsSoFar :eachSymbolicAccessSymbol |
- bitsSoFar bitOr:(OperatingSystem accessMaskFor:eachSymbolicAccessSymbol)
- ].
-
- (OperatingSystem changeAccessModeOf:osName to:access) ifFalse:[
- ^ self accessDeniedError:self
+ bitsSoFar bitOr:(OperatingSystem accessMaskFor:eachSymbolicAccessSymbol)
+ ].
+
+ osErrorHolder := OperatingSystem changeAccessModeOf:osName to:access.
+ osErrorHolder notNil ifTrue:[
+ osErrorHolder reportProceedableError:'change access rights failed'.
].
"
|rights|
- rights := 'Makefile' asFilename symbolicAccessRights.
- 'Makefile' asFilename symbolicAccessRights:(rights , #(executeOthers)).
+ rights := 'Make.proto' asFilename symbolicAccessRights.
+ 'Make.proto' asFilename symbolicAccessRights:(rights , #(executeOthers)).
"
"Modified: / 5.5.1999 / 13:41:21 / cg"
@@ -3150,23 +3220,19 @@
inStream := self readStream.
[
- newNameOrStream isStream ifTrue:[
- outStream := newNameOrStream.
- ] ifFalse:[
- outStream := outStreamToClose := newNameOrStream asFilename appendingWriteStream.
- ].
-
- inStream binary.
- outStream binary.
-
- [
- inStream copyToEndInto:outStream.
- ] on:OsError do:[:ex|
- ^ self fileCreationError:newNameOrStream
- ]
+ newNameOrStream isStream ifTrue:[
+ outStream := newNameOrStream.
+ ] ifFalse:[
+ outStream := outStreamToClose := newNameOrStream asFilename appendingWriteStream.
+ ].
+
+ inStream binary.
+ outStream binary.
+
+ inStream copyToEndInto:outStream.
] ensure:[
- inStream close.
- outStreamToClose notNil ifTrue:[outStreamToClose close].
+ inStream close.
+ outStreamToClose notNil ifTrue:[outStreamToClose close].
].
"
@@ -3179,13 +3245,6 @@
"Modified: / 23.12.1999 / 21:52:36 / cg"
!
-basicMakeDirectory
- "create a directory with the receiver's name.
- Return true if successful, false if not."
-
- ^ OperatingSystem createDirectory:(self osNameForDirectory)
-!
-
copyTo:newNameArg
"Copy the file's contents into another file.
The argument must be convertable to a filename.
@@ -3214,11 +3273,10 @@
newNameAlreadyExists := newName exists.
outStream := newName writeStream.
newNameAlreadyExists ifFalse:[
- [
+ "ignore the error - may occur when copying to a network drive"
+ OsError catch:[
"would be nice to keep the access rights of the original test suite"
newName accessRights:self accessRights.
- ] on:OperatingSystem accessDeniedErrorSignal do:[:ex|
- "ignore the error - may occur when copying to a network drive"
].
].
inStream binary; buffered:false.
@@ -3298,14 +3356,35 @@
writeStream close.
!
+createAsHardLinkTo:linkFilenameString
+ "create a directory with the receiver's name.
+ Raises an exception if not successful"
+
+ |errorHolder|
+
+ errorHolder := OperatingSystem createHardLinkFrom:linkFilenameString asFilename osName to:self osName.
+ errorHolder notNil ifTrue:[
+ errorHolder reportProceedableError:'hard link failed'.
+ ].
+
+ "
+ '/tmp/link' asFilename createAsHardLinkTo:'bla'
+ "
+!
+
createAsSymbolicLinkTo:linkFilenameString
"create a directory with the receiver's name.
Raises an exception if not successful"
- OperatingSystem createSymbolicLinkFrom:linkFilenameString to:self pathName.
-
- "
- '/tmp/link' asFilename makeSymbolicLinkTo:'bla'
+ |errorHolder|
+
+ errorHolder := OperatingSystem createSymbolicLinkFrom:linkFilenameString asFilename osName to:self osName.
+ errorHolder notNil ifTrue:[
+ errorHolder reportError:'symbolic link failed'.
+ ].
+
+ "
+ '/tmp/link' asFilename createAsSymbolicLinkTo:'bla'
"
!
@@ -3319,16 +3398,18 @@
"create a directory with the receiver's name.
Raises an exception if not successful"
- (self basicMakeDirectory) ifFalse:[
- "/
- "/ could have existed before ...
- "/
- (self exists and:[self isDirectory]) ifFalse:[
- self fileCreationError:self.
- ^ false
- ]
- ].
- ^ true
+ |osErrorHolder|
+
+ osErrorHolder := OperatingSystem createDirectory:(self osNameForDirectory).
+ osErrorHolder notNil ifTrue:[
+ "/
+ "/ could have existed before ...
+ "/
+ (self exists and:[self isDirectory]) ifFalse:[
+ osErrorHolder reportProceedableError:'make directory failed'.
+ ]
+ ].
+ ^ nil
"Modified: / 5.5.1999 / 13:36:33 / cg"
!
@@ -3469,33 +3550,35 @@
destinationFilename := destination asFilename.
self isDirectory ifTrue:[
- destinationFilename exists ifFalse:[
- destinationFilename makeDirectory.
- destinationFilename accessRights:self accessRights.
- ].
-
- self directoryContentsDo:[:aFilenameString |
- |src srcInfo dst info|
-
- src := self construct:aFilenameString.
- dst := destinationFilename construct:aFilenameString.
-
- srcInfo := src linkInfo.
- srcInfo isDirectory ifTrue:[
- src recursiveCopyWithoutOSCommandTo:dst
- ] ifFalse:[srcInfo isSymbolicLink ifTrue:[
- dst
- remove;
- createAsSymbolicLinkTo:src linkInfo path.
- ] ifFalse:[
- src copyTo:dst.
- ]].
- ].
+ destinationFilename exists ifFalse:[
+ destinationFilename makeDirectory.
+ OsError catch:[
+ destinationFilename accessRights:self accessRights.
+ ].
+ ].
+
+ self directoryContentsDo:[:aFilenameString |
+ |src srcInfo dst info|
+
+ src := self construct:aFilenameString.
+ dst := destinationFilename construct:aFilenameString.
+
+ srcInfo := src linkInfo.
+ srcInfo isDirectory ifTrue:[
+ src recursiveCopyWithoutOSCommandTo:dst
+ ] ifFalse:[srcInfo isSymbolicLink ifTrue:[
+ dst
+ remove;
+ createAsSymbolicLinkTo:srcInfo path.
+ ] ifFalse:[
+ src copyTo:dst.
+ ]].
+ ].
] ifFalse:[
- destinationFilename isDirectory ifTrue:[
- destinationFilename := destinationFilename construct:self baseName.
- ].
- self copyTo:destinationFilename.
+ destinationFilename isDirectory ifTrue:[
+ destinationFilename := destinationFilename construct:self baseName.
+ ].
+ self copyTo:destinationFilename.
]
"
@@ -3511,12 +3594,24 @@
directories.
Raises an exception if not successful."
- (OperatingSystem recursiveCreateDirectory:(self osNameForDirectory)) ifFalse:[
- ^ self fileCreationError:self
- ]
+ |osErrorHolder|
+
+ osErrorHolder := OperatingSystem recursiveCreateDirectory:(self osNameForDirectory).
+ osErrorHolder notNil ifTrue:[
+ osErrorHolder reportProceedableError:'recursive makedir failed'.
+ ].
+
+ "
+ 'k:\bla\quark' asFilename recursiveMakeDirectory
+ "
"Created: / 27.11.1995 / 23:36:40 / cg"
"Modified: / 5.5.1999 / 13:38:42 / cg"
+
+ "
+ 'C:\windows\bla\xx' asFilename recursiveMakeDirectory
+ 'C:\windows\bla' asFilename recursiveRemoveAll
+ "
!
recursiveMoveDirectoryTo:newName
@@ -3571,26 +3666,23 @@
This one walks down the directory hierarchy, not using any OS
command to do the remove."
- |removeFailedError|
-
self isDirectory ifTrue:[
- removeFailedError := OperatingSystem accessDeniedErrorSignal.
- self directoryContentsAsFilenamesDo:[:eachFilename |
- removeFailedError handle:[:ex |
- eachFilename isDirectory ifFalse:[ ex reject ].
- eachFilename
- recursiveRemoveAll;
- removeDirectory.
- ] do:[
- eachFilename remove
- ].
+ self directoryContentsAsFilenamesDo:[:eachFilename |
+ OsError handle:[:ex |
+ eachFilename isDirectory ifFalse:[ ex reject ].
+ eachFilename
+ recursiveRemoveAll;
+ removeDirectory.
+ ] do:[
+ eachFilename remove
+ ].
"/ eachFilename isDirectory ifTrue:[
"/ eachFilename recursiveRemoveWithoutOSCommand
"/ ] ifFalse:[
"/ eachFilename remove
"/ ].
- ]
+ ]
].
"
@@ -3639,23 +3731,23 @@
Raises an exception if not successful.
Use #recursiveRemove in order to (recursively) remove non empty directories."
- |linkInfo osName ok|
+ |linkInfo osName osErrorHolder|
osName := self osNameForAccess.
- ok := OperatingSystem removeFile:osName.
- ok ifFalse:[
- linkInfo := self linkInfo.
- linkInfo isNil ifTrue:[
- "file does not exist - no error"
- ^ self.
- ] ifFalse:[linkInfo isDirectory ifTrue:[
- ok := OperatingSystem removeDirectory:osName
- ]].
- ok ifFalse:[
- self exists ifTrue:[
- self removeError:self pathName
- ]
- ]
+ osErrorHolder := OperatingSystem removeFile:osName.
+ osErrorHolder notNil ifTrue:[
+ linkInfo := self linkInfo.
+ linkInfo isNil ifTrue:[
+ "file does not exist - no error"
+ ^ self.
+ ] ifFalse:[linkInfo isDirectory ifTrue:[
+ osErrorHolder := OperatingSystem removeDirectory:osName
+ ]].
+ osErrorHolder notNil ifTrue:[
+ self exists ifTrue:[
+ osErrorHolder reportProceedableError:'remove failed'.
+ ]
+ ]
].
"
@@ -3680,10 +3772,15 @@
Use #remove if it is not known if the receiver is a directory or file.
Use #recursiveRemove in order to (recursively) remove non empty directories."
- (OperatingSystem removeDirectory:(self osNameForAccess)) ifFalse:[
- self exists ifFalse:[ ^ self].
- self removeError:self
- ].
+ |osErrorHolder|
+
+ osErrorHolder := OperatingSystem removeDirectory:self osNameForAccess.
+ osErrorHolder notNil ifTrue:[
+ self exists ifTrue:[
+ osErrorHolder reportProceedableError:'remove directory failed'.
+ ].
+ ].
+
"
(FileStream newFileNamed:'foo') close.
@@ -3699,7 +3796,7 @@
'foo' asFilename makeDirectory.
'foo/bar' asFilename writeStream close.
('foo' asFilename remove) ifFalse:[
- Transcript showCR:'could not remove foo'
+ Transcript showCR:'could not remove foo'
]
"
@@ -3713,10 +3810,13 @@
Use #remove if it is not known if the receiver is a directory or file.
Use #recursiveRemove in order to (recursively) remove non empty directories."
- (OperatingSystem removeFile:self osNameForAccess) ifFalse:[
- self exists ifTrue:[
- self removeError:self
- ].
+ |osErrorHolder|
+
+ osErrorHolder := OperatingSystem removeFile:self osNameForAccess.
+ osErrorHolder notNil ifTrue:[
+ self exists ifTrue:[
+ osErrorHolder reportProceedableError:'remove of file failed'.
+ ].
].
"
@@ -3730,30 +3830,27 @@
"
!
-renameTo:newNameArg
+renameTo:newName
"rename the file - the argument must be convertable to a String.
Raises an exception if not successful.
If newName already exists, it will be replaced by myself."
- |errno newName|
-
- newName := newNameArg asFilename.
- (OperatingSystem
- renameFile:(self osNameForFile)
- to:(newName osNameForFile)
- ) ifFalse:[
- errno := OperatingSystem lastErrorNumber.
-
- self exists ifFalse:[
- ^ self fileNotFoundError:self
- ].
- (OperatingSystem errorHolderForNumber:errno)
- parameter:newName;
- reportError.
+ |errorHolder|
+
+ errorHolder := OperatingSystem
+ renameFile:(self osNameForFile)
+ to:(newName asFilename osNameForFile).
+
+ errorHolder notNil ifTrue:[
+ errorHolder
+ parameter:self;
+ reportProceedableError:'rename failed'.
].
"
'/tmp/foo' asFilename renameTo:'/tmp/bar'
+ '/tmp/' asFilename renameTo:'/etc/bar'
+ 'C:\windows' asFilename renameTo:'C:\win'
"
"Modified: / 5.5.1999 / 13:41:27 / cg"
@@ -3782,11 +3879,10 @@
[
"let the temp filename start with a ~ to make it invisible"
tempStream := FileStream newTemporaryIn:newName directory osNameForFile nameTemplate:'~%1_%2'.
- [
+ "ignore the error - may occur when copying to a network drive"
+ OsError catch:[
"would be nice to keep the access rights of the original file"
tempStream fileName accessRights:accessRights.
- ] on:OperatingSystem accessDeniedErrorSignal do:[:ex|
- "ignore the error - may occur when copying to a network drive"
].
inStream binary; buffered:false.
@@ -4010,30 +4106,30 @@
the info (for which corresponding access methods are understood by
the returned object) is:
- type - a symbol giving the files fileType
- mode - numeric access mode
- uid - owners user id
- gid - owners group id
- size - files size
- id - files number (i.e. inode number)
- accessed - last access time (as osTime-stamp)
- modified - last modification time (as osTime-stamp)
- statusChangeTime - last staus change (as osTime-stamp)
+ type - a symbol giving the files fileType
+ mode - numeric access mode
+ uid - owners user id
+ gid - owners group id
+ size - files size
+ id - files number (i.e. inode number)
+ accessed - last access time (as osTime-stamp)
+ modified - last modification time (as osTime-stamp)
+ statusChangeTime - last staus change (as osTime-stamp)
Some of the fields may be returned as nil on systems which do not provide
all of the information.
The minimum returned info (i.e. on all OS's) will consist of at least:
- modified
- size
- type
-
- Dont expect things like uid/gid/mode to be non-nil; write your application
+ modified
+ size
+ type
+
+ Don't expect things like uid/gid/mode to be non-nil; write your application
to either handle nil values,
or (better) use one of isXXXX query methods. (Be prepared for DOS ...)
(i.e. instead of:
- someFilename type == #directory
+ someFilename type == #directory
use
- someFilename isDirectory
+ someFilename isDirectory
"
^ OperatingSystem infoOf:(self osNameForAccess)
@@ -4418,30 +4514,44 @@
on unix, an xterm is opened."
OperatingSystem isOSXlike ifTrue:[
- "/ I dont know yet how to tell the terminal to
- "/ go to a particular directory.
- "/ therefore, use the built in terminal
- VT100TerminalView openShellIn:self pathName.
- ^ self.
+ "/ I don't know yet how to tell the terminal to
+ "/ go to a particular directory.
+ "/ therefore, use the built in terminal
+ VT100TerminalView openShellIn:self pathName.
+ ^ self.
+ ].
+ "/ using the code below seems to close the window immediately
+ "/ at least on win7.
+ "/ use out own terminal, to make sure.
+ (OperatingSystem isMSWINDOWSlike
+ and:[OperatingSystem isWin7Like]) ifTrue:[
+ "/ I don't know yet how to tell the terminal to
+ "/ go to a particular directory.
+ "/ therefore, use the built in terminal
+ VT100TerminalView openShellIn:self pathName.
+ ^ self.
].
[
- |cmd|
-
- OperatingSystem isOSXlike ifTrue:[
- cmd := '/Applications/Utilities/Terminal.app/Contents/MacOS/Terminal '
- ] ifFalse:[
- OperatingSystem isMSWINDOWSlike ifTrue:[
- cmd := 'c:\windows\System32\cmd.exe'
- ] ifFalse:[
- "/ VT100TerminalView openShellIn:self pathName
- cmd := 'xterm'
- ]
- ].
- OperatingSystem
- executeCommand:cmd
- inDirectory:self pathName.
+ |cmd|
+
+ OperatingSystem isOSXlike ifTrue:[
+ cmd := '/Applications/Utilities/Terminal.app/Contents/MacOS/Terminal '
+ ] ifFalse:[
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ cmd := #('c:\windows\System32\cmd.exe')
+ ] ifFalse:[
+ "/ VT100TerminalView openShellIn:self pathName
+ cmd := 'xterm'
+ ]
+ ].
+ OperatingSystem
+ executeCommand:cmd
+ inDirectory:self pathName
+ showWindow:#default.
] fork
+
+ "Modified: / 18-10-2016 / 16:08:15 / cg"
! !
!Filename methodsFor:'printing & storing'!
@@ -5051,6 +5161,7 @@
'../..' asFilename directoryPathName
'/foo/bar/baz/..' asFilename directoryName
'/foo/bar/baz/.' asFilename directoryName
+ 'c:\' asFilename directoryName
"
"Modified: / 7.9.1995 / 10:42:03 / claus"
@@ -5535,7 +5646,7 @@
^ pathOrNil asFilename
"
- '/foo/bar' asFilename physicalFileName
+ '/foo/bar' asFilename physicalFilename
"
!
@@ -6481,6 +6592,11 @@
version_CVS
^ '$Header$'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/Float.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Float.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -665,7 +663,7 @@
e
"return the constant e as Float"
- "/ dont expect this many valid digits on all machines;
+ "/ don't expect this many valid digits on all machines;
"/ The actual precision is very CPU specific.
^ 2.7182818284590452353602874713526625
@@ -708,7 +706,7 @@
pi
"return the constant pi as Float"
- "/ dont expect this many valid digits on all machines;
+ "/ don't expect this many valid digits on all machines;
"/ The actual precision is very CPU specific.
^ 3.14159265358979323846264338327950288419716939937510582097494459
@@ -717,7 +715,7 @@
!
sqrt2
- "/ dont expect this many valid digits on all machines;
+ "/ don't expect this many valid digits on all machines;
"/ The actual precision is very CPU specific.
^ 1.41421356237309504880168872420969808
@@ -1998,7 +1996,7 @@
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
1.0 printString
@@ -2041,23 +2039,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
-
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __floatVal(self));
-
- __END_PROTECT_REGISTERS__
-
- if (len < 0) goto fail;
-
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
+
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __floatVal(self));
+
+ __END_PROTECT_REGISTERS__
+
+ if (len < 0) goto fail;
+
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -2123,7 +2121,7 @@
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
1.0 storeString
@@ -2333,7 +2331,7 @@
RETURN (__MKFLOAT(frac));
%}.
^ super mantissa
-
+
"
1.0 exponent
1.0 mantissa
--- a/FloatArray.st Wed Oct 19 09:22:53 2016 +0100
+++ b/FloatArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -16,10 +14,10 @@
"{ NameSpace: Smalltalk }"
AbstractNumberVector variableFloatSubclass:#FloatArray
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Collections-Arrayed'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
!
!FloatArray class methodsFor:'documentation'!
@@ -688,28 +686,6 @@
OBJ retVal;
_min = _max = _p[0];
-#ifdef PRE_4_OCT_2011
- if (_sz > 1) {
- float _this = _p[1];
- float _prev;
-
- /* how about inline-mmx-asm for this ... */
- for (_i=2; _i<_sz; _i++) {
- _prev = _this;
- _this = _p[_i];
- if (_prev < _min) {
- _min = _prev;
- } else if (_prev > _max) {
- _max = _prev;
- }
- }
- if (_this < _min) {
- _min = _this;
- } else if (_this > _max) {
- _max = _this;
- }
- }
-#else
for (_i=_sz-1; _i>0; _i-=2) {
float _v1 = _p[_i];
float _v2 = _p[_i-1];
@@ -721,7 +697,7 @@
if (_v1 > _max) _max = _v1;
}
}
-#endif
+
min = __MKFLOAT(_min);
__PROTECT__(min);
max = __MKFLOAT(_max);
@@ -734,7 +710,7 @@
empty == true ifTrue:[
^ self emptyCollectionError.
].
- ^ Array with:(super min) with:(super max)
+ ^ Array with:(self min) with:(self max)
"
|f1|
--- a/GenericException.st Wed Oct 19 09:22:53 2016 +0100
+++ b/GenericException.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -132,7 +130,7 @@
and NON-PROCEEDABLE signals must be raised with:
raise
- If you dont know/care as a raiser, you can use
+ If you don't know/care as a raiser, you can use
raiseSignal
which checks for proceedability and sends the appropriate message.
(sigh)
@@ -956,33 +954,33 @@
Deferring makes sense for some signals, such as UserInterrupt or AbortSignal,
which must occasionally be delayed temporarily until a save place is reached
- (especially when packages are sent across a communication channel, and you dont want
+ (especially when packages are sent across a communication channel, and you don't want
partial packages to be generated by user interruptions)."
|caughtException result|
self handle:[:ex |
- caughtException isNil ifTrue:[
- caughtException := ex.
- ].
- ex proceedWith:nil
+ caughtException isNil ifTrue:[
+ caughtException := ex.
+ ].
+ ex proceedWith:nil
] do:[
- result := aBlock value.
+ result := aBlock value.
].
caughtException notNil ifTrue:[
- caughtException suspendedContext:thisContext.
-
- "/ the exception was raised during the execution of aBlock above.
- "/ Raise it now (delayed).
- caughtException raiseSignal.
+ caughtException suspendedContext:thisContext.
+
+ "/ the exception was raised during the execution of aBlock above.
+ "/ Raise it now (delayed).
+ caughtException raiseSignal.
].
^ result
"
UserInterrupt deferAfter:[
- Transcript showCR:'1 - now raising, but will be deferred.'.
- UserInterrupt raiseRequestWith:'hello'.
- Transcript showCR:'2 - after the raise, deferred exception will be handled soon.'.
+ Transcript showCR:'1 - now raising, but will be deferred.'.
+ UserInterrupt raiseRequestWith:'hello'.
+ Transcript showCR:'2 - after the raise, deferred exception will be handled soon.'.
].
Transcript showCR:'3 - here after the protected block.'.
"
@@ -1109,6 +1107,10 @@
!GenericException class methodsFor:'testing'!
+isAbstract
+ ^ self == GenericException
+!
+
isControlInterrupt
^ false
@@ -1222,6 +1224,9 @@
!GenericException methodsFor:'Compatibility-Squeak'!
signalerContext
+ "return the context in which the raise occurred.
+ Same as suspendedContext, for squeak compatibility"
+
^ self suspendedContext
! !
--- a/Geometric.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Geometric.st Fri Dec 09 22:31:28 2016 +0000
@@ -485,7 +485,7 @@
canBeFilled
"return true, if the receiver can be drawn as a filled geometric.
- Return false here, since we dont know."
+ Return false here, since we don't know."
^ false
--- a/Integer.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Integer.st Fri Dec 09 22:31:28 2016 +0000
@@ -501,7 +501,7 @@
].
].
"/ val > 5000 ifTrue:[
-"/ ^ RomanNumberFormatError raiseErrorStirng:'number out of range (1..5000)'
+"/ ^ RomanNumberFormatError raiseErrorString:'number out of range (1..5000)'
"/ ].
^ val.
@@ -773,8 +773,6 @@
"Modified: / 15.11.1999 / 20:35:20 / cg"
! !
-
-
!Integer class methodsFor:'class initialization'!
initialize
@@ -1034,7 +1032,9 @@
|cls|
- max < IntegerArray maxVal ifTrue:[
+ "/ sigh: IntegerArray is in libbasic2...
+ (IntegerArray notNil
+ and:[ max < IntegerArray maxVal]) ifTrue:[
cls := IntegerArray.
] ifFalse:[
cls := Array.
@@ -1199,23 +1199,6 @@
!Integer methodsFor:'Compatibility-Dolphin'!
-& aNumber
- "return the bitwise-and of the receiver and the argument, anInteger.
- Same as bitAnd: - added for compatibility with Dolphin Smalltalk.
- Notice:
- PLEASE DO NOT USE & for integers in new code; it makes the code harder
- to understand, as it may be not obvious, whether a boolean-and a bitWise-and is intended.
- For integers, use bitAnd: to make the intention explicit.
- Also, consider using and: for booleans, which is does not evaluate the right part if the left is false."
-
- ^ self bitAnd:aNumber
-
- "
- 14 | 1
- 9 & 8
- "
-!
-
highWord
"return the high 16 bits of a 32 bit value"
@@ -1462,6 +1445,7 @@
! !
+
!Integer methodsFor:'bcd conversion'!
decodeFromBCD
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/IntegerArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,216 @@
+"
+ COPYRIGHT (c) 1997 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 }"
+
+UnboxedIntegerArray variableLongSubclass:#IntegerArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!IntegerArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 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
+"
+ IntegerArrays store integers in the range 0..16rFFFFFFFF.
+ In contrast to normal arrays (which store pointers to their elements),
+ integerArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of unsigned int32's, this is also useful to pass bulk data to c primitive code.
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 4)
+
+ [see also:]
+ ByteArray BooleanArray FloatArray DoubleArray Array
+ SignedWordArray WordArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!IntegerArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 4 is returned"
+
+ ^ 4
+
+ "Created: / 15-09-2011 / 14:12:15 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me"
+
+ ^ 16rFFFFFFFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me"
+
+ ^ 0
+! !
+
+!IntegerArray methodsFor:'accessing'!
+
+unsignedInt32At:index MSB:msb
+ "return the 4-bytes starting at index as an (unsigned) Integer.
+ The index is a smalltalk index (i.e. 1-based).
+ The value is retrieved MSB (high 8 bits at lower index) if msb is true;
+ LSB-first (i.e. low 8-bits at lower byte index) if its false.
+ Notice:
+ the index is a byte index; thus, this allows for unaligned access to
+ words on any boundary.
+ Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
+
+ |w|
+
+ (index bitAnd: 16r03) == 1 ifTrue:[
+ "/ aligned fetch
+ w := self at:(index // 4) + 1.
+ (msb ~~ UninterpretedBytes isBigEndian) ifTrue:[
+ w := w swapBytes
+ ].
+ ^ w
+ ].
+ ^ super unsignedInt32At:index MSB:msb
+
+ "
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:1 MSB:false
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:5 MSB:false
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:9 MSB:false
+
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:2 MSB:false
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:3 MSB:false
+ #(16r0201 16r0403 16r0605) asIntegerArray unsignedInt32At:4 MSB:false
+
+ #(16rFFEE 16r0403 16r0605) asIntegerArray unsignedInt32At:1 MSB:false
+ #(16rFFEE 16r0403 16r0605) asIntegerArray unsignedInt32At:1 MSB:true
+ "
+! !
+
+!IntegerArray methodsFor:'comparing'!
+
+< anIntegerArray
+ "Compare the receiver with the argument and return true if the
+ receiver is greater than the argument. Otherwise return false.
+
+ Redefined for speed (xpath handling)"
+
+%{ /* NOCONTEXT */
+
+ int len1, len2, min, i;
+ REGISTER OBJ s = anIntegerArray;
+ unsigned int *ip1, *ip2;
+ OBJ cls;
+ OBJ myCls;
+
+ if (__isNonNilObject(s)) {
+ cls = __qClass(s);
+ myCls = __qClass(self);
+
+ if ((cls == IntegerArray) || (cls == myCls)) {
+ ip2 = __integerArrayVal(s);
+ len2 = __integerArraySize(s);
+ /*
+ * care for instances of subclasses ...
+ */
+ if (cls != IntegerArray) {
+ int n = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)) / sizeof(__integerArrayVal(s));
+
+ ip2 += n;
+ len2 -= n;
+ }
+
+ ip1 = __integerArrayVal(self);
+ len1 = __integerArraySize(self);
+ /*
+ * care for instances of subclasses ...
+ */
+ if (myCls != IntegerArray) {
+ int n = __OBJS2BYTES__(__intVal(__ClassInstPtr(myCls)->c_ninstvars)) / sizeof(__integerArrayVal(s));
+
+ ip1 += n;
+ len1 -= n;
+ }
+
+ if (len1 <= len2)
+ min = len1;
+ else
+ min = len2;
+
+ for (i = 0; i < min; i++) {
+ if (ip1[i] < ip2[i]) {
+ RETURN(true)
+ }
+ if (ip1[i] > ip2[i]) {
+ RETURN(false)
+ }
+ }
+
+ if (len1 < len2) {
+ RETURN ( true );
+ }
+ RETURN ( false );
+ }
+ }
+%}.
+ ^ super < anIntegerArray
+
+
+ "
+ (IntegerArray newFrom:#[1 2 3 4 5]) < (IntegerArray newFrom:#[1 2 3 4 5])
+ (IntegerArray newFrom:#[1 2 3 4 5]) < (IntegerArray newFrom:#[1 2 3 4])
+ (IntegerArray newFrom:#[1 2 3 4]) < (IntegerArray newFrom:#[1 2 3 4 5])
+ (IntegerArray newFrom:#[1 2 3 4 5]) < (IntegerArray newFrom:#[1 2 3 4 6])
+ (IntegerArray newFrom:#[]) < (IntegerArray newFrom:#[1 2 3 4 6])
+ "
+! !
+
+!IntegerArray methodsFor:'converting'!
+
+asIntegerArray
+ "return a new IntegerArray with the collection's elements.
+ That's the receiver itself here"
+
+ ^ self.
+! !
+
+!IntegerArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/Interval.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Interval.st Fri Dec 09 22:31:28 2016 +0000
@@ -220,6 +220,10 @@
!Interval methodsFor:'converting'!
+asInterval
+ ^ self.
+!
+
fromLiteralArrayEncoding:encoding
"read my values from an encoding.
The encoding is supposed to be either of the form:
--- a/JavaPackage.st Wed Oct 19 09:22:53 2016 +0100
+++ b/JavaPackage.st Fri Dec 09 22:31:28 2016 +0000
@@ -142,7 +142,7 @@
name:aStringOrSymbol
"create a new nameSpace, named aStringOrSymbol.
Notice, that the nameSpace is created in the current one -
- dont get confused; we recommend, not to nest them too much."
+ don't get confused; we recommend, not to nest them too much."
|currentNameSpace newNameSpace existing ok nameSym fullName|
@@ -324,13 +324,21 @@
!JavaPackage class methodsFor:'documentation'!
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+!
+
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
- ^ '$Id: JavaPackage.st,v 1.2 2014-11-14 09:52:45 vrany Exp $'
+ ^ '$Id$'
! !
--- a/LimitedPrecisionReal.st Wed Oct 19 09:22:53 2016 +0100
+++ b/LimitedPrecisionReal.st Fri Dec 09 22:31:28 2016 +0000
@@ -425,18 +425,21 @@
fmax
"The largest value allowed by instances of this class."
- |radix|
+ |radix _radix|
radix := self radix.
- ^(self fromNumber: 1) -
- ((self fromNumber: radix) timesTwoPower: self precision negated - 1) * radix
- * ((self fromNumber: radix) timesTwoPower: self emax - 1)
+ _radix := (self fromNumber: radix).
+ ^ ((self fromNumber: 1) -
+ (_radix timesTwoPower: self precision negated - 1)) * radix
+ * (_radix timesTwoPower: self emax - 1)
"
- Float fmax
+ Float fmax
ShortFloat fmax
LongFloat fmax
"
+
+ "Modified (comment): / 16-11-2016 / 23:12:36 / cg"
!
fmin
@@ -1190,7 +1193,6 @@
! !
-
!LimitedPrecisionReal methodsFor:'printing & storing'!
printOn:aStream
@@ -1261,7 +1263,6 @@
^ 0
! !
-
!LimitedPrecisionReal methodsFor:'testing'!
isFinite
--- a/LongFloat.st Wed Oct 19 09:22:53 2016 +0100
+++ b/LongFloat.st Fri Dec 09 22:31:28 2016 +0000
@@ -1613,7 +1613,7 @@
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
1.234 asLongFloat printString.
@@ -1658,23 +1658,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
-
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __longFloatVal(self));
-
- __END_PROTECT_REGISTERS__
-
- if (len < 0) goto fail;
-
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
+
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __longFloatVal(self));
+
+ __END_PROTECT_REGISTERS__
+
+ if (len < 0) goto fail;
+
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -1746,7 +1746,7 @@
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
1.0 asLongFloat storeString
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/LongIntegerArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,97 @@
+"
+ COPYRIGHT (c) 1998 by Claus Gittinger / 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 }"
+
+UnboxedIntegerArray variableLongLongSubclass:#LongIntegerArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!LongIntegerArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1998 by Claus Gittinger / 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
+"
+ LongIntegerArrays store 64bit unsigned integers in the range
+ 0..16rFFFFFFFFFFFFFFFF.
+ In contrast to normal arrays (which store pointers to their elements),
+ longIntegerArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of unsigned longlong's, this is also useful to pass bulk data to c primitive code.
+ (the system makes certain, that the first longlong is aligned as required)
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 8)
+
+ [see also:]
+ ByteArray BooleanArray FloatArray DoubleArray Array
+ WordArray SignedWordArray IntegerArray SignedIntegerArray
+ SignedLongIntegerArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!LongIntegerArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 8 is returned"
+
+ ^ 8
+
+ "Created: / 15-09-2011 / 14:11:59 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For LongIntegerArrays, this is 18446744073709551615 eg. 16rFFFFFFFFFFFFFFFF
+ (largest 64bit unsigned int)"
+
+ ^ 16rFFFFFFFFFFFFFFFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For LongIntegerArrays, this is 0"
+
+ ^ 0
+! !
+
+!LongIntegerArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/Lookup.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Lookup.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
All Rights Reserved
@@ -151,7 +149,7 @@
The returned method object will NOT be put into the inline- and
polyCache bu default. To update the call site's cache, you have to
call ilcCache bindTo: method forClass: initialSearch class. If you
- dont call it, inline/poly cache won't be updated and next call
+ don't call it, inline/poly cache won't be updated and next call
won't be cached (therefore it will be relatively slow.
If I return nil, a doesNotUnderstand: will be send."
--- a/Make.proto Wed Oct 19 09:22:53 2016 +0100
+++ b/Make.proto Fri Dec 09 22:31:28 2016 +0000
@@ -196,6 +196,7 @@
$(OUTDIR)UndefinedObject.$(O) UndefinedObject.$(C) UndefinedObject.$(H): UndefinedObject.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)UserMessage.$(O) UserMessage.$(C) UserMessage.$(H): UserMessage.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)Visitor.$(O) Visitor.$(C) Visitor.$(H): Visitor.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)VoidObject.$(O) VoidObject.$(C) VoidObject.$(H): VoidObject.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)AbstractTime.$(O) AbstractTime.$(C) AbstractTime.$(H): AbstractTime.st $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ApplicationDefinition.$(O) ApplicationDefinition.$(C) ApplicationDefinition.$(H): ApplicationDefinition.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
$(OUTDIR)ArithmeticValue.$(O) ArithmeticValue.$(C) ArithmeticValue.$(H): ArithmeticValue.st $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -314,6 +315,7 @@
$(OUTDIR)AbstractSourceFileWriter.$(O) AbstractSourceFileWriter.$(C) AbstractSourceFileWriter.$(H): AbstractSourceFileWriter.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Notification.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Query.$(H) $(STCHDR)
$(OUTDIR)ActivityNotification.$(O) ActivityNotification.$(C) ActivityNotification.$(H): ActivityNotification.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Notification.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/UserNotification.$(H) $(STCHDR)
$(OUTDIR)Array.$(O) Array.$(C) Array.$(H): Array.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(STCHDR)
+$(OUTDIR)BitArray.$(O) BitArray.$(C) BitArray.$(H): BitArray.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(STCHDR)
$(OUTDIR)BreakPointInterrupt.$(O) BreakPointInterrupt.$(C) BreakPointInterrupt.$(H): BreakPointInterrupt.st $(INCLUDE_TOP)/stx/libbasic/ControlInterrupt.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/HaltInterrupt.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(O) CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(C) CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(H): CharacterEncoderImplementations__ISO10646_to_UTF16LE.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoder.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderImplementations__ISO10646_to_UTF16BE.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderImplementations__TwoByteEncoder.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(O) CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(C) CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(H): CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoder.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderImplementations__ISO10646_to_UTF8.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderImplementations__TwoByteEncoder.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -368,6 +370,7 @@
$(OUTDIR)AbstractNumberVector.$(O) AbstractNumberVector.$(C) AbstractNumberVector.$(H): AbstractNumberVector.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)AllocationFailure.$(O) AllocationFailure.$(C) AllocationFailure.$(H): AllocationFailure.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)AutoloadMetaclass.$(O) AutoloadMetaclass.$(C) AutoloadMetaclass.$(H): AutoloadMetaclass.st $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/Metaclass.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)BooleanArray.$(O) BooleanArray.$(C) BooleanArray.$(H): BooleanArray.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/BitArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(STCHDR)
$(OUTDIR)ByteArray.$(O) ByteArray.$(C) ByteArray.$(H): ByteArray.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)CharacterArray.$(O) CharacterArray.$(C) CharacterArray.$(H): CharacterArray.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)CharacterWriteStream.$(O) CharacterWriteStream.$(C) CharacterWriteStream.$(H): CharacterWriteStream.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(STCHDR)
@@ -451,6 +454,7 @@
$(OUTDIR)SubclassResponsibilityError.$(O) SubclassResponsibilityError.$(C) SubclassResponsibilityError.$(H): SubclassResponsibilityError.st $(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)TimeConversionError.$(O) TimeConversionError.$(C) TimeConversionError.$(H): TimeConversionError.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/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)TwoByteString.$(O) TwoByteString.$(C) TwoByteString.$(H): TwoByteString.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)UnboxedIntegerArray.$(O) UnboxedIntegerArray.$(C) UnboxedIntegerArray.$(H): UnboxedIntegerArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)UnimplementedFunctionalityError.$(O) UnimplementedFunctionalityError.$(C) UnimplementedFunctionalityError.$(H): UnimplementedFunctionalityError.st $(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)UnprotectedExternalBytes.$(O) UnprotectedExternalBytes.$(C) UnprotectedExternalBytes.$(H): UnprotectedExternalBytes.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/ExternalBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)WeakDependencyDictionary.$(O) WeakDependencyDictionary.$(C) WeakDependencyDictionary.$(H): WeakDependencyDictionary.st $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Dictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/IdentityDictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Set.$(H) $(INCLUDE_TOP)/stx/libbasic/WeakIdentityDictionary.$(H) $(STCHDR)
@@ -468,11 +472,13 @@
$(OUTDIR)HandleRegistry.$(O) HandleRegistry.$(C) HandleRegistry.$(H): HandleRegistry.st $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Dictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/IdentityDictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Registry.$(H) $(INCLUDE_TOP)/stx/libbasic/Set.$(H) $(INCLUDE_TOP)/stx/libbasic/WeakIdentityDictionary.$(H) $(STCHDR)
$(OUTDIR)ImmutableString.$(O) ImmutableString.$(C) ImmutableString.$(H): ImmutableString.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/String.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)IndexNotFoundError.$(O) IndexNotFoundError.$(C) IndexNotFoundError.$(H): IndexNotFoundError.st $(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/NotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
+$(OUTDIR)IntegerArray.$(O) IntegerArray.$(C) IntegerArray.$(H): IntegerArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)InvalidByteCodeError.$(O) InvalidByteCodeError.$(C) InvalidByteCodeError.$(H): InvalidByteCodeError.st $(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/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)InvalidInstructionError.$(O) InvalidInstructionError.$(C) InvalidInstructionError.$(H): InvalidInstructionError.st $(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/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)InvalidReadError.$(O) InvalidReadError.$(C) InvalidReadError.$(H): InvalidReadError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadError.$(H) $(INCLUDE_TOP)/stx/libbasic/StreamError.$(H) $(STCHDR)
$(OUTDIR)InvalidWriteError.$(O) InvalidWriteError.$(C) InvalidWriteError.$(H): InvalidWriteError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/StreamError.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteError.$(H) $(STCHDR)
$(OUTDIR)KeyNotFoundError.$(O) KeyNotFoundError.$(C) KeyNotFoundError.$(H): KeyNotFoundError.st $(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/NotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
+$(OUTDIR)LongIntegerArray.$(O) LongIntegerArray.$(C) LongIntegerArray.$(H): LongIntegerArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)MissingClassInLiteralArrayErrorSignal.$(O) MissingClassInLiteralArrayErrorSignal.$(C) MissingClassInLiteralArrayErrorSignal.$(H): MissingClassInLiteralArrayErrorSignal.st $(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/NotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NoByteCodeError.$(O) NoByteCodeError.$(C) NoByteCodeError.$(H): NoByteCodeError.st $(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/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NonPositionableExternalStream.$(O) NonPositionableExternalStream.$(C) NonPositionableExternalStream.$(H): NonPositionableExternalStream.st $(INCLUDE_TOP)/stx/libbasic/ExternalStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadWriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(STCHDR)
@@ -480,13 +486,19 @@
$(OUTDIR)PTYOpenError.$(O) PTYOpenError.$(C) PTYOpenError.$(H): PTYOpenError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/OpenError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/StreamError.$(H) $(STCHDR)
$(OUTDIR)PackageNotCompatibleError.$(O) PackageNotCompatibleError.$(C) PackageNotCompatibleError.$(H): PackageNotCompatibleError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PackageLoadError.$(H) $(INCLUDE_TOP)/stx/libbasic/PackageNotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)RangeError.$(O) RangeError.$(C) RangeError.$(H): RangeError.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) $(STCHDR)
+$(OUTDIR)SignedIntegerArray.$(O) SignedIntegerArray.$(C) SignedIntegerArray.$(H): SignedIntegerArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)SignedLongIntegerArray.$(O) SignedLongIntegerArray.$(C) SignedLongIntegerArray.$(H): SignedLongIntegerArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)SignedWordArray.$(O) SignedWordArray.$(C) SignedWordArray.$(H): SignedWordArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)Symbol.$(O) Symbol.$(C) Symbol.$(H): Symbol.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/String.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)UnboundedExternalStream.$(O) UnboundedExternalStream.$(C) UnboundedExternalStream.$(H): UnboundedExternalStream.st $(INCLUDE_TOP)/stx/libbasic/ExternalStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadWriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(STCHDR)
$(OUTDIR)Unicode16String.$(O) Unicode16String.$(C) Unicode16String.$(H): Unicode16String.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/TwoByteString.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)UnorderedNumbersError.$(O) UnorderedNumbersError.$(C) UnorderedNumbersError.$(H): UnorderedNumbersError.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) $(STCHDR)
+$(OUTDIR)WordArray.$(O) WordArray.$(C) WordArray.$(H): WordArray.st $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)WrongNumberOfArgumentsError.$(O) WrongNumberOfArgumentsError.$(C) WrongNumberOfArgumentsError.$(H): WrongNumberOfArgumentsError.st $(INCLUDE_TOP)/stx/libbasic/ArgumentError.$(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)WrongProceedabilityError.$(O) WrongProceedabilityError.$(C) WrongProceedabilityError.$(H): WrongProceedabilityError.st $(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/SignalError.$(H) $(STCHDR)
$(OUTDIR)CharacterRangeError.$(O) CharacterRangeError.$(C) CharacterRangeError.$(H): CharacterRangeError.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderError.$(H) $(INCLUDE_TOP)/stx/libbasic/ConversionError.$(H) $(INCLUDE_TOP)/stx/libbasic/DecodingError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)DirectoryStream.$(O) DirectoryStream.$(C) DirectoryStream.$(H): DirectoryStream.st $(INCLUDE_TOP)/stx/libbasic/ExternalStream.$(H) $(INCLUDE_TOP)/stx/libbasic/FileStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadWriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(STCHDR)
+$(OUTDIR)ImaginaryResultError.$(O) ImaginaryResultError.$(C) ImaginaryResultError.$(H): ImaginaryResultError.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)InvalidEncodingError.$(O) InvalidEncodingError.$(C) InvalidEncodingError.$(H): InvalidEncodingError.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderError.$(H) $(INCLUDE_TOP)/stx/libbasic/ConversionError.$(H) $(INCLUDE_TOP)/stx/libbasic/DecodingError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NonIntegerIndexError.$(O) NonIntegerIndexError.$(C) NonIntegerIndexError.$(H): NonIntegerIndexError.st $(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/IndexNotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/NotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(OUTDIR)OverflowError.$(O) OverflowError.$(C) OverflowError.$(H): OverflowError.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)
@@ -495,6 +507,7 @@
$(OUTDIR)SubscriptOutOfBoundsError.$(O) SubscriptOutOfBoundsError.$(C) SubscriptOutOfBoundsError.$(H): SubscriptOutOfBoundsError.st $(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/IndexNotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/NotFoundError.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(STCHDR)
$(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)UnixFileDescriptorHandle.$(O) UnixFileDescriptorHandle.$(C) UnixFileDescriptorHandle.$(H): UnixFileDescriptorHandle.st $(INCLUDE_TOP)/stx/libbasic/ExternalAddress.$(H) $(INCLUDE_TOP)/stx/libbasic/OSFileHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/OSHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)UnixFileHandle.$(O) UnixFileHandle.$(C) UnixFileHandle.$(H): UnixFileHandle.st $(INCLUDE_TOP)/stx/libbasic/ExternalAddress.$(H) $(INCLUDE_TOP)/stx/libbasic/OSFileHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/OSHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)UnixOperatingSystem.$(O) UnixOperatingSystem.$(C) UnixOperatingSystem.$(H): UnixOperatingSystem.st $(INCLUDE_TOP)/stx/libbasic/AbstractOperatingSystem.$(H) $(INCLUDE_TOP)/stx/libbasic/ExternalAddress.$(H) $(INCLUDE_TOP)/stx/libbasic/OSFileHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/OSHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SharedPool.$(H) $(STCHDR)
--- a/Make.spec Wed Oct 19 09:22:53 2016 +0100
+++ b/Make.spec Fri Dec 09 22:31:28 2016 +0000
@@ -106,6 +106,7 @@
UndefinedObject \
UserMessage \
Visitor \
+ VoidObject \
AbstractTime \
ApplicationDefinition \
ArithmeticValue \
@@ -224,6 +225,7 @@
AbstractSourceFileWriter \
ActivityNotification \
Array \
+ BitArray \
BreakPointInterrupt \
CharacterEncoderImplementations::ISO10646_to_UTF16LE \
CharacterEncoderImplementations::ISO10646_to_UTF8_MAC \
@@ -278,6 +280,7 @@
AbstractNumberVector \
AllocationFailure \
AutoloadMetaclass \
+ BooleanArray \
ByteArray \
CharacterArray \
CharacterWriteStream \
@@ -361,6 +364,7 @@
SubclassResponsibilityError \
TimeConversionError \
TwoByteString \
+ UnboxedIntegerArray \
UnimplementedFunctionalityError \
UnprotectedExternalBytes \
WeakDependencyDictionary \
@@ -378,11 +382,13 @@
HandleRegistry \
ImmutableString \
IndexNotFoundError \
+ IntegerArray \
InvalidByteCodeError \
InvalidInstructionError \
InvalidReadError \
InvalidWriteError \
KeyNotFoundError \
+ LongIntegerArray \
MissingClassInLiteralArrayErrorSignal \
NoByteCodeError \
NonPositionableExternalStream \
@@ -390,13 +396,19 @@
PTYOpenError \
PackageNotCompatibleError \
RangeError \
+ SignedIntegerArray \
+ SignedLongIntegerArray \
+ SignedWordArray \
Symbol \
+ UnboundedExternalStream \
Unicode16String \
UnorderedNumbersError \
+ WordArray \
WrongNumberOfArgumentsError \
WrongProceedabilityError \
CharacterRangeError \
DirectoryStream \
+ ImaginaryResultError \
InvalidEncodingError \
NonIntegerIndexError \
OverflowError \
@@ -405,6 +417,7 @@
SubscriptOutOfBoundsError \
UnderflowError \
ZeroDivide \
+ BadRomanNumberFormatError \
WIN32_CLASSES= \
Win32Process \
@@ -484,6 +497,7 @@
$(OUTDIR_SLASH)UndefinedObject.$(O) \
$(OUTDIR_SLASH)UserMessage.$(O) \
$(OUTDIR_SLASH)Visitor.$(O) \
+ $(OUTDIR_SLASH)VoidObject.$(O) \
$(OUTDIR_SLASH)AbstractTime.$(O) \
$(OUTDIR_SLASH)ApplicationDefinition.$(O) \
$(OUTDIR_SLASH)ArithmeticValue.$(O) \
@@ -602,6 +616,7 @@
$(OUTDIR_SLASH)AbstractSourceFileWriter.$(O) \
$(OUTDIR_SLASH)ActivityNotification.$(O) \
$(OUTDIR_SLASH)Array.$(O) \
+ $(OUTDIR_SLASH)BitArray.$(O) \
$(OUTDIR_SLASH)BreakPointInterrupt.$(O) \
$(OUTDIR_SLASH)CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(O) \
$(OUTDIR_SLASH)CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(O) \
@@ -656,6 +671,7 @@
$(OUTDIR_SLASH)AbstractNumberVector.$(O) \
$(OUTDIR_SLASH)AllocationFailure.$(O) \
$(OUTDIR_SLASH)AutoloadMetaclass.$(O) \
+ $(OUTDIR_SLASH)BooleanArray.$(O) \
$(OUTDIR_SLASH)ByteArray.$(O) \
$(OUTDIR_SLASH)CharacterArray.$(O) \
$(OUTDIR_SLASH)CharacterWriteStream.$(O) \
@@ -739,6 +755,7 @@
$(OUTDIR_SLASH)SubclassResponsibilityError.$(O) \
$(OUTDIR_SLASH)TimeConversionError.$(O) \
$(OUTDIR_SLASH)TwoByteString.$(O) \
+ $(OUTDIR_SLASH)UnboxedIntegerArray.$(O) \
$(OUTDIR_SLASH)UnimplementedFunctionalityError.$(O) \
$(OUTDIR_SLASH)UnprotectedExternalBytes.$(O) \
$(OUTDIR_SLASH)WeakDependencyDictionary.$(O) \
@@ -756,11 +773,13 @@
$(OUTDIR_SLASH)HandleRegistry.$(O) \
$(OUTDIR_SLASH)ImmutableString.$(O) \
$(OUTDIR_SLASH)IndexNotFoundError.$(O) \
+ $(OUTDIR_SLASH)IntegerArray.$(O) \
$(OUTDIR_SLASH)InvalidByteCodeError.$(O) \
$(OUTDIR_SLASH)InvalidInstructionError.$(O) \
$(OUTDIR_SLASH)InvalidReadError.$(O) \
$(OUTDIR_SLASH)InvalidWriteError.$(O) \
$(OUTDIR_SLASH)KeyNotFoundError.$(O) \
+ $(OUTDIR_SLASH)LongIntegerArray.$(O) \
$(OUTDIR_SLASH)MissingClassInLiteralArrayErrorSignal.$(O) \
$(OUTDIR_SLASH)NoByteCodeError.$(O) \
$(OUTDIR_SLASH)NonPositionableExternalStream.$(O) \
@@ -768,13 +787,19 @@
$(OUTDIR_SLASH)PTYOpenError.$(O) \
$(OUTDIR_SLASH)PackageNotCompatibleError.$(O) \
$(OUTDIR_SLASH)RangeError.$(O) \
+ $(OUTDIR_SLASH)SignedIntegerArray.$(O) \
+ $(OUTDIR_SLASH)SignedLongIntegerArray.$(O) \
+ $(OUTDIR_SLASH)SignedWordArray.$(O) \
$(OUTDIR_SLASH)Symbol.$(O) \
+ $(OUTDIR_SLASH)UnboundedExternalStream.$(O) \
$(OUTDIR_SLASH)Unicode16String.$(O) \
$(OUTDIR_SLASH)UnorderedNumbersError.$(O) \
+ $(OUTDIR_SLASH)WordArray.$(O) \
$(OUTDIR_SLASH)WrongNumberOfArgumentsError.$(O) \
$(OUTDIR_SLASH)WrongProceedabilityError.$(O) \
$(OUTDIR_SLASH)CharacterRangeError.$(O) \
$(OUTDIR_SLASH)DirectoryStream.$(O) \
+ $(OUTDIR_SLASH)ImaginaryResultError.$(O) \
$(OUTDIR_SLASH)InvalidEncodingError.$(O) \
$(OUTDIR_SLASH)NonIntegerIndexError.$(O) \
$(OUTDIR_SLASH)OverflowError.$(O) \
@@ -783,6 +808,7 @@
$(OUTDIR_SLASH)SubscriptOutOfBoundsError.$(O) \
$(OUTDIR_SLASH)UnderflowError.$(O) \
$(OUTDIR_SLASH)ZeroDivide.$(O) \
+ $(OUTDIR_SLASH)BadRomanNumberFormatError.$(O) \
WIN32_OBJS= \
$(OUTDIR_SLASH)Win32Process.$(O) \
--- a/Method.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Method.st Fri Dec 09 22:31:28 2016 +0000
@@ -115,7 +115,7 @@
LastFileReference weak reference to the last sourceFile
LastSourceFileName to speedup source access via NFS
- WARNING: layout known by compiler and runtime system - dont change
+ WARNING: layout known by compiler and runtime system - don't change
[author:]
Claus Gittinger
@@ -1462,8 +1462,8 @@
cls := self containingClass.
cls isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
+ ^ nil
].
"we have to sequentialize this using a lock-semaphore,
@@ -1473,60 +1473,60 @@
(happened when autoloading animation demos)
"
CompilationLock critical:[
- "
- dont want this to go into the changes file,
- dont want output on Transcript and definitely
- dont want a lazy method ...
- "
- Class withoutUpdatingChangesDo:[
- |silent lazy|
-
- silent := Smalltalk silentLoading:true.
- lazy := Compiler compileLazy:false.
-
- [
- |compiler|
-
- Class nameSpaceQuerySignal answer:(cls nameSpace)
- do:[
- compiler := cls compilerClass.
-
- "/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
- "/
- (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
- ifTrue:[
- temporaryMethod := compiler
- compile:newSource
- forClass:cls
- inCategory:(self category)
- notifying:nil
- install:false.
- ] ifFalse:[
- temporaryMethod := compiler new
- compile:newSource
- in:cls
- notifying:nil
- ifFail:nil
- ].
- ].
- ] ensure:[
- Compiler compileLazy:lazy.
- Smalltalk silentLoading:silent.
- ]
- ].
+ "
+ don't want this to go into the changes file,
+ don't want output on Transcript and definitely
+ don't want a lazy method ...
+ "
+ Class withoutUpdatingChangesDo:[
+ |silent lazy|
+
+ silent := Smalltalk silentLoading:true.
+ lazy := Compiler compileLazy:false.
+
+ [
+ |compiler|
+
+ Class nameSpaceQuerySignal answer:(cls nameSpace)
+ do:[
+ compiler := cls compilerClass.
+
+ "/
+ "/ kludge - have to make ST/X's compiler protocol
+ "/ be compatible to ST-80's
+ "/
+ (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
+ ifTrue:[
+ temporaryMethod := compiler
+ compile:newSource
+ forClass:cls
+ inCategory:(self category)
+ notifying:nil
+ install:false.
+ ] ifFalse:[
+ temporaryMethod := compiler new
+ compile:newSource
+ in:cls
+ notifying:nil
+ ifFail:nil
+ ].
+ ].
+ ] ensure:[
+ Compiler compileLazy:lazy.
+ Smalltalk silentLoading:silent.
+ ]
+ ].
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
- 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
- ^ nil.
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
].
"/
"/ try to save a bit of memory, by sharing the source (whatever it is)
"/
temporaryMethod source:newSource.
"/
- "/ dont forget the methods class & package ...
+ "/ don't forget the methods class & package ...
"/
temporaryMethod setPackage:package.
temporaryMethod mclass:(self getMclass).
@@ -2725,6 +2725,16 @@
^ self externalLibraryFunction notNil
!
+isForCompatibility
+ "returns true, if this method only used for compatibility
+ and should use only when porting foreign code but not otherwise"
+
+ |res|
+
+ ^ self package == #'stx:libcompat'
+ or:[(res := self resources) notNil and:[res includesKey:#compatibility]]
+!
+
isInvalid
"return true, if this method is not executable due to
a (re)-compilation error. Since invalidation is by patching the
@@ -3073,16 +3083,6 @@
"Created: / 9.11.1998 / 06:15:08 / cg"
!
-overrides: aMethod
- <resource: #obsolete>
-
- self obsoleteMethodWarning: 'Use overwrites: instead, stupid naming'.
- self overwrites: aMethod.
-
- "Modified: / 18-06-2009 / 12:15:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 05-07-2012 / 10:52:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
overwrites:aMethod
|mth|
@@ -3173,15 +3173,15 @@
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: don't know
].
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethod: src.
(parser isNil or: [parser == #Error]) ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ annotations := parser annotations.
@@ -3191,26 +3191,26 @@
parseResources
"return the method's resource spec; either nil or a collection of symbols.
Resources are a special kind of annotation, of the form:
- <resource: #symbol...>
+ <resource: #symbol...>
and flags methods which depend on keyboard bindings or provide menus, specs or bitmap images"
|src parser|
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: don't know
].
(src findString:'resource:') == 0 ifTrue:[
- ^ nil "/ actually: error
+ ^ nil "/ actually: error
].
"/ no need to parse all - only interested in resource-info
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethodArgAndVarSpecificationSilent:src in:nil.
parser isNil ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ parser primitiveResources.
!
--- a/MiniDebugger.st Wed Oct 19 09:22:53 2016 +0100
+++ b/MiniDebugger.st Fri Dec 09 22:31:28 2016 +0000
@@ -46,12 +46,12 @@
or if CTRL-C is pressed in the controlling tty/console.
Needs a console.
- MiniDebugger enter
+ MiniDebugger enter
Attention:
- all printing is done via lowLevelErrorPrint,
- to ensure that output is to stderr, even if a logger is present, or
- Stderr has been set to some other stream (Transcript).
+ all printing is done via lowLevel _errorPrint messages,
+ to ensure that output is to stderr, even if a logger is present,
+ or Stderr has been set to some other stream (Transcript).
Also to avoid the logger's interfering and adding imestamp information.
[author:]
@@ -96,25 +96,25 @@
ex return
] do:[
thisContext isRecursive ifTrue:[
- "/ 'recursive lowLevelError in debugger ignored' lowLevelErrorPrintCR.
+ "/ 'recursive _error in debugger ignored' _errorPrintCR.
^ self
].
- aString lowLevelErrorPrintCR.
+ aString _errorPrintCR.
Processor notNil ifTrue:[
active := Processor activeProcess.
- 'process: id=' lowLevelErrorPrint. active id lowLevelErrorPrint.
- ' name=' lowLevelErrorPrint. active name lowLevelErrorPrintCR.
+ 'process: id=' _errorPrint. active id _errorPrint.
+ ' name=' _errorPrint. active name _errorPrintCR.
- 'context: ' lowLevelErrorPrint. aContext printString lowLevelErrorPrintCR.
+ 'context: ' _errorPrint. aContext printString _errorPrintCR.
(con := aContext) notNil ifTrue:[
con := con sender.
- ' ......: ' lowLevelErrorPrint. con printString lowLevelErrorPrintCR.
+ ' ......: ' _errorPrint. con printString _errorPrintCR.
[con notNil] whileTrue:[
sender := con sender.
(sender notNil and:[sender selector == con selector]) ifTrue:[
- ' ......: ' lowLevelErrorPrint. sender printString lowLevelErrorPrintCR.
- ' ......: [** intermediate recursive contexts skipped **]' lowLevelErrorPrintCR.
+ ' ......: ' _errorPrint. sender printString _errorPrintCR.
+ ' ......: [** intermediate recursive contexts skipped **]' _errorPrintCR.
[sender notNil
and:[sender selector == con selector
and:[sender method == con method]]] whileTrue:[
@@ -123,13 +123,13 @@
].
].
con := sender.
- ' ......: ' lowLevelErrorPrint. con printString lowLevelErrorPrintCR.
+ ' ......: ' _errorPrint. con printString _errorPrintCR.
]
]
].
NotFirstTimeEntered ~~ true ifTrue:[
NotFirstTimeEntered := true.
- 'Type "c" to proceed, "?" for help' lowLevelErrorPrintCR.
+ 'Type "c" to proceed, "?" for help' _errorPrintCR.
].
].
@@ -137,11 +137,11 @@
Error handle:[:ex |
ex return
] do:[
- self warn:('Unexpected lowLevelError:\' , aString , '\\No MiniDebugger functionality available') withCRs .
+ self warn:('Unexpected _error:\' , aString , '\\No MiniDebugger functionality available') withCRs .
].
Error handle:[:ex |
- 'cannot raise Abort - exiting ...' lowLevelErrorPrintCR.
+ 'cannot raise Abort - exiting ...' _errorPrintCR.
OperatingSystem exit:10.
] do:[
AbortOperationRequest raise.
@@ -228,7 +228,7 @@
!
trace:aBlock
- self trace:aBlock with:[:where | where lowLevelErrorPrintCR]
+ self trace:aBlock with:[:where | where _errorPrintCR]
"Modified: 20.5.1996 / 10:27:37 / cg"
!
@@ -285,17 +285,17 @@
stillHere := true.
[stillHere] whileTrue:[
AbortOperationRequest handle:[:ex |
- '** Abort caught - back in previous debugLevel' lowLevelErrorPrintCR.
+ '** Abort caught - back in previous debugLevel' _errorPrintCR.
] do:[
Error handle:[:ex |
StreamError handle:[:ex|
"You won't see this probably - but you will see it when doing a syscall trace"
- 'Error while processing lowLevelError in MiniDebugger (Stdout closed?):' lowLevelErrorPrintCR.
- ex description lowLevelErrorPrintCR.
+ 'Error while processing _error in MiniDebugger (Stdout closed?):' _errorPrintCR.
+ ex description _errorPrintCR.
OperatingSystem exit:10.
] do:[
- 'Error while executing MiniDebugger command: ' lowLevelErrorPrint.
- ex description lowLevelErrorPrintCR.
+ 'Error while executing MiniDebugger command: ' _errorPrint.
+ ex description _errorPrintCR.
yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '.
yesNo == $d ifTrue:[
MiniDebugger enterWithMessage:'Debugging debugger' mayProceed:true.
@@ -375,7 +375,7 @@
where notNil ifTrue:[
self printContext:where
] ifFalse:[
- 'stepInterrupt: no context' lowLevelErrorPrintCR
+ 'stepInterrupt: no context' _errorPrintCR
].
self enter:where mayProceed:true
] ifFalse:[
@@ -384,7 +384,7 @@
traceBlock value:where
]
] ifFalse:[
- 'traceInterrupt: no context' lowLevelErrorPrintCR
+ 'traceInterrupt: no context' _errorPrintCR
].
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
@@ -470,16 +470,18 @@
dot := c.
"/ dot fullPrint.
] ifFalse:[
- '** dot is the bottom of the calling chain' lowLevelErrorPrintCR.
+ '** dot is the bottom of the calling chain' _errorPrintCR.
].
!
moveDotUp
- dot sender notNil ifTrue:[
- dot := dot sender.
+ |sender|
+
+ (sender := dot sender) notNil ifTrue:[
+ dot := sender.
"/ dot fullPrint.
] ifFalse:[
- '** dot is the top of the calling chain' lowLevelErrorPrintCR.
+ '** dot is the top of the calling chain' _errorPrintCR.
].
!
@@ -487,7 +489,7 @@
|context n|
aContext isNil ifTrue:[
- 'no context' lowLevelErrorPrintCR.
+ 'no context' _errorPrintCR.
^ self
].
@@ -510,30 +512,61 @@
"/ aContext fullPrint.
- aContext receiverPrintString lowLevelErrorPrint. ' ' lowLevelErrorPrint.
- aContext selector asString lowLevelErrorPrint.
+ aContext receiverPrintString _errorPrint. ' ' _errorPrint.
+ aContext selector asString _errorPrint.
aContext argumentCount ~~ 0 ifTrue: [
- ' ' lowLevelErrorPrint. aContext argsDisplayString lowLevelErrorPrint
+ ' ' _errorPrint. aContext argsDisplayString _errorPrint
].
- ' [' lowLevelErrorPrint.
- aContext lineNumber asString lowLevelErrorPrint.
- ']' lowLevelErrorPrintCR
+ ' [' _errorPrint.
+ aContext lineNumber asString _errorPrint.
+ ']' _errorPrintCR
!
printDot
+ |mthd argNames varNames|
+
+ '' _errorPrintCR.
+
self printContext:dot.
- ' receiver: ' lowLevelErrorPrint. dot receiver printString lowLevelErrorPrintCR.
- ' selector: ' lowLevelErrorPrint. dot selector lowLevelErrorPrintCR.
- ' args: ' lowLevelErrorPrintCR.
+ ' receiver: ' _errorPrint. dot receiver printString _errorPrintCR.
+ ' selector: ' _errorPrint. dot selector _errorPrintCR.
+
+ dot isBlockContext ifFalse:[
+ (mthd := dot method) notNil ifTrue:[
+ Error ignoreIn:[
+ argNames := mthd methodArgNames.
+ ].
+ Error ignoreIn:[
+ varNames := mthd methodVarNames
+ ].
+ ].
+ ].
+ "/ ' args: ' _errorPrint. (argNames ? #() asStringWith:$;) _errorPrintCR.
+ "/ ' vars: ' _errorPrint. (varNames ? #() asStringWith:$;) _errorPrintCR.
+
+ ' args: ' _errorPrintCR.
dot args keysAndValuesDo:[:idx :eachArg |
- ' ' lowLevelErrorPrint. idx printString lowLevelErrorPrint.
- ': ' lowLevelErrorPrint. eachArg printString lowLevelErrorPrintCR.
+ ' ' _errorPrint.
+ argNames notNil ifTrue:[
+ (argNames at:idx) _errorPrint.
+ ] ifFalse:[
+ 'arg' _errorPrint. idx _errorPrint.
+ ].
+ ': ' _errorPrint. eachArg printString _errorPrintCR.
].
- ' vars: ' lowLevelErrorPrintCR.
+
+ ' vars: ' _errorPrintCR.
dot vars keysAndValuesDo:[:idx :eachVar |
- ' ' lowLevelErrorPrint. idx printString lowLevelErrorPrint.
- ': ' lowLevelErrorPrint. eachVar printString lowLevelErrorPrintCR.
+ ' ' _errorPrint.
+ varNames notNil ifTrue:[
+ (varNames at:idx) _errorPrint.
+ ] ifFalse:[
+ 'var' _errorPrint. idx _errorPrint.
+ ].
+ ': ' _errorPrint. eachVar printString _errorPrintCR.
].
+
+ '' _errorPrintCR.
!
printDotsMethodSource
@@ -546,12 +579,12 @@
home := dot methodHome.
mthd := home method.
mthd isNil ifTrue:[
- '** no source **' lowLevelErrorPrintCR.
+ '** no source **' _errorPrintCR.
^ self.
].
src := mthd source.
src isNil ifTrue:[
- '** no source **' lowLevelErrorPrintCR.
+ '** no source **' _errorPrintCR.
^ self.
].
pcLineNr := dot lineNumber.
@@ -566,12 +599,12 @@
].
startLnr to:stopLnr do:[:lNr |
lNr == pcLineNr ifTrue:[
- '>> ' lowLevelErrorPrint.
+ '>> ' _errorPrint.
] ifFalse:[
- ' ' lowLevelErrorPrint.
+ ' ' _errorPrint.
].
- (lNr printStringLeftPaddedTo:3) lowLevelErrorPrint. ' ' lowLevelErrorPrint.
- (src at:lNr) asString lowLevelErrorPrintCR.
+ (lNr printStringLeftPaddedTo:3) _errorPrint. '| ' _errorPrint.
+ (src at:lNr) asString _errorPrintCR.
]
!
@@ -613,7 +646,7 @@
(sig := AbortOperationRequest) isHandled ifTrue:[
sig raise.
- 'abort raise failed' lowLevelErrorPrintCR.
+ 'abort raise failed' _errorPrintCR.
].
"TEMPORARY kludge - find event handler context
@@ -626,10 +659,10 @@
con notNil ifTrue:[
"got it"
con return.
- 'return failed' lowLevelErrorPrintCR.
+ 'return failed' _errorPrintCR.
].
- 'found no context to resume' lowLevelErrorPrintCR.
+ 'found no context to resume' _errorPrintCR.
"Modified: / 16.11.2001 / 17:39:14 / cg"
!
@@ -660,13 +693,13 @@
(cmd == $w) ifTrue:[
proc notNil ifTrue:[
- '-------- walkback of process ' lowLevelErrorPrint. id lowLevelErrorPrint. ' -------' lowLevelErrorPrintCR.
+ '-------- walkback of process ' _errorPrint. id _errorPrint. ' -------' _errorPrintCR.
self printBacktraceFrom:(proc suspendedContext)
] ifFalse:[
id notNil ifTrue:[
- 'no process with id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'no process with id: ' _errorPrint. id _errorPrintCR.
] ifFalse:[
- '-------- walkback of current process -------' lowLevelErrorPrintCR.
+ '-------- walkback of current process -------' _errorPrintCR.
self printBacktraceFrom:(self getContext)
]
].
@@ -675,7 +708,7 @@
(cmd == $b) ifTrue:[
proc notNil ifTrue:[
- '-------- VM walkback of process ' lowLevelErrorPrint. id lowLevelErrorPrint. ' -------' lowLevelErrorPrintCR.
+ '-------- VM walkback of process ' _errorPrint. id _errorPrint. ' -------' _errorPrintCR.
(Processor activeProcess environmentAt:#Stderr ifAbsent:Stderr) == Stderr ifTrue:[
ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
] ifFalse:[
@@ -684,9 +717,9 @@
].
] ifFalse:[
id notNil ifTrue:[
- 'no process with id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'no process with id: ' _errorPrint. id _errorPrintCR.
] ifFalse:[
- '-------- VM walkback of current process -------' lowLevelErrorPrintCR.
+ '-------- VM walkback of current process -------' _errorPrintCR.
(Processor activeProcess environmentAt:#Stderr ifAbsent:Stderr) == Stderr ifTrue:[
ObjectMemory printStackBacktrace
] ifFalse:[
@@ -699,9 +732,9 @@
].
(cmd == $S) ifTrue:[
- 'saving "crash.img"...' lowLevelErrorPrint.
+ 'saving "crash.img"...' _errorPrint.
ObjectMemory writeCrashImage.
- 'done.' lowLevelErrorPrintCR.
+ 'done.' _errorPrintCR.
^ false
].
(cmd == $C) ifTrue:[
@@ -712,7 +745,7 @@
OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ].
ChangeSet current fileOutAs: changesFilename.
- ('saved session changes to "',changesFilename,'".') lowLevelErrorPrintCR.
+ ('saved session changes to "',changesFilename,'".') _errorPrintCR.
^ false
].
@@ -731,7 +764,7 @@
].
(cmd == $r) ifTrue:[
- dot receiver lowLevelErrorPrintCR.
+ dot receiver _errorPrintCR.
^ false
].
@@ -756,7 +789,7 @@
^ false
].
(cmd == $e) ifTrue:[
- (Parser evaluate:commandArg) lowLevelErrorPrintCR.
+ (Parser evaluate:commandArg) _errorPrintCR.
^ false
].
@@ -776,7 +809,7 @@
(bool notNil) ifTrue:[
Smalltalk ignoreHalt:bool not.
].
- 'halts are ' lowLevelErrorPrint. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) lowLevelErrorPrintCR.
+ 'halts are ' _errorPrint. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) _errorPrintCR.
^ false
].
@@ -792,7 +825,7 @@
proc terminate.
] ifFalse:[
id notNil ifTrue:[
- 'no process with id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'no process with id: ' _errorPrint. id _errorPrintCR.
] ifFalse:[
Processor terminateActive
]
@@ -802,10 +835,10 @@
(cmd == $W) ifTrue:[
proc notNil ifTrue:[
- 'stopping process id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'stopping process id: ' _errorPrint. id _errorPrintCR.
proc stop.
] ifFalse:[
- 'invalid process id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'invalid process id: ' _errorPrint. id _errorPrintCR.
].
^ false
].
@@ -813,10 +846,10 @@
(cmd == $a) ifTrue:[
"without id-arg, this is handled by caller"
proc notNil ifTrue:[
- 'aborting process id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'aborting process id: ' _errorPrint. id _errorPrintCR.
proc interruptWith:[AbortOperationRequest raise]
] ifFalse:[
- 'aborting' lowLevelErrorPrintCR.
+ 'aborting' _errorPrintCR.
].
^ false
].
@@ -826,7 +859,7 @@
proc terminateNoSignal.
] ifFalse:[
id notNil ifTrue:[
- 'no process with id: ' lowLevelErrorPrint. id lowLevelErrorPrintCR.
+ 'no process with id: ' _errorPrint. id _errorPrintCR.
] ifFalse:[
Processor terminateActiveNoSignal
]
@@ -903,7 +936,7 @@
'MiniDebugger> '
] ifFalse:[
'MiniDebugger' , nesting printString , '>'
- ])) lowLevelErrorPrint.
+ ])) _errorPrint.
UserInterrupt handle:[:ex |
ex restart
@@ -912,7 +945,7 @@
cmd := self getCharacter.
cmd isNil ifTrue:[
- '<EOF>' lowLevelErrorPrintCR.
+ '<EOF>' _errorPrintCR.
"
mhmh end-of-file;
return a 'c' (for continue); hope that's ok.
@@ -930,7 +963,7 @@
[cmd notNil and:[cmd == Character space]] whileTrue:[
cmd := self getCharacter
].
- cmd isNil ifTrue:[ '<EOF>' lowLevelErrorPrintCR ].
+ cmd isNil ifTrue:[ '<EOF>' _errorPrintCR ].
].
"
@@ -941,7 +974,7 @@
[c isNil or:[c isEndOfLineCharacter]] whileFalse: [
arg := arg copyWith:c.
c := self getCharacter.
- c isNil ifTrue:[ '<EOF>' lowLevelErrorPrintCR ].
+ c isNil ifTrue:[ '<EOF>' _errorPrintCR ].
].
commandArg := (arg copyFrom:2) withoutSeparators.
command := cmd.
@@ -956,21 +989,21 @@
|args className sym val match showMethod|
commandArg withoutSeparators isEmpty ifTrue:[
- 'usage: H className [methodPattern]' lowLevelErrorPrintCR.
+ 'usage: H className [methodPattern]' _errorPrintCR.
^self
].
args := commandArg asCollectionOfWords.
className := args first.
(sym := className asSymbolIfInterned) isNil ifTrue:[
- 'no such class' lowLevelErrorPrintCR.
+ 'no such class' _errorPrintCR.
^ self.
].
- val := Smalltalk at:sym ifAbsent:['no such class' lowLevelErrorPrintCR. ^ self.].
+ val := Smalltalk at:sym ifAbsent:['no such class' _errorPrintCR. ^ self.].
val isBehavior ifFalse:[
- 'not a class: ' lowLevelErrorPrint. className lowLevelErrorPrintCR.
+ 'not a class: ' _errorPrint. className _errorPrintCR.
val := val class.
- 'showing help for ' lowLevelErrorPrint. val name lowLevelErrorPrintCR.
+ 'showing help for ' _errorPrint. val name _errorPrintCR.
].
args size > 1 ifTrue:[
match := args at:2
@@ -986,11 +1019,11 @@
or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[
mthd := cls compiledMethodAt:sel.
mthd category ~= 'documentation' ifTrue:[
- sel lowLevelErrorPrintCR.
+ sel _errorPrintCR.
(mthd comment ? '') asStringCollection do:[:l |
- ' ' lowLevelErrorPrint. l withoutSeparators lowLevelErrorPrintCR.
+ ' ' _errorPrint. l withoutSeparators _errorPrintCR.
].
- '' lowLevelErrorPrintCR
+ '' _errorPrintCR
].
].
].
@@ -1006,9 +1039,9 @@
interpreterLoopWith:anObject
'MinDebugger read-eval-print loop; exit with "#exit"; help with "?"' printCR.
ReadEvalPrintLoop new
+ prompt:'mDBG > ';
doChunkFormat:false;
error:(Processor activeProcess stderr);
- prompt:'mDBG > ';
readEvalPrintLoop.
"/ |line done rslt|
@@ -1045,13 +1078,13 @@
Process allInstancesDo:[:p |
(p isActive not
and:[p isDead not]) ifTrue:[
- '---------------------------------------------------------' lowLevelErrorPrintCR.
- ' proc id=' lowLevelErrorPrint. p id asString lowLevelErrorPrint.
- ' name=''' lowLevelErrorPrint. p name asString lowLevelErrorPrint.
- ''' createdBy: ' lowLevelErrorPrint. p creatorId asString lowLevelErrorPrint.
- ' state=' lowLevelErrorPrint. p state asString lowLevelErrorPrint.
- ' prio=' lowLevelErrorPrint. p priority asString lowLevelErrorPrintCR.
- '' lowLevelErrorPrintCR. '' lowLevelErrorPrintCR.
+ '---------------------------------------------------------' _errorPrintCR.
+ ' proc id=' _errorPrint. p id asString _errorPrint.
+ ' name=''' _errorPrint. p name asString _errorPrint.
+ ''' createdBy: ' _errorPrint. p creatorId asString _errorPrint.
+ ' state=' _errorPrint. p state asString _errorPrint.
+ ' prio=' _errorPrint. p priority asString _errorPrintCR.
+ '' _errorPrintCR. '' _errorPrintCR.
self printBacktraceFrom:(p suspendedContext)
]
@@ -1066,26 +1099,29 @@
|active|
active := Processor activeProcess.
- 'current id=' lowLevelErrorPrint.
- active id printString lowLevelErrorPrint.
- ' name=''' lowLevelErrorPrint. active name lowLevelErrorPrint. '''' lowLevelErrorPrintCR.
+ 'current id=' _errorPrint.
+ active id printString _errorPrint.
+ ' name=''' _errorPrint. active name _errorPrint. '''' _errorPrintCR.
(Process allSubInstances sort:[:a :b | (a id ? -1)<(b id ? -1)]) do:[:p |
|doShow|
- doShow := (how == #all).
- doShow := doShow or:[ (how == #dead) and:[ p isDead ]].
- doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]].
+ doShow := (how == #all) or:[ (how == #dead) == ( p isDead ) ].
doShow ifTrue:[
- 'proc id=' lowLevelErrorPrint. (p id printStringPaddedTo:6) lowLevelErrorPrint.
- (p state printStringPaddedTo:10) lowLevelErrorPrint.
- ' pri=' lowLevelErrorPrint. (p priority printStringPaddedTo:2) lowLevelErrorPrint.
- ' creator:' lowLevelErrorPrint. (p creatorId printStringPaddedTo:5) lowLevelErrorPrint.
- ' group:' lowLevelErrorPrint. (p processGroupId printStringPaddedTo:5) lowLevelErrorPrint.
- ' sys:' lowLevelErrorPrint. (p isSystemProcess ifTrue:'y' ifFalse:'n') lowLevelErrorPrint.
- ' ui:' lowLevelErrorPrint. (p isGUIProcess ifTrue:'y' ifFalse:'n') lowLevelErrorPrint.
- ' name=''' lowLevelErrorPrint. p name lowLevelErrorPrint.
- '''' lowLevelErrorPrintCR.
+ 'id=' _errorPrint. (p id printStringPaddedTo:6) _errorPrint.
+ (p state printStringPaddedTo:10) _errorPrint.
+ ' pri=' _errorPrint. (p priority printStringPaddedTo:2) _errorPrint.
+ ' creator:' _errorPrint. (p creatorId printStringPaddedTo:5) _errorPrint.
+ ' group:' _errorPrint. (p processGroupId printStringPaddedTo:5) _errorPrint.
+ "/ ' sys:' _errorPrint. (p isSystemProcess ifTrue:'y' ifFalse:'n') _errorPrint.
+ "/ ' ui:' _errorPrint. (p isGUIProcess ifTrue:'y' ifFalse:'n') _errorPrint.
+ (p isGUIProcess
+ ifTrue:[' ui']
+ ifFalse:[p isSystemProcess
+ ifTrue:['sys']
+ ifFalse:['usr']]) _errorPrint.
+ ' name=''' _errorPrint. p name _errorPrint.
+ '''' _errorPrintCR.
]
]
@@ -1106,7 +1142,7 @@
p ........ list processes ("P" for full list)
w [id] ... walkback (of current/process with id)
b [id] ... full (VM) backtrace with more detail
- B ........ backtrace of all other processes
+ B ........ backtrace for all processes
U ........ unwrap all traced/breakpointed methods
D ........ disable all line breakpoints
@@ -1130,7 +1166,7 @@
I ........ interpreter (expression evaluator)
e expr ... evaluate expression & print result ("E" to not print)
? c [p] .. help on class c (selectors matching p)
-' lowLevelErrorPrintCR.
+' _errorPrintCR.
(XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[
' To repair a broken X-Connection, enter an interpreter (enter "I") and evaluate:
@@ -1140,7 +1176,7 @@
NewLauncher openOnDevice:Display.
#exit
then enter "c" to continue; a NewLauncher should pop up soon.
-' lowLevelErrorPrintCR
+' _errorPrintCR
]
"Modified: / 03-02-2014 / 10:38:36 / cg"
--- a/MiniInspector.st Wed Oct 19 09:22:53 2016 +0100
+++ b/MiniInspector.st Fri Dec 09 22:31:28 2016 +0000
@@ -43,10 +43,16 @@
Sometimes useful as a last chance to fix a broken UI / event handling.
Needs a console.
- MiniInspector openOn: Display
+ MiniInspector openOn: Display
+
+ Attention:
+ all printing is done via lowLevel _errorPrint messages,
+ to ensure that output is to stderr, even if a logger is present,
+ or Stderr has been set to some other stream (Transcript).
+ Also to avoid the logger's interfering and adding imestamp information.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -73,11 +79,21 @@
!MiniInspector methodsFor:'private'!
-commandLoop
- |cmd valid|
+callInspect:anotherObject message:msg
+ msg _errorPrintCR.
+
+ MiniInspector openOn:anotherObject input:inputStream.
- 'MiniInspector on ' errorPrint. inspectedObject displayString errorPrintCR.
- '' errorPrintCR.
+ 'Back in previous inspector on: ' _errorPrint.
+ inspectedObject displayString _errorPrintCR.
+!
+
+commandLoop
+ |cmd valid lastValue|
+
+ 'MiniInspector on ' _errorPrint.
+ inspectedObject displayString _errorPrintCR.
+ '' _errorPrintCR.
[true] whileTrue:[
valid := false.
@@ -95,32 +111,34 @@
].
(cmd == $p) ifTrue:[
valid := true.
- inspectedObject displayString errorPrintCR
+ inspectedObject displayString _errorPrintCR
].
(cmd == $c) ifTrue:[
valid := true.
- inspectedObject class displayString errorPrintCR
+ inspectedObject class displayString _errorPrintCR
].
(cmd == $C) ifTrue:[
valid := true.
- MiniInspector openOn:inspectedObject class input:inputStream.
- 'back in previous inspector; inspecting ' errorPrint. inspectedObject displayString errorPrintCR.
+ self callInspect:inspectedObject class message:'inspecting class...'.
].
(cmd == $d) ifTrue:[
valid := true.
ObjectMemory dumpObject:inspectedObject
].
- (cmd == $E) ifTrue:[
+ (cmd == $D) ifTrue:[
valid := true.
- Parser evaluate:commandArg receiver:inspectedObject.
+ ObjectMemory dumpObject:inspectedObject class
].
- (cmd == $e) ifTrue:[
+ ((cmd == $e) or:[ cmd == $E ]) ifTrue:[
valid := true.
- (Parser evaluate:commandArg receiver:inspectedObject) errorPrintCR.
+ lastValue := Parser evaluate:commandArg receiver:inspectedObject.
+ (cmd == $e) ifTrue:[
+ lastValue _errorPrintCR.
+ ].
].
- (cmd == $e) ifTrue:[
+ (cmd == $$) ifTrue:[
valid := true.
- ObjectMemory dumpObject:inspectedObject
+ self callInspect:lastValue message:'inspecting last value...'.
].
(cmd == $*) ifTrue:[
valid := true.
@@ -139,19 +157,21 @@
valid ifFalse: [
'valid commands:
p ...... print inspected object
- c ...... print inspected objects class
i ...... print instvars
d ...... VM-dump inspected object
+ P ...... print inspected object''s class
+ D ...... VM-dump inspected object''s class
I ...... interpreter
e expr evaluate expression & print result ("E" to not print)
+ $ inspect the value of the last evaluated expression
C ...... inspect class
<Num> .. inspect instvar num (1..)
* ...... becomeNil and quit (dangerous)
q ...... quit
-' errorPrintCR
+' _errorPrintCR
]
].
@@ -160,25 +180,25 @@
enter
AbortOperationRequest handle:[:ex |
- '** Abort Signal caught - back in previous debugLevel' printCR.
- ex restart
+ '** Abort Signal caught - back in previous debugLevel' _errorPrintCR.
+ ex restart
] do:[
- Error handle:[:ex |
- |yesNo|
+ Error handle:[:ex |
+ |yesNo|
- 'Error while executing command: ' errorPrint.
- ex description errorPrintCR.
- yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug ? '.
- yesNo == $d ifTrue:[
- ex reject
- ].
- yesNo == $p ifTrue:[
- ex proceed
- ].
- ex restart
- ] do:[
- self commandLoop.
- ].
+ 'Error while executing command: ' _errorPrint.
+ ex description _errorPrintCR.
+ yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug ? '.
+ yesNo == $d ifTrue:[
+ ex reject
+ ].
+ yesNo == $p ifTrue:[
+ ex proceed
+ ].
+ ex restart
+ ] do:[
+ self commandLoop.
+ ].
].
^ nil
!
@@ -194,7 +214,7 @@
getCommand:prompt
|cmd c num arg|
- prompt errorPrint.
+ prompt _errorPrint.
c := cmd := self getCharacter.
c isNil ifTrue:[
@@ -239,19 +259,15 @@
which > numInsts ifTrue:[
idx := which - numInsts.
idx > anObject basicSize ifTrue:[
- 'invalid indexed instvar index: ' errorPrint. idx errorPrintCR
+ 'invalid indexed instvar index: ' _errorPrint. idx _errorPrintCR
] ifFalse:[
- 'Inspecting indexed instVar ' errorPrint. idx errorPrint. '...' errorPrintCR.
- MiniInspector openOn:(anObject basicAt:idx) input:inputStream.
- 'back in previous inspector; inspecting ' errorPrint. inspectedObject displayString errorPrintCR.
+ self callInspect:(anObject basicAt:idx) message:('Inspecting indexed instVar ',which printString,'...')
]
] ifFalse: [
which < 0 ifTrue:[
- 'invalid instVar # (must be >= 1)' errorPrintCR
+ 'invalid instVar # (must be >= 1)' _errorPrintCR
] ifFalse:[
- 'Inspecting instVar ' errorPrint. which errorPrint. '...' errorPrintCR.
- MiniInspector openOn:(anObject instVarAt:which) input:inputStream.
- 'back in previous inspector; inspecting ' errorPrint. inspectedObject displayString errorPrintCR.
+ self callInspect:(anObject instVarAt:which) message:('Inspecting instVar ',which printString,'...')
].
]
@@ -261,12 +277,12 @@
interpreterLoopWith:anObject
|line done rslt|
- 'read-eval-print loop; exit with empty line' errorPrintCR.
- '' errorPrintCR.
+ 'read-eval-print loop; exit with empty line' _errorPrintCR.
+ '' _errorPrintCR.
done := false.
[done] whileFalse:[
- '> ' errorPrint.
+ '> ' _errorPrint.
line := Processor activeProcess stdin nextLine.
(line size == 0) ifTrue:[
@@ -278,7 +294,7 @@
receiver:anObject
notifying:nil
ifFail:[].
- rslt errorPrintCR.
+ rslt _errorPrintCR.
]
]
!
@@ -289,22 +305,22 @@
n := anObject class instSize.
names := anObject class allInstVarNames.
- 'number of instvars: ' errorPrint. n errorPrintCR.
+ 'number of instvars: ' _errorPrint. n _errorPrintCR.
1 to:n do:[:i |
- (i printStringLeftPaddedTo:2) errorPrint.
- ' {' errorPrint. (names at:i) errorPrint. '}' errorPrint.
- ': ' errorPrint.
- ((anObject instVarAt:i) displayString contractAtEndTo:80) errorPrintCR
+ (i printStringLeftPaddedTo:2) _errorPrint.
+ ' {' _errorPrint. (names at:i) _errorPrint. '}' _errorPrint.
+ ': ' _errorPrint.
+ ((anObject instVarAt:i) displayString contractAtEndTo:160) _errorPrintCR
].
n := anObject basicSize.
n > 0 ifTrue:[
- 'number of indexed instvars: ' errorPrint. n errorPrintCR.
- n > 10 ifTrue:[n := 10].
- 1 to:n do:[:i |
- ' [' errorPrint. i errorPrint. ']: ' errorPrint.
- ((anObject basicAt:i) displayString contractAtEndTo:80) errorPrintCR
- ]
+ 'number of indexed instvars: ' _errorPrint. n _errorPrintCR.
+ n > 10 ifTrue:[n := 10].
+ 1 to:n do:[:i |
+ ' [' _errorPrint. i _errorPrint. ']: ' _errorPrint.
+ ((anObject basicAt:i) displayString contractAtEndTo:160) _errorPrintCR
+ ]
].
"Modified: 20.5.1996 / 10:27:45 / cg"
--- a/MiniLogger.st Wed Oct 19 09:22:53 2016 +0100
+++ b/MiniLogger.st Fri Dec 09 22:31:28 2016 +0000
@@ -22,7 +22,7 @@
category:'System-Debugging-Support'
!
-Object subclass:#Severity
+Magnitude subclass:#Severity
instanceVariableNames:'name value'
classVariableNames:''
poolDictionaries:''
@@ -50,14 +50,14 @@
A very simple logger for Smalltalk/X. This one is always present.
It mimics the protocol of the loggers found in stx:goodies/loggia,
which can be activated by setting the global 'Logger' to an instance of
- on of them.
+ one of them.
All
- `Transcript show: 'Processor [info]: xxx'
+ 'Transcript show: 'Processor [info]: xxx'
should be rewritten over time to use the Logger.
'Object infoPrint' and 'Object debugPrint' have been changed to
- forward their message to the global 'Logger' unless nil.
+ forward their message to the global 'Logger' if not nil.
Usage:
Logger info: 'Hello world'.
@@ -68,7 +68,12 @@
to disable logging:
MiniLogger logOnTranscript:false.
MiniLogger logOnStderr:false.
-
+
+ for selective logging:
+ Logger loggingThreshold: Logger severityALL.
+ Logger loggingThreshold: Logger severityINFO.
+ Logger loggingThreshold: Logger severityNONE.
+
For more examples, see #examples.
[author:]
@@ -118,6 +123,9 @@
!MiniLogger class methodsFor:'initialization'!
initialize
+ LogOnStderr := true.
+ LogOnTranscript := true.
+
ALL := Severity new initializeWithName:#all value:0.
ENTER := Severity new initializeWithName:#enter value:10.
LEAVE := Severity new initializeWithName:#leave value:10.
@@ -134,21 +142,7 @@
FATAL := Severity new initializeWithName:#fatal value:100.
NONE := Severity new initializeWithName:#none value:65535.
- Severities := Array new:13.
- Severities at:1 put:ENTER.
- Severities at:2 put:LEAVE.
- Severities at:3 put:TRACE3.
- Severities at:4 put:TRACE2.
- Severities at:5 put:TRACE1.
- Severities at:6 put:TRACE0.
- Severities at:7 put:TRACE.
- Severities at:8 put:DEBUG.
- Severities at:9 put:INFO.
- Severities at:10 put:WARN.
- Severities at:11 put:WARNING.
- Severities at:12 put:ERROR.
- Severities at:13 put:FATAL.
-
+ Severities := {ENTER. LEAVE. TRACE3. TRACE2. TRACE1. TRACE0. TRACE. DEBUG. INFO. WARN. WARNING. ERROR. FATAL.}.
Threshold := InfoPrinting ifTrue:[INFO] ifFalse:[WARN].
(Smalltalk at:#Logger) isNil ifTrue:[
@@ -205,7 +199,7 @@
!
logOnStderr
- ^ LogOnStderr ? true
+ ^ LogOnStderr
!
logOnStderr:aBoolean
@@ -223,7 +217,7 @@
!
logOnTranscript
- ^ LogOnTranscript ? true
+ ^ LogOnTranscript
!
logOnTranscript:aBoolean
@@ -254,6 +248,10 @@
!MiniLogger class methodsFor:'accessing-severities'!
+severities
+ ^ Severities.
+!
+
severityDEBUG
^ DEBUG
@@ -424,38 +422,27 @@
log: message severity: severity facility: facility originator: originator attachment: attachment
"Pricipal logging method. This mimics VM __stxLog__()"
- | severityXlated messageXlated |
+ | severityXlated messageXlated logOnStderr logOnTranscript prevLogOnTranscript |
- (self logOnStderr or:[self logOnTranscript]) ifFalse:[^ self].
+ logOnStderr := self logOnStderr.
+ logOnTranscript := self logOnTranscript and:[Transcript isView].
+
+ (logOnStderr or:[logOnTranscript]) ifFalse:[^ self].
severityXlated := severity.
"/ Be backward compatible, allow for symbolic severities
"/ but when encountered, issue a warning...
- severity isSymbol ifTrue:[
- | nseverities i |
-
- i := 1.
- nseverities := Severities size.
- [ i <= nseverities ] whileTrue:[
- | s |
+ severity isSymbol ifTrue:[
+ severityXlated := Severities detect:[:each| each name == severity] ifNone:[].
- (s := Severities at: i) name = severity ifTrue:[
- | caller |
- severityXlated := s.
- i := nseverities + 1. "/ exit the loop
-
- "/ This will be enabled later, so far it generates
- "/ way to much warnings. at least stx:libjava & exept:jdi has to be rewritten
-
- "/ self log: 'using symbols as severity is deprecated, use Logger severityXXX to get severity object' severity: WARN facility: 'STX' originator: self.
- "/ caller := thisContext sender.
- "/ [ caller notNil and: [ caller receiver ~~ originator ] ] whileTrue:[ caller := caller sender ].
- "/ self log: 'caller is ', caller printString severity: INFO facility: 'STX' originator: self.
-
- ].
- i := i + 1.
- ].
+ "/ This will be enabled later, so far it generates
+ "/ way to much warnings. at least stx:libjava & exept:jdi has to be rewritten
+
+ "/ self log: 'using symbols as severity is deprecated, use Logger severityXXX to get severity object' severity: WARN facility: 'STX' originator: self.
+ "/ caller := thisContext sender.
+ "/ [ caller notNil and: [ caller receiver ~~ originator ] ] whileTrue:[ caller := caller sender ].
+ "/ self log: 'caller is ', caller printString severity: INFO facility: 'STX' originator: self.
].
"/ Now check whether the severity is one of the predefined ones,
@@ -463,27 +450,41 @@
(Severities includesIdentical: severityXlated) ifFalse:[
| caller |
- self log: ('no such severity (%1), use one from predefined severities. Original message will be logged as INFO' bindWith: severityXlated) severity: ERROR facility: 'STX' originator: self.
caller := thisContext sender.
- [ caller notNil and: [ caller receiver ~~ originator ] ] whileTrue:[ caller := caller sender ].
- self log: 'caller is ', caller printString severity: INFO facility: 'STX' originator: self.
+ [caller notNil and:[caller receiver ~~ originator]] whileTrue:[
+ caller := caller sender
+ ].
+ self log:('no such severity (%1, called from %2), use one from predefined severities. Original message will be logged as INFO' bindWith:severityXlated with:caller)
+ severity: ERROR facility: 'STX' originator: self.
severityXlated := INFO.
].
- severityXlated value < Threshold value ifTrue:[ ^ self ].
+ severityXlated < Threshold ifTrue:[ ^ self ].
messageXlated := message value asString.
- self logOnStderr ifTrue:[
- self log: messageXlated severity: severityXlated facility: facility originator: originator attachment: attachment on:Stderr.
+ "/ to avoid recursion, turn off logOnTranscript while logging
+ "/ had this problem with RecursionLock, which wanted to issue a warning
+ "/ ("cleanup for dead process") from inside Transcript code.
+ [
+ prevLogOnTranscript := LogOnTranscript.
+ LogOnTranscript := false.
+
+ logOnStderr ifTrue:[
+ self log:messageXlated severity:severityXlated facility:facility
+ originator:originator attachment:attachment on:Stderr.
+ ].
+ logOnTranscript ifTrue:[
+ Transcript nextPutLine:messageXlated.
+ ].
+ ] ensure:[
+ LogOnTranscript := prevLogOnTranscript.
].
- self logOnTranscript ifTrue:[
- (Transcript isView) ifTrue:[
- self log: messageXlated severity: severityXlated facility: facility originator: originator attachment: attachment on:Transcript
- ].
- ].
-
+
"
- Logger log:'test message' severity: #debug facility: 'TEST'
+ Logger log:'test message' severity:self severityINFO facility: 'TEST'
+ Logger log:'test message' severity:#info facility: 'TEST'
+ Logger log:'test message' severity:#bla facility: 'TEST'
+ Logger log:'test message' severity:123 facility: 'TEST'
"
"Created: / 14-09-2011 / 21:18:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -500,336 +501,336 @@
!MiniLogger class methodsFor:'logging - utils'!
debug: message
- DEBUG value < Threshold value ifTrue:[ ^ self ].
+ DEBUG < Threshold ifTrue:[ ^ self ].
self log: message severity: DEBUG originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debug: format with: arg1
- DEBUG value < Threshold value ifTrue:[ ^ self ].
+ DEBUG < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: DEBUG originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debug: format with: arg1 with: arg2
- DEBUG value < Threshold value ifTrue:[ ^ self ].
+ DEBUG < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: DEBUG originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debug: format with: arg1 with: arg2 with:arg3
- DEBUG value < Threshold value ifTrue:[ ^ self ].
+ DEBUG < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: DEBUG originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enter: message
- ENTER value < Threshold value ifTrue:[ ^ self ].
+ ENTER < Threshold ifTrue:[ ^ self ].
self log: message severity: ENTER originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enter: format with: arg1
- ENTER value < Threshold value ifTrue:[ ^ self ].
+ ENTER < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: ENTER originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enter: format with: arg1 with: arg2
- ENTER value < Threshold value ifTrue:[ ^ self ].
+ ENTER < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: ENTER originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enter: format with: arg1 with: arg2 with:arg3
- ENTER value < Threshold value ifTrue:[ ^ self ].
+ ENTER < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: ENTER originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
error: message
- ERROR value < Threshold value ifTrue:[ ^ self ].
+ ERROR < Threshold ifTrue:[ ^ self ].
self log: message severity: ERROR originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
error: format with: arg1
- ERROR value < Threshold value ifTrue:[ ^ self ].
+ ERROR < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: ERROR originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
error: format with: arg1 with: arg2
- ERROR value < Threshold value ifTrue:[ ^ self ].
+ ERROR < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: ERROR originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
error: format with: arg1 with: arg2 with:arg3
- ERROR value < Threshold value ifTrue:[ ^ self ].
+ ERROR < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: ERROR originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fatal: message
- FATAL value < Threshold value ifTrue:[ ^ self ].
+ FATAL < Threshold ifTrue:[ ^ self ].
self log: message severity: FATAL originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fatal: format with: arg1
- FATAL value < Threshold value ifTrue:[ ^ self ].
+ FATAL < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: FATAL originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fatal: format with: arg1 with: arg2
- FATAL value < Threshold value ifTrue:[ ^ self ].
+ FATAL < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: FATAL originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fatal: format with: arg1 with: arg2 with:arg3
- FATAL value < Threshold value ifTrue:[ ^ self ].
+ FATAL < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: FATAL originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
info: message
- INFO value < Threshold value ifTrue:[ ^ self ].
+ INFO < Threshold ifTrue:[ ^ self ].
self log: message severity: INFO originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
info: format with: arg1
- INFO value < Threshold value ifTrue:[ ^ self ].
+ INFO < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: INFO originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
info: format with: arg1 with: arg2
- INFO value < Threshold value ifTrue:[ ^ self ].
+ INFO < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: INFO originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
info: format with: arg1 with: arg2 with:arg3
- INFO value < Threshold value ifTrue:[ ^ self ].
+ INFO < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: INFO originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
leave: message
- LEAVE value < Threshold value ifTrue:[ ^ self ].
+ LEAVE < Threshold ifTrue:[ ^ self ].
self log: message severity: LEAVE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
leave: format with: arg1
- LEAVE value < Threshold value ifTrue:[ ^ self ].
+ LEAVE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: LEAVE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
leave: format with: arg1 with: arg2
- LEAVE value < Threshold value ifTrue:[ ^ self ].
+ LEAVE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: LEAVE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
leave: format with: arg1 with: arg2 with:arg3
- LEAVE value < Threshold value ifTrue:[ ^ self ].
+ LEAVE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: LEAVE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace0: message
- TRACE0 value < Threshold value ifTrue:[ ^ self ].
+ TRACE0 < Threshold ifTrue:[ ^ self ].
self log: message severity: TRACE0 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace0: format with: arg1
- TRACE0 value < Threshold value ifTrue:[ ^ self ].
+ TRACE0 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: TRACE0 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace0: format with: arg1 with: arg2
- TRACE0 value < Threshold value ifTrue:[ ^ self ].
+ TRACE0 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: TRACE0 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace0: format with: arg1 with: arg2 with:arg3
- TRACE0 value < Threshold value ifTrue:[ ^ self ].
+ TRACE0 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: TRACE0 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace1: message
- TRACE1 value < Threshold value ifTrue:[ ^ self ].
+ TRACE1 < Threshold ifTrue:[ ^ self ].
self log: message severity: TRACE1 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace1: format with: arg1
- TRACE1 value < Threshold value ifTrue:[ ^ self ].
+ TRACE1 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: TRACE1 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace1: format with: arg1 with: arg2
- TRACE1 value < Threshold value ifTrue:[ ^ self ].
+ TRACE1 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: TRACE1 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace1: format with: arg1 with: arg2 with:arg3
- TRACE1 value < Threshold value ifTrue:[ ^ self ].
+ TRACE1 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: TRACE1 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace2: message
- TRACE2 value < Threshold value ifTrue:[ ^ self ].
+ TRACE2 < Threshold ifTrue:[ ^ self ].
self log: message severity: TRACE2 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace2: format with: arg1
- TRACE2 value < Threshold value ifTrue:[ ^ self ].
+ TRACE2 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: TRACE2 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace2: format with: arg1 with: arg2
- TRACE2 value < Threshold value ifTrue:[ ^ self ].
+ TRACE2 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: TRACE2 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace2: format with: arg1 with: arg2 with:arg3
- TRACE2 value < Threshold value ifTrue:[ ^ self ].
+ TRACE2 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: TRACE2 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace3: message
- TRACE3 value < Threshold value ifTrue:[ ^ self ].
+ TRACE3 < Threshold ifTrue:[ ^ self ].
self log: message severity: TRACE3 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace3: format with: arg1
- TRACE3 value < Threshold value ifTrue:[ ^ self ].
+ TRACE3 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: TRACE3 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:55:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace3: format with: arg1 with: arg2
- TRACE3 value < Threshold value ifTrue:[ ^ self ].
+ TRACE3 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: TRACE3 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace3: format with: arg1 with: arg2 with:arg3
- TRACE3 value < Threshold value ifTrue:[ ^ self ].
+ TRACE3 < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: TRACE3 originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace: message
- TRACE value < Threshold value ifTrue:[ ^ self ].
+ TRACE < Threshold ifTrue:[ ^ self ].
self log: message severity: TRACE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace: format with: arg1
- TRACE value < Threshold value ifTrue:[ ^ self ].
+ TRACE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: TRACE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace: format with: arg1 with: arg2
- TRACE value < Threshold value ifTrue:[ ^ self ].
+ TRACE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: TRACE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
trace: format with: arg1 with: arg2 with:arg3
- TRACE value < Threshold value ifTrue:[ ^ self ].
+ TRACE < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2 with:arg3) severity: TRACE originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
warning: message
- WARN value < Threshold value ifTrue:[ ^ self ].
+ WARN < Threshold ifTrue:[ ^ self ].
self log: message severity: WARN originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
warning: format with: arg1
- WARN value < Threshold value ifTrue:[ ^ self ].
+ WARN < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1) severity: WARN originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
warning:format with:arg1 with:arg2
- WARN value < Threshold value ifTrue:[ ^ self ].
+ WARN < Threshold ifTrue:[ ^ self ].
self log: (format bindWith: arg1 with: arg2) severity: WARN originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
warning:format with:arg1 with:arg2 with:arg3
- WARN value < Threshold value ifTrue:[ ^ self ].
+ WARN < Threshold ifTrue:[ ^ self ].
self log: (format bindWith:arg1 with:arg2 with:arg3) severity: WARN originator: thisContext sender receiver
"Modified: / 02-12-2014 / 10:56:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -860,62 +861,72 @@
!
log: message severity: severity facility: facilityArg originator: originator attachment: attachment on:aStream
- "Pricipal logging method. This mimics VM __stxLog__()"
+ "Principal logging method. This mimics VM __stxLog__()"
+
+ |facility severityName words messageAsSent secondWord|
- |facility severityName messageProperlyEncoded words messageAsSent|
+ thisContext isRecursive ifTrue:[
+ 'STX [error]: recursive logger invocation.' _errorPrintCR.
+ ^ self.
+ ].
+
+ facility := facilityArg.
+ messageAsSent := message.
+ severityName := severity name.
- facility := facilityArg.
- messageProperlyEncoded := message.
- severityName := severity name.
+ "/ hack to allow calls from infoPrint/errorPrint.
+ "/ if this is an oldStyle infoPrint or errorPrint, do not append another facility and severity
+ words := messageAsSent asCollectionOfWords.
+ (words size >= 2
+ and:[words first isAlphaNumeric
+ and:[((secondWord := words second) startsWith:$[ )
+ and:[(secondWord endsWith:$]) or:[(secondWord endsWith:']:')]]]]) ifTrue:[
+ facility := words first.
+ severityName := secondWord copyButFirst.
+ severityName := severityName copyTo:(severityName indexOf:$])-1.
+ messageAsSent := messageAsSent copyFrom:(messageAsSent indexOf:$])+1.
+ "/ messageAsSent := messageAsSent withoutSeparators.
+ (messageAsSent startsWith:$:) ifTrue:[
+ messageAsSent := messageAsSent copyFrom:2.
+ "/ messageAsSent := messageAsSent withoutSeparators.
+ (messageAsSent startsWith:Character space) ifTrue:[
+ messageAsSent := messageAsSent copyFrom:2.
+ ].
+ ].
+ ].
+
+ messageAsSent :=
+ self logFormat
+ bindWith:(facility ? 'STX')
+ with:severityName
+ with:(Timestamp now printStringFormat:(self timestampFormat))
+ with:originator
+ with:messageAsSent.
"/ If the message is Unicode 16/32 string and stream is external,
"/ we have to recode the message using locale-specific encoding
- (message isWideString and:[ aStream isExternalStream ]) ifTrue:[
- OperatingSystem isMSWINDOWSlike ifTrue:[
- messageProperlyEncoded := message utf8Encoded.
- ] ifFalse:[
- messageProperlyEncoded := OperatingSystem encodePath: message.
- ]
- ].
- messageProperlyEncoded := messageProperlyEncoded withoutSeparators.
-
- "/ hack to allow calls from infPrint/errorPrint.
- "/ if this is an oldStyle infoPrint or errorPrint, do not append another facility and severity
- words := message asCollectionOfWords.
- (words size > 2
- and:[ words first isAlphaNumeric
- and:[(words second startsWith:$[ )
- and:[(words second endsWith:$] ) or:[(words second endsWith:']:' )]]]]) ifTrue:[
- facility := words first.
- severityName := words second copyButFirst.
- severityName := severityName copyTo:(severityName indexOf:$])-1.
- messageProperlyEncoded := messageProperlyEncoded copyFrom:(messageProperlyEncoded indexOf:$])+1.
- messageProperlyEncoded := messageProperlyEncoded withoutSeparators.
- (messageProperlyEncoded startsWith:$:) ifTrue:[
- messageProperlyEncoded := (messageProperlyEncoded copyFrom:2) withoutSeparators.
+ aStream isExternalStream ifTrue:[
+ messageAsSent := messageAsSent string. "take care of Texts"
+ messageAsSent containsNon7BitAscii ifTrue:[
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ messageAsSent := messageAsSent utf8Encoded.
+ ] ifFalse:[
+ messageAsSent := OperatingSystem encodePath:messageAsSent.
+ ].
].
].
- messageAsSent := (self logFormat
- bindWith:(facility ? 'STX')
- with:severityName
- with:(Timestamp now printStringFormat:(self timestampFormat))
- with:originator printString
- with:messageProperlyEncoded).
- aStream isView ifFalse:[
- messageAsSent := messageAsSent string utf8Encoded
- ].
- "/ Timestamp now printOn:aStream format:'%(year)-%(mon)-%(day) %h:%m:%s.%i'.
- "/ aStream space.
aStream nextPutLine: messageAsSent
"
'hello' infoPrintCR.
- Logger log:'test message' severity: #debug facility: 'TEST'
- Logger log:'test message' severity: #info facility: 'TEST'
- Logger log:'test message' severity: #warning facility: 'TEST'
- Logger log:'test message' severity: #error facility: 'TEST'
+ Logger log:'test message' severity: DEBUG facility: 'TEST'
+ Logger log:'test message' severity: INFO facility: 'TEST'
+ Logger log:'test message' asUnicode16String severity: INFO facility: 'TEST'
+ Logger log:'test message äöüß' severity: INFO facility: 'TEST'
+ Logger log:'test message' severity: WARNING facility: 'TEST'
+ Logger log:'test message' severity: ERROR facility: 'TEST'
'test message' infoPrintCR
'test message' errorPrintCR
"
@@ -928,6 +939,23 @@
"Created: / 14-09-2011 / 21:18:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-12-2014 / 10:50:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+severityThresholdOf:originator
+ "allow each class to define an individual threshold for Logging"
+
+ ^ originator class
+ perform:#logSeverityThreshold
+ ifNotUnderstood:[
+ ^ Threshold.
+ ]
+
+ "
+ Logger severityThresholdOf: Object
+ Logger severityThresholdOf: Expecco::Browser
+ "
+
+ "Created: / 15-09-2011 / 10:20:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MiniLogger::Severity methodsFor:'accessing'!
@@ -940,6 +968,41 @@
^ value
! !
+!MiniLogger::Severity methodsFor:'arithmethic'!
+
++ aNumber
+ |next|
+
+ next := value + aNumber.
+ aNumber negative ifTrue:[
+ ^ MiniLogger severities detectLast:[:each| each = next or:[each < next]] ifNone:[self class new initializeWithName:#nil value:next]
+ ].
+
+ ^ MiniLogger severities detect:[:each| each >= next] ifNone:[self class new initializeWithName:#nil value:next]
+
+ "
+ MiniLogger severityINFO + 1
+ MiniLogger severityTRACE to:MiniLogger severityFATAL do:[:each| Transcript showCR:each].
+ MiniLogger severityFATAL downTo:MiniLogger severityTRACE do:[:each| Transcript showCR:each].
+ "
+! !
+
+!MiniLogger::Severity methodsFor:'comparing'!
+
+< aSeverity
+ ^ value < aSeverity value
+!
+
+= aSeverity
+ ^ self == aSeverity or:[value = aSeverity value]
+!
+
+hash
+ "instances, for which #= answers true must answer the same hash"
+
+ ^ value hash
+! !
+
!MiniLogger::Severity methodsFor:'initialization'!
initializeWithName: aString value: anInteger
--- a/NameSpace.st Wed Oct 19 09:22:53 2016 +0100
+++ b/NameSpace.st Fri Dec 09 22:31:28 2016 +0000
@@ -698,7 +698,7 @@
canHaveExtensions
"return true, if this class allows extensions from other packages.
- Private classes, namespaces and projectDefinitions dont allow this"
+ Private classes, namespaces and projectDefinitions don't allow this"
^ self == NameSpace
@@ -756,7 +756,7 @@
!NameSpace class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.79 2015-02-19 09:44:38 cg Exp $'
+ ^ '$Header$'
!
version_SVN
--- a/NamespaceAwareLookup.st Wed Oct 19 09:22:53 2016 +0100
+++ b/NamespaceAwareLookup.st Fri Dec 09 22:31:28 2016 +0000
@@ -96,7 +96,19 @@
"
%{
- OBJ sendingMthd = __ContextInstPtr(sendingContext)->c_method;
+ OBJ sendingMthd = nil;
+ OBJ ctx = sendingContext;
+ while ( ctx &&
+ (__isLazy(ctx)
+ ? __isLazyBCon(ctx)
+ : __qIsBlockContextLike(ctx))) {
+ ctx = __ContextInstPtr(ctx)->c_home;
+ }
+ if ( (ctx != nil) &&
+ (((INT)(__ContextInstPtr(ctx)->c_flags) & __MASKSMALLINT(__METHOD_VALID))) ) {
+ sendingMthd = __ContextInstPtr(sendingContext)->c_method;
+ }
+
if (__Class(sendingMthd) == Method &&
__MethodInstPtr(sendingMthd)->m_annotation == nil) {
OBJ m = __lookup(initialSearchClass, selector);
@@ -126,8 +138,21 @@
since class browser involves dozens of super-polymorphic
sends (> 1000 receiver classes per send-site).
"
-%{
- sendingMthd = __ContextInstPtr(sendingContext)->c_method;
+
+%{
+ OBJ ctx = sendingContext;
+ sendingMthd = nil;
+ while ( ctx &&
+ (__isLazy(ctx)
+ ? __isLazyBCon(ctx)
+ : __qIsBlockContextLike(ctx))) {
+ ctx = __ContextInstPtr(ctx)->c_home;
+ }
+ if ( (ctx != nil) &&
+ (((INT)(__ContextInstPtr(ctx)->c_flags) & __MASKSMALLINT(__METHOD_VALID))) ) {
+ sendingMthd = __ContextInstPtr(ctx)->c_method;
+ }
+
if (__Class(sendingMthd) == Method &&
__MethodInstPtr(sendingMthd)->m_annotation == nil) {
OBJ m = __lookup(initialSearchClass, selector);
--- a/NonPositionableExternalStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/NonPositionableExternalStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -66,7 +66,7 @@
There are three special instances of this class, representing stdin,
stdout and stderr of the smalltalk/X process (see Unix manuals, if you
- dont know what those are used for). These special streams are bound to
+ don't know what those are used for). These special streams are bound to
to globals Stdin, Stdout and Stderr at early initialization time
(see Smalltalk>>initializeStandardStreams).
@@ -74,7 +74,7 @@
'TTYStream' or similar.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -402,6 +402,23 @@
super storeOn:aStream
! !
+!NonPositionableExternalStream protectedMethodsFor:'private'!
+
+closeFile
+ |semasToSignal|
+
+ handle notNil ifTrue:[
+ "make sure, that no select is performed on closed file descriptors"
+ semasToSignal := Processor disableFd:self fileDescriptor doSignal:false.
+ super closeFile.
+
+ "tell the waiters that they must not wait any longer"
+ semasToSignal do:[:eachSema|
+ eachSema signalForAll.
+ ].
+ ].
+! !
+
!NonPositionableExternalStream methodsFor:'private'!
handleForStderr
@@ -522,7 +539,12 @@
!NonPositionableExternalStream methodsFor:'queries'!
atEnd
- "return true, if position is at end"
+ "return true, if position is at end.
+ Notice: this is a blocking operation, as we do not know in advance,
+ if there will be anything to read
+ (i.e. if the partner will send more or close the stream).
+ If you want to check for available data,
+ use nextAvailable:, or canReadWithoutBlocking"
(self == StdInStream) ifTrue:[
OperatingSystem hasConsole ifFalse:[
@@ -530,12 +552,14 @@
]
].
- "first, wait to avoid blocking on the read.
- On end of stream or error, readWait will return"
+ handle notNil ifTrue:[
+ "first, wait to avoid blocking on the read.
+ On end of stream or error, readWait will return"
- self readWaitWithTimeoutMs:nil.
+ self readWaitWithTimeoutMs:nil.
+ ].
handle isNil ifTrue:[
- "we were closed while waiting - so we are at the end"
+ "we are closed or were closed while waiting - so we are at the end"
^ true.
].
^ super atEnd.
@@ -633,7 +657,11 @@
Redefined, to wait on pipes and sockets"
- self atEnd ifTrue:[^ nil].
+ self readWaitWithTimeoutMs:nil.
+ handle isNil ifTrue:[
+ "we were closed while waiting - so we are at the end"
+ ^ nil.
+ ].
^ super nextOrNil
!
@@ -651,7 +679,11 @@
Redefined, to wait on pipes and sockets"
- self atEnd ifTrue:[^ nil].
+ self readWaitWithTimeoutMs:nil.
+ handle isNil ifTrue:[
+ "we were closed while waiting - so we are at the end"
+ ^ nil.
+ ].
^ self peek
!
--- a/Number.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Number.st Fri Dec 09 22:31:28 2016 +0000
@@ -1702,7 +1702,7 @@
"print the receiver as swiss business number with thousands separator to aStream.
Caveat: Should use the separator from the locale here"
- ^ self printStringWithThousandsSeparator:$'.
+ ^ self printStringWithThousandsSeparator:(UserPreferences current thousandsSeparatorCharacter).
"
1000000 printStringWithThousandsSeparator
@@ -1721,6 +1721,7 @@
1234 asFixedPoint printStringWithThousandsSeparator
123 asFixedPoint printStringWithThousandsSeparator
((9999999//10000) asFixedPoint:9) printStringWithThousandsSeparator
+ ((99999999//10000) asFixedPoint:9) printStringWithThousandsSeparator
"
!
--- a/OSErrorHolder.st Wed Oct 19 09:22:53 2016 +0100
+++ b/OSErrorHolder.st Fri Dec 09 22:31:28 2016 +0000
@@ -15,7 +15,7 @@
Object subclass:#OSErrorHolder
instanceVariableNames:'errorSymbol errorCategory parameter'
- classVariableNames:'Signals OSErrorSignal'
+ classVariableNames:'Signals'
poolDictionaries:''
category:'OS-Support'
!
@@ -64,6 +64,16 @@
"
! !
+!OSErrorHolder class methodsFor:'instance creation'!
+
+errorSymbol:sym errorCategory:typ
+ ^ self new errorSymbol:sym errorCategory:typ
+!
+
+unsupportedOperation
+ ^ self new errorSymbol:'operation not supported' errorCategory:#unsupportedOperationSignal
+! !
+
!OSErrorHolder class methodsFor:'Signal constants'!
allocRetrySignal
@@ -227,126 +237,117 @@
!OSErrorHolder class methodsFor:'class initialization'!
-initialize
- "init signals etc."
-
- OSErrorSignal isNil ifTrue:[
- OSErrorSignal := OsError.
- OSErrorSignal notifierString:'OperatingSystem error'.
- ]
-!
-
initializeSignals
"init signals etc."
|unavailableReferentSignal|
Signals isNil ifTrue:[
- Signals := Dictionary new:40.
+ Signals := Dictionary new:40.
- OsNoResourcesError notifierString:'Not enough resources'.
- Signals at:#noResourcesSignal put:OsNoResourcesError.
+ OsNoResourcesError notifierString:'Not enough resources'.
+ Signals at:#noResourcesSignal put:OsNoResourcesError.
- OsIllegalOperation notifierString:'Illegal Operation'.
- Signals at:#illegalOperationSignal put:OsIllegalOperation.
+ OsIllegalOperation notifierString:'Illegal Operation'.
+ Signals at:#illegalOperationSignal put:OsIllegalOperation.
- OsInvalidArgumentsError notifierString:'Invalid Arguments'.
- Signals at:#invalidArgumentsSignal put:OsInvalidArgumentsError.
+ OsInvalidArgumentsError notifierString:'Invalid Arguments'.
+ Signals at:#invalidArgumentsSignal put:OsInvalidArgumentsError.
- OsInaccessibleError notifierString:'Referent inaccessible'.
- Signals at:#inaccessibleSignal put:OsInaccessibleError.
+ OsInaccessibleError notifierString:'Referent inaccessible'.
+ Signals at:#inaccessibleSignal put:OsInaccessibleError.
- OsTransferFaultError notifierString:'Transfer fault'.
- Signals at:#transferFaultSignal put:OsTransferFaultError.
+ OsTransferFaultError notifierString:'Transfer fault'.
+ Signals at:#transferFaultSignal put:OsTransferFaultError.
- OsNeedRetryError notifierString:'Retry Operation'.
- Signals at:#needRetrySignal put:OsNeedRetryError.
+ OsNeedRetryError notifierString:'Retry Operation'.
+ Signals at:#needRetrySignal put:OsNeedRetryError.
- Signals at:#defaultOsErrorSignal put:OSErrorSignal.
+ Signals at:#defaultOsErrorSignal put:OsError.
- "/ Information signals
+ "/ Information signals
"/ s := self setupSignal:#informationSignal parent:OSErrorSignal
"/ notifier:'Information'.
"/ self setupSignal:#operationStartedSignal parent:s
"/ notifier:'Operation started'.
- "/ Retry signals
+ "/ Retry signals
- self setupSignal:#notReadySignal parent:OsNeedRetryError
- notifier:' -- referent not ready'.
- self setupSignal:#transientErrorSignal parent:OsNeedRetryError
- notifier:' -- transient error'.
- self setupSignal:#allocRetrySignal parent:OsNeedRetryError
- notifier:' -- allocation failure'.
+ self setupSignal:#notReadySignal parent:OsNeedRetryError
+ notifier:' -- referent not ready'.
+ self setupSignal:#transientErrorSignal parent:OsNeedRetryError
+ notifier:' -- transient error'.
+ self setupSignal:#allocRetrySignal parent:OsNeedRetryError
+ notifier:' -- allocation failure'.
- "/ Resource signals
+ "/ Resource signals
- self setupSignal:#noMemorySignal parent:OsNoResourcesError
- notifier:' -- memory'.
+ self setupSignal:#noMemorySignal parent:OsNoResourcesError
+ notifier:' -- memory'.
- "/ Transfer faults
+ "/ Transfer faults
- self setupSignal:#noDataSignal parent:OsTransferFaultError
- notifier:'Data unavailable/EOF reached'.
- self setupSignal:#peerFaultSignal parent:OsTransferFaultError
- notifier:'Communication with peer failed'.
- self setupSignal:#volumeFullSignal parent:OsTransferFaultError
- notifier:'Volume full'.
+ self setupSignal:#noDataSignal parent:OsTransferFaultError
+ notifier:'Data unavailable/EOF reached'.
+ self setupSignal:#peerFaultSignal parent:OsTransferFaultError
+ notifier:'Communication with peer failed'.
+ self setupSignal:#volumeFullSignal parent:OsTransferFaultError
+ notifier:'Volume full'.
- "/ Inaccesible faults
+ "/ Inaccesible faults
- self setupSignal:#nonexistentSignal parent:OsInaccessibleError
- notifier:'File does not exist'.
- unavailableReferentSignal :=
- self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
- notifier:' currently'.
- self setupSignal:#noPermissionsSignal parent:OsInaccessibleError
- notifier:'Permission denied'.
- self setupSignal:#existingReferentSignal parent:OsInaccessibleError
- notifier:' -- already exists or currently in use'.
- self setupSignal:#inappropriateReferentSignal parent:OsInaccessibleError
- notifier:' -- operation inappropriate'.
+ self setupSignal:#nonexistentSignal parent:OsInaccessibleError
+ notifier:'File does not exist'.
+ unavailableReferentSignal :=
+ self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
+ notifier:' currently'.
+ self setupSignal:#noPermissionsSignal parent:OsInaccessibleError
+ notifier:'Permission denied'.
+ self setupSignal:#existingReferentSignal parent:OsInaccessibleError
+ notifier:' -- already exists or currently in use'.
+ self setupSignal:#inappropriateReferentSignal parent:OsInaccessibleError
+ notifier:' -- operation inappropriate'.
- "/ Illegal operations
+ "/ Illegal operations
- self setupSignal:#inappropriateOperationSignal parent:OsIllegalOperation
- notifier:'Inappropriate operation'.
- self setupSignal:#wrongSubtypeForOperationSignal parent:OsIllegalOperation
- notifier:' -- wrong subtype'.
- self setupSignal:#unsupportedOperationSignal parent:OsIllegalOperation
- notifier:' -- on this platform'.
- self setupSignal:#unpreparedOperationSignal parent:OsIllegalOperation
- notifier:' -- wrong sequence'.
+ self setupSignal:#inappropriateOperationSignal parent:OsIllegalOperation
+ notifier:'Inappropriate operation'.
+ self setupSignal:#wrongSubtypeForOperationSignal parent:OsIllegalOperation
+ notifier:' -- wrong subtype'.
+ self setupSignal:#unsupportedOperationSignal parent:OsIllegalOperation
+ notifier:' -- on this platform'.
+ self setupSignal:#unpreparedOperationSignal parent:OsIllegalOperation
+ notifier:' -- wrong sequence'.
- "/ Illegal arguments
+ "/ Illegal arguments
- self setupSignal:#badArgumentsSignal parent:OsInvalidArgumentsError
- notifier:' -- wrong class'.
- self setupSignal:#badAccessorSignal parent:OsInvalidArgumentsError
- notifier:' -- accessor invalid'.
- self setupSignal:#rangeErrorSignal parent:OsInvalidArgumentsError
- notifier:' -- out of range'.
- self setupSignal:#underSpecifiedSignal parent:OsInvalidArgumentsError
- notifier:' -- operation not fully specified'.
+ self setupSignal:#badArgumentsSignal parent:OsInvalidArgumentsError
+ notifier:' -- wrong class'.
+ self setupSignal:#badAccessorSignal parent:OsInvalidArgumentsError
+ notifier:' -- accessor invalid'.
+ self setupSignal:#rangeErrorSignal parent:OsInvalidArgumentsError
+ notifier:' -- out of range'.
+ self setupSignal:#underSpecifiedSignal parent:OsInvalidArgumentsError
+ notifier:' -- operation not fully specified'.
- "/ COM errors
- self setupSignal:#coNotInitializedSignal parent:OsIllegalOperation
- notifier:'COM not initialized'.
- self setupSignal:#noInterfaceSignal parent:unavailableReferentSignal
- notifier:'No such interface'.
- self setupSignal:#classNotRegisteredSignal parent:unavailableReferentSignal
- notifier:'Class not registered'.
- self setupSignal:#noAggregationSignal parent:OsIllegalOperation
- notifier:'No Aggregation'.
- self setupSignal:#unknownNameSignal parent:unavailableReferentSignal
- notifier:'Unknown member name'.
- self setupSignal:#noVerbsSignal parent:OsIllegalOperation
- notifier:'No verbs for OLE object'.
+ "/ COM errors
+ self setupSignal:#coNotInitializedSignal parent:OsIllegalOperation
+ notifier:'COM not initialized'.
+ self setupSignal:#noInterfaceSignal parent:unavailableReferentSignal
+ notifier:'No such interface'.
+ self setupSignal:#classNotRegisteredSignal parent:unavailableReferentSignal
+ notifier:'Class not registered'.
+ self setupSignal:#noAggregationSignal parent:OsIllegalOperation
+ notifier:'No Aggregation'.
+ self setupSignal:#unknownNameSignal parent:unavailableReferentSignal
+ notifier:'Unknown member name'.
+ self setupSignal:#noVerbsSignal parent:OsIllegalOperation
+ notifier:'No verbs for OLE object'.
- "/ Shell errors
- self setupSignal:#noAssociationSignal parent:unavailableReferentSignal
- notifier:'No association for file extension'.
+ "/ Shell errors
+ self setupSignal:#noAssociationSignal parent:unavailableReferentSignal
+ notifier:'No association for file extension'.
].
"
@@ -380,7 +381,7 @@
errorSymbol:sym errorCategory:typ
errorSymbol := sym.
- errorCategory := typ.
+ errorCategory := typ ? #defaultOsErrorSignal.
!
parameter
@@ -401,11 +402,26 @@
signal := self class signalNamed:errorCategory.
signal
- raiseWith:self
- errorString:(parameter isNil ifTrue:[nil] ifFalse:[' - ', parameter printString])
- in:(thisContext "sender").
+ raiseWith:self
+ errorString:(parameter isNil ifTrue:[nil] ifFalse:[' - ', parameter printString])
+ in:(thisContext "sender").
+
+ "
+ (OperatingSystem errorHolderForNumber:22) reportError
+ "
+!
-"/ ^ self errorReporter reportOn:self
+reportError:errorMessage
+ "Report an error. Show insert errorMessage into error string."
+ "Delegate to the receiver's error reporter."
+
+ |signal|
+
+ signal := self class signalNamed:errorCategory.
+ signal
+ raiseWith:self
+ errorString:(self makeErrorStringFor:errorMessage)
+ in:(thisContext "sender").
!
reportProceedableError
@@ -421,20 +437,37 @@
in:(thisContext "sender").
"/ ^ self errorReporter reportOn:self
+!
+
+reportProceedableError:errorMessage
+ "Report an error. Show insert errorMessage into error string."
+ "Delegate to the receiver's error reporter."
+
+ |signal|
+
+ signal := self class signalNamed:errorCategory.
+ signal
+ raiseRequestWith:self
+ errorString:(self makeErrorStringFor:errorMessage)
+ in:(thisContext "sender").
! !
!OSErrorHolder methodsFor:'others'!
-errorString
+description
|s|
- s := OperatingSystem errorStringForSymbol:errorSymbol.
+ s := self errorString.
parameter notNil ifTrue:[
- ^ s,': ',parameter printString.
+ ^ s,': ',parameter printString.
].
^ s
"Modified: / 12-02-2007 / 12:29:07 / cg"
+!
+
+errorString
+ ^ OperatingSystem errorStringForSymbol:errorSymbol.
! !
!OSErrorHolder methodsFor:'printing'!
@@ -449,6 +482,35 @@
nextPut:$).
! !
+!OSErrorHolder methodsFor:'private'!
+
+makeErrorStringFor:aString
+ "Private: compute an errorString from myself and aString"
+
+ |errorString|
+
+ errorString := aString ? ''.
+ parameter notNil ifTrue:[
+ errorString notEmpty ifTrue:[
+ errorString := errorString, ': '.
+ ].
+ errorString := errorString, parameter printString.
+ ].
+ errorString notEmptyOrNil ifTrue:[
+ errorString := ' - ', errorString.
+ ] ifFalse:[
+ errorString := nil.
+ ].
+
+ ^ errorString.
+! !
+
+!OSErrorHolder methodsFor:'testing'!
+
+isOSErrorHolder
+ ^ true
+! !
+
!OSErrorHolder class methodsFor:'documentation'!
version
@@ -459,5 +521,3 @@
^ '$Header$'
! !
-
-OSErrorHolder initialize!
--- a/OSXOperatingSystem.st Wed Oct 19 09:22:53 2016 +0100
+++ b/OSXOperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
@@ -73,28 +73,59 @@
!
defaultPackagePath
- "redefined to add stx.app packages and /Library stuff"
+ "redefined to add /Application and /Library stuff"
+ "called by Smalltalk initSystemPath"
+ "self defaultPackagePath"
- |path executablePath executableDir packagesDir libDir vsnDirName vsnDir|
+ |path executablePath executableDir packagesDir
+ libDir appDir versionsDir vsnDirName vsnDir|
path := super defaultPackagePath.
executablePath := OperatingSystem pathOfSTXExecutable.
executablePath notNil ifTrue:[
- executableDir := executablePath asFilename directory.
- packagesDir := executableDir directory directory / 'Packages'.
- packagesDir exists ifTrue:[
- path add:packagesDir.
- ].
- libDir := '/Library/Smalltalk-x' asFilename.
- libDir exists ifTrue:[
- vsnDirName := '%1.%2' bindWith:Smalltalk majorVersionNr
- with:Smalltalk minorVersionNr.
- vsnDir := libDir / vsnDirName.
- vsnDir exists ifTrue:[
- path add:vsnDir.
- ].
- ].
+ executableDir := executablePath asFilename directory.
+ packagesDir := executableDir directory directory / 'Packages'.
+ packagesDir exists ifTrue:[
+ packagesDir := packagesDir pathName.
+ (path includes:packagesDir) ifFalse:[
+ path add:packagesDir.
+ ].
+ ].
+ libDir := '/Library/Frameworks/SmalltalkX.framework' asFilename.
+ libDir exists ifTrue:[
+ versionsDir := libDir / 'Versions'.
+ versionsDir exists ifTrue:[
+ vsnDirName := '%1.%2.%3'
+ bindWith:Smalltalk majorVersionNr
+ with:Smalltalk minorVersionNr
+ with:Smalltalk revisionNr.
+ vsnDir := versionsDir / vsnDirName.
+ vsnDir exists ifTrue:[
+ vsnDir := vsnDir pathName.
+ (path includes:vsnDir) ifFalse:[
+ path add:vsnDir.
+ ].
+ ].
+ ].
+ ].
+ appDir := '/Applications/SmalltalkX/' asFilename.
+ appDir exists ifTrue:[
+ versionsDir := appDir / 'Versions'.
+ versionsDir exists ifTrue:[
+ vsnDirName := '%1.%2.%3'
+ bindWith:Smalltalk majorVersionNr
+ with:Smalltalk minorVersionNr
+ with:Smalltalk revisionNr.
+ vsnDir := versionsDir / vsnDirName.
+ vsnDir exists ifTrue:[
+ vsnDir := vsnDir pathName.
+ (path includes:vsnDir) ifFalse:[
+ path add:vsnDir.
+ ].
+ ].
+ ].
+ ].
].
^ path
!
--- a/Object.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Object.st Fri Dec 09 22:31:28 2016 +0000
@@ -14,22 +14,22 @@
"{ NameSpace: Smalltalk }"
nil subclass:#Object
- instanceVariableNames:''
- classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal
- DebuggerHooks DeepCopyErrorSignal Dependencies
- ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion
- ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal
- InfoPrinting InformationSignal InternalErrorSignal
- KeyNotFoundSignal MessageNotUnderstoodSignal
- NonIntegerIndexSignal NonWeakDependencies NotFoundSignal
- OSSignalInterruptSignal ObjectAttributes
- ObjectAttributesAccessLock PartialErrorPrintLine
- PartialInfoPrintLine PrimitiveFailureSignal
- RecursionInterruptSignal RecursiveStoreStringSignal
- SubscriptOutOfBoundsSignal SynchronizationSemaphores
- UserInterruptSignal UserNotificationSignal WarningSignal'
- poolDictionaries:''
- category:'Kernel-Objects'
+ instanceVariableNames:''
+ classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal
+ DebuggerHooks DeepCopyErrorSignal Dependencies
+ ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion
+ ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal
+ InfoPrinting InformationSignal InternalErrorSignal
+ KeyNotFoundSignal MessageNotUnderstoodSignal
+ NonIntegerIndexSignal NonWeakDependencies NotFoundSignal
+ OSSignalInterruptSignal ObjectAttributes
+ ObjectAttributesAccessLock PartialErrorPrintLine
+ PartialInfoPrintLine PrimitiveFailureSignal
+ RecursionInterruptSignal RecursiveStoreStringSignal
+ SubscriptOutOfBoundsSignal SynchronizationSemaphores
+ UserInterruptSignal UserNotificationSignal WarningSignal'
+ poolDictionaries:''
+ category:'Kernel-Objects'
!
!Object class methodsFor:'documentation'!
@@ -521,6 +521,7 @@
+
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -1916,7 +1917,6 @@
! !
-
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
@@ -3047,7 +3047,7 @@
<resource: #skipInDebuggersWalkBack>
- "/ dont send #breakPoint:info: here - ask cg why.
+ "/ don't send #breakPoint:info: here - ask cg why.
(self isBreakPointEnabled:someKey) ifTrue:[
^ HaltSignal
raiseRequestWith:someKey
@@ -3657,37 +3657,39 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps n d|
+ |deps n dep|
deps := self dependents.
deps size ~~ 0 ifTrue:[
-
"/ to save a fair amount of memory in case of
"/ many dependencies, we store a single dependent in
"/ a WeakArray, and switch to a WeakSet if more dependents are
"/ added. Here we have to do the inverse ...
((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
- ((d := deps at:1) == anObject
- or:[d isNil
- or:[d class == SmallInteger]]) ifTrue:[
+ ((dep := deps at:1) == anObject
+ or:[dep isNil
+ or:[dep class == SmallInteger]]) ifTrue:[
self dependents:nil
]
] ifFalse:[
- deps remove:anObject ifAbsent:[].
- (n := deps size) == 0 ifTrue:[
- self dependents:nil
- ] ifFalse:[
- n == 1 ifTrue:[
- d := deps firstIfEmpty:nil.
- d notNil ifTrue:[
- deps := (deps isWeakCollection ifTrue:[WeakArray] ifFalse:[Array]) with:d
- ] ifFalse:[
- deps := nil
- ].
- self dependents:deps.
- ]
- ]
+ dep := deps remove:anObject ifAbsent:[].
+ "if dep is nil, nothing has changed"
+ dep notNil ifTrue:[
+ (n := deps size) == 0 ifTrue:[
+ self dependents:nil
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ dep := deps firstIfEmpty:nil.
+ dep notNil ifTrue:[
+ deps := (deps isWeakCollection ifTrue:[WeakArray] ifFalse:[Array]) with:dep
+ ] ifFalse:[
+ deps := nil
+ ].
+ self dependents:deps.
+ ]
+ ].
+ ].
]
]
] ensure:[
@@ -4943,8 +4945,9 @@
and:[ex exception creator == UserInterrupt]) ifTrue:[
OperatingSystem exit:130.
].
- msgString errorPrintCR.
- 'Backtrace:' errorPrintCR.
+ msgString _errorPrintCR.
+ 'Backtrace:' _errorPrintCR.
+ '' _errorPrintCR.
thisContext fullPrintAll.
OperatingSystem exit:1
].
@@ -5011,7 +5014,7 @@
Time will show, if this is a good idea or leads to sloppy programming
style ... (the idea was borrowed from the Self language).
- WARNING: dont 'optimize' away ifXXX: blocks
+ WARNING: don't 'optimize' away ifXXX: blocks
(i.e. do NOT replace
foo ifTrue:[var1] ifFalse:[var2]
by:
@@ -7074,6 +7077,50 @@
Collection browse
Collection class browse
"
+!
+
+inspect
+ "{ Pragma: +optSpace }"
+
+ "launch an inspector on the receiver.
+ this method (or better: inspectorClass) can be redefined in subclasses
+ to start special inspectors."
+
+ |cls|
+
+ Inspector ~~ MiniInspector ifTrue:[
+ cls := (Smalltalk classNamed: #'Tools::Inspector2').
+ ].
+ cls isNil ifTrue:[
+ cls := self inspectorClass.
+ cls isNil ifTrue:[
+ ^ self basicInspect
+ ].
+ ].
+ cls openOn:self
+
+ "
+ Object new inspect
+ (1 @ 2) inspect
+ Smalltalk inspect
+ #(1 2 3) asOrderedCollection inspect
+ (Color red) inspect
+ (Image fromFile:'bitmaps/garfield.gif') inspect
+ "
+!
+
+inspectorClass
+ "{ Pragma: +optSpace }"
+
+ "return the class to use for inspect.
+ Can (should) be redefined in classes for which a better inspector is available"
+
+ Inspector notNil ifTrue:[
+ ^ Inspector.
+ ].
+ ^ (Smalltalk classNamed: #'InspectorView')
+
+ "Modified: / 08-03-2012 / 16:09:38 / cg"
! !
!Object methodsFor:'object persistency'!
@@ -7162,6 +7209,40 @@
!Object methodsFor:'printing & storing'!
+_errorPrint
+ "Do not use this in user code.
+ Prints on stderr, regardless of any redirection to a logger.
+ Only to be used by the MiniDebugger, to ensure that its output is shown to a user"
+
+ self asString _errorPrint.
+!
+
+_errorPrintCR
+ "Do not use this in user code.
+ Prints on stderr, regardless of any redirection to a logger.
+ Only to be used by the MiniDebugger, to ensure that its output is shown to a user"
+
+ self asString _errorPrintCR.
+!
+
+_print
+ "Do not use this in user code.
+ Prints on stdout, regardless of any redirection to a logger.
+ Only to be used by low-level crash utilities (like MiniDebugger),
+ to ensure that its output is shown to a user"
+
+ self asString _print.
+!
+
+_printCR
+ "Do not use this in user code.
+ Prints on stdout, regardless of any redirection to a logger.
+ Only to be used by low-level crash utilities (like MiniDebugger),
+ to ensure that its output is shown to a user"
+
+ self asString _printCR.
+!
+
basicPrintOn:aStream
"append the receiver's className with an article to the argument, aStream"
@@ -7189,7 +7270,7 @@
classNameWithArticle
"return a string consisting of classname preceeded by an article.
- (dont expect me to write national variants for this ... :-)
+ (don't expect me to write national variants for this ... :-)
If you have special preferences, redefine it ..."
| cls|
@@ -7347,22 +7428,6 @@
^ self infoPrintCR
!
-lowLevelErrorPrint
- "do not use this directly.
- Prints on stderr, regardless of any redirection to a logger.
- Only to be used by the MiniDebugger, to ensure that its output is shown to a user"
-
- self asString lowLevelErrorPrint.
-!
-
-lowLevelErrorPrintCR
- "do not use this directly.
- Prints on stderr, regardless of any redirection to a logger.
- Only to be used by the MiniDebugger, to ensure that its output is shown to a user"
-
- self asString lowLevelErrorPrintCR.
-!
-
print
"print the receiver on the standard output stream (which is not the Transcript)"
@@ -9823,6 +9888,10 @@
^ false
!
+isOSErrorHolder
+ ^ false
+!
+
isOrderedCollection
"return true if the receiver is some kind of ordered collection (or list etc);
false is returned here - the method is only redefined in OrderedCollection."
@@ -9872,6 +9941,10 @@
"Created: / 10-08-2006 / 16:24:53 / cg"
!
+isProtoObject
+ ^ false
+!
+
isProxy
"return true if the receiver is a proxy for another (lazy loaded) object.
False is returned here."
@@ -10072,6 +10145,19 @@
^ false
!
+isVoid
+ "Return true if the receiver is void.
+ This is (and should only be) redefined in VoidObject,
+ for the one and only instance of it, void"
+
+ ^ false
+
+ "
+ nil isVoid
+ void isVoid
+ "
+!
+
isWeakCollection
"return true if the receiver has weak references to its elements."
@@ -10517,4 +10603,5 @@
^ '$Changeset: <not expanded> $'
! !
+
Object initialize!
--- a/ObjectMemory.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ObjectMemory.st Fri Dec 09 22:31:28 2016 +0000
@@ -30,7 +30,8 @@
InterruptLatencyGoal VMSelectors DynamicCodeGCTrigger
DynamicCodeLimit JustInTimeCompilationEnabled
JavaJustInTimeCompilationEnabled JavaNativeCodeOptimization
- BackgroundCollectMaximumInterval SavedGarbageCollectorSettings'
+ BackgroundCollectMaximumInterval SavedGarbageCollectorSettings
+ FinalizerAccessLock'
poolDictionaries:''
category:'System-Support'
!
@@ -696,32 +697,33 @@
"/ protect against double initialization
AllocationFailureSignal isNil ifTrue:[
- AllocationFailureSignal := AllocationFailure.
- AllocationFailureSignal notifierString:'allocation failure'.
-
- MallocFailureSignal := MallocFailure.
- MallocFailureSignal notifierString:'(malloc) allocation failure'.
-
- LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'.
-
- DisposeInterruptHandler := self.
-
- "/ BackgroundCollectMaximumInterval := 3600. "/ run it at least once an hour
- BackgroundCollectMaximumInterval := nil. "/ only run when space situation makes it feasable
- IncrementalGCLimit := 500000. "/ run it whenever 500k have been allocated
- FreeSpaceGCLimit := FreeSpaceGCAmount := nil. "/ no minumum-freeSpace trigger.
- MemoryInterruptHandler := self.
- ExceptionInterruptHandler := self.
-
- VMSelectors := #( #noByteCode #invalidCodeObject #invalidByteCode #invalidInstruction
- #tooManyArguments #badLiteralTable #receiverNotBoolean: #typeCheckError
- #integerCheckError #wrongNumberOfArguments: #privateMethodCalled
- #doesNotUnderstand: #invalidReturn: #invalidReturnOrRestart:
- #userInterrupt #internalError: #spyInterrupt #timerInterrupt #stepInterrupt
- #errorInterrupt:with: #disposeInterrupt #recursionInterrupt
- #memoryInterrupt #fpExceptionInterrupt #signalInterrupt: #childSignalInterrupt
- #ioInterrupt #customInterrupt #schedulerInterrupt #contextInterrupt
- #interruptLatency:receiver:class:selector:vmActivity:id:).
+ AllocationFailureSignal := AllocationFailure.
+ AllocationFailureSignal notifierString:'allocation failure'.
+
+ MallocFailureSignal := MallocFailure.
+ MallocFailureSignal notifierString:'(malloc) allocation failure'.
+
+ LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'.
+ FinalizerAccessLock := Semaphore forMutualExclusion.
+
+ DisposeInterruptHandler := self.
+
+ "/ BackgroundCollectMaximumInterval := 3600. "/ run it at least once an hour
+ BackgroundCollectMaximumInterval := nil. "/ only run when space situation makes it feasable
+ IncrementalGCLimit := 500000. "/ run it whenever 500k have been allocated
+ FreeSpaceGCLimit := FreeSpaceGCAmount := nil. "/ no minumum-freeSpace trigger.
+ MemoryInterruptHandler := self.
+ ExceptionInterruptHandler := self.
+
+ VMSelectors := #( #noByteCode #invalidCodeObject #invalidByteCode #invalidInstruction
+ #tooManyArguments #badLiteralTable #receiverNotBoolean: #typeCheckError
+ #integerCheckError #wrongNumberOfArguments: #privateMethodCalled
+ #doesNotUnderstand: #invalidReturn: #invalidReturnOrRestart:
+ #userInterrupt #internalError: #spyInterrupt #timerInterrupt #stepInterrupt
+ #errorInterrupt:with: #disposeInterrupt #recursionInterrupt
+ #memoryInterrupt #fpExceptionInterrupt #signalInterrupt: #childSignalInterrupt
+ #ioInterrupt #customInterrupt #schedulerInterrupt #contextInterrupt
+ #interruptLatency:receiver:class:selector:vmActivity:id:).
]
"Modified: / 5.8.1998 / 15:30:12 / cg"
@@ -4413,7 +4415,7 @@
supportsJustInTimeCompilation
"return true, if this system supports just-in-time-compilation of
- bytecode to machine code. Dont confuse this with stc-compilation."
+ bytecode to machine code. Don't confuse this with stc-compilation."
%{ /* NOCONTEXT */
extern int __canDoJustInTimeCompilation();
@@ -4425,7 +4427,6 @@
"
ObjectMemory supportsJustInTimeCompilation
"
-
! !
!ObjectMemory class methodsFor:'low memory handling'!
@@ -4518,20 +4519,22 @@
finalize
"tell all weak objects that something happened."
- self allChangedShadowObjectsDo:[:aShadowArray |
- Error handle:[:ex |
- 'ObjectMemory [warning]: caught error in weakArray processing: ' errorPrint.
- ex description errorPrintCR.
- ex suspendedContext fullPrintAllLevels:10.
- "Restart the do block to clean up the rest of the shadow array.
- This is safe here, because the old executor that triggered the error
- has already been removed from the Registry"
- ex restart.
- ] do:[
- aShadowArray lostPointer.
- ].
+ FinalizerAccessLock critical:[
+ self allChangedShadowObjectsDo:[:aShadowArray |
+ Error handle:[:ex |
+ 'ObjectMemory [warning]: caught error in weakArray processing: ' errorPrint.
+ ex description errorPrintCR.
+ ex suspendedContext fullPrintAllLevels:10.
+ "Restart the do block to clean up the rest of the shadow array.
+ This is safe here, because the old executor that triggered the error
+ has already been removed from the Registry"
+ ex restart.
+ ] do:[
+ aShadowArray lostPointer.
+ ].
+ ].
].
-
+
"/ we should change the setup,
"/ to make the Dependencies collection a dependent
"/ of all the WeakArrays and WeakIDSets there,
--- a/OrderedDictionary.st Wed Oct 19 09:22:53 2016 +0100
+++ b/OrderedDictionary.st Fri Dec 09 22:31:28 2016 +0000
@@ -66,12 +66,12 @@
similar fashion to OrderedCollection.
That is, while being filled via #at:put: messages (or similar Dictionary protocol),
the order in which associations are added, is remembered and accessible via the #atIndex:
- or #order messages.
-
- I have one instance variable:
-
- order <OrderedCollection> Ordered collection of keys reflecting the order of
- associations in the dictionary.
+ or #order messages.
+ Therefore, this combines fast access via hashing with a defined order when enumerating.
+
+ [instance variables:]
+ order <OrderedCollection> Ordered collection of keys reflecting the order of
+ associations in the dictionary.
[complexity:]
access by index: O(1)
--- a/OrderedSet.st Wed Oct 19 09:22:53 2016 +0100
+++ b/OrderedSet.st Fri Dec 09 22:31:28 2016 +0000
@@ -43,11 +43,12 @@
That is, I have both Set behavior (only keeping a single instance of
an element) but I also remember the original order, in which elements
were added.
-
- I have one additional instance variable:
+ Therefore, this combines fast access/check/add via hashing with a defined
+ order when enumerating.
- order <OrderedCollection> Ordered collection of values reflecting the order
- in the set.
+ [instance variables:]
+ order <OrderedCollection> Ordered collection of values reflecting the order
+ in the set.
[author:]
Claus Gittinger
@@ -436,10 +437,10 @@
!OrderedSet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OrderedSet.st,v 1.28 2015-02-04 19:59:46 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/OrderedSet.st,v 1.28 2015-02-04 19:59:46 stefan Exp $'
+ ^ '$Header$'
! !
--- a/OsError.st Wed Oct 19 09:22:53 2016 +0100
+++ b/OsError.st Fri Dec 09 22:31:28 2016 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Error subclass:#OsError
instanceVariableNames:''
classVariableNames:''
@@ -34,16 +36,70 @@
"
! !
+!OsError class methodsFor:'initialization'!
+
+initialize
+ NotifierString := 'OperatingSystem error'.
+! !
+
!OsError class methodsFor:'queries'!
mayProceed
^ true
! !
+!OsError methodsFor:'accessing'!
+
+description
+
+ "parameter is an OSErrorHolder, if present"
+ parameter class == OSErrorHolder ifTrue:[
+ ^ super description , ' (', parameter description, ')'.
+ ].
+ ^ super description.
+
+ "
+ [
+ (OperatingSystem errorHolderForNumber:22)
+ parameter:'bla';
+ reportError.
+ ] on:OsError do:[:ex|
+ ex description inspect.
+ ].
+ "
+!
+
+errorCategory
+
+ "parameter is an OSErrorHolder, if present"
+ parameter notNil ifTrue:[
+ ^ parameter errorCategory.
+ ].
+ ^ ''.
+!
+
+errorString
+
+ "parameter is an OSErrorHolder, if present"
+ parameter notNil ifTrue:[
+ ^ parameter errorString.
+ ].
+ ^ ''.
+!
+
+errorSymbol
+
+ "parameter is an OSErrorHolder, if present"
+ parameter notNil ifTrue:[
+ ^ parameter errorSymbol.
+ ].
+ ^ ''.
+! !
+
!OsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsError.st,v 1.3 2003/08/30 12:31:08 cg Exp $'
+ ^ '$Header$'
!
version_SVN
@@ -51,4 +107,4 @@
! !
-
+OsError initialize!
--- a/PCFilename.st Wed Oct 19 09:22:53 2016 +0100
+++ b/PCFilename.st Fri Dec 09 22:31:28 2016 +0000
@@ -142,6 +142,19 @@
"Modified: / 23-03-2011 / 16:29:34 / cg"
!
+rootComponents:aCollectionOfDirectoryNames
+ |rootDirOrVolume|
+
+ aCollectionOfDirectoryNames notEmpty ifTrue:[
+ rootDirOrVolume := aCollectionOfDirectoryNames first.
+ (rootDirOrVolume endsWith:$:) ifTrue:[
+ "do not add a leading \ to C:"
+ ^ self fromComponents:aCollectionOfDirectoryNames.
+ ].
+ ].
+ ^ super rootComponents:aCollectionOfDirectoryNames.
+!
+
rootDirectoryOnVolume:aVolumeName
"return a filename for the root directory on some volume"
@@ -411,27 +424,27 @@
newFilename := newName asFilename.
newFilename exists ifTrue:[
- (self pathName sameAs:newFilename pathName) ifFalse:[
- newFilename delete
- ].
+ (self pathName sameAs:newFilename pathName) ifFalse:[
+ newFilename delete
+ ].
].
"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.
- retryCtr > 0 ifTrue:[
- ('stx: Error caught while renaming %1 to %2 - maybe temporary locked by virus scanner, still trying: %3'
- bindWith:self pathName
- with:newFilename pathName
- with:ex description) infoPrintCR.
- ] ifFalse:[
- ex reject
- ].
- Delay waitForMilliseconds:200.
- ex restart.
+ retryCtr := retryCtr - 1.
+ 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.
+ ] ifFalse:[
+ ex reject
+ ].
+ Delay waitForMilliseconds:200.
+ ex restart.
] do:[
- ^ super renameTo:newName
+ ^ super renameTo:newName
].
"
@@ -601,7 +614,7 @@
^ true.
].
- (self suffix asLowercase = 'bat') ifTrue:[
+ (#('bat' 'cmd') includes:self suffix asLowercase) ifTrue:[
^ (OperatingSystem isValidPath:osName)
and:[(OperatingSystem isDirectory:osName) not].
].
@@ -781,15 +794,15 @@
|vol vsz rest|
vol := self volume.
- (vsz := vol size) > 0 ifTrue:[
- rest := nameString copyFrom:vsz + 1.
- rest size == 0 ifTrue:[
- ^ '\'
- ].
- (rest startsWith:$\) ifFalse:[
- ^ '\' , rest
- ].
- ^ rest
+ (vsz := vol size) ~~ 0 ifTrue:[
+ rest := nameString copyFrom:vsz + 1.
+ rest size == 0 ifTrue:[
+ ^ '\'
+ ].
+ (rest startsWith:$\) ifFalse:[
+ ^ '\' , rest
+ ].
+ ^ rest
].
^ nameString
@@ -849,26 +862,22 @@
"return the disc volume part of the name or an empty string.
This is only used with DOS filenames - on unix, an empty string is returned.
A full path can be reconstructed from
- aFilename volume , aFilename localPathName
+ aFilename volume , aFilename localPathName
"
- |endIdx endIdx2|
+ |endIdx|
nameString size >= 2 ifTrue:[
- (nameString at:2) == $: ifTrue:[
- ^ nameString copyTo:2
- ].
- (nameString startsWith:'\\') ifTrue:[
- endIdx := nameString indexOf:$\ startingAt:3.
- endIdx == 0 ifTrue:[
- ^ nameString.
- ].
- endIdx2 := nameString indexOf:$\ startingAt:endIdx+1.
- endIdx2 == 0 ifTrue:[
- ^ nameString.
- ].
- ^ nameString copyFrom:1 to:endIdx2-1
- ].
+ (nameString at:2) == $: ifTrue:[
+ ^ nameString copyTo:2
+ ].
+ (nameString startsWith:'\\') ifTrue:[
+ endIdx := nameString indexOf:$\ startingAt:3.
+ endIdx == 0 ifTrue:[
+ ^ nameString.
+ ].
+ ^ nameString copyFrom:1 to:endIdx-1
+ ].
].
^ ''
--- a/PeekableStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/PeekableStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -125,6 +125,12 @@
"Modified: / 23-10-2006 / 16:33:40 / cg"
! !
+!PeekableStream class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PeekableStream
+! !
+
!PeekableStream methodsFor:'chunk input/output'!
nextChunk
--- a/PipeStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/PipeStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -224,7 +222,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
"
@@ -489,7 +487,7 @@
!PipeStream methodsFor:'closing'!
-shutDown
+abortAndClose
"close the Stream and terminate the command"
self unregisterForFinalization.
@@ -506,6 +504,31 @@
self terminatePipeCommand.
!
+close
+ "low level close
+ This waits for the command to finish.
+ Use abortAndClose for a fast (nonBlocking) close."
+
+ handle notNil ifTrue:[
+ super close.
+ pid notNil ifTrue:[
+ "/ wait for the pipe-command to terminate.
+ self waitForPipeCommandWithTimeout:nil.
+ ].
+ ].
+
+ "Modified: / 12.9.1998 / 16:51:04 / cg"
+!
+
+shutDown
+ <resource: #obsolete>
+ "this is a historic leftover kept for backward compatibility.
+ The name collides with the same name in Socket, which does
+ not hard terminate the connection."
+
+ self abortAndClose.
+!
+
shutDownOutput
"signal to the pipestream's command, that no more data will be sent"
@@ -524,30 +547,7 @@
finalize
"redefined to avoid blocking in close."
- self shutDown
-! !
-
-!PipeStream protectedMethodsFor:'private'!
-
-closeFile
- "low level close
- This waits for the command to finish.
- Use shutDown for a fast (nonBlocking) close."
-
- handle notNil ifTrue:[
- super closeFile.
-"/ OperatingSystem isMSDOSlike ifTrue:[
-"/ self terminatePipeCommand.
-"/ ].
-
- handle := nil.
- pid notNil ifTrue:[
- "/ wait for the pipe-command to terminate.
- self waitForPipeCommandWithTimeout:nil.
- ].
- ].
-
- "Modified: / 12.9.1998 / 16:51:04 / cg"
+ self abortAndClose
! !
!PipeStream methodsFor:'private'!
--- a/PositionableStream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/PositionableStream.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -125,6 +123,12 @@
"Modified: / 13-07-2006 / 20:36:54 / cg"
! !
+!PositionableStream class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PositionableStream
+! !
+
!PositionableStream methodsFor:'Compatibility-Dolphin'!
endChunk
@@ -852,6 +856,53 @@
"
!
+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
+ "
+!
+
upToAll:aCollection
"read until a subcollection consisisting of the elements in aCollection is encountered.
Return everything read excluding the elements in aCollection.
--- a/ProceedError.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProceedError.st Fri Dec 09 22:31:28 2016 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Warning subclass:#ProceedError
instanceVariableNames: ''
classVariableNames: ''
@@ -76,8 +78,13 @@
('WARNING: signal <', parameter creator printString, '> has been raised nonproceedable') errorPrintCR.
(' by: ', parameter suspendedContext printString) errorPrintCR.
+ (' : ', parameter suspendedContext sender printString) errorPrintCR.
+ (' : ', parameter suspendedContext sender sender printString) errorPrintCR.
(' ', suspendedContext printString , ' tries to proceed.') errorPrintCR.
- (' This will be an error in future ST/X versions.') errorPrintCR.
+ (' in: ', thisContext sender printString) errorPrintCR.
+ (' : ', thisContext sender sender printString) errorPrintCR.
+ (' : ', thisContext sender sender sender printString) errorPrintCR.
+ (' This may be an error in future ST/X versions.') errorPrintCR.
self proceedWith:nil.
@@ -94,13 +101,15 @@
Object errorSignal raise
].
"
+
+ "Modified: / 13-11-2016 / 10:52:37 / cg"
! !
!ProceedError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProceedError.st,v 1.6 2013-04-19 08:40:03 cg Exp $'
+ ^ '$Header$'
!
version_SVN
--- a/Process.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Process.st Fri Dec 09 22:31:28 2016 +0000
@@ -94,7 +94,7 @@
situations, when soft termination fails. (for example, if some error was
coded into a handler or unwind block).
- Leaving the processes startBlock has the same effct as a soft-terminate
+ Leaving the processes startBlock has the same effect as a soft-terminate
(i.e. there is no need to send an explicit terminate).
Notice:
@@ -532,17 +532,6 @@
^ self isDead
! !
-!Process methodsFor:'Compatibility-V''Age'!
-
-queueInterrupt:aBlock
- "VisualAge compatibility: alias for #interruptWith:
- arrange for the receiver process to be interrupted and
- evaluate aBlock in its interrupt handler."
-
- ^ self interruptWith:aBlock
-
- "Created: 15.11.1996 / 11:41:06 / cg"
-! !
!Process methodsFor:'accessing'!
@@ -986,9 +975,13 @@
interrupt
"evaluate my interrupt-actions.
The process will go back to where it got interrupted
- after doing this."
-
- self evaluateInterruptActionsWithContext:thisContext sender
+ after doing this.
+
+ This is also sent by the VM."
+
+ interruptActions size ~~ 0 ifTrue:[
+ self evaluateInterruptActionsWithContext:thisContext sender.
+ ].
!
interruptWith:aBlock
@@ -1019,16 +1012,16 @@
"/ and will be redelivered.
interruptsDisabled == true ifTrue:[
- "/ no, I dont want interrupts right now;
- "/ try again later.
- ^ false
+ "/ no, I don't want interrupts right now;
+ "/ try again later.
+ ^ false
].
"/ I tend to disable interrupts, while processing interrupt actions;
"/ however, this leads to a blocking Debugger sometimes (scroll).
"/ [
"/ interruptsDisabled := true.
- self evaluateInterruptActionsWithContext:aContext.
+ self evaluateInterruptActionsWithContext:aContext.
"/ ] ensure:[
"/ interruptsDisabled := false.
"/ ].
@@ -1076,10 +1069,8 @@
(i.e. those which are installed via #interruptWith:)"
interruptsDisabled := false.
- interruptActions size ~~ 0 ifTrue:[
- Processor activeProcess == self ifTrue:[
- self interrupt
- ]
+ (interruptActions size ~~ 0 and:[Processor activeProcess == self]) ifTrue:[
+ self interrupt.
]
! !
@@ -1930,26 +1921,26 @@
the receiver itself)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or don't nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess creatorId == id ifTrue:[
- aProcess isGUIProcess ifTrue:[
- aProcess terminateWithAllGUISubprocesses
- ]
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ aProcess creatorId == id ifTrue:[
+ aProcess isGUIProcess ifTrue:[
+ aProcess terminateWithAllGUISubprocesses
+ ]
+ ]
+ ]
].
"Created: / 28-10-1996 / 20:43:32 / cg"
@@ -1963,17 +1954,17 @@
and recursively oll of their group processes.)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or don't nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
self terminateAllSubprocessesInGroup:id
!
@@ -2001,24 +1992,24 @@
that are in the receiver's process group."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or don't nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess processGroupId == id ifTrue:[
- aProcess terminate
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ aProcess processGroupId == id ifTrue:[
+ aProcess terminate
+ ]
+ ]
].
self terminate
!
@@ -2058,29 +2049,29 @@
the receiver itself)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or don't nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
processGroupId == SysProcessId ifTrue:[
- ProcessorScheduler invalidProcessSignal
- raiseWith:self errorString:'trying to terminate the system process group'.
+ 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
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ (aProcess processGroupId == processGroupId
+ or:[aProcess processGroupId == id]) ifTrue:[
+ aProcess terminate
+ ]
+ ]
].
"Created: 28.10.1996 / 20:41:49 / cg"
@@ -2208,7 +2199,8 @@
!
threadVariableValueOf:aKey
- "return the value of a thread local variable, or nil if no such variable exists"
+ "return the value of a thread local variable,
+ or nil if no such variable exists"
^ self environmentAt:aKey ifAbsent:nil
@@ -2249,42 +2241,46 @@
|var oldValue result|
environment isNil ifTrue:[
- environment := IdentityDictionary new
+ environment := IdentityDictionary new
].
var := environment at:variableNameSymbol ifAbsent:nil.
var isNil ifTrue:[
- var := ValueHolder new.
- environment at:variableNameSymbol put:var.
+ var := ValueHolder new.
+ environment at:variableNameSymbol put:var.
].
oldValue := var value.
[
- var value:aValue.
- result := aBlock value.
+ var value:aValue.
+ result := aBlock value.
] ensure:[
- oldValue isNil
- ifTrue:[ environment removeKey:variableNameSymbol]
- ifFalse:[ var value:oldValue ]
+ oldValue isNil
+ ifTrue:[ environment removeKey:variableNameSymbol]
+ ifFalse:[ var value:oldValue ]
].
^ result
"
|printIt|
- printIt := [ Transcript showCR:'foo is now ',(Processor activeProcess threadVariableValueOf:#foo) printString ].
+ printIt := [
+ Transcript
+ showCR:'foo is now ',
+ (Processor activeProcess threadVariableValueOf:#foo) printString
+ ].
Processor activeProcess
- withThreadVariable:#foo
- boundTo:1234
- do:[
- printIt value.
- Processor activeProcess
- withThreadVariable:#foo
- boundTo:2345
- do:[
- printIt value
- ].
- ]
+ withThreadVariable:#foo
+ boundTo:1234
+ do:[
+ printIt value.
+ Processor activeProcess
+ withThreadVariable:#foo
+ boundTo:2345
+ do:[
+ printIt value
+ ].
+ ]
"
! !
--- a/ProcessorScheduler.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProcessorScheduler.st Fri Dec 09 22:31:28 2016 +0000
@@ -78,105 +78,105 @@
(for examples, see ProcessMonitor or MemoryMonitor).
This pure-event mode may not be supported in the future
- (actually, it is no longer maintained, so dont run the system without Processes).
+ (actually, it is no longer maintained, so don't run the system without Processes).
[instance variables:]
- quiescentProcessLists - list of waiting processes
- scheduler - the scheduler process itself
- zombie - internal temporary (recently died process)
- activeProcess - the current process
- activeProcessId - the current processes id
- currentPriority - the current processes priority
- readFdArray - fd-sema-checkBlock triple-association
- readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- readCheckArray
- writeFdArray - fd-sema-checkBlock triple-association
- writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- writeCheckArray
- timeoutArray - time-action-process-sema quadruple-association
- timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- timeoutProcessArray
- timeoutSemaphoreArray
- idleActions - actions to be executed when idle
- preWaitActions - actions to be executed BEFORE going into an OS-wait
- anyTimeouts - flag if any timeouts are pending
- dispatching - flag if dispatch process is running (i.e. NOT initializing)
- interruptedProcess - the currently interrupted process.
- useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
- gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
- osChildExitActions - OS chid process actions
- gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
- exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
- suspendScheduler - internal use
- timeSliceProcess - the timeSlicer process
- supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
- scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
+ quiescentProcessLists - list of waiting processes
+ scheduler - the scheduler process itself
+ zombie - internal temporary (recently died process)
+ activeProcess - the current process
+ activeProcessId - the current processes id
+ currentPriority - the current processes priority
+ readFdArray - fd-sema-checkBlock triple-association
+ readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ readCheckArray
+ writeFdArray - fd-sema-checkBlock triple-association
+ writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ writeCheckArray
+ timeoutArray - time-action-process-sema quadruple-association
+ timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ timeoutProcessArray
+ timeoutSemaphoreArray
+ idleActions - actions to be executed when idle
+ preWaitActions - actions to be executed BEFORE going into an OS-wait
+ anyTimeouts - flag if any timeouts are pending
+ dispatching - flag if dispatch process is running (i.e. NOT initializing)
+ interruptedProcess - the currently interrupted process.
+ useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
+ gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
+ osChildExitActions - OS chid process actions
+ gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
+ exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
+ suspendScheduler - internal use
+ timeSliceProcess - the timeSlicer process
+ supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
+ scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
[class variables:]
- KnownProcesses <WeakArray> all known processes
- KnownProcessIds <Collection> and their IDs
-
- PureEventDriven <Boolean> true, if no process support
- is available
-
- UserSchedulingPriority <Integer> the priority at which normal
- user interfaces run
-
- UserInterruptPriority the priority at which user-
- interrupts (Cntl-C) processing
- takes place. Processes with
- a greater or equal priority are
- not interruptable.
-
- TimingPriority the priority used for timing.
- Processes with a greater or
- equal priority are not interrupted
- by timers.
-
- HighestPriority The highest allowed prio for processes
-
- SchedulingPriority The priority of the scheduler (must
- me higher than any other).
-
- MaxNumberOfProcesses if non-nil, no more than this
- number of processes are allowed
- (for debugging)
-
- TimeSliceInterval for preemptive priority scheduling only:
- the time interval in millis, at which processes
- are timesliced
-
- TimeSlicingPriorityLimit for preemptive priority scheduling only:
- processes are only timesliced, if running
- at or below this priority.
-
- EventPollingInterval for systems which do not support select on
- a fileDescriptor: the polling interval in millis.
+ KnownProcesses <WeakArray> all known processes
+ KnownProcessIds <Collection> and their IDs
+
+ PureEventDriven <Boolean> true, if no process support
+ is available
+
+ UserSchedulingPriority <Integer> the priority at which normal
+ user interfaces run
+
+ UserInterruptPriority the priority at which user-
+ interrupts (Cntl-C) processing
+ takes place. Processes with
+ a greater or equal priority are
+ not interruptable.
+
+ TimingPriority the priority used for timing.
+ Processes with a greater or
+ equal priority are not interrupted
+ by timers.
+
+ HighestPriority The highest allowed prio for processes
+
+ SchedulingPriority The priority of the scheduler (must
+ me higher than any other).
+
+ MaxNumberOfProcesses if non-nil, no more than this
+ number of processes are allowed
+ (for debugging)
+
+ TimeSliceInterval for preemptive priority scheduling only:
+ the time interval in millis, at which processes
+ are timesliced
+
+ TimeSlicingPriorityLimit for preemptive priority scheduling only:
+ processes are only timesliced, if running
+ at or below this priority.
+
+ EventPollingInterval for systems which do not support select on
+ a fileDescriptor: the polling interval in millis.
most interesting methods:
- Processor>>suspend: (see also Process>>suspend)
- Processor>>resume: (see also Process>>resume)
- Processor>>terminate: (see also Process>>terminate)
- Processor>>yield
- Processor>>changePriority:for: (see also Process>>priority:
-
- Processor>>signal:afterSeconds: (see also Delay>>forSeconds:)
- Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
- Processor>>signal:onInput: (see also ExternalStream>>readWait)
- Processor>>signal:onOutput: (see also ExternalStream>>writeWait)
- Processor>>disableSemaphore:
+ Processor>>suspend: (see also Process>>suspend)
+ Processor>>resume: (see also Process>>resume)
+ Processor>>terminate: (see also Process>>terminate)
+ Processor>>yield
+ Processor>>changePriority:for: (see also Process>>priority:
+
+ Processor>>signal:afterSeconds: (see also Delay>>forSeconds:)
+ Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
+ Processor>>signal:onInput: (see also ExternalStream>>readWait)
+ Processor>>signal:onOutput: (see also ExternalStream>>writeWait)
+ Processor>>disableSemaphore:
[see also:]
- Process
- Delay Semaphore SemaphoreSet SharedQueue
- WindowGroup
- (``Working with processes'': programming/processes.html)
+ Process
+ Delay Semaphore SemaphoreSet SharedQueue
+ WindowGroup
+ (``Working with processes'': programming/processes.html)
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -274,7 +274,7 @@
Processor isNil ifTrue:[
"create the one and only processor"
- Processor := self basicNew initialize.
+ Smalltalk at:#Processor put:(self basicNew initialize).
].
"
@@ -365,17 +365,17 @@
This may raise an exception, if a VM process could not be created."
MaxNumberOfProcesses notNil ifTrue:[
- KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
- (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
- "
- the number of processes has reached the (soft) limit.
- This limit prevents runaway programs from creating too many
- processes. If you continue in the debugger, the process will be
- created as usual. If you dont want this, abort or terminate.
- "
- self error:'too many processes'.
- ]
- ]
+ KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
+ (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
+ "
+ the number of processes has reached the (soft) limit.
+ This limit prevents runaway programs from creating too many
+ processes. If you continue in the debugger, the process will be
+ created as usual. If you don't want this, abort or terminate.
+ "
+ self error:'too many processes'.
+ ]
+ ]
].
%{
@@ -383,11 +383,11 @@
extern int __threadCreate();
tid = __threadCreate(aProcess,
- 0 /* stackSize: no longer needed */,
- __isSmallInteger(id) ? __intVal(id) /* assign id */
- : -1 /* let VM assign one */ );
+ 0 /* stackSize: no longer needed */,
+ __isSmallInteger(id) ? __intVal(id) /* assign id */
+ : -1 /* let VM assign one */ );
if (tid) {
- RETURN ( __mkSmallInteger(tid));
+ RETURN ( __mkSmallInteger(tid));
}
%}
.
@@ -397,7 +397,7 @@
or if it ran out of memory, when allocating internal data
structures.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
threadDestroy:id
@@ -579,7 +579,7 @@
interruptCounter
"for statistics: counts the overall number of interrupts"
-
+
^ interruptCounter
"
@@ -607,7 +607,7 @@
timedActionCounter
"for statistics: counts the overall number of timer actions"
-
+
^ timedActionCounter
"
@@ -666,7 +666,7 @@
handle all timeout actions
"
anyTimeouts ifTrue:[
- self evaluateTimeouts
+ self evaluateTimeouts
].
"first do a quick check for semaphores using checkActions - this is needed for
@@ -678,40 +678,40 @@
"
nActions := readCheckArray size.
1 to:nActions do:[:index |
- checkBlock := readCheckArray at:index.
- (checkBlock notNil and:[checkBlock value]) ifTrue:[
- sema := readSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- ].
- ]
+ checkBlock := readCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
nActions := writeCheckArray size.
1 to:nActions do:[:index |
- checkBlock := writeCheckArray at:index.
- (checkBlock notNil and:[checkBlock value]) ifTrue:[
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- ].
- ]
+ checkBlock := writeCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
"now, someone might be runnable ..."
p := self highestPriorityRunnableProcess.
p isNil ifTrue:[
- "/ no one runnable, hard wait for event or timeout
- "/ Trace ifTrue:['w' printCR.].
- self waitForEventOrTimeout.
-
- "/ check for OS process termination
- gotChildSignalInterrupt ifTrue:[
- gotChildSignalInterrupt := false.
- self handleChildSignalInterrupt
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ no one runnable, hard wait for event or timeout
+ "/ Trace ifTrue:['w' printCR.].
+ self waitForEventOrTimeout.
+
+ "/ check for OS process termination
+ gotChildSignalInterrupt ifTrue:[
+ gotChildSignalInterrupt := false.
+ self handleChildSignalInterrupt
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
pri := p priority.
@@ -726,7 +726,7 @@
we schedule a timer interrupt to interrupt us after 1/20s of a second
- effectively polling the filedescriptors 20 times a second.
(which is bad, since low prio processes will be hurt in performance)
- Therefore, dont let benchmarks run with low prio ...
+ Therefore, don't let benchmarks run with low prio ...
Higher prio processes must be suspended,
same prio ones must yield or suspend to get back control
@@ -742,13 +742,13 @@
"
pri < TimingPriority ifTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ millis == 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ]
+ ]
].
"
@@ -761,38 +761,38 @@
pri < UserInterruptPriority ifTrue:[
"comment out this if above is uncommented"
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
- ].
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ millis == 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ].
+ ].
"---"
- useIOInterrupts ifTrue:[
+ useIOInterrupts ifTrue:[
"/ readFdArray do:[:fd |
"/ (fd notNil and:[fd >= 0]) ifTrue:[
"/ OperatingSystem enableIOInterruptsOn:fd
"/ ].
"/ ].
- ] ifFalse:[
- millis notNil ifTrue:[
- millis := millis min:EventPollingInterval
- ] ifFalse:[
- millis := EventPollingInterval
- ]
- ]
+ ] ifFalse:[
+ millis notNil ifTrue:[
+ millis := millis min:EventPollingInterval
+ ] ifFalse:[
+ millis := EventPollingInterval
+ ]
+ ]
].
millis notNil ifTrue:[
- "/ Trace ifTrue:['C' print. millis printCR.].
- "schedule a clock interrupt after millis milliseconds"
- OperatingSystem enableTimer:millis rounded.
+ "/ Trace ifTrue:['C' print. millis printCR.].
+ "schedule a clock interrupt after millis milliseconds"
+ OperatingSystem enableTimer:millis rounded.
].
scheduledProcesses notNil ifTrue:[
- scheduledProcesses add:p
+ scheduledProcesses add:p
].
"
@@ -804,17 +804,17 @@
"/ Trace ifTrue:['<-' printCR.].
"... when we arrive here, we are back on stage.
- Either by an ALARM or IO signal, or by a suspend of another process
+ Either by an ALARM or IO signal, or by a suspend of another process
"
millis notNil ifTrue:[
- OperatingSystem disableTimer.
+ OperatingSystem disableTimer.
].
"/ check for OS process termination
gotChildSignalInterrupt ifTrue:[
- gotChildSignalInterrupt := false.
- self handleChildSignalInterrupt
+ gotChildSignalInterrupt := false.
+ self handleChildSignalInterrupt
].
"/ check for new input
@@ -822,8 +822,8 @@
OperatingSystem unblockInterrupts.
(gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
- gotIOInterrupt := false.
- self checkForIOWithTimeout:0.
+ gotIOInterrupt := false.
+ self checkForIOWithTimeout:0.
].
wasBlocked ifTrue:[OperatingSystem blockInterrupts].
@@ -841,8 +841,8 @@
"avoid confusion if entered twice"
dispatching == true ifTrue:[
- 'Processor [info]: already in dispatch' infoPrintCR.
- ^ self
+ 'Processor [info]: already in dispatch' infoPrintCR.
+ ^ self
].
dispatching := true.
@@ -851,35 +851,43 @@
"/ (thanks to stefans objectAllocation monitor,
"/ this safes a bit of memory allocation in the scheduler)
- dispatchAction := [ [dispatching] whileTrue:[ self dispatch ] ].
-
- handlerAction := [:ex |
- (HaltInterrupt accepts:ex creator) ifTrue:[
- "/ in a standalone application, we do not want those
- Smalltalk isStandAloneApp ifTrue:[
- Smalltalk isStandAloneDebug ifFalse:[
- ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
- ex proceed.
- ]
- ].
- ].
-
- ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
- ex return
- ].
+ dispatchAction :=
+ [
+ [dispatching] whileTrue:[
+ self dispatch
+ ]
+ ].
+
+ handlerAction :=
+ [:ex |
+ (HaltInterrupt accepts:ex creator) ifTrue:[
+ "/ in a standalone application, we do not want those
+ (Smalltalk isStandAloneApp and:[Smalltalk isStandAloneDebug not]) ifTrue:[
+ ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
+ ex proceed.
+ ].
+ "/ MiniDebugger enter. -- should this be done when some --debug/--verbose was given?
+ ex proceed.
+ ].
+
+ ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
+ ex return
+ ].
ignoredSignals := SignalSet
- with:HaltInterrupt
- with:TerminateProcessRequest
- with:RecursionError
- with:AbortAllOperationRequest.
+ with:HaltInterrupt
+ with:TerminateProcessRequest
+ with:RecursionError
+ with:AbortAllOperationRequest.
"/
"/ I made this an extra call to dispatch; this allows recompilation
"/ of the dispatch-handling code in the running system.
"/
[dispatching] whileTrue:[
- ignoredSignals handle:handlerAction do:dispatchAction
+ ignoredSignals
+ handle:handlerAction
+ do:dispatchAction
].
"/ we arrive here in standalone Apps,
@@ -1133,9 +1141,9 @@
gotChildSignalInterrupt := true.
interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 12.4.1996 / 10:12:18 / stefan"
@@ -1211,7 +1219,7 @@
"/ start the OS-Process
pid := aBlockReturningPid value.
pid notNil ifTrue:[
- osChildExitActions at:pid put:actionBlock.
+ osChildExitActions at:pid put:actionBlock.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ pid
@@ -1287,16 +1295,16 @@
"
no interrupts now - activeProcess has already been changed
- (dont add any message sends here)
+ (don't add any message sends here)
"
"/ ok := self threadSwitchFrom:oldProcess to:aProcess id:id singleStep:singleStep.
%{
extern OBJ ___threadSwitch();
if (__isSmallInteger(id)) {
- ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
+ ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
} else {
- ok = false;
+ ok = false;
}
%}.
@@ -1308,41 +1316,40 @@
activeProcessId := oldId.
currentPriority := oldProcess priority.
- ok == true ifFalse:[
- "
- switch failed for some reason -
- destroy (hard-terminate) the bad process.
- This happens when:
- - the stack went above the absolute limit
- (VM switches back to scheduler)
- - a halted process cannot execute its interrupt
- actions (win32 only)
- "
- (id := p id) ~~ SysProcessId ifTrue:[
- id notNil ifTrue:[
- 'Processor [warning]: problem with process ' errorPrint.
- id errorPrint.
- (nm := p name) notNil ifTrue:[
- ' (' errorPrint. nm errorPrint. ')' errorPrint.
- ].
-
- ok == #halted ifTrue:[
- "/ that process was halted (win32 only)
- p state:#halted.
- '; stopped it.' errorPrintCR.
- self suspend:p.
- ] ifFalse:[
- '; hard-terminate it.' errorPrintCR.
- 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
- p state:#cleanup.
- self terminateNoSignal:p.
- ]
- ]
- ]
+ ok ~~ true ifTrue:[
+ "
+ switch failed for some reason -
+ destroy (hard-terminate) the bad process.
+ This happens when:
+ - the stack went above the absolute limit
+ (VM switches back to scheduler)
+ - a halted process cannot execute its interrupt
+ actions (win32 only)
+ "
+ id := p id.
+ (id ~~ SysProcessId and:[id notNil]) ifTrue:[
+ 'Processor [warning]: problem with process ' errorPrint.
+ id errorPrint.
+ (nm := p name) notNil ifTrue:[
+ ' (' errorPrint. nm errorPrint. ')' errorPrint.
+ ].
+
+ ok == #halted ifTrue:[
+ "/ that process was halted (win32 only)
+ p state:#halted.
+ '; stopped it.' errorPrintCR.
+ self suspend:p.
+ ] ifFalse:[
+ '; hard-terminate it.' errorPrintCR.
+ 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
+ p state:#cleanup.
+ self terminateNoSignal:p.
+ ]
+ ]
].
zombie notNil ifTrue:[
- self class threadDestroy:zombie.
- zombie := nil
+ self class threadDestroy:zombie.
+ zombie := nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -1549,60 +1556,81 @@
"Modified: 17.4.1997 / 12:59:33 / stefan"
!
+anyScheduledWindowGroupAtAll
+ "return true, if there is any window group with active topviews.
+ This is used to determine if we should stop scheduling
+ in standAlone applications."
+
+ Screen notNil ifTrue:[
+ Screen allScreens notEmptyOrNil ifTrue:[
+ WindowGroup scheduledWindowGroups notEmptyOrNil ifTrue:[^ true].
+ ].
+ ].
+ ^ false
+
+ "
+ Processor anyScheduledWindowGroupAtAll
+ "
+!
+
anyUserProcessAtAll
"return true, if there is any user process still running,
or waiting on a semaphore.
This is used to determine if we should stop scheduling
in standAlone applications.
- A user process has a non-zero processGroup."
-
- |listArray l prio "{ Class: SmallInteger }"
- wasBlocked|
+ A user process has a non-zero processGroup.
+ Should be called with interrupts blocked."
+
+ |listArray l prio "{ Class: SmallInteger }"|
prio := HighestPriority.
- wasBlocked := OperatingSystem blockInterrupts.
listArray := quiescentProcessLists.
[prio >= 1] whileTrue:[
- l := listArray at:prio.
- l notNil ifTrue:[
- l linksDo:[:aProcess |
- aProcess isUserProcess ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
- ]
- ]
- ].
- prio := prio - 1
+ l := listArray at:prio.
+ l notNil ifTrue:[
+ l linksDo:[:aProcess |
+ aProcess isUserProcess ifTrue:[
+ "/ 'anyUserProcess: found quiescent ' _errorPrint. aProcess asString _errorPrintCR.
+ ^ true.
+ ]
+ ]
+ ].
+ prio := prio - 1
].
+ (scheduledProcesses notNil
+ and:[scheduledProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]) ifTrue:[
+ "/ 'anyUserProcess: found scheduled ' _errorPrint.
+ "/ (scheduledProcesses detect:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]) asString _errorPrintCR.
+ ^ true.
+ ].
+
"/ any user process waiting on a sema?
(readSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on read sema' _errorPrintCR.
+ ^ true.
].
(writeSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on write sema' _errorPrintCR.
+ ^ true.
].
(timeoutSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on timeout sema' _errorPrintCR.
+ ^ true.
].
(timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ ^ true.
].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ false
"
@@ -1911,8 +1939,8 @@
If the process is the current one, reschedule.
Notice:
- This method should only be called by Process>>suspend or
- Process>>suspendWithState:"
+ This method should only be called by Process>>suspend or
+ Process>>suspendWithState:"
|pri l p wasBlocked|
@@ -1920,30 +1948,31 @@
some debugging stuff
"
aProcess isNil ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
+ ^ self
].
aProcess isDead ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
- self threadSwitch:scheduler.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
+ self threadSwitch:scheduler.
+ ^ self
].
aProcess == scheduler ifTrue:[
- "only the scheduler may suspend itself"
- activeProcess == scheduler ifTrue:[
- suspendScheduler := true.
- [suspendScheduler] whileTrue:[
- self dispatch.
- ].
- ^ self
- ].
-
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
- ^ self
+ "only the scheduler may suspend itself"
+ activeProcess == scheduler ifTrue:[
+ suspendScheduler := true.
+ [suspendScheduler] whileTrue:[
+ self dispatch.
+ ].
+ ^ self
+ ].
+
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
+ ^ self
].
- aProcess hasInterruptActions ifTrue:[
- aProcess interrupt.
+ (aProcess == activeProcess) ifTrue:[
+ "this is a no-op if the process has no interrupt actions"
+ aProcess interrupt.
].
wasBlocked := OperatingSystem blockInterrupts.
@@ -1955,23 +1984,23 @@
the ifAbsent block, because [] is a shared cheap block, created at compile time
"
(l isNil or:[(l removeIdentical:aProcess ifAbsent:nil) isNil]) ifTrue:[
- "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
- "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
- aProcess == activeProcess ifTrue:[
- self threadSwitch:scheduler.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
+ "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
+ aProcess == activeProcess ifTrue:[
+ self threadSwitch:scheduler.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
(aProcess == activeProcess) ifTrue:[
- "we can immediately switch sometimes"
- l isEmpty ifTrue:[
- p := scheduler
- ] ifFalse:[
- p := l firstLink
- ].
- self threadSwitch:p
+ "we can immediately switch sometimes"
+ l isEmpty ifTrue:[
+ p := scheduler
+ ] ifFalse:[
+ p := l firstLink
+ ].
+ self threadSwitch:p
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2017,17 +2046,19 @@
|pri id l wasBlocked|
aProcess isNil ifTrue:[^ self].
+
aProcess == scheduler ifTrue:[
- InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
- ^ self
+ InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
+ ^ self
].
wasBlocked := OperatingSystem blockInterrupts.
id := aProcess id.
id isNil ifTrue:[ "already dead"
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ self checkForEndOfDispatch.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
aProcess setId:nil state:#dead.
@@ -2037,36 +2068,38 @@
pri := aProcess priority.
l := quiescentProcessLists at:pri.
l notNil ifTrue:[
- (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
- l isEmpty ifTrue:[
- quiescentProcessLists at:pri put:nil
- ]
- ]."
+ (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
+ l isEmpty ifTrue:[
+ quiescentProcessLists at:pri put:nil
+ ]
+ ]."
].
aProcess == activeProcess ifTrue:[
- "
- hard case - it's the currently running process
- we must have the next active process destroy this one
- (we cannot destroy the chair we are sitting on ... :-)
- "
- zombie notNil ifTrue:[
- self error:'active process is zombie' mayProceed:true.
- self class threadDestroy:zombie.
- ].
-
- self unRemember:aProcess.
- zombie := id.
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self threadSwitch:scheduler.
- "not reached"
- ^ self
+ "
+ hard case - it's the currently running process
+ we must have the next active process destroy this one
+ (we cannot destroy the chair we are sitting on ... :-)
+ "
+ zombie notNil ifTrue:[
+ self error:'active process is zombie' mayProceed:true.
+ self class threadDestroy:zombie.
+ ].
+
+ self unRemember:aProcess.
+ zombie := id.
+
+ self checkForEndOfDispatch.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self threadSwitch:scheduler.
+ "not reached"
+ ^ self
].
self unRemember:aProcess.
self class threadDestroy:id.
+ self checkForEndOfDispatch.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
"Modified: / 23-09-1996 / 13:50:24 / stefan"
@@ -2311,27 +2344,27 @@
myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
flipFlop := true.
- 'Processor [info]: timeslicer started' infoPrintCR.
+ Smalltalk verbose ifTrue:[ 'Processor [info]: timeslicer started' infoPrintCR ].
[
- t ~~ TimeSliceInterval ifTrue:[
- "/ interval changed -> need a new delay
- myDelay delay:(t := TimeSliceInterval).
- ].
- myDelay wait.
- self slice.
-
- "/ every other tick, recompute priorities.
- flipFlop := flipFlop not.
- flipFlop ifTrue:[
- scheduledProcesses notNil ifTrue:[
- supportDynamicPriorities ifTrue:[
- self recomputeDynamicPriorities.
- ].
- scheduledProcesses clearContents.
- ] ifFalse:[
- scheduledProcesses := IdentitySet new.
- ].
- ].
+ t ~~ TimeSliceInterval ifTrue:[
+ "/ interval changed -> need a new delay
+ myDelay delay:(t := TimeSliceInterval).
+ ].
+ myDelay wait.
+ self slice.
+
+ "/ every other tick, recompute priorities.
+ flipFlop := flipFlop not.
+ flipFlop ifTrue:[
+ scheduledProcesses notNil ifTrue:[
+ supportDynamicPriorities ifTrue:[
+ self recomputeDynamicPriorities.
+ ].
+ scheduledProcesses clearContents.
+ ] ifFalse:[
+ scheduledProcesses := IdentitySet new.
+ ].
+ ].
] loop.
! !
@@ -2339,52 +2372,62 @@
disableFd:aFileDescriptor doSignal:doSignal
"disable triggering of a semaphore for aFileDescriptor..
- If doSignal is true, the associated semaphore is signaled."
+ If doSignal is true, the associated semaphore is signaled.
+ Answer a collection of semaphores that haven't been signaled."
|idx "{ Class: SmallInteger }"
- wasBlocked sema|
+ wasBlocked sema semaCollection|
wasBlocked := OperatingSystem blockInterrupts.
useIOInterrupts ifTrue:[
OperatingSystem disableIOInterruptsOn:aFileDescriptor.
].
- idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := readFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
readFdArray at:idx put:nil.
readCheckArray at:idx put:nil.
(sema := readSemaphoreArray at:idx) notNil ifTrue:[
readSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
- ].
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
].
- idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
- idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := writeFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
writeFdArray at:idx put:nil.
writeCheckArray at:idx put:nil.
(sema := writeSemaphoreArray at:idx) notNil ifTrue:[
writeSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
- ].
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
].
- idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
- idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := exceptFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
exceptFdArray at:idx put:nil.
(sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
exceptSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
+ ].
+ idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1.
+ ].
+
+ semaCollection isNil ifTrue:[
+ semaCollection := #().
+ ] ifFalse:[
+ doSignal ifTrue:[
+ semaCollection do:[:eachSema|
+ eachSema signalForAll.
+ semaCollection := #().
].
].
- idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ semaCollection
!
disableSemaphore:aSemaphore
@@ -2397,34 +2440,34 @@
idx := 0.
[idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := readFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- readFdArray at:idx put:nil.
- readSemaphoreArray at:idx put:nil.
- readCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := readFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ readFdArray at:idx put:nil.
+ readSemaphoreArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
].
idx := 0.
[idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := writeFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- writeFdArray at:idx put:nil.
- writeSemaphoreArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := writeFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ writeFdArray at:idx put:nil.
+ writeSemaphoreArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
].
idx := 0.
[idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- exceptFdArray at:idx put:nil.
- exceptSemaphoreArray at:idx put:nil.
+ exceptFdArray at:idx put:nil.
+ exceptSemaphoreArray at:idx put:nil.
].
self removeTimeoutForSemaphore:aSemaphore.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2904,18 +2947,17 @@
!
addTimedBlock:aBlock for:aProcess atMilliseconds:aMillisecondTime
- "add the argument, aBlock to the list of time-scheduled-blocks; to be
- evaluated by aProcess when the millisecondClock value passes
+ "add the argument, aBlock to the list of time-scheduled-blocks;
+ to be evaluated by aProcess when the millisecondClock value passes
aMillisecondTime.
- If that block is already in the timeout list,
- its trigger-time is changed.
- The process specified by the argument, aProcess will be interrupted
- for execution of the block.
+ If that block is already in the timeout list, its trigger-time is changed.
+ The process specified by the argument, aProcess
+ will be interrupted for execution of the block.
If aProcess is nil, the block will be evaluated by the scheduler itself
- (which is dangerous - the block should not raise any error conditions).
+ (which is dangerous: the block should not raise any error conditions).
If the process is active at trigger time, the interrupt will occur in
- whatever method it is executing; if suspended at trigger time, it will be
- resumed.
+ whatever method it is executing;
+ if suspended at trigger time, it will be resumed.
The block will be removed from the timed-block list after evaluation
(i.e. it will trigger only once).
Returns an ID, which can be used in #removeTimeoutWidthID:"
@@ -2926,21 +2968,21 @@
wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActionArray identityIndexOf:aBlock startingAt:1.
index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime
+ timeoutArray at:index put:aMillisecondTime
] ifFalse:[
- index := timeoutArray indexOf:nil.
- index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime.
- timeoutActionArray at:index put:aBlock.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:aProcess
- ] ifFalse:[
- timeoutArray := timeoutArray copyWith:aMillisecondTime.
- timeoutActionArray := timeoutActionArray copyWith:aBlock.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
- timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
- index := timeoutArray size.
- ].
+ index := timeoutArray indexOf:nil.
+ index ~~ 0 ifTrue:[
+ timeoutArray at:index put:aMillisecondTime.
+ timeoutActionArray at:index put:aBlock.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:aProcess
+ ] ifFalse:[
+ timeoutArray := timeoutArray copyWith:aMillisecondTime.
+ timeoutActionArray := timeoutActionArray copyWith:aBlock.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
+ timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
+ index := timeoutArray size.
+ ].
].
anyTimeouts := true.
@@ -3044,7 +3086,7 @@
block := timeoutActionArray at:index.
block notNil ifTrue:[
"/ usually (>99%), there is only one single timeout action to call;
- "/ avoid creation of an OrderedCollection
+ "/ avoid creation of an OrderedCollection
firstBlockToEvaluate isNil ifTrue:[
firstBlockToEvaluate := block.
firstProcess := timeoutProcessArray at:index.
@@ -3086,7 +3128,7 @@
].
"/ usually (>99%), there is only one single timeout action to call;
- "/ above code avoided the creation of an OrderedCollection
+ "/ above code avoided the creation of an OrderedCollection
blocksAndProcessesToEvaluate isNil ifTrue:[
firstBlockToEvaluate notNil ifTrue:[
timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
@@ -3096,16 +3138,17 @@
firstProcess isDead ifTrue:[
"/ a timedBlock for a process which has already terminated
"/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
"/ and thereby could block the whole smalltalk system.
"/ For this reason is it IGNORED here.)
-"/ Could handle it in timeoutProcess, but we don't,
-"/ because otherwise timeouts might be reissued forever...
-"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/ timeoutHandlerProcess interruptWith:block.
-"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') infoPrintCR.
-"/ ].
+
+ "/ Could handle it in timeoutProcess, but we don't,
+ "/ because otherwise timeouts might be reissued forever...
+ "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+ "/ timeoutHandlerProcess interruptWith:block.
+ "/ ] ifFalse:[
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') errorPrintCR.
+ "/ ].
] ifFalse:[
firstProcess interruptWith:firstBlockToEvaluate
]
@@ -3123,16 +3166,17 @@
p isDead ifTrue:[
"/ a timedBlock for a process which has already terminated
"/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
"/ and thereby could block the whole smalltalk system.
"/ For this reason is it IGNORED here.)
-"/ Could handle it in timeoutProcess, but we don't,
-"/ because otherwise timeouts might be reissued forever...
-"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/ timeoutHandlerProcess interruptWith:block.
-"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') infoPrintCR.
-"/ ].
+
+ "/ Could handle it in timeoutProcess, but we don't,
+ "/ because otherwise timeouts might be reissued forever...
+ "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+ "/ timeoutHandlerProcess interruptWith:block.
+ "/ ] ifFalse:[
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') errorPrintCR.
+ "/ ].
] ifFalse:[
timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
p interruptWith:block
@@ -3173,8 +3217,10 @@
wasBlocked := OperatingSystem blockInterrupts.
index := 0.
- [index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
- index ~~ 0] whileTrue:[
+ [
+ index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
+ index ~~ 0
+ ] whileTrue:[
timeoutArray at:index put:nil.
timeoutSemaphoreArray at:index put:nil.
timeoutActionArray at:index put:nil.
@@ -3263,10 +3309,15 @@
(i.e. it will always just wait forever, and perform timeout actions
in its interrupt handler)."
+ |mySema|
+
+ mySema := Semaphore new name:'timeoutHandler'.
[
[
- (Semaphore new name:'timeoutHandler') wait.
+ mySema wait.
] on:Exception do:[:ex|
+ "/ an error occurred in one of the timeout actions.
+
"ignore errors, but tell the user"
InfoPrinting == true ifTrue:[
('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
@@ -3309,6 +3360,37 @@
!ProcessorScheduler methodsFor:'waiting'!
+checkForEndOfDispatch
+ |wasBlocked|
+
+ exitWhenNoMoreUserProcesses ifTrue:[
+ "/ check if there are any processes at all
+ "/ stop dispatching if there is none
+ "/ (and anyTimeouts is false, which means that no timeout blocks are present)
+ "/ and no readSemaphores are present (which means that noone is waiting for input)
+ "/ and no writeSemaphores are present
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ "/ 'scheduled: ' _errorPrint. self anyScheduledWindowGroupAtAll asString _errorPrintCR.
+ "/ 'anyUserProcess: ' _errorPrint. self anyUserProcessAtAll asString _errorPrintCR.
+
+ self anyScheduledWindowGroupAtAll ifFalse:[
+ self anyUserProcessAtAll ifFalse:[
+ Smalltalk verbose ifTrue:[
+ 'Processor [info]: end of dispatch' infoPrintCR.
+ ].
+ dispatching := false.
+ "/ false ifTrue:[
+ "/ MiniInspector basicNew printInstVarsOf:self.
+ "/ MiniDebugger enter:thisContext withMessage:'about to exit' mayProceed:true.
+ "/ ].
+ ].
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+!
+
checkForIOWithTimeout:millis
"this is called, when there is absolutely nothing to do;
hard wait for either input to arrive, or output to be possible
@@ -3494,47 +3576,15 @@
gotIOInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 21.12.1995 / 16:17:40 / stefan"
"Modified: 4.8.1997 / 14:23:08 / cg"
!
-noMoreUserProcesses
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and anyTimeouts is false, which means that no timeout blocks are present)
- "/ and no readSemaphores are present (which means that noone is waiting for input)
- "/ and no writeSemaphores are present
-
- anyTimeouts ifFalse:[
- ^ self anyUserProcessAtAll not.
- ].
- ^ false
-"/ |anySema|
-"/
-"/
-"/ anyTimeouts ifFalse:[
-"/ anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/ anySema ifFalse:[
-"/ anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/ anySema ifFalse:[
-"/ self anyUserProcessAtAll ifFalse:[
-"/ ^ true
-"/ ]
-"/ ].
-"/ ].
-"/ ].
-"/ ^ false
-
- "
- Processor noMoreUserProcesses
- "
-!
-
removeCorruptedFds
"this is sent when select returns an error due to some invalid
fileDescriptor. May happen, if someone does a readWait/writeWait on a
@@ -3546,91 +3596,91 @@
readFdArray/writeFdArray in the debugger)"
readFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- readFdArray at:idx put:nil.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ].
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ readFdArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
+ (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+ readSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ].
].
writeFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- writeFdArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
- (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
- writeSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+ writeSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
exceptFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- exceptFdArray at:idx put:nil.
- (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
- exceptSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ exceptFdArray at:idx put:nil.
+ (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+ exceptSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- osChildExitActions keysDo:[:eachPid |
- |result sema|
-
- eachPid notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ]
- ]
- ].
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ osChildExitActions keysDo:[:eachPid |
+ |result sema|
+
+ eachPid notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ]
+ ]
+ ].
].
"Modified: 12.4.1996 / 09:32:58 / stefan"
@@ -3642,9 +3692,9 @@
what to do now."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
!
@@ -3694,9 +3744,9 @@
of whichever process is currently running."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 18.10.1996 / 20:35:54 / cg"
@@ -3713,80 +3763,81 @@
doingGC := true.
[doingGC] whileTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- (millis notNil and:[millis <= 0]) ifTrue:[
- ^ self "oops - hurry up checking"
- ].
- ].
-
- "
- if its worth doing, collect a bit of garbage;
- but not, if a backgroundCollector is active
- "
- ObjectMemory backgroundCollectorRunning ifTrue:[
- doingGC := false
- ] ifFalse:[
- doingGC := ObjectMemory gcStepIfUseful.
- ].
-
- "then do idle actions"
- (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
- idleActions do:[:aBlock |
- aBlock value.
- ].
- ^ self "go back checking"
- ].
-
- doingGC ifTrue:[
- (self checkForIOWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ (millis notNil and:[millis <= 0]) ifTrue:[
+ ^ self "oops - hurry up checking"
+ ].
+ ].
+
+ "
+ if its worth doing, collect a bit of garbage;
+ but not, if a backgroundCollector is active
+ "
+ ObjectMemory backgroundCollectorRunning ifTrue:[
+ doingGC := false
+ ] ifFalse:[
+ doingGC := ObjectMemory gcStepIfUseful.
+ ].
+
+ "then do idle actions"
+ (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
+ idleActions do:[:aBlock |
+ aBlock value.
+ ].
+ ^ self "go back checking"
+ ].
+
+ doingGC ifTrue:[
+ (self checkForIOWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ]
+ ]
].
exitWhenNoMoreUserProcesses ifTrue:[
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and anyTimeouts is false, which means that no timeout blocks are present)
- "/ and no readSemaphores are present (which means that noone is waiting for input)
- "/ and no writeSemaphores are present
-
- self noMoreUserProcesses ifTrue:[
- dispatching := false.
- ^ self
- ].
+ "/ check if there are any processes at all
+ "/ stop dispatching if there is none
+ "/ (and anyTimeouts is false, which means that no timeout blocks are present)
+ "/ and no readSemaphores are present (which means that noone is waiting for input)
+ "/ and no writeSemaphores are present
+
+ "/ cg: changed to only check when a process terminated
+ "/ self checkForEndOfDispatch.
+ dispatching ifFalse:[
+ ^ self
+ ].
].
preWaitActions notNil ifTrue:[
- preWaitActions do:[:action | action value].
+ preWaitActions do:[:action | action value].
].
"/
"/ absolutely nothing to do - simply wait
"/
OperatingSystem supportsSelect ifFalse:[
- "SCO instant ShitStation has a bug here,
- waiting always 1 sec in the select - therefore we delay a bit and
- return - effectively polling in 50ms cycles
- "
- (self checkForIOWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ].
- OperatingSystem millisecondDelay:EventPollingInterval.
- ^ self
+ "SCO instant ShitStation has a bug here,
+ waiting always 1 sec in the select - therefore we delay a bit and
+ return - effectively polling in 50ms cycles
+ "
+ (self checkForIOWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ].
+ OperatingSystem millisecondDelay:EventPollingInterval.
+ ^ self
].
useIOInterrupts ifTrue:[
- dT := 999999
+ dT := 999999
] ifFalse:[
- dT := EventPollingInterval
+ dT := EventPollingInterval
].
millis isNil ifTrue:[
- millis := dT.
+ millis := dT.
] ifFalse:[
- millis := millis rounded min:dT.
+ millis := millis rounded min:dT.
].
self checkForIOWithTimeout:millis
--- a/ProgrammingLanguage.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProgrammingLanguage.st Fri Dec 09 22:31:28 2016 +0000
@@ -58,10 +58,12 @@
QuerySignal new
nameClass:self message:#languageQuerySignal;
notifierString:'asking for current language';
- handlerBlock:[:ex | ex proceedWith:SmalltalkLanguage instance].
+ handlerBlock:[:ex | ex proceedWith:SmalltalkLanguage instance];
+ yourself.
"Created: / 12-08-2009 / 14:56:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 16-08-2009 / 10:36:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 25-11-2016 / 15:48:19 / cg"
! !
!ProgrammingLanguage class methodsFor:'instance creation'!
@@ -569,12 +571,25 @@
!
methodTemplateForDocumentation
- "return a method definition template string (or nil)"
+ "return a documentation method definition template string (or nil)"
|generatorClass|
(generatorClass := self codeGeneratorClass) isNil ifTrue:[^ nil].
^ generatorClass methodTemplateForDocumentation
+
+ "Modified (comment): / 18-11-2016 / 10:53:36 / cg"
+!
+
+methodTemplateForPackageDocumentation
+ "return a documentation method definition template string (or nil) for packages"
+
+ |generatorClass|
+
+ (generatorClass := self codeGeneratorClass) isNil ifTrue:[^ nil].
+ ^ generatorClass methodTemplateForPackageDocumentation
+
+ "Created: / 18-11-2016 / 10:51:09 / cg"
!
methodTemplateForVersionMethodCVS
--- a/ProjectDefinition.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProjectDefinition.st Fri Dec 09 22:31:28 2016 +0000
@@ -144,7 +144,7 @@
separator, use slash (as on UNIX), it will be automagically converted to platform's separator.
* The second paramterer (true or false) tells the SCM whether the file should be generated (and thus
overwritten) upon each commit (when true) or only the first time (when false). Important: see the
- emark below.
+ remark below.
* The method itself should return file's contents a string. If it returns nil, then the file is *not*
generated at all.
@@ -158,9 +158,9 @@
## Adding additional rules to generated makefiles
- There are two ways to add additional rules to generatec makefiles (Make.proto and bc.mak):
+ There are two ways to add additional rules to generated makefiles (Make.proto and bc.mak):
1) overriding #additionalRules_make_dot_proto and/or #additionalRules_bc_dot_mak
- 2) addng a method annotated by <file:target:> or <file:target:extends:>
+ 2) adding a method annotated by <file:target:> or <file:target:extends:>
### Overriding #additionalRules* methods
@@ -176,7 +176,7 @@
Alternatively, you may add one method per rule and annotate it by
<file:target:> or <file:target:extends:> annotation. For example,
- to call ant whenever a package is built, add a method like:
+ to call 'ant' whenever a package is built, add a method like:
additionalRuleAnt_make_dot_proto
<file: 'Make.proto' target: 'ant' extends: 'pre_objs' >
@@ -1472,7 +1472,7 @@
the class is installed as autoloaded in the image (i.e. the state in the image is taken).
If false, it is taken from an existing definition in #classNamesAndAttributes"
- |newSpec oldSpec ignored sortedSpec|
+ |newSpec oldSpec ignored|
oldSpec := self classNamesAndAttributesAsSpecArray.
ignored := self ignoredClassNames asSet.
@@ -1498,7 +1498,7 @@
"JV @ 2010-06-19
Force merge default class attributes with existing ones"
newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
- newSpec add:newEntry.
+ newSpec add:newEntry.
]
].
].
@@ -1544,7 +1544,7 @@
attributes notEmptyOrNil ifTrue:[
newEntry := newEntry , attributes.
].
- newSpec add:newEntry
+ newSpec add:newEntry.
]
]
]
@@ -2244,7 +2244,8 @@
are extended by myself.
They are mandatory, because we need these packages as a prerequisite for loading and compiling.
This method is generated automatically,
- by searching along the inheritance chain of all of my classes."
+ by searching along the inheritance chain of all of my classes.
+ Please take a look at the #referencedPreRequisites method as well."
^ #()
!
@@ -2293,12 +2294,13 @@
referencedPreRequisites
"list packages which are a prerequisite, because they contain
classes which are referenced by my classes.
- We do not need these packages as a prerequisite for compiling or loading,
+ These packages are NOT needed as a prerequisite for compiling or loading,
however, a class from it may be referenced during execution and having it
unloaded then may lead to a runtime doesNotUnderstand error, unless the caller
includes explicit checks for the package being present.
This method is generated automatically,
- by searching all classes (and their packages) which are referenced by my classes."
+ by searching all classes (and their packages) which are referenced by my classes.
+ Please also take a look at the #mandatoryPreRequisites method"
^ #()
!
@@ -2319,7 +2321,7 @@
"list packages which are known as subprojects.
The generated makefile will enter those and make there as well.
However: they are not forced to be loaded when a package is loaded;
- for those, redefine requiredPrerequisites."
+ for those, redefine #referencedPrerequisites or #mandatoryPreRequisites."
^ #()
@@ -2867,7 +2869,6 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
-
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -2923,14 +2924,15 @@
Under win32, this is placed into the dll's file-info.
Other systems may put it elsewhere, or ignore it."
- (
- #(
- 'stx'
- 'exept'
- ) includes:self module) ifTrue:[
- ^ 'eXept Software AG'
- ].
-
+ |m|
+
+ m := self module.
+ (m = 'stx') ifTrue:[
+ ^ 'Claus Gittinger & eXept Software AG'
+ ].
+ (m = 'exept') ifTrue:[
+ ^ 'eXept Software AG'
+ ].
^ 'My Company'
"Modified: / 18-08-2006 / 16:08:20 / cg"
@@ -3078,24 +3080,29 @@
Under win32, this is placed into the dll's file-info.
Other systems may put it elsewhere, or ignore it."
- self module = 'stx' ifTrue:[
- "hardwired-default"
- ^ 'Copyright Claus Gittinger 1988-%1\nCopyright eXept Software AG %1'
- bindWith:(Date today year)
- ].
- self module = 'exept' ifTrue:[
+ |m thisYear template|
+
+ m := self module.
+ thisYear := Date today year.
+
+ m = 'stx' ifTrue:[
"hardwired-default"
- ^ 'Copyright eXept Software AG %1'
- bindWith:(Date today year)
- ].
-
- ^ 'My CopyRight or CopyLeft'
-
- "
- self legalCopyright
- "
-
- "Modified: / 30-08-2006 / 18:53:36 / cg"
+ template := 'Copyright Claus Gittinger %1\nCopyright eXept Software AG %1'
+ ] ifFalse:[
+ m = 'exept' ifTrue:[
+ "hardwired-default"
+ template := 'Copyright eXept Software AG %1'
+ ] ifFalse:[
+ template := 'My CopyRight or CopyLeft %1'
+ ].
+ ].
+ ^ template bindWith:thisYear
+
+ "
+ self legalCopyright
+ "
+
+ "Modified (comment): / 18-11-2016 / 12:23:36 / cg"
!
majorVersionNr
@@ -3208,7 +3215,7 @@
^ 'Smalltalk/X'
].
m = 'exept' ifTrue:[
- ^ 'eXept addOns'
+ ^ 'eXept AddOns'
].
self isApplicationDefinition ifFalse:[
@@ -3231,7 +3238,7 @@
^ nm
].
- "Modified: / 08-11-2007 / 16:45:14 / cg"
+ "Modified: / 18-11-2016 / 11:44:03 / cg"
!
productNameAsValidFilename
@@ -4929,6 +4936,8 @@
!
subProjectMakeCallsUsing:callString
+ "for xxxmake.bat files"
+
^ String streamContents:[:s |
self effectiveSubProjects do:[:packageID |
|pkgLabel skipLabel joinLabel|
@@ -4938,7 +4947,7 @@
joinLabel := 'done_',pkgLabel.
s nextPutLine:'@if not exist ',(self msdosPathToPackage:packageID from:(self package)),' goto ',skipLabel.
s nextPutLine:'@echo "***********************************"'.
- s nextPutLine:'@echo "Building ',(packageID copyReplaceAll:$: with:$/).
+ s nextPutLine:'@echo "Building ',(packageID copyReplaceAll:$: with:$/),'"'.
s nextPutLine:'@echo "***********************************"'.
s nextPutLine:'@pushd ', (self msdosPathToPackage:packageID from:(self package)).
s nextPutAll:'@'; nextPutAll:callString; nextPutLine:' || exit /b "%errorlevel%"'.
@@ -4946,7 +4955,7 @@
s nextPutLine:'@goto ',joinLabel.
s nextPutLine:':',skipLabel.
s nextPutLine:'@echo "###################################"'.
- s nextPutLine:'@echo "FOLDER MISSING: ',(packageID copyReplaceAll:$: with:$/).
+ s nextPutLine:'@echo "FOLDER MISSING: ',(packageID copyReplaceAll:$: with:$/),'"'.
s nextPutLine:'@echo "###################################"'.
s nextPutLine:'exit /b 1'.
s nextPutLine:':',joinLabel.
@@ -5346,7 +5355,7 @@
plist at:'CFBundleVersion' put:(self fileVersion asString).
plist at:'LSMinimumSystemVersion' put:'10.6'.
"/ plist at:'CFBundleDevelopmentRegion' put:'English'.
- "/ plist at:'CFBundleExecutable' put:(self executableName).
+ plist at:'CFBundleExecutable' put:(self applicationName).
self isLibraryDefinition ifTrue:[
plist at:'CFBundleName' put:(self package copyReplaceAny:':/' with:$.).
@@ -5583,9 +5592,9 @@
Smalltalk changed: #aboutToLoadPackage with: self.
[
newStuffHasBeenLoaded := false.
- (self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
+ Smalltalk silentLoading ifFalse:[
"/ thisContext fullPrintAll.
- Transcript showCR:('loading %1%2...'
+ Logger info:('loading %1%2...'
bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
with:self name).
].
@@ -5663,9 +5672,9 @@
self projectIsLoaded ifFalse:[^ false].
thisContext isRecursive ifTrue:[^ false].
- (self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
+ Smalltalk silentLoading ifFalse:[
"/ thisContext fullPrintAll.
- Transcript show:'unloading '; showCR:self name.
+ Logger info:'unloading %1' with:self name.
].
self activityNotification:'Executing pre-unload action'.
@@ -5878,12 +5887,16 @@
newSpec do:[:entry |
|clsName clsOrNil|
- clsName := entry isArray ifTrue:[ entry first ] ifFalse:[ entry ].
- clsOrNil := Smalltalk classNamed:clsName.
- (clsOrNil notNil and:[clsOrNil isLoaded]) ifTrue:[
- loadedClasses add:clsOrNil.
- ] ifFalse:[
+ (entry isArray and:[entry includes:#autoload]) ifTrue:[
itemsForUnloadedClasses add:entry.
+ ] ifFalse:[
+ clsName := entry isArray ifTrue:[ entry first ] ifFalse:[ entry ].
+ clsOrNil := Smalltalk classNamed:clsName.
+ (clsOrNil notNil and:[clsOrNil isLoaded]) ifTrue:[
+ loadedClasses add:clsOrNil.
+ ] ifFalse:[
+ itemsForUnloadedClasses add:entry.
+ ]
]
].
"/ and sort by load order
@@ -6527,7 +6540,7 @@
] ifFalse:[
errMsg := 'missing class for extension: ',className.
].
- Transcript showCR:errMsg.
+ Logger error:errMsg.
self error:errMsg mayProceed:true.
classesAlreadyWarned add:className.
].
@@ -7016,11 +7029,11 @@
!
unloadAllClasses
- Transcript showCR:'unloading not yet fully supported'
+ Logger warning:'unloading not yet fully supported'
!
unloadClassLibrary
- Transcript showCR:'unloading not yet fully supported'
+ Logger warning:'unloading not yet fully supported'
!
unloadSubProjects
@@ -7615,7 +7628,7 @@
cls := Smalltalk classNamed:nm.
cls isNil ifTrue:[
- Transcript showCR:('%1: failed to autoload class %2' bindWith:self name with:nm)
+ Logger warning:'%1: failed to autoload class %2' with:self name with:nm
].
cls
]
--- a/ProtoObject.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProtoObject.st Fri Dec 09 22:31:28 2016 +0000
@@ -50,6 +50,78 @@
"
! !
+!ProtoObject class methodsFor:'helpers'!
+
+shallowCopyOf:anObject
+ "return a copy of anObject with shared subobjects (a shallow copy)
+ i.e. the copy shares referenced instvars with its original."
+
+%{ /* NOCONTEXT */
+ int ninsts, spc, sz;
+ OBJ theCopy;
+ OBJ cls = __qClass(anObject);
+ int flags = __intVal(__ClassInstPtr(cls)->c_flags);
+
+ /*
+ * bail out for special objects ..
+ */
+ if (((flags & ~ARRAYMASK) == 0)
+ && ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
+ sz = __qSize(anObject);
+ __PROTECT__(anObject);
+ __qNew(theCopy, sz); /* OBJECT ALLOCATION */
+ __UNPROTECT__(anObject);
+ if (theCopy) {
+ cls = __qClass(anObject);
+ spc = __qSpace(theCopy);
+
+ theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
+
+ sz = sz - OHDR_SIZE;
+ if (sz) {
+ char *src, *dst;
+
+ src = (char *)(__InstPtr(anObject)->i_instvars);
+ dst = (char *)(__InstPtr(theCopy)->i_instvars);
+#ifdef bcopy4
+ {
+ /* care for odd-number of longs */
+ int nW = sz >> 2;
+
+ if (sz & 3) {
+ nW++;
+ }
+
+ bcopy4(src, dst, nW);
+ }
+#else
+ bcopy(src, dst, sz);
+#endif
+
+ flags &= ARRAYMASK;
+ if (flags == POINTERARRAY) {
+ ninsts = __BYTES2OBJS__(sz);
+ } else {
+ ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
+ }
+ if (ninsts) {
+ do {
+ OBJ el;
+
+ el = __InstPtr(theCopy)->i_instvars[ninsts-1];
+ __STORE_SPC(theCopy, el, spc);
+ } while (--ninsts);
+ }
+ }
+ RETURN (theCopy);
+ }
+ }
+%}.
+ "/ fallBack for special objects & memoryAllocation failure case
+
+ ^ self error:'ProtoObject>>#shallowCopyOf: failed'
+! !
+
!ProtoObject methodsFor:'error handling'!
doesNotUnderstand:aMessage
@@ -69,6 +141,26 @@
^ MessageNotUnderstood raiseRequestWith:aMessage
! !
+!ProtoObject methodsFor:'inspecting'!
+
+inspect
+ "this method is required to allow inspection of the object"
+
+ ^ (Object compiledMethodAt:#inspect)
+ valueWithReceiver:self
+ arguments:nil
+ selector:#inspect
+!
+
+instVarAt:index
+ "this method is required to allow inspection of the object"
+
+ ^ (Object compiledMethodAt:#instVarAt:)
+ valueWithReceiver:self
+ arguments:{index}
+ selector:#instVarAt:
+! !
+
!ProtoObject methodsFor:'queries'!
class
@@ -163,6 +255,10 @@
^ false
!
+isBridgeProxy
+ ^ false
+!
+
isException
^ false
!
@@ -185,6 +281,14 @@
^ false
"Created: / 04-06-2007 / 17:19:10 / cg"
+!
+
+isNil
+ ^ false.
+!
+
+isProtoObject
+ ^ true
! !
!ProtoObject class methodsFor:'documentation'!
--- a/ReadEvalPrintLoop.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ReadEvalPrintLoop.st Fri Dec 09 22:31:28 2016 +0000
@@ -15,8 +15,9 @@
Object subclass:#ReadEvalPrintLoop
instanceVariableNames:'inputStream outputStream errorStream compiler prompt
- doChunkFormat traceFlag timingFlag printFlag exitAction
- currentDirectory'
+ doChunkFormat traceFlag timingFlag profilingFlag printFlag
+ exitAction currentDirectory lastEditedClass lastEditedSelector
+ editorCommand'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -42,20 +43,27 @@
"
A simple read-eval-print loop for non-GUI or stscript operation.
Invoked, for example if stx is started with a --repl argument.
-.
+
A line starting with '?' shows the usage message.
Lines starting with '#' are directives:
- #exit - exit the rep-loop
-
+ #exit - exit the rep-loop
+ type '?' to see more.
+
The input can be in one of two formats:
- 1) traditional chunk format (bang-separated chunks, bangs duplicated)
- this is the traditional fileIn format, as generated by fileOut from the browser
+ 1) traditional chunk format (bang-separated chunks, bangs duplicated)
+ this is the traditional fileIn format, as generated by fileOut from the browser
- 2) interactive line mode. Chunks are any number of lines up to either an empty line or
- a line ending in a period. This is more useful for an interactive REPL, where statements/expressions
- are entered linewise by a user.
+ 2) interactive line mode. Chunks are any number of lines up to either an empty line or
+ a line ending in a period. This is more useful for an interactive REPL, where statements/expressions
+ are entered linewise by a user.
The input can is switched to non-chunk format whenever a line with a '#' in the first column appears.
+
+ Try it (but only if you have a console):
+ Smalltalk readEvalPrintLoop
+
+ [Author:]
+ Claus Gittinger
"
! !
@@ -83,6 +91,27 @@
"Created: / 07-12-2006 / 18:24:04 / cg"
!
+editorCommand
+ |editor|
+
+ (editor := editorCommand) isNil ifTrue:[
+ editor := OperatingSystem getEnvironment:'STX_EDITOR'.
+ editor isNil ifTrue:[
+ editor := OperatingSystem getEnvironment:'EDITOR'.
+ editor isNil ifTrue:[
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ editor := 'notepad'.
+ ] ifFalse:[
+ editor := 'vi'.
+ ].
+ ].
+ ].
+ ].
+ ^ editor
+
+ "Created: / 08-11-2016 / 22:45:22 / cg"
+!
+
error:aStream
"assign an error stream"
@@ -188,6 +217,152 @@
"Created: / 07-12-2006 / 19:04:50 / cg"
!
+cmd_debug:lineStream
+ MiniDebugger enter.
+!
+
+cmd_edit:lineStream
+ "edit a class or selector in an external editor"
+
+ |errStream classOrMethodName cls methodName selector
+ code isNewClass editFullClass tmpFile modifiedTime|
+
+ errStream := self errorStream.
+
+ isNewClass := editFullClass := false.
+
+ lineStream skipSeparators.
+ lineStream atEnd ifTrue:[
+ cls := lastEditedClass.
+ methodName := lastEditedSelector.
+ ] ifFalse:[
+
+ classOrMethodName := lineStream
+ upToElementForWhich:[:ch |
+ ch isLetterOrDigit not and:[ch ~~ $_]
+ ].
+ "/
+ (classOrMethodName isUppercaseFirst) ifTrue:[
+ (cls := Smalltalk classNamed:classOrMethodName) isNil ifTrue:[
+ errStream show:'edit: no such class: ',classOrMethodName,' ; create (y/n)? '.
+ (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
+ isNewClass := true.
+ code :=
+'"/ change the code as required, then save and exit the editor.
+"/ To cancel this edit, leave the editor WITHOUT saving.
+"/
+
+Object
+ subclass:#%1
+ instanceVariableNames:''''
+ classVariableNames:''''
+ poolDictionaries:''''
+ category:''user classes''
+' bindWith:classOrMethodName.
+ ] ifFalse:[
+ lineStream skipSeparators.
+ lineStream atEnd ifFalse:[
+ methodName := lineStream upToSeparator.
+ ].
+ ].
+ ] ifFalse:[
+ methodName := classOrMethodName
+ ].
+ ].
+
+ isNewClass ifFalse:[
+ cls := cls ? lastEditedClass.
+ cls isNil ifTrue:[
+ errStream showCR:'edit usage:'.
+ errStream showCR:' #edit className selector'.
+ errStream showCR:' #edit className '.
+ errStream showCR:' #edit selector (class as in previous edit)'.
+ errStream showCR:' #edit (class/method as in previous edit)'.
+ ^ self.
+ ].
+ lastEditedClass := cls.
+ lastEditedSelector := methodName.
+
+ methodName isNil ifTrue:[
+ editFullClass := true.
+ code := cls source asString
+ ] ifFalse:[
+ ((selector := methodName asSymbolIfInterned) isNil
+ or:[ (cls implements:selector) not]) ifTrue:[
+ errStream show:('"',methodName,'" is a new method; create (y/n)? ').
+ (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
+ code :=
+'"/ change the code as required, then save and exit the editor.
+"/ To cancel this edit, leave the editor WITHOUT saving.
+
+%1
+ "this is a new method"
+ self halt
+' bindWith:methodName.
+ ] ifFalse:[
+ code := (cls compiledMethodAt:selector) source.
+ ].
+ ].
+ ].
+
+ [
+ |ok cmd|
+
+ tmpFile := Filename newTemporary.
+ tmpFile contents:code.
+ modifiedTime := tmpFile modificationTime.
+
+ cmd := '%1 "%2"'.
+ OperatingSystem isUNIXlike ifTrue:[
+ cmd := '%1 "%2" </dev/tty'.
+ ].
+
+ ok := OperatingSystem
+ executeCommand:(cmd bindWith:(self editorCommand) with:tmpFile pathName)
+ inputFrom:Stdin
+ outputTo:Stdout
+ errorTo:Stderr
+ auxFrom:nil
+ environment:nil
+ inDirectory:nil
+ lineWise:false
+ newPgrp:false
+ showWindow:true
+ onError:[:status | false].
+
+ (ok and:[tmpFile modificationTime ~= modifiedTime]) ifTrue:[
+ isNewClass ifTrue:[
+ Compiler evaluate:tmpFile contentsOfEntireFile.
+ errStream showCR:'Class (re)defined.'
+ ] ifFalse:[
+ editFullClass ifTrue:[
+ tmpFile fileIn.
+ errStream showCR:'Class (re)compiled.'
+ ] ifFalse:[
+ cls compile:tmpFile contentsOfEntireFile classified:'*as yet uncategorized'.
+ errStream showCR:'Method (re)compiled.'
+ ].
+ ].
+ ] ifFalse:[
+ errStream showCR:'No change.'
+ ].
+ ] ensure:[
+ tmpFile notNil ifTrue:[
+ tmpFile remove
+ ]
+ ].
+
+ "
+ Smalltalk readEvalPrintLoop
+
+ self new
+ input:Stdin;
+ cmd_edit:'MyClass foo' readStream
+ "
+
+ "Modified: / 08-11-2016 / 22:46:12 / cg"
+!
+
cmd_exit:lineStream
exitAction value
@@ -196,7 +371,7 @@
cmd_help:lineStream
self errorStream
- nextPutAll:
+ nextPutAll:
'Everything entered up to an empty line or a line ending in "." is called a "chunk" and evaluated.
Lines starting with "#" are commands to the read-eval-print interpreter.
@@ -204,75 +379,92 @@
#help ............... this text
#exit ............... exit interpreter loop
#use <package>....... use (load) a package
- stx:libwidg .............. GUI package
- stx:libtool .............. IDE tool package
- stx:goodies/regex ........ regex package
- stx:goodies/petitparser .. peg parser package
+ stx:libwidg .............. GUI package
+ stx:libtool .............. IDE tool package
+ stx:goodies/regex ........ regex package
+ stx:goodies/petitparser .. peg parser package
#read <filename>..... read another script or source file
#show <what> ........ show info
- variables .......... interpreter variables
- processes .......... processes
- memory ............. memory usage
- flags .............. flags
- modules ............ loaded modules
+ variables .......... interpreter variables
+ processes .......... processes
+ memory ............. memory usage
+ flags .............. flags
+ modules ............ loaded modules
+ packages ........... available packages to load
+ all ................ all of the above
#set/clear <flag> ... set or clear a flag
- trace .............. tracing execution
- timing ............. timing execution
- chunkFormat ........ traditional bang chunk format input mode
+ trace .............. tracing execution
+ timing ............. timing execution
+ profiling .......... show execution profile
+ chunkFormat ........ traditional bang chunk format input mode
+ editor ............. command used with #edit directive
+ #debug ................. enter a MiniDebugger
+ #edit <what> ........ open an external editor
+ class .............. on a class
+ class selector ..... on a method
+ <empty> ............ on previously edited method/last class
The MiniDebugger (if entered) shows its own help with "?".
'
"Created: / 07-12-2006 / 18:54:20 / cg"
+ "Modified: / 08-11-2016 / 22:53:53 / cg"
!
cmd_read:lineStream
- |filename newInput savedPrompt savedPrint savedInput savedCurrentDirectory|
+ |filename newInput savedPrompt savedPrint savedInput savedCurrentDirectory savedDoChunkFormat|
lineStream skipSeparators.
filename := lineStream upToEnd withoutSeparators.
filename isNil ifTrue:[
- '? which file?' errorPrintCR.
- ^ self.
+ self errorStream showCR:'? which file?'.
+ ^ self.
].
filename := filename withoutSeparators.
filename isEmpty ifTrue:[
- '? which file?' errorPrintCR.
- ^ self.
+ self errorStream showCR:'? which file?'.
+ ^ self.
].
+ currentDirectory := currentDirectory ? (Filename currentDirectory).
+
filename := filename asFilename.
filename isAbsolute ifFalse:[
- filename := currentDirectory construct:filename.
+ filename := currentDirectory construct:filename.
].
- newInput := filename readStream.
+ StreamError ignoreIn:[
+ newInput := filename readStream.
+ ].
newInput isNil ifTrue:[
- ('Could not find file: "',filename,'"') errorPrintCR.
- ^ self.
+ self errorStream showCR:('Could not find file: "',filename pathName,'"').
+ ^ self.
].
[
- savedCurrentDirectory := currentDirectory.
- savedInput := inputStream.
- savedPrint := printFlag.
- savedPrompt := prompt.
-
- currentDirectory := filename directory.
- inputStream := newInput.
+ savedCurrentDirectory := currentDirectory.
+ savedDoChunkFormat := doChunkFormat.
+ savedInput := inputStream.
+ savedPrint := printFlag.
+ savedPrompt := prompt.
- self
- basicReadEvalPrintLoopWithInput:newInput
- output:outputStream
- error:errorStream
- compiler:compiler
- prompt:false
- print:false.
+ currentDirectory := filename directory.
+ inputStream := newInput.
+
+ self
+ basicReadEvalPrintLoopWithInput:newInput
+ output:outputStream
+ error:errorStream
+ compiler:(compiler ? Compiler ? Parser)
+ prompt:false
+ print:false.
] ensure:[
- currentDirectory := savedCurrentDirectory.
- inputStream := savedInput.
- printFlag := savedPrint.
- prompt := savedPrompt
+ newInput close.
+ doChunkFormat := savedDoChunkFormat.
+ currentDirectory := savedCurrentDirectory.
+ inputStream := savedInput.
+ printFlag := savedPrint.
+ prompt := savedPrompt.
].
!
@@ -288,91 +480,111 @@
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
what notNil ifTrue:[
- (what startsWith:'tra') ifTrue:[
- traceFlag := aBoolean.
- ^ self.
- ].
- (what startsWith:'tim') ifTrue:[
- timingFlag := aBoolean.
- ^ self.
- ].
- (what startsWith:'chunk') ifTrue:[
- doChunkFormat := aBoolean.
- ^ self.
- ].
+ (what startsWith:'tra') ifTrue:[
+ traceFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'tim') ifTrue:[
+ timingFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'pro') ifTrue:[
+ profilingFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'chunk') ifTrue:[
+ doChunkFormat := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'edi') ifTrue:[
+ aBoolean ifTrue:[
+ "/ set editor cmd
+ lineStream skipSeparators.
+ editorCommand := lineStream upToEnd.
+ ] ifFalse:[
+ editorCommand := nil.
+ ].
+ ^ self.
+ ].
].
- self errorStream nextPutLine:'? which flag ?'.
+ self errorStream showCR:'? which flag ?'.
- "Modified: / 07-12-2006 / 19:13:34 / cg"
+ "Modified: / 08-11-2016 / 22:49:17 / cg"
!
cmd_show:lineStream
- |errStream what all printModule|
+ |errStream what showAll ok|
-"
- self basicNew cmd_show:'packages' readStream
-"
errStream := self errorStream.
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
+ ok := false.
+
what notNil ifTrue:[
- (what startsWith:'var') ifTrue:[
- Workspace notNil ifTrue:[
- Workspace workspaceVariables keysAndValuesDo:[:nm :h |
- errStream nextPutAll:nm; nextPutAll:' -> '; nextPutLine:h value.
- ].
- ].
- ^ self.
- ].
- (what startsWith:'proc') ifTrue:[
- MiniDebugger basicNew showProcesses.
- ^ self.
- ].
- (what startsWith:'mod') ifTrue:[
- printModule :=
- [:mod |
- errStream
- nextPutAll:' ';
- nextPutAll:(mod package "libraryName");
- nextPutLine:' (',(mod type),')'.
- ].
+ showAll := (what startsWith:'all').
+
+ (showAll or:[ what startsWith:'var' ]) ifTrue:[
+ showAll ifTrue:[ errStream showCR:'Variables:'; showCR:'----------' ].
+ self showVariables.
+ ok := true.
+ ].
+
+ (showAll or:[ what startsWith:'proc' ]) ifTrue:[
+ showAll ifTrue:[ errStream cr; showCR:'Threads:'; showCR:'--------' ].
+ MiniDebugger basicNew showProcesses.
+ ok := true.
+ ].
+
+ ("showAll or:[" what startsWith:'pack' "]") ifTrue:[
+ showAll ifTrue:[ errStream cr; showCR:'Available Packages:'; showCR:'--------' ].
+ self showPackages.
+ ok := true.
+ ].
+
+ (showAll or:[ what startsWith:'mod' ]) ifTrue:[
+ showAll ifTrue:[ errStream cr; showCR:'Modules:'; showCR:'--------' ].
+ self showModules.
- errStream nextPutLine:'builtIn:'.
- ((ObjectMemory binaryModuleInfo
- reject:[:m | m dynamic])
- asSortedCollection:[:a :b | a name < b name]) do:printModule.
-
- errStream nextPutLine:'dynamic:'.
- ((ObjectMemory binaryModuleInfo
- select:[:m | m dynamic])
- asSortedCollection:[:a :b | a name < b name]) do:printModule.
-
- ^ self.
- ].
- (what startsWith:'mem') ifTrue:[
- all := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
- + ObjectMemory newSpaceUsed.
- errStream
- nextPutLine:('overall: ',(all // 1024) printString,' Kb');
- nextPutLine:('in use : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
- nextPutLine:('free : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
- nextPutLine:('minorGC: ',(ObjectMemory scavengeCount) printString);
- nextPutLine:('majorGC: ',(ObjectMemory garbageCollectCount) printString).
- ^ self.
- ].
- (what startsWith:'flag') ifTrue:[
- errStream
- nextPutLine:('trace : ',traceFlag printString);
- nextPutLine:('timing: ',timingFlag printString);
- nextPutLine:('chunkFormat: ',doChunkFormat printString).
- ^ self.
- ].
+ ok := true.
+ ].
+
+ (showAll or:[ what startsWith:'mem' ]) ifTrue:[
+ |allMem|
+
+ showAll ifTrue:[ errStream cr; showCR:'Memory:'; showCR:'-------' ].
+ "/ allMem := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
+ "/ + ObjectMemory newSpaceUsed.
+ errStream
+ "/ showCR:('overall: ',(allMem // 1024) printString,' Kb');
+ showCR:('used : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
+ showCR:('free : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
+ show:('minorGC: ',(ObjectMemory scavengeCount) printString);
+ showCR:(' majorGC: ',(ObjectMemory garbageCollectCount) printString).
+ ok := true.
+ ].
+
+ (showAll or:[ what startsWith:'flag' ]) ifTrue:[
+ showAll ifTrue:[ errStream cr; showCR:'Flags:'; showCR:'------' ].
+ errStream
+ showCR:('trace : ',(traceFlag ? false) printString);
+ showCR:('timing: ',(timingFlag ? false) printString);
+ showCR:('profiling: ',(profilingFlag ? false) printString);
+ showCR:('chunkFormat: ',(doChunkFormat ? false) printString);
+ showCR:('editor: ',self editorCommand printString).
+ ok := true.
+ ].
].
- errStream nextPutLine:'? show what ?'.
+ ok ifFalse:[
+ errStream showCR:'? show what ?'.
+ ].
+
+ "
+ self basicNew cmd_show:'packages' readStream
+ "
- "Modified: / 07-12-2011 / 22:15:07 / cg"
+ "Modified: / 08-11-2016 / 22:46:51 / cg"
!
cmd_use:lineStream
@@ -381,26 +593,26 @@
lineStream skipSeparators.
pkg := lineStream upToEnd.
pkg isNil ifTrue:[
- '? which package?' errorPrintCR.
- ^ self.
+ self errorStream showCR:'? which package?'.
+ ^ self.
].
pkg := pkg withoutSeparators.
pkg isEmpty ifTrue:[
- '? which package?' errorPrintCR.
- ^ self.
+ self errorStream showCR:'? which package?'.
+ ^ self.
].
[
- Smalltalk loadPackage:pkg.
+ Smalltalk loadPackage:pkg.
] on:PackageLoadError do:[:ex|
- "/ allow for some shortcuts...
- (pkg includes:$:) ifTrue:[
- self errorStream nextPutLine:('Failed to load package: "',pkg,'"').
- ] ifFalse:[
- "/ try stx standard package
- pkg := 'stx:', pkg.
- ex restart.
- ].
+ "/ allow for some shortcuts...
+ (pkg includes:$:) ifTrue:[
+ self errorStream showCR:('Failed to load package: "',pkg,'"').
+ ] ifFalse:[
+ "/ try stx standard package
+ pkg := 'stx:', pkg.
+ ex restart.
+ ].
].
"Created: / 07-12-2006 / 19:07:56 / cg"
@@ -411,22 +623,108 @@
s := line readStream.
s next. "/ skip the hash
+ s peek == $!! ifTrue:[
+ "/ skip shebang line
+ ^ self.
+ ].
s skipSeparators.
cmd := s nextAlphaNumericWord.
cmd notNil ifTrue:[
- self
- perform:('cmd_',cmd) asMutator with:s
- ifNotUnderstood:[
- self errorStream
- nextPutAll:'?? invalid command: ';
- nextPutAll:cmd;
- nextPutAll:'. Type "#help" for help.';
- cr.
- ].
+ AbortAllOperationRequest handle:[:ex |
+ self errorStream showCR:('Directive aborted: ', ex description)
+ ] do:[
+ Error handle:[:ex |
+ self errorStream showCR:('Caught in directive: ', ex description).
+ ex suspendedContext fullPrintAll.
+ ] do:[
+ ControlInterrupt handle:[:ex |
+ MiniDebugger enter.
+ "/ self errorStream showCR:('Ignored in directive: ', ex description).
+ "/ ex reject.
+ "/ ex proceed.
+ ] do:[
+ self
+ perform:('cmd_',cmd) asMutator with:s
+ ifNotUnderstood:[
+ self errorStream
+ show:'?? invalid command: '; show:cmd;
+ showCR:'. Type "#help" for help.'
+ ].
+ ].
+ ].
+ ].
].
"Created: / 07-12-2006 / 18:49:17 / cg"
+ "Modified: / 08-11-2016 / 21:59:16 / cg"
+!
+
+showModules
+ |errStream printModule|
+
+ errStream := self errorStream.
+
+ printModule :=
+ [:mod |
+ errStream
+ show:' ';
+ show:(mod package "libraryName");
+ showCR:' (',(mod type),')'.
+ ].
+
+ errStream nextPutLine:'builtIn:'.
+ ((ObjectMemory binaryModuleInfo
+ reject:[:m | m dynamic])
+ asSortedCollection:[:a :b | a name < b name]) do:printModule.
+
+ errStream nextPutLine:'dynamic:'.
+ ((ObjectMemory binaryModuleInfo
+ select:[:m | m dynamic])
+ asSortedCollection:[:a :b | a name < b name]) do:printModule.
+
+ "
+ ReadEvalPrintLoop basicNew showModules
+ "
+!
+
+showPackages
+ |all|
+
+ all := Set new.
+ Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
+ all add:packageID
+ ].
+ all := all asOrderedCollection sort.
+ all do:[:eachPackage |
+ self errorStream show:eachPackage.
+ (Smalltalk isPackageLoaded:eachPackage) ifTrue:[
+ self errorStream show:' (loaded)'.
+ ].
+ self errorStream cr.
+ ].
+
+ "
+ ReadEvalPrintLoop basicNew showPackages
+ ReadEvalPrintLoop basicNew showModules
+ "
+!
+
+showVariables
+ Workspace notNil ifTrue:[
+ Workspace workspaceVariables keys asOrderedCollection sort do:[:nm |
+ |holder|
+ holder := Workspace workspaceVariables at:nm.
+ self errorStream
+ show:nm;
+ show:' -> ';
+ showCR:holder value printString.
+ ].
+ ].
+
+ "
+ ReadEvalPrintLoop basicNew showVariables
+ "
! !
!ReadEvalPrintLoop methodsFor:'evaluation'!
@@ -440,112 +738,130 @@
for included scripts.
If chunkFormat is true, chunks are read.
Otherwise, lines up to an empty line (or EOF) or a line ending in '.' are read.
- A '#' character appearing in the first column of the first line turns off chunkmode."
+ A '#' character appearing in the first column of the first line turns off chunkmode,
+ which allows for convenient shell scripts containing a #/bin/stx as the first line."
+
+ exitAction := [^ self].
[
- |lines chunk|
+ |lines chunk|
- prompt notNil ifTrue:[
- error nextPutAll:prompt.
- ].
+ prompt notNil ifTrue:[
+ error show:prompt.
+ ].
- input atEnd ifTrue:[
- error cr.
- ^ self.
- ].
+ input atEnd ifTrue:[
+ doPrint ifTrue:[ error cr ].
+ ^ self.
+ ].
- input peek == $# ifTrue:[
- self doChunkFormat:false.
- ].
+ input peek == $# ifTrue:[
+ self doChunkFormat:false.
+ ].
- self doChunkFormat ifTrue:[
- input skipSeparators.
- chunk := input nextChunk.
- ] ifFalse:[
- lines := OrderedCollection new.
- [
- |line|
+ self doChunkFormat ifTrue:[
+ input skipSeparators.
+ chunk := input nextChunk.
+ ] ifFalse:[
+ lines := OrderedCollection new.
+ [
+ |line|
- line := input nextLine.
- line notEmptyOrNil ifTrue:[
- line = '?' ifTrue:[
- self cmd_help:nil.
- prompt notNil ifTrue:[
- error nextPutAll:prompt.
- ].
- ] ifFalse:[
- (line startsWith:'#') ifTrue:[
- self directive:line.
- prompt notNil ifTrue:[
- error nextPutAll:prompt.
- ].
- ] ifFalse:[
- lines add:line.
- ]
- ]
- ].
- line notEmptyOrNil and:[(line endsWith:$.) not].
- ] whileTrue.
- chunk := lines asStringWith:Character cr.
- ].
+ line := input nextLine.
+ line notEmptyOrNil ifTrue:[
+ line = '?' ifTrue:[
+ self cmd_help:nil.
+ prompt notNil ifTrue:[
+ error show:prompt.
+ ].
+ ] ifFalse:[
+ (line startsWith:'#') ifTrue:[
+ self directive:line.
+ prompt notNil ifTrue:[
+ error show:prompt.
+ ].
+ ] ifFalse:[
+ lines add:line.
+ ]
+ ]
+ ].
+ line notEmptyOrNil and:[(line endsWith:$.) not].
+ ] whileTrue.
+ chunk := lines asStringWith:Character cr.
+ ].
- (chunk notEmptyOrNil and:[chunk withoutSeparators notEmpty]) ifTrue:[
- "abortAll is handled, but not asked for here!!"
- AbortAllOperationRequest handle:[:ex |
- error nextPutLine:('Evaluation aborted: ', ex description)
- ] do:[
- (Error, ControlInterrupt) handle:[:ex |
- prompt isNil ifTrue:[
- ex reject
- ].
- MiniDebugger enterWithMessage:(ex errorString) mayProceed:true.
- ex mayProceed ifTrue:[
- ex proceed.
- ].
- error nextPutLine:('Evaluation aborted: ', ex description).
- ex return.
- ] do:[
- |value ms us|
+ (chunk notEmptyOrNil
+ and:[chunk withoutSeparators notEmpty
+ and:[chunk withoutSeparators ~= '.']]
+ ) ifTrue:[
+ "abortAll is handled, but not asked for here!!"
+ AbortAllOperationRequest handle:[:ex |
+ error nextPutLine:('Evaluation aborted: ', ex description)
+ ] do:[
+ (Error, ControlInterrupt) handle:[:ex |
+ prompt isNil ifTrue:[
+ ex reject
+ ].
+ MiniDebugger enterWithMessage:(ex errorString) mayProceed:true.
+ ex mayProceed ifTrue:[
+ ex proceed.
+ ].
+ error showCR:('Evaluation aborted: ', ex description).
+ ex return.
+ ] do:[
+ |value ms us|
- ms := Time millisecondsToRun:[
- us := Time microsecondsToRun:[
- value := (compilerClass new
- requestor:self)
- evaluate:chunk
- compile:true.
- ].
- ].
- doPrint ifTrue:[
- value printOn:output. output cr.
- ].
+ profilingFlag == true ifTrue:[
+ MessageTally spyDetailedOn:[
+ value := (compilerClass new requestor:self)
+ evaluate:chunk
+ compile:true.
+ ].
+ doPrint ifTrue:[
+ value printOn:output. output cr.
+ output flush.
+ ].
+ ] ifFalse:[
+ us := Time microsecondsToRun:[
+ value := (compilerClass new requestor:self)
+ evaluate:chunk compile:true.
+ ].
+ doPrint ifTrue:[
+ value isVoid ifFalse:[
+ value printOn:output. output cr.
+ ].
+ ].
- timingFlag == true ifTrue:[
- 'execution time: ' printOn:error.
- ms < 1 ifTrue:[
- us < 1 ifTrue:[
- 'too small to measure (<1us)' printOn:error.
- ] ifFalse:[
- us printOn:output. 'us' printOn:error.
- ]
- ] ifFalse:[
- ms printOn:output. 'ms' printOn:error.
- ].
- error cr.
- ].
- Workspace notNil ifTrue:[
- Workspace workspaceVariableAt:'_$$' put:value.
- ].
- ].
- ].
- ].
+ timingFlag == true ifTrue:[
+ 'execution time: ' printOn:error.
+ us < 1000 ifTrue:[
+ us < 1 ifTrue:[
+ 'too small to measure (<1us)' printOn:error.
+ ] ifFalse:[
+ us printOn:output. 'us' printOn:error.
+ ]
+ ] ifFalse:[
+ ((us / 1000) asFixedPoint:2) printOn:output. 'ms' printOn:error.
+ ].
+ error cr.
+ ].
+ ].
+ Workspace notNil ifTrue:[
+ Workspace rememberResultAsWorkspaceVariable:value.
+ ].
+ ].
+ ].
+ ].
] loop.
"
+ Smalltalk readEvalPrintLoop.
+
(ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
- "Modified: / 06-12-2011 / 15:29:03 / cg"
+ "Modified: / 08-11-2016 / 22:41:47 / cg"
!
readEvalPrintLoop
@@ -557,35 +873,55 @@
A '#' character appearing in the first column of the first line
switches to chunkmode."
- exitAction := [^ self].
+ ControlInterrupt handle:[:ex |
+ self errorStream showCR:('Caught: ', ex description).
+ self inputStream atEnd ifTrue:[
+ ex return.
+ ].
+ MiniDebugger enter.
+ ex proceed.
+ "/ ex restart.
+ ] do:[
+ |input output error compilerClass|
- ControlInterrupt handle:[:ex |
- self errorStream nextPutLine:('Caught: ', ex description).
- ex restart.
- ] do:[
- |input output error compilerClass|
+ "/ re-evaluate these in the loop, so they can be changed dynamically
+ input := self inputStream.
+ output := self outputStream.
+ error := self errorStream.
- "/ re-evaluate these in the loop, so they can be changed dynamically
- input := self inputStream.
- output := self outputStream.
- error := self errorStream.
-
- compilerClass := compiler ? Compiler ? Parser.
- compilerClass isNil ifTrue:[
- self errorStream nextPutLine:('oops - no Compiler class found').
- ^ self.
- ].
- self
- basicReadEvalPrintLoopWithInput:input output:output error:error
- compiler:compilerClass prompt:prompt print:(printFlag ? true).
- ]
+ compilerClass := compiler ? Compiler ? Parser.
+ compilerClass isNil ifTrue:[
+ error showCR:('oops - no Compiler class found').
+ ^ self.
+ ].
+ StreamError handle:[:ex |
+ (input isOpen not or:[input atEnd]) ifTrue:[
+ error showCR:'EOF on input'.
+ ex return.
+ ].
+ (output isOpen not) ifTrue:[
+ error showCR:'no output'.
+ ].
+ (error isOpen not) ifTrue:[
+ ].
+ ] do:[
+ input signalAtEnd:true.
+ self
+ basicReadEvalPrintLoopWithInput:input output:output error:error
+ compiler:compilerClass prompt:prompt print:(printFlag ? true).
+ ]
+ ].
+ "/ self errorStream showCR:('done.').
"
+ Stdin atEnd
+ Stdin clearEOF
+ Smalltalk readEvalPrintLoop
(ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
- "Modified: / 06-12-2011 / 15:29:03 / cg"
+ "Modified: / 08-11-2016 / 22:42:21 / cg"
! !
!ReadEvalPrintLoop methodsFor:'queries'!
--- a/Rectangle.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Rectangle.st Fri Dec 09 22:31:28 2016 +0000
@@ -821,16 +821,19 @@
l := LayoutFrame new.
l
- leftFraction:(self left);
- rightFraction:(self right);
- topFraction:(self top);
- bottomFraction:(self bottom).
+ leftFraction:(self left);
+ rightFraction:(self right);
+ topFraction:(self top);
+ bottomFraction:(self bottom).
^ l
"
(0.5@0.5 corner:0.75@0.75) asFractionalLayout
(0.5@0.5 corner:0.75@0.75) asOffsetLayout
(0.5@0.5 corner:0.75@0.75) asLayout
+ (0@0 corner:1@1) asLayout
+ (0@0 corner:1@1) asFractionalLayout
+ (0@0 corner:1@1) asOffsetLayout
"
!
--- a/RecursionLock.st Wed Oct 19 09:22:53 2016 +0100
+++ b/RecursionLock.st Fri Dec 09 22:31:28 2016 +0000
@@ -172,7 +172,9 @@
Attention: if asked without some global lock (blockedInterrupts),
the returned value may be outdated right away."
- ^ process notNil and:[Processor activeProcess ~~ process]
+ |p|
+
+ ^ (p := process) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
! !
!RecursionLock methodsFor:'signaling'!
@@ -223,8 +225,9 @@
wasBlocked := OperatingSystem blockInterrupts.
[
(process notNil and:[process isDead]) ifTrue:[
+ process := nil.
'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- process := nil. sema signal.
+ sema signal.
].
gotSema := sema wait.
process := active.
@@ -285,8 +288,9 @@
wasBlocked := OperatingSystem blockInterrupts.
[
(process notNil and:[process isDead]) ifTrue:[
+ process := nil.
'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- process := nil. sema signal.
+ sema signal.
].
gotSema := sema waitWithTimeoutMs:timeoutMs.
gotSema notNil ifTrue:[
@@ -332,8 +336,10 @@
wasBlocked := OperatingSystem blockInterrupts.
(process notNil and:[process isDead]) ifTrue:[
- 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- process := nil. sema signal.
+ "/ a process which had the lock died without a chance to release it (i.e. it was hard terminated)
+ process := nil.
+ 'RecursionLock [info]: cleanup leftover lock from dead process' infoPrintCR.
+ sema signal.
].
sema wait.
process := active.
--- a/Registry.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Registry.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993,2015 by Claus Gittinger
All Rights Reserved
@@ -76,8 +78,7 @@
!Registry methodsFor:'accessing'!
contents
- "return the collection of registered objects.
- Warning: this returns a weak collection."
+ "return the collection of registered objects"
^ self keys.
! !
@@ -146,8 +147,16 @@
!Registry methodsFor:'enumerating'!
detect:aBlock ifNone:exceptionValue
- keyArray validElementsDo:[:obj |
- (obj ~~ DeletedEntry and:[aBlock value:obj]) ifTrue:[^ obj].
+ "detect a key, for which aBlock answers true"
+
+ keyArray validElementsDo:[:eachElement |
+ eachElement ~~ DeletedEntry ifTrue:[
+ |realObject|
+
+ realObject := eachElement.
+ eachElement == NilEntry ifTrue:[realObject := nil].
+ (aBlock value:realObject) ifTrue:[^ realObject].
+ ].
].
^ exceptionValue value
!
@@ -155,12 +164,7 @@
do:aBlock
"evaluate aBlock for each registered object"
- "#keysDo: would not work, since the keyArray instvar may change if
- elements are unregistered while looping."
-
- ^ keyArray validElementsDo:[:each|
- each ~~ DeletedEntry ifTrue:[aBlock value:each].
- ]
+ ^ self keysDo:aBlock.
! !
!Registry methodsFor:'private'!
--- a/SequenceableCollection.st Wed Oct 19 09:22:53 2016 +0100
+++ b/SequenceableCollection.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -205,22 +203,6 @@
(Array new:10) inspect.
(Array withSize:10) inspect.
"
-!
-
-withSize:size
- "return a new collection of size.
- For variable size collections, this is different from #new:,
- in that #new: creates an empty collection with preallocated size,
- while #withSize: creates a non empty one."
-
- ^ (self new:size) grow:size.
-
- "
- (OrderedCollection new:10) inspect.
- (OrderedCollection withSize:10) inspect.
- (Array new:10) inspect.
- (Array withSize:10) inspect.
- "
! !
!SequenceableCollection class methodsFor:'Signal constants'!
@@ -450,6 +432,7 @@
^ self == SequenceableCollection
! !
+
!SequenceableCollection methodsFor:'Compatibility-Squeak'!
allButFirst
@@ -762,6 +745,7 @@
^ self replaceFrom:start to:stop with:anArray startingAt:repStart
! !
+
!SequenceableCollection methodsFor:'accessing'!
after:anObject
@@ -4099,9 +4083,12 @@
"
"
- '123123abc123' copyReplaceAll:$1 withAll:'one'
- #(1 2 3 4 1 2 3 4) copyReplaceAll:1 withAll:'one'
- "
+ '123123abc123' copyReplaceAll:$1 withAll:'one'
+ #(1 2 3 4 1 2 3 4) copyReplaceAll:1 withAll:#(9 9 9)
+ #(1 2 3 4 1 2 3 4) copyReplaceAll:1 withAll:'one'
+ "
+
+ "Modified (comment): / 16-11-2016 / 21:35:36 / cg"
!
copyReplaceAny:collectionOfOldElements with:newElement
@@ -6981,7 +6968,8 @@
s := self species new:size withAll:padElement.
s replaceFrom:(size - len + 1) with:self.
^ s
- ]
+ ].
+ ^ self
"
'foo' leftPaddedTo:10 with:$.
@@ -7874,6 +7862,7 @@
"Created: 14.2.1997 / 16:13:03 / cg"
! !
+
!SequenceableCollection methodsFor:'searching'!
detect:aBlock startingAt:startIndex
@@ -8755,9 +8744,9 @@
!
nextIndexOf:anElement from:start to:stop
- "search the collection for anElement, starting the search at index start,
- stopping at:stop;
- if found, return the index otherwise return 0.
+ "search the collection for anElement,
+ starting the search at index start, stopping at:stop.
+ If found, return the index; otherwise return 0.
The comparison is done using =
(i.e. equality test - not identity test)."
@@ -8787,6 +8776,7 @@
"
"Modified: / 23-09-2011 / 14:03:05 / cg"
+ "Modified (comment): / 19-11-2016 / 13:04:56 / cg"
!
nextIndexOf:anElement from:start to:stop ifAbsent:exceptionBlock
--- a/ShortFloat.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ShortFloat.st Fri Dec 09 22:31:28 2016 +0000
@@ -1359,23 +1359,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
- __END_PROTECT_REGISTERS__
+ __END_PROTECT_REGISTERS__
- if (len < 0) goto fail;
+ if (len < 0) goto fail;
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -1438,7 +1438,7 @@
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
0.1 asShortFloat storeString
@@ -1631,7 +1631,7 @@
#endif
%}.
^ super mantissa
-
+
"
1.0 asShortFloat exponent
1.0 asShortFloat mantissa
--- a/Signal.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Signal.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -42,7 +40,7 @@
"
Note:
The instance based Signal framework is being replaced by class based exceptions.
- I.e. what used to be instances of Signal/QuerySignal is beeing
+ I.e. what used to be instances of Signal/QuerySignal is being
rewritten into subclasses of Exception/Error/Query and Warning.
Although the functionality is basically unchanged, the new
@@ -322,7 +320,16 @@
"answer a new exception object for this signal.
Subclasses may redefine this method"
- ^ Exception basicNew creator:self
+ |exception|
+
+ parent notNil ifTrue:[
+ "parent may be a class based signal"
+ exception := parent newException.
+ ] ifFalse:[
+ exception := Exception basicNew.
+ ].
+
+ ^ exception creator:self
"Created: / 26.2.1998 / 19:53:56 / stefan"
"Modified: / 23.7.1999 / 13:41:00 / stefan"
@@ -850,25 +857,25 @@
Deferring makes sense for some signals, such as UserInterrupt or AbortSignal,
which must occasionally be delayed temporarily until a save place is reached
- (especially when packages are sent across a communication channel, and you dont want
+ (especially when packages are sent across a communication channel, and you don't want
partial packages to be generated by user interruptions)."
|caughtException result|
self handle:[:ex |
- caughtException isNil ifTrue:[
- caughtException := ex.
- ].
- ex proceedWith:nil
+ caughtException isNil ifTrue:[
+ caughtException := ex.
+ ].
+ ex proceedWith:nil
] do:[
- result := aBlock value.
+ result := aBlock value.
].
caughtException notNil ifTrue:[
- caughtException suspendedContext:thisContext.
+ caughtException suspendedContext:thisContext.
- "/ the signal was raised during the execution of aBlock above.
- "/ Raise it now (delayed).
- caughtException raiseSignal
+ "/ the signal was raised during the execution of aBlock above.
+ "/ Raise it now (delayed).
+ caughtException raiseSignal
].
^ result
@@ -877,7 +884,7 @@
s := Signal new mayProceed:true.
s deferAfter:[
- s raiseRequestWith:'hello' errorString:'eeee'
+ s raiseRequestWith:'hello' errorString:'eeee'
]
"
!
--- a/SignalSet.st Wed Oct 19 09:22:53 2016 +0100
+++ b/SignalSet.st Fri Dec 09 22:31:28 2016 +0000
@@ -236,33 +236,33 @@
Deferring makes sense for some signals, such as UserInterrupt or AbortSignal,
which must occasionally be delayed temprarily until a save place is reached
- (especially when packages are sent across a communication channel, and you dont want
+ (especially when packages are sent across a communication channel, and you don't want
partial packages to be generated by user interruptions)."
|caughtException result|
self handle:[:ex |
- caughtException isNil ifTrue:[
- caughtException := ex.
- ].
- ex proceedWith:nil
+ caughtException isNil ifTrue:[
+ caughtException := ex.
+ ].
+ ex proceedWith:nil
] do:[
- result := aBlock value.
+ result := aBlock value.
].
caughtException notNil ifTrue:[
- caughtException suspendedContext:thisContext.
+ caughtException suspendedContext:thisContext.
- "/ a signal was raised during the execution of aBlock above.
- "/ Raise it now (delayed).
- caughtException raiseSignal
+ "/ a signal was raised during the execution of aBlock above.
+ "/ Raise it now (delayed).
+ caughtException raiseSignal
].
^ result
"
(UserInterrupt , AbortOperationRequest) deferAfter:[
- Transcript showCR:'1 - now raising, but will be deferred.'.
- UserInterrupt raiseRequestWith:'hello'.
- Transcript showCR:'2 - after the raise, deferred exception will be handled soon.'.
+ Transcript showCR:'1 - now raising, but will be deferred.'.
+ UserInterrupt raiseRequestWith:'hello'.
+ Transcript showCR:'2 - after the raise, deferred exception will be handled soon.'.
].
Transcript showCR:'3 - here after the protected block.'.
"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SignedIntegerArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,94 @@
+"
+ COPYRIGHT (c) 1997 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 }"
+
+UnboxedIntegerArray variableSignedLongSubclass:#SignedIntegerArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!SignedIntegerArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 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
+"
+ SignedIntegerArrays store 32bit signed integers in the range -16r80000000..16r7FFFFFFF.
+ In contrast to normal arrays (which store pointers to their elements),
+ signedIntegerArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of signed int32's, this is also useful to pass bulk data to c primitive code.
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 4)
+
+ [see also:]
+ ByteArray BooleanArray FloatArray DoubleArray Array
+ SignedWordArray WordArray IntegerArray LongIntegerArray
+ SignedLongIntegerArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!SignedIntegerArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 4 is returned"
+
+ ^ 4
+
+ "Created: / 15-09-2011 / 14:11:46 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For SignedIntegerArrays, this is 2147483647, eg. 16r7FFFFFFF (largest 32bit signed int)"
+
+ ^ 16r7FFFFFFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For SignedIntegerArrays, this is -2147483648 eg. -16r80000000 (smallest 32bit signed int)"
+
+ ^ -16r80000000
+! !
+
+!SignedIntegerArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SignedLongIntegerArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,98 @@
+"
+ COPYRIGHT (c) 1998 by Claus Gittinger / 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 }"
+
+UnboxedIntegerArray variableSignedLongLongSubclass:#SignedLongIntegerArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!SignedLongIntegerArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1998 by Claus Gittinger / 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
+"
+ SignedLongIntegerArrays store 64bit signed integers in the range
+ -16r8000000000000000..16r7FFFFFFFFFFFFFFF.
+ In contrast to normal arrays (which store pointers to their elements),
+ signedLongIntegerArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of signed longlong's, this is also useful to pass bulk data to c primitive code.
+ (the system makes certain, that the first longlong is aligned as required)
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 8)
+
+ [see also:]
+ ByteArray BooleanArray FloatArray DoubleArray Array
+ WordArray SignedWordArray IntegerArray SignedIntegerArray
+ LongIntegerArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!SignedLongIntegerArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 8 is returned"
+
+ ^ 8
+
+ "Created: / 15-09-2011 / 14:11:31 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For SignedLongIntegerArrays, this is 9223372036854775807 eg. 16r7FFFFFFFFFFFFFFF
+ (largest 64bit signed int)"
+
+ ^ 16r7FFFFFFFFFFFFFFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For SignedLongIntegerArrays, this is -9223372036854775808 eg. -16r8000000000000000
+ (smallest 64bit signed int)"
+
+ ^ -16r8000000000000000
+! !
+
+!SignedLongIntegerArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SignedWordArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,105 @@
+"
+ COPYRIGHT (c) 1997 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 }"
+
+UnboxedIntegerArray variableSignedWordSubclass:#SignedWordArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!SignedWordArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 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
+"
+ SignedWordArrays store 16bit signed integers in the range -16r8000..16r7FFF.
+ They are much like WordArrays, but the values stored are signed.
+ In contrast to normal arrays (which store pointers to their elements),
+ signedWordArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of signed int16's, this is also useful to pass bulk data to c primitive code.
+
+ Therefore, SignedWordArrays can be used to hold bulk data in a more compact way.
+ For example:
+ Array new:100000 withAll:1
+ requires 400k of object memory;
+
+ in contrast,
+ SignedWordArray new:100000 withAll:1
+ only requires half of it.
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 2)
+
+ [see also:]
+ ByteArray WordArray BooleanArray FloatArray DoubleArray Array
+ IntegerArray LongIntegerArray SignedLongIntegerArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!SignedWordArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 2 is returned"
+
+ ^ 2
+
+ "Created: / 15-09-2011 / 14:11:18 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For SignedWordArrays, this is 16r7FFF (largest 16bit signed int)"
+
+ ^ 16r7FFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For SignedWordArrays, this is -16r8000 (smallest 16bit signed int)"
+
+ ^ -16r8000
+! !
+
+!SignedWordArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/SmallInteger.st Wed Oct 19 09:22:53 2016 +0100
+++ b/SmallInteger.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -16,10 +14,10 @@
"{ NameSpace: Smalltalk }"
Integer subclass:#SmallInteger
- instanceVariableNames:''
- classVariableNames:'ZeroString'
- poolDictionaries:''
- category:'Magnitude-Numbers'
+ instanceVariableNames:''
+ classVariableNames:'ZeroString'
+ poolDictionaries:''
+ category:'Magnitude-Numbers'
!
!SmallInteger primitiveDefinitions!
@@ -3807,7 +3805,7 @@
/*
* no discussion about those gotos ...
* ... its better for your CPU's pipelines
- * (if you dont understand why, just dont argue).
+ * (if you don't understand why, just don't argue).
*/
interrupted7:
__interruptL(@line); goto continue7;
--- a/Smalltalk.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Smalltalk.st Fri Dec 09 22:31:28 2016 +0000
@@ -20,19 +20,20 @@
StartupArguments CommandLine CommandName CommandLineArguments
CachedAbbreviations VerboseStartup VerboseLoading Verbose
SilentLoading Initializing StandAlone HeadlessOperation IsPlugin
- IsSharedLibraryComponent IsSTScript DebuggingStandAlone Debugging
- LogDoits LoadBinaries RealSystemPath ResourcePath SourcePath
- BinaryPath FileInPath PackagePath BinaryDirName ResourceDirName
- SourceDirName BitmapDirName PackageDirName FileInDirName
- ChangeFileName ImageStartTime ImageRestartTime DemoMode
- SaveEmergencyImage SpecialObjectArray CallbackSignal
- ClassesFailedToInitialize HasNoConsole IgnoreHalt
- PackageToPathMapping IgnoreAssertions'
+ IsSharedLibraryComponent IsSTScript IsRepl DebuggingStandAlone
+ Silent Debugging LogDoits LoadBinaries RealSystemPath
+ ResourcePath SourcePath BinaryPath FileInPath PackagePath
+ BinaryDirName ResourceDirName SourceDirName BitmapDirName
+ PackageDirName FileInDirName ChangeFileName ImageStartTime
+ ImageRestartTime DemoMode SaveEmergencyImage SpecialObjectArray
+ CallbackSignal ClassesFailedToInitialize HasNoConsole IgnoreHalt
+ PackageToPathMapping IgnoreAssertions LanguageModifier
+ LanguageCodeset'
poolDictionaries:''
category:'System-Support'
!
-Smalltalk comment:'documentation'
+Smalltalk comment:''
!
!Smalltalk class methodsFor:'documentation'!
@@ -238,14 +239,14 @@
OrderedCollection initialize.
- Compiler := ByteCodeCompiler.
+ Smalltalk at:#Compiler put:ByteCodeCompiler.
Compiler isNil ifTrue:[
"
ByteCodeCompiler is not in the system (i.e. has not been linked in)
this allows at least immediate evaluations for runtime systems without compiler
NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
"
- Compiler := Parser
+ Smalltalk at:#Compiler put:Parser
].
"/
@@ -533,11 +534,14 @@
PackagePath := OperatingSystem defaultPackagePath.
].
self addWorkspaceDirectoryToPackagePath.
+ self addIdeTopDirectoryToPackagePath.
"
Smalltalk initSystemPath
Smalltalk systemPath
+ SystemPath := nil.
+ PackagePath := nil.
OperatingSystem defaultSystemPath
OperatingSystem defaultPackagePath
"
@@ -642,12 +646,8 @@
CommandLineArguments := CommandLineArguments asOrderedCollection.
CommandName := CommandLineArguments removeFirst. "/ the command
- SilentLoading := false.
- VerboseLoading := false.
- VerboseStartup := false.
- Verbose := false.
- self initializeVerboseFlags.
-
+ SilentLoading := Silent := false.
+ VerboseLoading := VerboseStartup := Verbose := false.
DebuggingStandAlone := Debugging := false.
"/ if no argument was given, look for an environment variable named
@@ -676,30 +676,7 @@
].
].
- idx := CommandLineArguments indexOf:'--debug'.
- Debugging := (idx ~~ 0).
-
- StandAlone ifTrue:[
- InfoPrinting := false.
- ObjectMemory infoPrinting:false.
- IgnoreAssertions := true.
-
- DebuggingStandAlone := Debugging.
- DebuggingStandAlone ifTrue:[
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- IgnoreAssertions := false.
- ].
- ] ifFalse:[
- "/
- "/ define low-level debugging tools - graphical classes are not prepared yet
- "/ to handle things.
- "/ This will bring us into the MiniDebugger when an error occurs during startup.
- "/
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- IgnoreAssertions := false.
- ].
+ self initializeVerboseFlags.
Error handle:[:ex |
StandAlone ifTrue:[
@@ -721,10 +698,30 @@
initializeVerboseFlags
|idx|
+ StandAlone ifTrue:[
+ InfoPrinting := false.
+ ObjectMemory infoPrinting:false.
+ IgnoreAssertions := true.
+ ] ifFalse:[
+ IgnoreAssertions := false.
+ ].
+
(idx := CommandLineArguments indexOf:'--ignoreHalt') ~~ 0 ifTrue:[
IgnoreHalt := true.
CommandLineArguments removeIndex:idx
].
+ (idx := CommandLineArguments indexOf:'--noIgnoreHalt') ~~ 0 ifTrue:[
+ IgnoreHalt := false.
+ CommandLineArguments removeIndex:idx
+ ].
+ (idx := CommandLineArguments indexOf:'--ignoreAssert') ~~ 0 ifTrue:[
+ IgnoreAssertions := true.
+ CommandLineArguments removeIndex:idx
+ ].
+ (idx := CommandLineArguments indexOf:'--noIgnoreAssert') ~~ 0 ifTrue:[
+ IgnoreAssertions := false.
+ CommandLineArguments removeIndex:idx
+ ].
(idx := CommandLineArguments indexOf:'--silentStartup') ~~ 0 ifTrue:[
SilentLoading := true.
CommandLineArguments removeIndex:idx
@@ -738,11 +735,59 @@
VerboseStartup := true.
CommandLineArguments removeIndex:idx
].
+
+ "/ reinterpret those, in case given after the VM options.
+ (idx := CommandLineArguments indexOf:'--debugPrint') ~~ 0 ifTrue:[
+ ObjectMemory debugPrinting:true.
+ CommandLineArguments removeIndex:idx
+ ].
+ (idx := CommandLineArguments indexOf:'--infoPrint') ~~ 0 ifTrue:[
+ ObjectMemory infoPrinting:true.
+ CommandLineArguments removeIndex:idx
+ ].
+
(idx := CommandLineArguments indexOf:'--verbose') ~~ 0 ifTrue:[
+ Object infoPrinting:true.
Verbose := true.
VerboseLoading := true.
VerboseStartup := true.
- CommandLineArguments removeIndex:idx
+ Logger notNil ifTrue:[
+ Logger loggingThreshold: Logger severityALL.
+ ].
+ CommandLineArguments removeIndex:idx.
+ ].
+
+ Silent := false.
+ (idx := CommandLineArguments indexOf:'--silent') ~~ 0 ifTrue:[
+ CommandLineArguments removeIndex:idx.
+ Silent := SilentLoading := true.
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ ObjectMemory debugPrinting:false.
+ Verbose := VerboseLoading := VerboseStartup := false.
+ Logger notNil ifTrue:[
+ Logger loggingThreshold: Logger severityNONE
+ ].
+ ].
+
+ idx := CommandLineArguments indexOf:'--debug'.
+ Debugging := (idx ~~ 0).
+
+ StandAlone ifTrue:[
+ DebuggingStandAlone := Debugging.
+ DebuggingStandAlone ifTrue:[
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ IgnoreAssertions := false.
+ ].
+ ] ifFalse:[
+ "/
+ "/ define low-level debugging tools - graphical classes are not prepared yet
+ "/ to handle things.
+ "/ This will bring us into the MiniDebugger when an error occurs during startup.
+ "/
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
].
!
@@ -968,7 +1013,7 @@
"Created: / 07-02-2012 / 15:57:05 / cg"
! !
-!Smalltalk class methodsFor:'Compatibility-VW5.4'!
+!Smalltalk class methodsFor:'Compatibility-VW'!
defineClass:nameSymbol superclass:superclass indexedType:indexed private:private instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category
^ self
@@ -1010,6 +1055,22 @@
newNameSpace := NameSpace name:nameSymbol.
newNameSpace setCategory:category.
^ newNameSpace
+!
+
+dialectName
+ ^ #SmalltalkX
+
+ "
+ Smalltalk dialectName
+ "
+!
+
+dialectReleaseVersion
+ ^ self versionString
+
+ "
+ Smalltalk dialectReleaseVersion
+ "
! !
!Smalltalk class methodsFor:'accessing'!
@@ -1388,7 +1449,7 @@
self at:sym put:nil. "nil it out for compiled accesses"
"/
- "/ see comment in removeKey: on why we dont remove it here
+ "/ see comment in removeKey: on why we don't remove it here
"/
"/ self removeKey:sym. "/ remove key - this actually fails, if there are
"/ still compiled code references."
@@ -1593,24 +1654,24 @@
i2 := 1.
ns := self.
[i2 ~~ 0] whileTrue:[
- i2 := newName indexOfSubCollection:'::' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- nm := newName copyFrom:i1 to:i2-1.
- ns isNameSpace ifTrue:[
- subns := ns at:nm asSymbol ifAbsent:nil.
- subns isNil ifTrue:[
- self error:'Nonexisting namespace: ',nm.
- ^ nil.
- ].
- ] ifFalse:[
- subns := ns privateClassesAt:nm asSymbol.
- subns isNil ifTrue:[
- self error:'Cannot create a namespace below a class'
- ]
- ].
- ns := subns.
- i1 := i2 + 2.
- ].
+ i2 := newName indexOfSubCollection:'::' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ nm := newName copyFrom:i1 to:i2-1.
+ ns isNameSpace ifTrue:[
+ subns := ns at:nm asSymbol ifAbsent:nil.
+ subns isNil ifTrue:[
+ self error:'Nonexisting namespace: ',nm.
+ ^ nil.
+ ].
+ ] ifFalse:[
+ subns := ns privateClassesAt:nm asSymbol.
+ subns isNil ifTrue:[
+ self error:'Cannot create a namespace below a class'
+ ]
+ ].
+ ns := subns.
+ i1 := i2 + 2.
+ ].
].
oldName := aClass name.
@@ -1621,8 +1682,8 @@
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -1631,42 +1692,42 @@
"/ change the owning class
ns isNameSpace ifFalse:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:ns.
- ] ifFalse:[
- "/ sigh - must make a PrivateMetaclass from Metaclass
- oldMetaclass := aClass class.
- newMetaclass := PrivateMetaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
- newMetaclass setOwningClass:ns.
-
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:ns.
+ ] ifFalse:[
+ "/ sigh - must make a PrivateMetaclass from Metaclass
+ oldMetaclass := aClass class.
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+ newMetaclass setOwningClass:ns.
+
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
] ifTrue:[
- aClass isPrivate ifTrue:[
- newCategory := aClass topOwningClass category.
-
- "/ sigh - must make a Metaclass from PrivateMetaclass
- oldMetaclass := aClass class.
-
- newMetaclass := Metaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
-
- aClass category:newCategory.
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ newCategory := aClass topOwningClass category.
+
+ "/ sigh - must make a Metaclass from PrivateMetaclass
+ oldMetaclass := aClass class.
+
+ newMetaclass := Metaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+
+ aClass category:newCategory.
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
].
aClass setName:newSym.
@@ -1675,7 +1736,7 @@
self at:oldSym put:nil.
"/
- "/ see comment in #removeKey: on why we dont remove it it here
+ "/ see comment in #removeKey: on why we don't remove it it here
"/
"/ self removeKey:oldSym.
self at:newSym put:aClass.
@@ -1686,32 +1747,32 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
- aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1734,85 +1795,85 @@
newNameSpace := aClass topNameSpace.
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- Class withoutUpdatingChangesDo:[
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
-
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ "/ must rename privateClasses as well
+ Class withoutUpdatingChangesDo:[
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
"/ ClassBuilder
"/ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
"/ in:newNameSpace
"/ except:nil.
- ]
- ]
+ ]
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
] ifFalse:[
- "/ all references to a global with my new name in my owning class
- "/ must now be redirected to myself.
-
- aClass isPrivate ifTrue:[
- newBaseName := aClass nameWithoutNameSpacePrefix.
- newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
- ]
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
].
aClass changed:#definition.
"/ because of the change of my superclasses name ...
aClass allSubclassesDo:[:subClass |
- subClass changed:#definition.
+ subClass changed:#definition.
].
"/ because of the change of my superclasses name ...
aClass subclassesDo:[:subClass |
- subClass addChangeRecordForClass:subClass.
+ subClass addChangeRecordForClass:subClass.
].
self changed:#definition.
self changed:#classRename with:(Array with:aClass with:oldName).
@@ -1889,12 +1950,12 @@
exitWithCoreDump
"{ Pragma: +optSpace }"
- "abort program and dump core"
+ "abort the program and dump core"
OperatingSystem exitWithCoreDump
"/ never returns
- "Be careful evaluating this
+ "Be careful evaluating this:
Smalltalk exitWithCoreDump
"
!
@@ -2184,6 +2245,7 @@
!
allKeysDo:aBlock
+ <resource: #obsolete>
"evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
self keysDo:aBlock
@@ -2349,6 +2411,11 @@
|sav|
+ Smalltalk verbose ifTrue:[
+ aBlock value.
+ ^ self.
+ ].
+
sav := SilentLoading.
SilentLoading := true.
aBlock ensure:[ SilentLoading := sav ].
@@ -3633,22 +3700,6 @@
!Smalltalk class methodsFor:'queries-system'!
-dialectName
- ^ #SmalltalkX
-
- "
- Smalltalk dialectName
- "
-!
-
-dialectReleaseVersion
- ^ self versionString
-
- "
- Smalltalk dialectReleaseVersion
- "
-!
-
isAmber
"is this an Amber Smalltalk system ?
Return false here - this may be useful to write portable
@@ -3809,6 +3860,23 @@
"Modified: / 11-09-2010 / 14:06:59 / cg"
!
+defineCommandLineAsWorkspaceVariablesForScripts
+ "/ enable this, so we can provide _$1.._$n in the script
+ ParserFlags allowUnderscoreInIdentifier:true.
+ ParserFlags allowDollarInIdentifier:true.
+ ParserFlags warnDollarInIdentifier:false.
+ ParserFlags warnUnderscoreInIdentifier:false.
+ ParserFlags allowOldStyleAssignment:false.
+
+ "/ add bindings for arguments
+ Workspace workspaceVariableAt:('_$0') put:CommandName.
+ Workspace workspaceVariableAt:('_$n') put:CommandLineArguments size.
+ Workspace workspaceVariableAt:('_$$') put:CommandLineArguments.
+ CommandLineArguments doWithIndex:[:arg :i |
+ Workspace workspaceVariableAt:('_$',i printString) put:arg.
+ ].
+!
+
displayInitializationDone
"inform the restart, that the display has been initialized"
@@ -3847,6 +3915,18 @@
%}
!
+lateOpenDisplay
+ "this is called when a view is opened without a display being already opened."
+
+ Smalltalk openDisplay.
+ Display notNil ifTrue:[
+ IsRepl ifFalse:[
+ Display exitOnLastClose:true.
+ ].
+ "/ Processor exitWhenNoMoreUserProcesses:true.
+ ].
+!
+
mainStartup:graphicalMode
"common start/restart action, if there is a Display, initialize it
and start dispatching; otherwise go into a read-eval-print loop."
@@ -3973,10 +4053,10 @@
self fileIn:(imageName , '.rc')
].
-"/ Display notNil ifTrue:[
-"/ Display exitOnLastClose:true.
-"/ ].
-"/ Processor exitWhenNoMoreUserProcesses:true.
+ Display notNil ifTrue:[
+ Display exitOnLastClose:true.
+ ].
+ Processor exitWhenNoMoreUserProcesses:true.
process := [
'Smalltalk [info]: startup process 2 active.' infoPrintCR.
@@ -4005,7 +4085,7 @@
"/ "/ GUI apps exit after the last user process has finished
"/ "/
"/ Display exitOnLastClose:true.
-"/ Processor exitWhenNoMoreUserProcesses:true.
+ Processor exitWhenNoMoreUserProcesses:true.
] newProcess.
process priority:(Processor userSchedulingPriority).
process name:'main'.
@@ -4022,9 +4102,9 @@
].
].
- Display notNil ifTrue:[
- Display exitOnLastClose:true.
- ].
+"/ Display notNil ifTrue:[
+"/ Display exitOnLastClose:true.
+"/ ].
"
if view-classes exist, start dispatching;
otherwise go into a read-eval-print loop
@@ -4032,14 +4112,15 @@
((Display notNil and:[graphicalMode])
or:[process notNil
or:[HeadlessOperation
- or:[StandAlone]]]) ifTrue:[
+ or:[StandAlone]]]
+ ) ifTrue:[
Processor exitWhenNoMoreUserProcesses:true.
Processor dispatchLoop.
"done - the last process finished"
'Smalltalk [info]: last process finished - exit.' infoPrintCR.
] ifFalse:[
StandAlone ifFalse:[
- self readEvalPrint
+ self readEvalPrintLoop
]
].
@@ -4089,7 +4170,17 @@
"Created: / 06-12-2006 / 15:38:17 / cg"
!
-readEvalPrint
+providingDisplayDo:aBlock
+ "/ provide a Display, if needed
+ (Smalltalk at:#Screen) currentScreenQuerySignal handle:[:ex |
+ Display isNil ifTrue:[ self lateOpenDisplay ].
+ ex proceedWith:Display.
+ ] do:aBlock
+!
+
+readEvalPrintLoop
+ "say hello, then go into a read-eval-print loop"
+
"{ Pragma: +optSpace }"
Transcript showCR:(self hello).
@@ -4098,10 +4189,10 @@
Transcript showCR:'Read-eval-print loop; exit with "#exit"; help with "?"'.
ReadEvalPrintLoop new
- prompt:'ST> ';
- doChunkFormat:false;
- error:Stderr;
- readEvalPrintLoop
+ prompt:'ST> ';
+ doChunkFormat:false;
+ error:Stderr;
+ readEvalPrintLoop
"Modified: / 07-12-2006 / 17:35:19 / cg"
!
@@ -4341,8 +4432,19 @@
!
start
- "main startup, if there is a Display, initialize it
- and start dispatching; otherwise go into a read-eval-print loop."
+ "low level entry from the VM's main.
+ After initializeSystem, this is the very first real entry into the Smalltalk world.
+ Analyzes the command line and checks what to do
+ (i.e. script/repl/eval or full blown IDE).
+ Also handles --load and various debug options.
+ Caveat:
+ this has become too complicated and desperately needs a rewrite.
+
+ Also:
+ Be very careful when changing things here;
+ especially be careful to ensure that the scripting options are robust against any
+ missing packages; so the error handlers should not depend on any stream, logger etc. features.
+ "
|idx graphicalMode arg didReadRCFile keepSplashWindow|
@@ -4350,31 +4452,32 @@
Initializing := true.
keepSplashWindow := StartupClass perform:#keepSplashWindowOpen ifNotUnderstood:[false].
-"/ now done AFTER reading smalltalk.rc
-"/ keepSplashWindow ifFalse:[
-"/ self hideSplashWindow. "/ if there is one, it's now time to hide it
-"/ ].
+
+ idx := CommandLineArguments indexOf:'--debug'.
+ (idx ~~ 0) ifTrue:[
+ CommandLineArguments removeAtIndex:idx.
+ ].
"
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |commandFile defaultRC prevCatchSetting
- isEval isPrint isFilter isRepl idxFileArg process|
-
- isEval := isPrint := isFilter := isRepl := false.
+ |commandFiles rcFile defaultRC prevCatchSetting
+ isEval isPrint isFilter isRepl isRunMain idxFileArg process|
+
+ isEval := isPrint := isFilter := isRepl := isRunMain := false.
didReadRCFile := false.
StandAlone ifFalse:[
- self initializeVerboseFlags.
-
+ "/ self initializeVerboseFlags.
+
"/
"/ look for any '-q', '-e', '-l' or '-f' command line arguments
"/ and handle them;
"/ read startup and patches file
"/
idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- isRepl := (idx ~~ 0).
+ isRepl := IsRepl := (idx ~~ 0).
idx := CommandLineArguments indexOfAny:#('-q' '--silent').
idx ~~ 0 ifTrue:[
@@ -4390,9 +4493,11 @@
] whileTrue:[
arg := CommandLineArguments at:idx + 1.
CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- self packagePath addLast:arg.
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
+ (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
+ self packagePath addLast:each.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
+ ].
].
].
@@ -4402,14 +4507,24 @@
] whileTrue:[
arg := CommandLineArguments at:idx + 1.
CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- arg asFilename exists ifTrue:[
- Smalltalk fileIn:arg
- ] ifFalse:[
- Smalltalk loadPackage:arg
+ Smalltalk silentlyLoadingDo:[
+ (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
+ each asFilename exists ifTrue:[
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: loading file: "', each, '".') infoPrintCR.
+ ].
+ Smalltalk fileIn:each
+ ] ifFalse:[
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: loading package: "', each, '".') infoPrintCR.
+ ].
+ Smalltalk loadPackage:each
+ ].
+ ].
].
].
- "/ look for a '-e filename' or '--execute filename' argument
+ "/ look for a '-e filename' or '--execute filename' or '--script filename' argument
"/ this will force fileIn of filename only, no standard startup.
idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
@@ -4425,38 +4540,68 @@
Initializing := false.
process := [
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
- ].
- UserInterrupt handle:[:ex |
- Debugging == true ifTrue:[
- 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
- "/ thisContext fullPrintAll.
- MiniDebugger enter.
- ex proceed.
- ].
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- arg = '-' ifTrue:[
- self fileInStream:Stdin
- lazy:nil
- silent:nil
- logged:false
- addPath:nil
- ] ifFalse:[
- IsSTScript := true.
- self fileIn:arg.
+ Processor exitWhenNoMoreUserProcesses:true.
+
+ "/ set workspace variables
+ self defineCommandLineAsWorkspaceVariablesForScripts.
+
+ "/ provide a Display, if needed
+ self providingDisplayDo:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
+ ].
+ NoHandlerError handle:[:ex |
+ Debugging == true ifTrue:[
+ MiniDebugger enterException:ex.
+ ] ifFalse:[
+ Silent ifFalse:[
+ 'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
+ ].
+ (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
+ ex suspendedContext fullPrintAll.
+ ].
+ self exit:1.
+ ].
+ self exit:1.
+ "/ ex reject.
+ ] do:[
+ UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enterException:ex.
+ ex proceed.
+ ].
+ Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ arg = '-' ifTrue:[
+ self fileInStream:Stdin
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil
+ ] ifFalse:[
+ IsSTScript := true.
+ Smalltalk silentlyLoadingDo:[
+ self fileIn:arg.
+ ].
+ ].
+ ].
].
].
+
"/ after the script, if Screen has been opened and there are any open windows,
"/ then do not exit
+false ifTrue:[
Display notNil ifTrue:[
- Display exitOnLastClose:true.
- Display checkForEndOfDispatch.
Processor exitWhenNoMoreUserProcesses:true.
+ "/ Display exitOnLastClose:true.
+ "/ Display checkForEndOfDispatch.
] ifFalse:[
self exit.
].
+].
] newProcess.
process priority:(Processor userSchedulingPriority).
process name:'main'.
@@ -4468,11 +4613,14 @@
].
"look for a '-f filename' or '--file filename' argument
- if scripting, this is loaded before -P, -E or -R action.
+ if scripting, these are loaded before -P, -E or -R action.
if not scripting, this will force evaluation of filename instead of smalltalk.rc"
- idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
- (idxFileArg ~~ 0) ifTrue:[
- commandFile := CommandLineArguments at:idxFileArg+1.
+ [
+ idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
+ (idxFileArg ~~ 0)
+ ] whileTrue:[
+ commandFiles isNil ifTrue:[ commandFiles := OrderedCollection new ].
+ commandFiles add:(CommandLineArguments at:idxFileArg+1).
CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
].
@@ -4487,128 +4635,243 @@
idx := CommandLineArguments indexOfAny:#('-F' '--filter').
(isFilter := (idx ~~ 0)) ifFalse:[
idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- isRepl := (idx ~~ 0)
+ (isRepl := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('--run').
+ isRunMain := (idx ~~ 0)
+ ].
].
].
].
- (isEval | isPrint | isFilter | isRepl) ifTrue:[
+ (isEval | isPrint | isFilter | isRepl | isRunMain) ifTrue:[
+ |args|
+
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval/filter/print or repl') infoPrintCR.
+ ].
isRepl ifFalse:[
CommandLineArguments size <= idx ifTrue:[
- 'stx: missing argument after -E/-P/-F' errorPrintCR.
- self exit:1.
+ StandAlone := true.
+ self exitWithErrorMessage:'missing argument after -E/-P/-F/--run.'.
].
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1.
+ isFilter ifTrue:[
+ args := CommandLineArguments copyFrom:idx + 1.
+ CommandLineArguments removeFromIndex:idx+1.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: filter expression(s): ') infoPrint.
+ args infoPrintCR.
+ ].
+ ] ifFalse:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval expression: ') infoPrint.
+ arg infoPrintCR.
+ ].
+ ].
].
CommandLineArguments removeAtIndex:idx.
self startSchedulerAndBackgroundCollector.
+
keepSplashWindow ifFalse:[ self hideSplashWindow ].
Initializing := false.
- "/ enable this, so we can provide $1..$n in the script
- ParserFlags allowDollarInIdentifier:true.
- ParserFlags warnDollarInIdentifier:false.
-
- "/ add bindings for arguments
- CommandLineArguments doWithIndex:[:arg :i |
- Workspace workspaceVariableAt:('_$',i printString) put:arg.
- ].
+ "/ set workspace variables
+ self defineCommandLineAsWorkspaceVariablesForScripts.
"/ all of the above allow for a -f file to be loaded before any other action
- (commandFile notNil) ifTrue:[
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
- ].
- (self secureFileIn:commandFile) ifFalse:[
- ('Smalltalk [error]: "', commandFile, '" not found.') errorPrintCR.
- OperatingSystem exit:1.
+ (commandFiles notEmptyOrNil) ifTrue:[
+ commandFiles do:[:commandFile |
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
+ ].
+ Smalltalk silentlyLoadingDo:[
+ (self secureFileIn:commandFile) ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:('"', commandFile, '" not found.').
+ ]
+ ]
]
].
- isRepl ifTrue:[
- self readEvalPrint.
- self exit.
+ isRepl ifFalse:[
+ Debugging == true ifFalse:[
+ "/ remove the Debugger
+ Debugger := nil.
+ ].
].
process := [
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: executing expression: "', arg, '".') infoPrintCR.
- ].
- UserInterrupt handle:[:ex |
- Debugging == true ifTrue:[
- 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
- "/ thisContext fullPrintAll.
- MiniDebugger enter.
- ex proceed.
- ].
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- isFilter ifTrue:[
- "/ --filter - apply code to each input line.
- "/ compile code only once
- Compiler
- compile:'doIt:line ',arg
- forClass:String
- notifying:(EvalScriptingErrorHandler new source:arg).
-
- [Stdin atEnd] whileFalse:[
- |line|
-
- line := Stdin nextLine.
- line doIt:line.
+ self providingDisplayDo:[
+ isRepl ifTrue:[
+ Processor exitWhenNoMoreUserProcesses:false.
+ Processor activeProcess name:'repl'.
+ self readEvalPrintLoop.
+ self exit.
+ ].
+
+ Processor exitWhenNoMoreUserProcesses:true.
+
+ NoHandlerError handle:[:ex |
+ Debugging == true ifTrue:[
+ MiniDebugger enterException:ex.
+ ] ifFalse:[
+ Silent ifFalse:[
+ 'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
+ ].
+ (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
+ ex suspendedContext fullPrintAll.
+ ].
+ self exit:1.
].
- ] ifFalse:[
- "/ --print or --eval
- |rslt|
-
- rslt := Parser new
- evaluate:arg
- notifying:(EvalScriptingErrorHandler new source:arg)
- compile:true.
- isPrint ifTrue:[
- rslt printCR.
+ self exit:1.
+ "/ ex reject.
+ ] do:[
+ UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enterException:ex.
+ ex proceed.
+ ].
+ Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ |filterCode filterStart filterEnd|
+
+ isFilter ifTrue:[
+ "/ --filter - apply code to each input line.
+ "/ compile code only once
+ (args size == 1) ifTrue:[
+ VerboseStartup ifTrue:[
+ 'Smalltalk [info]: filter 1-arg' infoPrintCR.
+ ].
+ filterCode := args at:1.
+ ] ifFalse:[
+ (args size == 3) ifTrue:[
+ VerboseStartup ifTrue:[
+ 'Smalltalk [info]: filter 3-arg' infoPrintCR.
+ ].
+ filterStart := args at:1.
+ filterCode := args at:2.
+ filterEnd := args at:3.
+ ] ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:'--filter must be followed by 1 or 3 expression arg(s)'
+ ].
+ ].
+ filterStart notEmptyOrNil ifTrue:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval: "', filterStart, '"...') infoPrintCR.
+ ].
+ Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
+ ].
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: compile: "', filterCode, '"...') infoPrintCR.
+ ].
+ Compiler
+ compile:'doIt:line ',filterCode
+ forClass:String
+ notifying:(EvalScriptingErrorHandler new source:filterCode).
+
+ [Stdin atEnd] whileFalse:[
+ |line|
+
+ line := Stdin nextLine.
+ line doIt:line.
+ ].
+ filterEnd notEmptyOrNil ifTrue:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval: "', filterEnd, '"...') infoPrintCR.
+ ].
+ Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
+ ].
+ ] ifFalse:[
+ (isPrint | isEval) ifTrue:[
+ "/ --print or --eval
+ |rslt|
+
+ rslt := Parser new
+ evaluate:arg
+ notifying:(EvalScriptingErrorHandler new source:arg)
+ compile:true.
+ isPrint ifTrue:[
+ rslt printCR.
+ ].
+ ] ifFalse:[
+ "/ --run <className>
+ |className class|
+
+ className := arg.
+ class := Smalltalk classNamed:className.
+ class isNil ifTrue:[
+ StandAlone := true.
+ self exitWithErrorMessage:'no such class: "', className, '".'
+ ].
+ (class respondsTo:#main:) ifTrue:[
+ class main:CommandLineArguments.
+ ] ifFalse:[
+ (class respondsTo:#main) ifTrue:[
+ class main.
+ ] ifFalse:[
+ (class respondsTo:#start) ifTrue:[
+ class start.
+ ] ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:'class has no "main:", "main" or "start" method.'
+ ].
+ ].
+ ].
+ ].
+ ].
].
].
].
-
+
"/ after the script, if Screen has been opened and there are any open windows,
"/ then do not exit
+false ifTrue:[
Display notNil ifTrue:[
- Display exitOnLastClose:true.
- Display checkForEndOfDispatch.
Processor exitWhenNoMoreUserProcesses:true.
- VerboseStartup == true ifTrue:[
+ "/ Display exitOnLastClose:true.
+ "/ Display checkForEndOfDispatch.
+ VerboseStartup ifTrue:[
('Smalltalk [info]: display opened.') infoPrintCR.
].
] ifFalse:[
- VerboseStartup == true ifTrue:[
+ VerboseStartup ifTrue:[
('Smalltalk [info]: no display - exit after script.') infoPrintCR.
].
self exit.
].
- ] newProcess.
+].
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: script/repl/eval finished.') infoPrintCR.
+ ].
+
+ ] newProcess.
process priority:(Processor userSchedulingPriority).
process name:'main'.
process beGroupLeader.
process resume.
Processor dispatchLoop.
- VerboseStartup == true ifTrue:[
+ VerboseStartup ifTrue:[
('Smalltalk [info]: exit normally.') infoPrintCR.
].
self exit
].
].
- commandFile notNil ifTrue:[
+ commandFiles notNil ifTrue:[
SilentLoading := true. "/ suppress the hello & copyright messages
self addStartBlock:
[
- (self secureFileIn:commandFile) ifFalse:[
- ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
- OperatingSystem exit:1.
+ commandFiles do:[:commandFile |
+ (self secureFileIn:commandFile) ifFalse:[
+ self exitWithErrorMessage:('startup file "', commandFile, '" not found.').
+ ].
].
].
@@ -4624,8 +4887,8 @@
"/ look for <command>.rc
"/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
- commandFile := self commandName asFilename withSuffix:'rc'.
- (didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
+ rcFile := self commandName asFilename withSuffix:'rc'.
+ (didReadRCFile := rcFile exists and:[self secureFileIn:rcFile]) ifFalse:[
StandAlone ifFalse:[
defaultRC := 'smalltalk.rc' "/asFilename
] ifTrue:[
@@ -4867,6 +5130,11 @@
"
self exitOrError:0
"
+!
+
+exitWithErrorMessage:msg
+ ('Smalltalk [error]: ',msg) errorPrintCR.
+ self exitOrError:1
! !
!Smalltalk class methodsFor:'startup queries'!
@@ -5173,6 +5441,14 @@
"Created: / 16-01-2011 / 10:19:42 / cg"
!
+languageCodeset
+ ^ LanguageCodeset
+!
+
+languageModifier
+ ^ LanguageModifier
+!
+
languageTerritory
"return the language territory setting"
@@ -5226,7 +5502,7 @@
incremental compiled methods.
Therefore, only those sources which are not coming from compiled
methods are put into the 'st.src' file - all others are untouched.
- This is being automated - so dont care for now."
+ This is being automated - so don't care for now."
|newStream table source pos fileName|
@@ -5239,26 +5515,26 @@
table := IdentityDictionary new:100.
Method allSubInstancesDo:[:aMethod |
- source := nil.
- aMethod sourcePosition notNil ifTrue:[
- aMethod sourceFilename = 'st.src' ifTrue:[
- source := aMethod source.
- ]
- ] ifFalse:[
- source := aMethod source
- ].
-
- source notNil ifTrue:[
- pos := newStream position + 1.
- newStream nextChunkPut:source.
-
- "
- dont change the methods info - maybe some write error
- occurs later, in that case we abort and leave everything
- untouched.
- "
- table at:aMethod put:pos
- ]
+ source := nil.
+ aMethod sourcePosition notNil ifTrue:[
+ aMethod sourceFilename = 'st.src' ifTrue:[
+ source := aMethod source.
+ ]
+ ] ifFalse:[
+ source := aMethod source
+ ].
+
+ source notNil ifTrue:[
+ pos := newStream position + 1.
+ newStream nextChunkPut:source.
+
+ "
+ dont change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
].
newStream syncData; close.
@@ -5273,7 +5549,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -5301,18 +5577,18 @@
table := IdentityDictionary new:100.
Method allSubInstancesDo:[:aMethod |
- source := aMethod source.
- source notNil ifTrue:[
- pos := newStream position + 1.
- newStream nextChunkPut:source.
-
- "
- dont change the methods info - maybe some write error
- occurs later, in that case we abort and leave everything
- untouched.
- "
- table at:aMethod put:pos
- ]
+ source := aMethod source.
+ source notNil ifTrue:[
+ pos := newStream position + 1.
+ newStream nextChunkPut:source.
+
+ "
+ don't change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
].
newStream syncData; close.
@@ -5327,7 +5603,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -6802,6 +7078,36 @@
!Smalltalk class methodsFor:'system management-files'!
+addIdeTopDirectoryToPackagePath
+ "{ Pragma: +optSpace }"
+
+ |topDirectory|
+
+ (topDirectory := OperatingSystem pathOfSTXExecutable) notNil ifTrue:[
+ topDirectory := topDirectory asFilename.
+ (topDirectory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory.
+ ] ifFalse:[
+ (topDirectory directory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory directory.
+ ] ifFalse:[
+ (topDirectory directory directory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory directory directory.
+ ] ifFalse:[
+ topDirectory := nil
+ ].
+ ].
+ ].
+ topDirectory notNil ifTrue:[
+ "/ one above "stx"
+ topDirectory := topDirectory directory pathName.
+ (PackagePath includes:topDirectory) ifFalse:[
+ PackagePath add:topDirectory
+ ]
+ ]
+ ].
+!
+
addWorkspaceDirectoryToPackagePath
"{ Pragma: +optSpace }"
@@ -6809,7 +7115,10 @@
(workspaceDirectory := UserPreferences current workspaceDirectory) notNil ifTrue:[
(workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
- PackagePath addFirst:workspaceDirectory
+ workspaceDirectory := workspaceDirectory pathName.
+ (PackagePath includes:workspaceDirectory) ifFalse:[
+ PackagePath addFirst:workspaceDirectory
+ ]
]
].
!
@@ -7426,23 +7735,23 @@
fn := aFileNameOrString asFilename.
nameString := fn name.
fn isAbsolute ifTrue:[
- "dont use path for absolute file names"
-
- ^ nameString
+ "don't use path for absolute file names"
+
+ ^ nameString
].
self realSystemPath do:[:dirName |
- |realName|
-
- realName := dirName asFilename / nameString.
- "/
- "/ here, we also return true if its a directory
- "/ (Even if unreadable).
- "/ It could be that the file itself is still readable.
- "/
- (realName isDirectory or:[realName isReadable]) ifTrue: [
- ^ realName name
- ]
+ |realName|
+
+ realName := dirName asFilename / nameString.
+ "/
+ "/ here, we also return true if its a directory
+ "/ (Even if unreadable).
+ "/ It could be that the file itself is still readable.
+ "/
+ (realName isDirectory or:[realName isReadable]) ifTrue: [
+ ^ realName name
+ ]
].
^ nil
@@ -7583,7 +7892,7 @@
Notice, that directories named 'packages' under the systemPath are
always consulted - even if not in the packagePath"
- ^ PackagePath
+ ^ PackagePath ? #()
"
Smalltalk packagePath
@@ -7871,26 +8180,26 @@
((f := aFileName asFilename) isAbsolute
or:[f isExplicitRelative]) ifTrue:[
- "/
- "/ dont use path for absolute or explicit .-relative file names
- "/
- ^ aFileName
+ "/
+ "/ don't use path for absolute or explicit .-relative file names
+ "/
+ ^ aFileName
].
aPath notNil ifTrue:[
- aPath do:[:dirName |
- |realName dir|
-
- dir := dirName asFilename.
- aDirName notNil ifTrue:[
- realName := dir / aDirName / aFileName.
- ] ifFalse:[
- realName := dir / aFileName.
- ].
- (realName isReadable) ifTrue:[
- ^ realName name
- ]
- ].
+ aPath do:[:dirName |
+ |realName dir|
+
+ dir := dirName asFilename.
+ aDirName notNil ifTrue:[
+ realName := dir / aDirName / aFileName.
+ ] ifFalse:[
+ realName := dir / aFileName.
+ ].
+ (realName isReadable) ifTrue:[
+ ^ realName name
+ ]
+ ].
].
"/ not needed - executing dir is always in SearchPath
@@ -8050,7 +8359,7 @@
(usually in subdirs such as resources, bitmaps, source etc.)
see comment in Smalltalk>>initSystemPath."
- ^ SystemPath
+ ^ SystemPath ? #()
"
Smalltalk systemPath
@@ -8145,6 +8454,69 @@
"
!
+knownLoadablePackagesDo:aBlock
+ "enumerate loadable packages from the packages folder."
+
+ Smalltalk realSystemPath do:[:dirName |
+ |packageDir|
+
+ packageDir := dirName asFilename / 'packages'.
+ (packageDir exists and:[packageDir isDirectory]) ifTrue:[
+ packageDir directoryContentsAsFilenames sort do:[:fn |
+ |item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded
+ defClass target type nameComponents packageName packageID|
+
+ ((fn suffix = 'mcz')
+ or:[ fn isDirectory
+ or:[ (fn baseName startsWith:'.')
+ or:[ (fn baseName = 'README') ]]]) ifFalse:[
+ base := fn withoutSuffix baseName.
+ (base startsWith:'lib') ifTrue:[
+ nm := (base copyFrom:4).
+ fn suffix notEmptyOrNil ifTrue:[
+ type := #library.
+ ] ifFalse:[
+ type := #application.
+ ]
+ ] ifFalse:[
+ nm := base.
+ type := #application.
+ ].
+
+ (base ~= 'librun') ifTrue:[
+ (fn suffix = 'mcz') ifTrue:[
+ packageName := fn withoutSuffix.
+ target := fn.
+ ] ifFalse:[
+ ( #('dll' 'so' 'sl' 'dylib') includes:(fn suffix)) ifTrue:[
+ (base startsWith:'lib') ifTrue:[
+ nm := base copyFrom:4.
+ ] ifFalse:[
+ nm := base.
+ ].
+ ].
+ nameComponents := nm asCollectionOfSubstringsSeparatedBy:$_.
+ packageName := nameComponents first.
+ nameComponents size > 1 ifTrue:[
+ packageName := packageName,':',((nameComponents from:2) asStringWith:'/')
+ ].
+ ].
+ packageName notNil ifTrue:[
+ aBlock value:packageName value:type value:fn .
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+
+ "
+ Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
+ Transcript showCR:'%1 (%2) in %3' with:packageID with:type with:path.
+ ]
+ "
+!
+
loadPackage:aPackageIdOrPackage
"make certain, that some particular package is loaded into the system.
Return true if loaded, false otherwise."
@@ -8194,11 +8566,11 @@
projectDefinition := aPackageIdOrPackage.
projectDefinition isProjectDefinition ifFalse:[
- projectDefinition := projectDefinition asPackageId projectDefinitionClass.
- projectDefinition isNil ifTrue:[
- 'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
- ^ self.
- ].
+ projectDefinition := projectDefinition asPackageId projectDefinitionClass.
+ projectDefinition isNil ifTrue:[
+ Logger warning:'trying to unload non-existing package: %1' with:aPackageIdOrPackage.
+ ^ self.
+ ].
].
projectDefinition unloadPackage.
--- a/SmalltalkChunkFileSourceWriter.st Wed Oct 19 09:22:53 2016 +0100
+++ b/SmalltalkChunkFileSourceWriter.st Fri Dec 09 22:31:28 2016 +0000
@@ -69,46 +69,50 @@
|s|
self obsoleteMethodWarning:'use codeGenerator'.
- s := (TextStream ? WriteStream) on:''.
- s nextPutAll:
-'message "selector and argument names"
- "comment stating purpose of this message"
-
- |temporaries|
-
- "statement."
- "statement."
+ ^ SmalltalkLanguage instance methodTemplate.
- "
- optional: comment giving example use
- "
-'.
- s cr.
- s emphasis:(UserPreferences current commentEmphasisAndColor).
- s nextPutAll:
-'"
- change the above template into real code;
- remove this comment.
- Then `accept'' either via the menu
- or via the keyboard (usually CMD-A).
+"/ s := (TextStream ? WriteStream) on:''.
+"/ s nextPutAll:
+"/'message "selector and argument names"
+"/ "comment stating purpose of this message"
+"/
+"/ |temporaries|
+"/
+"/ "statement."
+"/ "statement."
+"/
+"/ "
+"/ optional: comment giving example use
+"/ "
+"/'.
+"/ s cr.
+"/ s emphasis:(UserPreferences current commentEmphasisAndColor).
+"/ s nextPutAll:
+"/'"
+"/ change the above template into real code;
+"/ remove this comment.
+"/ Then `accept'' either via the menu
+"/ or via the keyboard (usually CMD-A).
+"/
+"/ You do not need this template; you can also
+"/ select any existing methods code, change it,
+"/ and finally `accept''. The method will then be
+"/ installed under the selector as defined in the
+"/ actual text - no matter which method is selected
+"/ in the browser.
+"/
+"/ Or clear this text, type in the method from scratch
+"/ and install it with `accept''.
+"/
+"/ If you don''t like this method template to appear,
+"/ disable it either via the global or browser''s settings dialog,
+"/ or by evaluating:
+"/ UserPreferences current showMethodTemplate:false
+"/"
+"/'.
+"/ ^ s contents
- You do not need this template; you can also
- select any existing methods code, change it,
- and finally `accept''. The method will then be
- installed under the selector as defined in the
- actual text - no matter which method is selected
- in the browser.
-
- Or clear this text, type in the method from scratch
- and install it with `accept''.
-
- If you don''t like this method template to appear,
- disable it either via the global or browser''s settings dialog,
- or by evaluating:
- UserPreferences current showMethodTemplate:false
-"
-'.
- ^ s contents
+ "Modified: / 18-11-2016 / 01:36:39 / cg"
!
methodTemplateForDocumentation
@@ -118,28 +122,32 @@
|s|
self obsoleteMethodWarning:'use codeGenerator'.
- s := (TextStream ? WriteStream) on:''.
- s nextPutAll:
-'documentation
-'.
- s emphasis:(UserPreferences current commentEmphasisAndColor).
- s nextPutAll:(
-'"
- comment describing this class.
- you can disable the generation of this template by evaluating:
- UserPreferences current showMethodTemplate:false
+ ^ SmalltalkLanguage instance methodTemplateForDocumentation.
- [instance variables:]
- describe instance variables
- [class variables:]
- describe class variables
- [see also:]
-
- [author:]
- %1
-"
-' bindWith:(OperatingSystem getFullUserName)).
- ^ s contents
+"/ s := (TextStream ? WriteStream) on:''.
+"/ s nextPutAll:
+"/'documentation
+"/'.
+"/ s emphasis:(UserPreferences current commentEmphasisAndColor).
+"/ s nextPutAll:(
+"/'"
+"/ comment describing this class.
+"/ you can disable the generation of this template by evaluating:
+"/ UserPreferences current showMethodTemplate:false
+"/
+"/ [instance variables:]
+"/ describe instance variables
+"/ [class variables:]
+"/ describe class variables
+"/ [see also:]
+"/
+"/ [author:]
+"/ %1
+"/"
+"/' bindWith:(OperatingSystem getFullUserName)).
+"/ ^ s contents
+
+ "Modified: / 18-11-2016 / 01:37:41 / cg"
!
versionMethodTemplateForCVS
--- a/SortedCollection.st Wed Oct 19 09:22:53 2016 +0100
+++ b/SortedCollection.st Fri Dec 09 22:31:28 2016 +0000
@@ -47,13 +47,15 @@
SortedCollection uses quickSort to resort and a binary search when adding/removing elements.
Because insertion/removal may require that remaining elements have to
- be shifted within the container, adding many individual elements may be done faster
- by creating a completely new collection from the unsorted elements.
+ be shifted within the container, adding many individual elements will be faster above a
+ particular number of added elements by creating a completely new collection from the
+ unsorted elements.
(see examples)
+ A sortblock, given arguments a,b should return true, if a is to be shown before b.
A sortBlock of [:a :b | a < b] defines ascending sort-order,
while [:a :b | a > b] defines descening order.
- The default sortBlock for SortedCollections is the first one.
+ The default sortBlock for SortedCollections is the first one (i.e. sorting in ascending order).
Compatibility Warning:
VW seems to use a default sortBlock which compares a<=b, wheras ST/X uses a<b.
@@ -66,7 +68,7 @@
[caveat:]
a balanced tree may be a better choice, as inserting may be slow when
- elements have to be shifted.
+ elements have to be shifted. See the performance measuremens in AATree.
[author:]
Claus Gittinger
--- a/StandaloneStartup.st Wed Oct 19 09:22:53 2016 +0100
+++ b/StandaloneStartup.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
@@ -51,7 +49,7 @@
In contrast, when a standAlone app is linked,
the show starts in the startup class's start method.
- This class is a subclassable template class for a standalone GUI-application's startup.
+ This class is an abstrat, subclassable template for a standalone GUI-application's startup.
For your own stand alone programs, define a subclass of this,
and redefine the #main: method there.
@@ -416,22 +414,29 @@
!StandaloneStartup class methodsFor:'helpers'!
printInfo:msg
- Transcript
- show:('%1 [info]: ' bindWith:(self applicationName));
- showCR:msg
+ "print an informal message using the logger"
+
+ ('%1 [info]: ' bindWith:(self applicationName)) infoPrint.
+ msg asString infoPrintCR.
!
redirectStandardStreams
+ "redirect all output for Transcript to stderr"
+
Transcript := Stderr.
!
verbose
+ "true iff the program was started with --verbose flag"
+
^ Verbose == true
"Created: / 01-02-2011 / 15:52:47 / cg"
!
verboseInfo:msg
+ "output some message, but only if the program was started with --verbose"
+
Verbose == true ifTrue:[
self printInfo:msg
]
--- a/StandaloneStartupHeadless.st Wed Oct 19 09:22:53 2016 +0100
+++ b/StandaloneStartupHeadless.st Fri Dec 09 22:31:28 2016 +0000
@@ -42,7 +42,7 @@
In contrast, when a standAlone app is linked,
the show starts in the startup class's start method.
- This class is a subclassable template class for a standalone headless-application's startup.
+ This class is an abstract, subclassable template for a standalone headless-application's startup.
For your own stand alone programs, define a subclass of this,
and redefine the #main: method there.
(of course, the other methods can also be redefined.)
--- a/Stream.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Stream.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -216,6 +214,12 @@
^ ChunkSeparator
! !
+!Stream class methodsFor:'testing'!
+
+isAbstract
+ ^ self == Stream
+! !
+
!Stream methodsFor:'Compatibility-Dolphin'!
display:someObject
@@ -261,10 +265,12 @@
!
signalAtEnd:aBoolean
- "set the signalAtEnd flag setting. If true, reading past the end
- will raise an EndOfStream exception. If false, no exception is
- raised and nil is returned from all reading messages.
- The default is to raise a signal, but return nil if not handled (st80 compatibility)."
+ "set the signalAtEnd flag setting.
+ If true, reading past the end will raise an EndOfStream exception.
+ If false, no exception is raised and nil is returned from all reading messages.
+ If nil (default), the exception is raised if there is a handler; otherwise, nil is returned.
+ The default (nil) is both st80 backward compatible (i.e. returning nil)
+ AND allows for modern code to provide a handler."
signalAtEnd := aBoolean.
@@ -535,7 +541,8 @@
^ nil
].
- "EndOfStreamNotification is ignored, if there is no handler.
+ "EndOfStreamNotification is a notification;
+ i.e. it is ignored, if there is no handler.
In this case, nil is returned"
^ EndOfStreamNotification raiseRequestFrom:self
@@ -1099,7 +1106,7 @@
most-significant-byte-first (true) or least-first (false).
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -1161,7 +1168,7 @@
most-significant-byte-first (true) or least-first (false).
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -1638,7 +1645,7 @@
most-significant-byte-first (true) or least-first (false).
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -1693,7 +1700,7 @@
most-significant-byte-first (true) or least-first (false).
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -2035,7 +2042,7 @@
"
(#[] writeStream
- nextPutAllUtf16Bytes:'BÄxxx' MSB:true;
+ nextPutAllUtf16Bytes:'BÄxxx' MSB:true;
nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true;
contents)
"
@@ -2241,7 +2248,7 @@
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -2435,25 +2442,28 @@
|codePoint "{Class: SmallInteger}"|
codePoint := aCharacter codePoint.
- (codePoint <= 16rD7FF
- or:[codePoint >= 16rE000 and:[codePoint <= 16rFFFF]]) ifTrue:[
- self nextPut:aCharacter.
- ] ifFalse:[codePoint <= 16r10FFFF ifTrue:[
- |highBits lowBits|
-
- codePoint := codePoint - 16r100000.
- highBits := codePoint bitShift:-10.
- lowBits := codePoint bitAnd:16r3FF.
- self nextPut:(Character codePoint:highBits+16rD800).
- self nextPut:(Character codePoint:lowBits+16rDC00).
- ] ifFalse:[
- EncodingError raiseWith:aCharacter errorString:'Character cannot be encoded as UTF-16'.
- ]].
+ (codePoint <= 16rD7FF or:[codePoint between:16rE000 and:16rFFFF])
+ ifTrue:[
+ self nextPut:aCharacter.
+ ]
+ ifFalse:[
+ codePoint <= 16r10FFFF ifTrue:[
+ |highBits lowBits|
+
+ codePoint := codePoint - 16r100000.
+ highBits := codePoint bitShift:-10.
+ lowBits := codePoint bitAnd:16r3FF.
+ self nextPut:(Character codePoint:highBits+16rD800).
+ self nextPut:(Character codePoint:lowBits+16rDC00).
+ ] ifFalse:[
+ EncodingError raiseWith:aCharacter errorString:'Character cannot be encoded as UTF-16'.
+ ]
+ ].
"
((WriteStream on:Unicode16String new)
nextPutUtf16:$B;
- nextPutUtf16:$Ä;
+ nextPutUtf16:$Ä;
nextPutUtf16:(Character codePoint:16r10CCCC)
yourself) contents
"
@@ -2464,37 +2474,38 @@
UTF-16 can encode only characters with code points between 0 to 16r10FFFF.
The underlying stream must support writing of bytes."
- |codePoint|
+ |codePoint "{ Class: SmallInteger }"|
codePoint := aCharacter codePoint.
- (codePoint <= 16rD7FF
- or:[ codePoint >= 16rE000 and:[ codePoint <= 16rFFFF ] ])
- ifTrue:[ self nextPutInt16:codePoint MSB:msb. ]
- ifFalse:[
- codePoint <= 16r10FFFF ifTrue:[
- |highBits lowBits|
-
- codePoint := codePoint - 16r100000.
- highBits := codePoint bitShift:-10.
- lowBits := codePoint bitAnd:16r3FF.
- self nextPutInt16:highBits + 16rD800 MSB:msb.
- self nextPutInt16:lowBits + 16rDC00 MSB:msb.
- ] ifFalse:[
- EncodingError raiseWith:aCharacter
- errorString:'Character cannot be encoded as UTF-16'.
- ]
- ].
+ (codePoint <= 16rD7FF or:[ codePoint between:16rE000 and:16rFFFF ])
+ ifTrue:[
+ self nextPutInt16:codePoint MSB:msb.
+ ]
+ ifFalse:[
+ codePoint <= 16r10FFFF ifTrue:[
+ |highBits lowBits|
+
+ codePoint := codePoint - 16r100000.
+ highBits := codePoint bitShift:-10.
+ lowBits := codePoint bitAnd:16r3FF.
+ self nextPutInt16:(highBits + 16rD800) MSB:msb.
+ self nextPutInt16:(lowBits + 16rDC00) MSB:msb.
+ ] ifFalse:[
+ EncodingError raiseWith:aCharacter
+ errorString:'Character cannot be encoded as UTF-16'.
+ ]
+ ].
"
(#[] writeStream
nextPutUtf16:$B MSB:true;
- nextPutUtf16:$Ä MSB:true;
+ nextPutUtf16:$Ä MSB:true;
nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true;
contents)
(FileStream newTemporary
nextPutUtf16:$B MSB:false;
- nextPutUtf16:$Ä MSB:false;
+ nextPutUtf16:$Ä MSB:false;
nextPutUtf16:(Character codePoint:16r10CCCC) MSB:false;
reset;
binary;
@@ -2559,7 +2570,7 @@
"
(String streamContents:[:s|
s nextPutUtf8:$a.
- s nextPutUtf8:$ü.
+ s nextPutUtf8:$ü.
s nextPutUtf8: (Character value:16r1fff).
s nextPutUtf8: (Character value:16rffff).
s nextPutUtf8: (Character value:16r1ffffff).
@@ -2582,7 +2593,7 @@
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
@@ -2640,7 +2651,7 @@
This interface is provided to allow talking to external programs,
where it's known that the byte order is some definite one.
- If you dont care (i.e. talk to other smalltalks) or you can control the
+ If you don't care (i.e. talk to other smalltalks) or you can control the
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
--- a/String.st Wed Oct 19 09:22:53 2016 +0100
+++ b/String.st Fri Dec 09 22:31:28 2016 +0000
@@ -143,17 +143,17 @@
For strings with other encodings, either keep the encoding separately,
or use instances of encodedString.
- Be careful when using the 0-byte in a String. This is not prohibited, but
+ Be careful when using the 0-byte in a String. This is not prohibited, but
the implementations of some String methods use C functions and may
therefore yield unexpected results (e.g. compareWith:collating:) when
processing a String containing the 0-byte.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Text StringCollection TwoByteString JISEncodedString
- Symbol
+ Text StringCollection TwoByteString JISEncodedString
+ Symbol
"
! !
@@ -519,6 +519,7 @@
! !
+
!String class methodsFor:'queries'!
defaultPlatformClass
@@ -797,20 +798,20 @@
OBJ cls;
if (__isCharacter(aCharacter)) {
- byteValue = __intVal(__characterVal(aCharacter));
- if (byteValue <= 0xFF) {
- last = __stringSize(self);
- cp = __stringVal(self);
- if ((cls = __qClass(self)) != String) {
- int numInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
-
- cp += numInstBytes;
- last -= numInstBytes;
- }
- cp = (unsigned char *) memchr(cp, byteValue, last);
- RETURN ( (cp == NULL) ? false : true );
- }
- RETURN (false);
+ byteValue = __intVal(__characterVal(aCharacter));
+ if (byteValue <= 0xFF) {
+ last = __stringSize(self);
+ cp = __stringVal(self);
+ if ((cls = __qClass(self)) != String) {
+ int numInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+
+ cp += numInstBytes;
+ last -= numInstBytes;
+ }
+ cp = (unsigned char *) memchr(cp, byteValue, last);
+ RETURN ( (cp == NULL) ? false : true );
+ }
+ RETURN (false);
}
#endif
%}.
@@ -825,12 +826,12 @@
s atAllPut:$a.
s at:512 put:(Character space).
Time millisecondsToRun:[
- 1000000 timesRepeat:[ s includes:(Character space) ]
+ 1000000 timesRepeat:[ s includes:(Character space) ]
]
timing (ms):
- bcc OSX(2007 powerbook)
- 110
+ bcc OSX(2007 powerbook)
+ 110
"
!
@@ -2412,30 +2413,6 @@
!String methodsFor:'converting'!
-asArrayOfSubstrings
- "Answer an array with all the substrings of the receiver separated by
- separator characters (space, cr, tab, linefeed, formfeed, etc).
- CG: This is ported Squeak code, and I am not sure if it is more efficient than
- the inherited one... after all: who added it anyway ?"
-
- | substrings start end stop |
-
- substrings := OrderedCollection new.
- start := 1.
- stop := self size.
- [start <= stop] whileTrue: [
- (self at: start) isSeparator ifFalse: [
- end := start + 1.
- [end <= stop and: [(self at: end) isSeparator not]]
- whileTrue: [end := end + 1].
- substrings add: (self copyFrom: start to: end - 1).
- start := end - 1
- ].
- start := start + 1
- ].
- ^ substrings asArray
-!
-
asAsciiZ
"if the receiver does not end with a 0-valued character, return a copy of it,
with an additional 0-character. Otherwise return the receiver. This is sometimes
@@ -2514,7 +2491,7 @@
asLowercase
"a tuned version for Strings with size < 255. Some apps call this very heavily.
- We can do this for 8-bit strings, since the mapping is well known and lowercase chars
+ We can do this for 8-bit strings, since the mapping is well known and lowercase chars
fit in one byte also."
%{ /* NOCONTEXT */
@@ -2522,65 +2499,65 @@
REGISTER OBJ slf = self;
if (__isStringLike(slf)) {
- char quickBuffer[256];
- int sz = __stringSize(slf);
-
- if (sz < (sizeof(quickBuffer)-1)) {
- REGISTER int i = 0;
- int anyChange = 0;
- REGISTER unsigned char *cp = __stringVal(slf);
-
- // fast advance
- // all uppercase chars are in the ranges 0x41 .. 0x5A (A..Z)
- // or 0xC0 .. 0xDF.
- // I.e. they have the 0x20 bit clear.
- // Thus, we can fast skip over lowercase, spaces and some punctuation,
- // if all bytes of a word have the x20 bit set.
+ char quickBuffer[256];
+ int sz = __stringSize(slf);
+
+ if (sz < (sizeof(quickBuffer)-1)) {
+ REGISTER int i = 0;
+ int anyChange = 0;
+ REGISTER unsigned char *cp = __stringVal(slf);
+
+ // fast advance
+ // all uppercase chars are in the ranges 0x41 .. 0x5A (A..Z)
+ // or 0xC0 .. 0xDF.
+ // I.e. they have the 0x20 bit clear.
+ // Thus, we can fast skip over lowercase, spaces and some punctuation,
+ // if all bytes of a word have the x20 bit set.
#if __POINTER_SIZE__ == 8
- for (; i < (sz-8); i += 8) {
- unsigned INT eightChars = *(unsigned INT *)(cp+i);
- if ((eightChars & 0x2020202020202020ULL) != 0x2020202020202020ULL) goto convert;
- *(unsigned INT *)(quickBuffer+i) = eightChars;
- }
+ for (; i < (sz-8); i += 8) {
+ unsigned INT eightChars = *(unsigned INT *)(cp+i);
+ if ((eightChars & 0x2020202020202020ULL) != 0x2020202020202020ULL) goto convert;
+ *(unsigned INT *)(quickBuffer+i) = eightChars;
+ }
#endif
- for (; i < (sz-4); i += 4) {
- unsigned int fourChars = *(unsigned int *)(cp+i);
- if ((fourChars & 0x20202020U) != 0x20202020U) break;
- *(unsigned int *)(quickBuffer+i) = fourChars;
- }
+ for (; i < (sz-4); i += 4) {
+ unsigned int fourChars = *(unsigned int *)(cp+i);
+ if ((fourChars & 0x20202020U) != 0x20202020U) break;
+ *(unsigned int *)(quickBuffer+i) = fourChars;
+ }
convert:
- for (; i<sz; i++) {
- unsigned char ch = cp[i];
-
- quickBuffer[i] = ch;
- if ((ch & 0x60) == 0x40) {
- if (ch >= 'A' && ch <= 'Z') {
- quickBuffer[i] = ch - 'A' + 'a';
- anyChange = 1;
- } else {
- // deal with national latin1 characters
- if (ch >= 0xC0 && ch <= 0xDE && ch != 0xD7) {
- quickBuffer[i] = ch + 0x20;
- anyChange = 1;
- }
- }
- }
- }
- if (! anyChange) {
- RETURN(slf);
- }
- quickBuffer[i] = '\0';
- RETURN (__MKSTRING_L(quickBuffer, i));
- }
+ for (; i<sz; i++) {
+ unsigned char ch = cp[i];
+
+ quickBuffer[i] = ch;
+ if ((ch & 0x60) == 0x40) {
+ if (ch >= 'A' && ch <= 'Z') {
+ quickBuffer[i] = ch - 'A' + 'a';
+ anyChange = 1;
+ } else {
+ // deal with national latin1 characters
+ if (ch >= 0xC0 && ch <= 0xDE && ch != 0xD7) {
+ quickBuffer[i] = ch + 0x20;
+ anyChange = 1;
+ }
+ }
+ }
+ }
+ if (! anyChange) {
+ RETURN(slf);
+ }
+ quickBuffer[i] = '\0';
+ RETURN (__MKSTRING_L(quickBuffer, i));
+ }
}
#endif /* ! __SCHTEAM__ */
%}.
^ super asLowercase
"
- 'Hello WORLD' asLowercase
- (String new:300) asLowercase
+ 'Hello WORLD' asLowercase
+ (String new:300) asLowercase
"
!
@@ -2646,7 +2623,7 @@
}
#endif /* not __SCHTEAM__ */
%}.
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
"
'hello' asSymbol
@@ -2656,7 +2633,7 @@
asSymbolIfInterned
"If a symbol with the receiver's characters is already known, return it. Otherwise, return nil.
This can be used to query for an existing symbol and is the same as:
- self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
+ self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
but slightly faster, since the symbol lookup operation is only
performed once."
@@ -2670,9 +2647,9 @@
int indx;
if (cls != String && cls != ImmutableString) {
- indx = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ indx = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
} else {
- indx = 0;
+ indx = 0;
}
RETURN ( __SYMBOL_OR_NIL(__stringVal(self) + indx));
#endif /* not __SCHTEAM__ */
@@ -2810,101 +2787,101 @@
%{
#ifdef __SCHTEAM__
if ( aStringOrCharacter.isStringLike() && self.isStringLike() ) {
- STString me = self.asSTString();
- STString other = aStringOrCharacter.asSTString();
- int myLength = me.characters.length;
- int otherLength = other.characters.length;
-
- char[] newChars = new char[myLength + otherLength];
- System.arraycopy(me.characters, 0, newChars, 0, myLength);
- System.arraycopy(other.characters, 0, newChars, myLength, otherLength);
- return context._RETURN( new STString( newChars ));
+ STString me = self.asSTString();
+ STString other = aStringOrCharacter.asSTString();
+ int myLength = me.characters.length;
+ int otherLength = other.characters.length;
+
+ char[] newChars = new char[myLength + otherLength];
+ System.arraycopy(me.characters, 0, newChars, 0, myLength);
+ System.arraycopy(other.characters, 0, newChars, myLength, otherLength);
+ return context._RETURN( new STString( newChars ));
}
#else
/*
* can do it here if both are Strings/Symbols:
*/
if (__qIsStringLike(self)) {
- char *cp1 = (char *) __stringVal(self);
- int l1 = __stringSize(self);
- int l2;
- char *cp2 = 0;
- int sz;
- OBJ newString;
- char character;
-
- if (__isCharacter(aStringOrCharacter)) {
- if (__intVal(__characterVal(aStringOrCharacter)) <= 0 || __intVal(__characterVal(aStringOrCharacter)) > 255)
- goto out;
-
- character = __intVal(__characterVal(aStringOrCharacter));
- l2 = 1;
- cp2 = &character;
- } else if (__isStringLike(aStringOrCharacter)) {
- l2 = __stringSize(aStringOrCharacter);
- } else
- goto out;
-
- sz = OHDR_SIZE + l1 + l2 + 1;
- __qNew(newString, sz); /* OBJECT ALLOCATION */
-
- cp1 = (char *) __stringVal(self);
- if (cp2 == 0)
- cp2 = (char *) __stringVal(aStringOrCharacter);
-
- if (newString != nil) {
- REGISTER unsigned char *dstp;
-
- __InstPtr(newString)->o_class = String;
- __qSTORE(newString, String);
- dstp = __stringVal(newString);
+ char *cp1 = (char *) __stringVal(self);
+ int l1 = __stringSize(self);
+ int l2;
+ char *cp2 = 0;
+ int sz;
+ OBJ newString;
+ char character;
+
+ if (__isCharacter(aStringOrCharacter)) {
+ if (__intVal(__characterVal(aStringOrCharacter)) <= 0 || __intVal(__characterVal(aStringOrCharacter)) > 255)
+ goto out;
+
+ character = __intVal(__characterVal(aStringOrCharacter));
+ l2 = 1;
+ cp2 = &character;
+ } else if (__isStringLike(aStringOrCharacter)) {
+ l2 = __stringSize(aStringOrCharacter);
+ } else
+ goto out;
+
+ sz = OHDR_SIZE + l1 + l2 + 1;
+ __qNew(newString, sz); /* OBJECT ALLOCATION */
+
+ cp1 = (char *) __stringVal(self);
+ if (cp2 == 0)
+ cp2 = (char *) __stringVal(aStringOrCharacter);
+
+ if (newString != nil) {
+ REGISTER unsigned char *dstp;
+
+ __InstPtr(newString)->o_class = String;
+ __qSTORE(newString, String);
+ dstp = __stringVal(newString);
# if defined(bcopy4)
- /* knowing that allocation is 4-byte aligned and
- * size rounded up to next 4-byte, the first copy
- * can be done word-wise.
- * that speeds up size-10-string , size-10-string
- * by 10% on a P5/200.
- */
- {
- int nw = l1 >> 2;
-
- if (l1 & 3) nw++;
- bcopy4(cp1, dstp, nw);
- dstp += l1;
- }
+ /* knowing that allocation is 4-byte aligned and
+ * size rounded up to next 4-byte, the first copy
+ * can be done word-wise.
+ * that speeds up size-10-string , size-10-string
+ * by 10% on a P5/200.
+ */
+ {
+ int nw = l1 >> 2;
+
+ if (l1 & 3) nw++;
+ bcopy4(cp1, dstp, nw);
+ dstp += l1;
+ }
# elif defined(FAST_MEMCPY)
- memcpy(dstp, cp1, l1);
- dstp += l1;
+ memcpy(dstp, cp1, l1);
+ dstp += l1;
# else
- while (l1 >= 4) {
- *(int *)dstp = *(int *)cp1;
- dstp += 4; cp1 += 4;
- l1 -= 4;
- }
- while (l1--) *dstp++ = *cp1++;
+ while (l1 >= 4) {
+ *(int *)dstp = *(int *)cp1;
+ dstp += 4; cp1 += 4;
+ l1 -= 4;
+ }
+ while (l1--) *dstp++ = *cp1++;
# endif
# ifdef bcopy4
- if (((INT)dstp & 3) == 0) {
- int nw = l2 >> 2;
-
- if (l2 & 3) nw++;
- bcopy4(cp2, dstp, nw);
- *(dstp + l2) = '\0';
- RETURN ( newString );
- }
+ if (((INT)dstp & 3) == 0) {
+ int nw = l2 >> 2;
+
+ if (l2 & 3) nw++;
+ bcopy4(cp2, dstp, nw);
+ *(dstp + l2) = '\0';
+ RETURN ( newString );
+ }
# endif
# ifdef FAST_MEMCPY
- memcpy(dstp, cp2, l2+1);
- dstp[l2] = '\0';
+ memcpy(dstp, cp2, l2+1);
+ dstp[l2] = '\0';
# else
- while (l2--) *dstp++ = *cp2++;
- *dstp = '\0';
+ while (l2--) *dstp++ = *cp2++;
+ *dstp = '\0';
# endif
- RETURN ( newString );
- }
+ RETURN ( newString );
+ }
}
out:;
#endif /* not SCHTEAM */
@@ -3045,35 +3022,35 @@
#ifndef NO_PRIM_STRING
if (__isSmallInteger(start) && __qIsStringLike(self)) {
- len = __stringSize(self);
- index1 = __intVal(start);
- if (index1 > 0) {
- if (index1 <= len) {
- count = len - index1 + 1;
- sz = OHDR_SIZE + count + 1;
-
- __PROTECT_CONTEXT__
- __qNew(newString, sz); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
-
- if (newString != nil) {
- __InstPtr(newString)->o_class = String;
- __qSTORE(newString, String);
- dstp = __stringVal(newString);
- srcp = __stringVal(self) + index1 - 1;
+ len = __stringSize(self);
+ index1 = __intVal(start);
+ if (index1 > 0) {
+ if (index1 <= len) {
+ count = len - index1 + 1;
+ sz = OHDR_SIZE + count + 1;
+
+ __PROTECT_CONTEXT__
+ __qNew(newString, sz); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+
+ if (newString != nil) {
+ __InstPtr(newString)->o_class = String;
+ __qSTORE(newString, String);
+ dstp = __stringVal(newString);
+ srcp = __stringVal(self) + index1 - 1;
#ifdef FAST_MEMCPY
- memcpy(dstp, srcp, count);
- dstp[count] = '\0';
+ memcpy(dstp, srcp, count);
+ dstp[count] = '\0';
#else
- while (count--) {
- *dstp++ = *srcp++;
- }
- *dstp = '\0';
+ while (count--) {
+ *dstp++ = *srcp++;
+ }
+ *dstp = '\0';
#endif
- RETURN ( newString );
- }
- }
- }
+ RETURN ( newString );
+ }
+ }
+ }
}
#endif
%}.
@@ -3083,9 +3060,9 @@
^ super copyFrom:start
"
- '12345' copyFrom:3
- '12345678' copyFrom:9 -> empty string
- '12345678' copyFrom:0 -> error
+ '12345' copyFrom:3
+ '12345678' copyFrom:9 -> empty string
+ '12345678' copyFrom:0 -> error
"
!
@@ -3105,62 +3082,62 @@
#ifndef NO_PRIM_STRING
if (__bothSmallInteger(start, stop) && __qIsStringLike(self)) {
- len = __stringSize(self);
- index1 = __intVal(start);
- index2 = __intVal(stop);
-
- if ((index1 <= index2) && (index1 > 0)) {
- if (index2 <= len) {
- count = index2 - index1 + 1;
- sz = OHDR_SIZE + count + 1;
-
- __PROTECT_CONTEXT__
- __qNew(newString, sz); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
-
- if (newString != nil) {
- __InstPtr(newString)->o_class = String;
- __qSTORE(newString, String);
- dstp = __stringVal(newString);
- srcp = __stringVal(self) + index1 - 1;
+ len = __stringSize(self);
+ index1 = __intVal(start);
+ index2 = __intVal(stop);
+
+ if ((index1 <= index2) && (index1 > 0)) {
+ if (index2 <= len) {
+ count = index2 - index1 + 1;
+ sz = OHDR_SIZE + count + 1;
+
+ __PROTECT_CONTEXT__
+ __qNew(newString, sz); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+
+ if (newString != nil) {
+ __InstPtr(newString)->o_class = String;
+ __qSTORE(newString, String);
+ dstp = __stringVal(newString);
+ srcp = __stringVal(self) + index1 - 1;
#ifdef bcopy4
- {
- int nw = count >> 2;
-
- if (count & 3) {
- nw++;
- }
- bcopy4(srcp, dstp, nw);
- dstp[count] = '\0';
- }
+ {
+ int nw = count >> 2;
+
+ if (count & 3) {
+ nw++;
+ }
+ bcopy4(srcp, dstp, nw);
+ dstp[count] = '\0';
+ }
#else
# ifdef FAST_MEMCPY
- memcpy(dstp, srcp, count);
- dstp[count] = '\0';
+ memcpy(dstp, srcp, count);
+ dstp[count] = '\0';
# else
- while (count--) {
- *dstp++ = *srcp++;
- }
- *dstp = '\0';
+ while (count--) {
+ *dstp++ = *srcp++;
+ }
+ *dstp = '\0';
# endif
#endif
- RETURN ( newString );
- }
- }
- }
- /*
- * allow empty copy
- */
- if (index1 > index2) {
- __PROTECT_CONTEXT__
- __qNew(newString, OHDR_SIZE+1); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newString != nil) {
- __InstPtr(newString)->o_class = String;
- (__stringVal(newString))[0] = '\0';
- RETURN ( newString );
- }
- }
+ RETURN ( newString );
+ }
+ }
+ }
+ /*
+ * allow empty copy
+ */
+ if (index1 > index2) {
+ __PROTECT_CONTEXT__
+ __qNew(newString, OHDR_SIZE+1); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newString != nil) {
+ __InstPtr(newString)->o_class = String;
+ (__stringVal(newString))[0] = '\0';
+ RETURN ( newString );
+ }
+ }
}
#endif
%}.
@@ -3170,18 +3147,18 @@
^ super copyFrom:start to:stop
"
- '12345678' copyFrom:3 to:7
- '12345678' copyFrom:3 to:3
- '12345678' copyFrom:3 to:2 -> empty string
-
- '12345678' copyFrom:9 to:9 -> error
- '12345678' copyFrom:3 to:9 -> error
- '12345678' copyFrom:0 to:8 -> error
-
- (Unicode16String with:(Character value:16r220) with:$a with:$b with:(Character value:16r221) with:(Character value:16r222))
- copyFrom:2 to:3
- ((Unicode16String with:(Character value:16r220) with:$a with:$b with:(Character value:16r221) with:(Character value:16r222))
- copyFrom:2 to:3) asSingleByteString
+ '12345678' copyFrom:3 to:7
+ '12345678' copyFrom:3 to:3
+ '12345678' copyFrom:3 to:2 -> empty string
+
+ '12345678' copyFrom:9 to:9 -> error
+ '12345678' copyFrom:3 to:9 -> error
+ '12345678' copyFrom:0 to:8 -> error
+
+ (Unicode16String with:(Character value:16r220) with:$a with:$b with:(Character value:16r221) with:(Character value:16r222))
+ copyFrom:2 to:3
+ ((Unicode16String with:(Character value:16r220) with:$a with:$b with:(Character value:16r221) with:(Character value:16r222))
+ copyFrom:2 to:3) asSingleByteString
"
!
@@ -3201,51 +3178,51 @@
#ifndef NO_PRIM_STRING
if (__isCharacter(aCharacter)) {
- unsigned int cVal = __intVal(__characterVal(aCharacter));
-
- if ((cVal <= 0xFF) && __qIsStringLike(self)) {
- count = __stringSize(self);
- sz = OHDR_SIZE + count + 1 + 1;
-
- __PROTECT_CONTEXT__
- __qNew(newString, sz); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
-
- if (newString) {
- __InstPtr(newString)->o_class = String;
- __qSTORE(newString, String);
- dstp = __stringVal(newString);
+ unsigned int cVal = __intVal(__characterVal(aCharacter));
+
+ if ((cVal <= 0xFF) && __qIsStringLike(self)) {
+ count = __stringSize(self);
+ sz = OHDR_SIZE + count + 1 + 1;
+
+ __PROTECT_CONTEXT__
+ __qNew(newString, sz); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+
+ if (newString) {
+ __InstPtr(newString)->o_class = String;
+ __qSTORE(newString, String);
+ dstp = __stringVal(newString);
# ifdef bcopy4
- {
- int nw = count >> 2;
- char *srcp = (char *)__stringVal(self);
-
- if (count & 3) {
- nw++;
- }
- bcopy4(srcp, dstp, nw);
- dstp += count;
- }
+ {
+ int nw = count >> 2;
+ char *srcp = (char *)__stringVal(self);
+
+ if (count & 3) {
+ nw++;
+ }
+ bcopy4(srcp, dstp, nw);
+ dstp += count;
+ }
# else
# ifdef FAST_MEMCPY
- memcpy(dstp, __stringVal(self), count);
- dstp += count;
+ memcpy(dstp, __stringVal(self), count);
+ dstp += count;
# else
- {
- REGISTER unsigned char *srcp;
-
- srcp = __stringVal(self);
- while ((*dstp = *srcp++) != '\0')
- dstp++;
- }
+ {
+ REGISTER unsigned char *srcp;
+
+ srcp = __stringVal(self);
+ while ((*dstp = *srcp++) != '\0')
+ dstp++;
+ }
# endif
# endif
- *dstp++ = cVal;
- *dstp = '\0';
- RETURN (newString );
- }
- }
+ *dstp++ = cVal;
+ *dstp = '\0';
+ RETURN (newString );
+ }
+ }
}
#endif
%}.
@@ -3716,6 +3693,94 @@
!String methodsFor:'printing & storing'!
+_errorPrint
+ "Do not use this in user code.
+ Print the receiver on standard error.
+ This method does NOT (by purpose) use the stream classes and
+ will therefore work even in case of emergency during early startup
+ or in a crash situation (MiniDebugger)."
+
+%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ if (self.isStringLike()) {
+ org.exept.stj.STSystem.err.print(self.asString());
+ return context._RETURN(self);
+ }
+#else
+ if (__qIsStringLike(self)) {
+ console_fprintf(stderr, "%s" , __stringVal(self));
+ console_fflush(stderr);
+ RETURN (self);
+ }
+#endif /* not SCHTEAM */
+%}.
+!
+
+_errorPrintCR
+ "Do not use this in user code.
+ Print the receiver on standard error.
+ This method does NOT (by purpose) use the stream classes and
+ will therefore work even in case of emergency during early startup
+ or in a crash situation (MiniDebugger)."
+
+%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ if (self.isStringLike()) {
+ org.exept.stj.STSystem.err.println(self.asString());
+ return context._RETURN(self);
+ }
+#else
+ if (__qIsStringLike(self)) {
+ console_fprintf(stderr, "%s\n" , __stringVal(self));
+ console_fflush(stderr);
+ RETURN (self);
+ }
+#endif
+%}.
+!
+
+_print
+ "Do not use this in user code.
+ Print the receiver on standard output.
+ This method does NOT (by purpose) use the stream classes and
+ will therefore work even in case of emergency during early startup
+ or in a crash situation (MiniDebugger)."
+
+%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ org.exept.stj.STSystem.out.print(self.toString());
+ return context._RETURN(self);
+#else
+ if (__qIsStringLike(self)) {
+ console_fprintf(stdout, "%s" , __stringVal(self));
+ console_fflush(stdout);
+ RETURN (self);
+ }
+#endif
+%}.
+!
+
+_printCR
+ "Do not use this in user code.
+ Print the receiver on standard output.
+ This method does NOT (by purpose) use the stream classes and
+ will therefore work even in case of emergency during early startup
+ or in a crash situation (MiniDebugger)."
+
+%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ org.exept.stj.STSystem.out.println(self.toString());
+ return context._RETURN(self);
+#else
+ if (__qIsStringLike(self)) {
+ console_fprintf(stdout, "%s\n" , __stringVal(self));
+ console_fflush(stdout);
+ RETURN (self);
+ }
+#endif
+%}.
+!
+
displayString
"return a string used when displaying the receiver in a view."
@@ -3731,14 +3796,14 @@
"print the receiver on standard error, if the global Stderr is nil;
otherwise, fall back to the inherited errorPrint, which sends the string to
the Stderr stream or to a logger.
- Redefined to be able to print during early startup, when the stream classes have not
- yet been initialized (Stderr is nil)."
+ Redefined to be able to print during early startup,
+ when the stream classes have not yet been initialized (i.e. Stderr is nil)."
Stderr isNil ifTrue:[
- self lowLevelErrorPrint
+ self _errorPrint
] ifFalse:[
super errorPrint
- ].
+ ].
"
'hello world' asUnicode16String errorPrint
@@ -3752,22 +3817,22 @@
"print the receiver on standard error, followed by a cr,
if the global Stderr is nil; otherwise, fall back to the inherited errorPrintCR,
which sends the string to the Stderr stream or to a logger.
- Redefined to be able to print during early startup, when the stream classes have not
- yet been initialized (Stderr is nil)."
+ Redefined to be able to print during early startup,
+ when the stream classes have not yet been initialized (i.e. Stderr is nil)."
Stderr isNil ifTrue:[
- self lowLevelErrorPrintCR
+ self _errorPrintCR
] ifFalse:[
super errorPrintCR
- ].
+ ].
!
lowLevelErrorPrint
- "Do not call this directly.
- print the receiver on standard error.
+ "Do not use this in user code.
+ Print the receiver on standard error.
This method does NOT (by purpose) use the stream classes and
will therefore work even in case of emergency during early startup
- (but only, as long as Stderr is nil, which is set later after startup)."
+ or in a crash situation (MiniDebugger)."
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -3793,11 +3858,11 @@
!
lowLevelErrorPrintCR
- "Do not call this directly.
- print the receiver on standard error, followed by a cr,
+ "Do not use this in user code.
+ Print the receiver on standard error.
This method does NOT (by purpose) use the stream classes and
will therefore work even in case of emergency during early startup
- (but only, as long as Stderr is nil, which is set later after startup)."
+ or in a crash situation (MiniDebugger)."
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -3816,11 +3881,11 @@
!
lowLevelPrint
- "Do not call this directly.
- print the receiver on standard output.
+ "Do not use this in user code.
+ Print the receiver on standard output.
This method does NOT (by purpose) use the stream classes and
will therefore work even in case of emergency during early startup
- (but only, as long as Stdout is nil, which is set later after startup)."
+ or in a crash situation (MiniDebugger)."
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -3837,11 +3902,11 @@
!
lowLevelPrintCR
- "Do not call this directly.
- print the receiver on standard output, followed by a cr,
+ "Do not use this in user code.
+ Print the receiver on standard output.
This method does NOT (by purpose) use the stream classes and
will therefore work even in case of emergency during early startup
- (but only, as long as Stdout is nil, which is set later after startup)."
+ or in a crash situation (MiniDebugger)."
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -3861,28 +3926,28 @@
"print the receiver on standard output, if the global Stdout is nil;
otherwise, fall back to the inherited print,
which sends the string to the Stdout stream.
- Redefined to be able to print during early startup, when the stream classes have not
- yet been initialized (Stdout is nil)."
+ Redefined to be able to print during early startup,
+ when the stream classes have not yet been initialized (i.e. Stdout is nil)."
Stdout isNil ifTrue:[
- self lowLevelPrint
+ self _print
] ifFalse:[
super print
- ].
+ ].
!
printCR
"print the receiver on standard output, followed by a cr,
if the global Stdout is nil; otherwise, fall back to the inherited errorPrintCR,
which sends the string to the Stdout stream.
- Redefined to be able to print during early startup, when the stream classes have not
- yet been initialized (Stdout is nil)."
+ Redefined to be able to print during early startup,
+ when the stream classes have not yet been initialized (i.e. Stdout is nil)."
Stdout isNil ifTrue:[
- self lowLevelPrintCR
+ self _printCR
] ifFalse:[
super printCR
- ].
+ ].
!
printfPrintString:formatString
@@ -3891,7 +3956,8 @@
which is defined by printf.
This method is NONSTANDARD and may be removed without notice.
WARNNG: this goes directly to the C-printf function and may therefore be inherently unsafe.
- Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
+ Please use the printf: method, which is both safe
+ and completely implemented in Smalltalk."
%{ /* STACK: 1000 */
#ifndef __SCHTEAM__
@@ -3905,44 +3971,44 @@
extern void *malloc();
if (__isStringLike(formatString)) {
- cp = (char *)__stringVal(self);
- if (__qClass(self) != String) {
- cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
- }
+ cp = (char *)__stringVal(self);
+ if (__qClass(self) != String) {
+ cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
+ }
again:
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
-
- len = snprintf(buf, bufsize, (char *)__stringVal(formatString), cp);
-
- __END_PROTECT_REGISTERS__
-
- if ((len < 0) || (len > bufsize)) {
- if (len < 0) {
- bufsize = bufsize * 2;
- } else {
- bufsize = len + 1;
- }
- if (mallocbuf)
- free(mallocbuf);
- buf = mallocbuf = malloc(bufsize);
- if (buf == NULL)
- goto fail;
- goto again;
- }
-
- s = __MKSTRING_L(buf, len);
-
- if (mallocbuf)
- free(mallocbuf);
-
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
+
+ len = snprintf(buf, bufsize, (char *)__stringVal(formatString), cp);
+
+ __END_PROTECT_REGISTERS__
+
+ if ((len < 0) || (len > bufsize)) {
+ if (len < 0) {
+ bufsize = bufsize * 2;
+ } else {
+ bufsize = len + 1;
+ }
+ if (mallocbuf)
+ free(mallocbuf);
+ buf = mallocbuf = malloc(bufsize);
+ if (buf == NULL)
+ goto fail;
+ goto again;
+ }
+
+ s = __MKSTRING_L(buf, len);
+
+ if (mallocbuf)
+ free(mallocbuf);
+
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail:;
#endif
@@ -3960,13 +4026,13 @@
!
storeOn:aStream
- "put the storeString of myself on aStream"
+ "put the storeString of myself onto a aStream"
aStream nextPut:$'.
(self includes:$') ifTrue:[
- self printWithQuotesDoubledOn:aStream
+ self printWithQuotesDoubledOn:aStream
] ifFalse:[
- aStream nextPutAll:self
+ aStream nextPutAll:self
].
aStream nextPut:$'
@@ -3994,10 +4060,10 @@
slf = self;
cls = __qClass(slf);
if (cls == String) {
- RETURN ( __mkSmallInteger(__stringSize(slf)) );
+ RETURN ( __mkSmallInteger(__stringSize(slf)) );
}
RETURN ( __mkSmallInteger(__stringSize(slf)
- - __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));
+ - __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));
#endif
%}.
^ super basicSize - 1
@@ -4406,7 +4472,7 @@
slowIndexOfSubCollection:aSubString startingAt:startIndex ifAbsent:exceptionValue caseSensitive:caseSensitive
"naive search fallback (non-BM).
Use this for short searchStrings (<= 2)
- or for caseSensitive searches"
+ or for caseInSensitive searches"
|notFound|
--- a/Symbol.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Symbol.st Fri Dec 09 22:31:28 2016 +0000
@@ -130,7 +130,7 @@
"only allowed to intern strings"
^ self mustBeString
].
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
internCharacter:aCharacter
@@ -149,6 +149,8 @@
! !
+
+
!Symbol class methodsFor:'queries'!
findInterned:aString
@@ -242,6 +244,7 @@
"
! !
+
!Symbol methodsFor:'accessing'!
basicAt:index put:something
@@ -381,8 +384,8 @@
Namespace selectors have a special, fix defined format, which is also known in the VM.
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
- This special format (a symbol starting with a colon) was chosen,
- because almost every other selector is legal,
+ This special format (a symbol starting with a colon) was chosen,
+ because almost every other selector is legal,
and this can be checked quickly in the VM, by just looking at the first character."
self obsoleteMethodWarning:'use selectorWithoutNameSpace'.
@@ -488,40 +491,40 @@
REGISTER unsigned int val; // yes: only 32 bit
if (__qIsSymbol(self)) {
- val = __GET_HASH(self);
- /*
- * only do it, if I have no standard hash key
- * assigned (which can only happen due to a #become:,
- * or by creating a symbol uninterned, and interning it
- * after it got a hashKey assigned.
- */
- if (val == 0) {
- extern unsigned int __symbolHash(char *);
+ val = __GET_HASH(self);
+ /*
+ * only do it, if I have no standard hash key
+ * assigned (which can only happen due to a #become:,
+ * or by creating a symbol uninterned, and interning it
+ * after it got a hashKey assigned.
+ */
+ if (val == 0) {
+ extern unsigned int __symbolHash(char *);
- val = __symbolHash(__stringVal(self));
- // make sure, it fits into a smallInt
- val = (val ^ (val >> 30)) & 0x3FFFFFFF;
- } else {
- val = __MAKE_HASH__(val);
- }
- RETURN ( __mkSmallInteger(val) );
+ val = __symbolHash(__stringVal(self));
+ // make sure, it fits into a smallInt
+ val = (val ^ (val >> 30)) & 0x3FFFFFFF;
+ } else {
+ val = __MAKE_HASH__(val);
+ }
+ RETURN ( __mkSmallInteger(val) );
}
%}.
^ super identityHash.
"
- |hashColl hashSet|
+ |hashColl hashSet|
- hashColl := OrderedCollection new:20000.
- Symbol allInstancesDo:[:instance |
- hashColl add:instance identityHash
- ].
- hashSet := hashColl asSet.
+ hashColl := OrderedCollection new:20000.
+ Symbol allInstancesDo:[:instance |
+ hashColl add:instance identityHash
+ ].
+ hashSet := hashColl asSet.
- Transcript showCR:'Symbols: ', hashColl size printString,
- ' unique hash keys: ', hashSet size printString,
- ' collisions:', (hashColl size - hashSet size) printString.
+ Transcript showCR:'Symbols: ', hashColl size printString,
+ ' unique hash keys: ', hashSet size printString,
+ ' collisions:', (hashColl size - hashSet size) printString.
"
"Modified (comment): / 26-12-2011 / 14:32:10 / cg"
@@ -591,6 +594,10 @@
Since I am a symbol - just return myself"
^ self
+!
+
+asSymbolIfInternedOrSelf
+ ^ self
! !
!Symbol methodsFor:'copying'!
--- a/Time.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Time.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -331,70 +329,70 @@
either 24 hour format or being am."
^ [
- |str hour min sec peekC millis|
+ |str hour min sec peekC millis|
- str := aStringOrStream readStream.
+ str := aStringOrStream readStream.
- hour := Integer readFrom:str.
- (hour between:0 and:24) ifFalse:[^ exceptionBlock value].
+ hour := Integer readFrom:str.
+ (hour between:0 and:24) ifFalse:[^ exceptionBlock value].
- min := 0.
- sec := 0.
- millis := 0.
+ min := 0.
+ sec := 0.
+ millis := 0.
- str atEnd ifFalse:[
- peekC := str peek.
- (peekC == $:) ifTrue:[
- str next.
- min := Integer readFrom:str.
- (min between:0 and:59) ifFalse:[^ exceptionBlock value].
+ str atEnd ifFalse:[
+ peekC := str peek.
+ (peekC == $:) ifTrue:[
+ str next.
+ min := Integer readFrom:str.
+ (min between:0 and:59) ifFalse:[^ exceptionBlock value].
- (str peek == $:) ifTrue:[
- str next.
- sec := Integer readFrom:str.
- (sec between:0 and:59) ifFalse:[^ exceptionBlock value].
- (str peek == $.) ifTrue:[
- str next.
- millis := ((Fraction readDecimalFractionFrom:str onError:[^ exceptionBlock value]) * 1000) asInteger.
- ].
- ].
- peekC := str peek.
- ].
- [peekC == Character space] whileTrue:[str next. peekC := str peek].
- (peekC == $p or:[peekC == $P]) ifTrue:[
- str next.
- (str peek == $m or:[str peek == $M]) ifTrue:[
- str next
- ].
- (hour <= 0 or:[hour > 12]) ifTrue:[^ exceptionBlock value].
+ (str peek == $:) ifTrue:[
+ str next.
+ sec := Integer readFrom:str.
+ (sec between:0 and:59) ifFalse:[^ exceptionBlock value].
+ (str peek == $.) ifTrue:[
+ str next.
+ millis := ((Fraction readDecimalFractionFrom:str onError:[^ exceptionBlock value]) * 1000) asInteger.
+ ].
+ ].
+ peekC := str peek.
+ ].
+ [peekC == Character space] whileTrue:[str next. peekC := str peek].
+ (peekC == $p or:[peekC == $P]) ifTrue:[
+ str next.
+ (str peek == $m or:[str peek == $M]) ifTrue:[
+ str next
+ ].
+ (hour <= 0 or:[hour > 12]) ifTrue:[^ exceptionBlock value].
- "pm"
- hour ~~ 12 ifTrue:[
- hour := hour + 12
- ].
- peekC := str peek
- ] ifFalse:[
- (peekC == $a or:[peekC == $A]) ifTrue:[
- str next.
- (str peek == $m or:[str peek == $M]) ifTrue:[
- str next
- ].
- hour == 12 ifTrue:[
- hour := 0.
- ].
- hour > 12 ifTrue:[^ exceptionBlock value].
- peekC := str peek
- ] ifFalse:[
- "/ cg: dont be too picky here - we do not care, what comes after the
- "/ time string. (Needed to be able to read rfc822 strings where a timezone
- "/ follows (-/+0700 GMT, for example)
+ "pm"
+ hour ~~ 12 ifTrue:[
+ hour := hour + 12
+ ].
+ peekC := str peek
+ ] ifFalse:[
+ (peekC == $a or:[peekC == $A]) ifTrue:[
+ str next.
+ (str peek == $m or:[str peek == $M]) ifTrue:[
+ str next
+ ].
+ hour == 12 ifTrue:[
+ hour := 0.
+ ].
+ hour > 12 ifTrue:[^ exceptionBlock value].
+ peekC := str peek
+ ] ifFalse:[
+ "/ cg: don't be too picky here - we do not care, what comes after the
+ "/ time string. (Needed to be able to read rfc822 strings where a timezone
+ "/ follows (-/+0700 GMT, for example)
"/ peekC notNil ifTrue:[
"/ peekC isSeparator ifFalse:[^ exceptionBlock value].
"/ ]
- ].
- ]
- ].
- self basicNew setHours:hour minutes:min seconds:sec milliseconds:millis
+ ].
+ ]
+ ].
+ self basicNew setHours:hour minutes:min seconds:sec milliseconds:millis
] on:Error do:exceptionBlock.
"
@@ -460,20 +458,20 @@
"a language specific format string to present times in user interfaces.
Do not use this to store/retrieve times (use ISO8601 for that)"
- LanguageTerritory == #us ifTrue:[
- ^ self formatString12us
+ Smalltalk languageTerritory == #us ifTrue:[
+ ^ self formatString12us
] ifFalse:[
- ^ self formatString24
+ ^ self formatString24
]
"Created: / 16-01-2011 / 11:23:36 / cg"
!
defaultFormatStringWithMilliseconds
- LanguageTerritory == #us ifTrue:[
- ^ self formatStringWithMilliseconds12us
+ Smalltalk languageTerritory == #us ifTrue:[
+ ^ self formatStringWithMilliseconds12us
] ifFalse:[
- ^ self formatStringWithMilliseconds24
+ ^ self formatStringWithMilliseconds24
]
!
--- a/TimeDuration.st Wed Oct 19 09:22:53 2016 +0100
+++ b/TimeDuration.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -211,7 +209,7 @@
"Created: / 06-08-2007 / 15:32:42 / cg"
!
-readFrom:aStringOrStream defaultUnit:defaultUnitOrNil onError:exceptionBlock
+readFrom:aStringOrStream defaultUnit:defaultUnitOrNilArg onError:exceptionBlock
"return a new TimeDuration, reading a printed representation from aStream.
The format is either:
[n 'yr'] [n 'mon'] [n 'w'] [n 'd'] [n 'h'] [n 'm'] [n 's'] [n 'ms']
@@ -230,19 +228,41 @@
The yr and mon specifiers stand for 365d and 30d respectively.
If defaultUnitOrNil is non-nil, a plain number is treated as that;
otherwise, a plain number raises an error.
+ Individual components may be negative, as in '1h -10m', which gives 50m
+ or the whole duration may be negative, as in '-(1h 10m)'
"
^ [
- |seconds millis str val fraction uIdx unit unitChar1 unitChar2|
+ |seconds millis str val fraction uIdx unit unitChar1 negative defaultUnitOrNil|
+ defaultUnitOrNil := defaultUnitOrNilArg.
str := aStringOrStream readStream.
seconds := 0.
millis := 0.
+
+ negative := false.
+ str peek == $- ifTrue:[
+ str next.
+ str peek == $( ifTrue:[
+ |t|
+ str next.
+ t := self readFrom:str defaultUnit:defaultUnitOrNil onError:[^ exceptionBlock value].
+ str skipSeparators.
+ str peek == $) ifTrue:[
+ str next.
+ ^ t negated.
+ ].
+ ^ exceptionBlock value.
+ ].
+ negative := true.
+ ].
+
[
|nextCh|
val := Integer readFrom:str onError:nil.
val isNil ifTrue:[^ exceptionBlock value].
+ negative ifTrue:[ val := val negated. negative := false. ].
str peek == $: ifTrue:[
"/ hour:minutes format
str next.
@@ -278,6 +298,8 @@
].
"/ no unit given - assume defaultUnit
unitChar1 := defaultUnitOrNil.
+ "/ can be only used for one number
+ defaultUnitOrNil := nil.
] ifFalse:[
unitChar1 := str next.
].
@@ -304,12 +326,13 @@
].
seconds := seconds + (unit * val).
].
- [str atEnd not and:[str peek isSeparator not]] whileTrue:[ str next].
+ [str atEnd not and:[str peek isSeparator not and:[str peek ~~ $)]]] whileTrue:[ str next].
str skipSeparators.
- str atEnd
+ "/ done when at the end or a $) is to be read
+ str atEnd or:[aStringOrStream isString not and:[str peek == $)]]
] whileFalse.
self fromMilliseconds:(seconds*1000+millis) rounded asInteger.
- ] on:Error do:[
+ ] on:Error do:[:ex |
|t|
"/ retry, using inherited readFrom (Object-storeString)
@@ -321,10 +344,10 @@
]
"
- TimeDuration readFrom:'2' defaultUnit:$h onError:nil 2h
- TimeDuration readFrom:'100' defaultUnit:$m onError:nil 1h 40m
- TimeDuration readFrom:'02:00' defaultUnit:$m onError:nil 2h
- TimeDuration readFrom:'0200' defaultUnit:$h onError:nil 2h
+ TimeDuration readFrom:'2' defaultUnit:$h onError:nil -> 2h
+ TimeDuration readFrom:'100' defaultUnit:$m onError:nil -> 1h 40m
+ TimeDuration readFrom:'100' defaultUnit:$s onError:nil -> 1m 40s
+ TimeDuration readFrom:'0200' defaultUnit:$h onError:nil -> 1w 1d 8h
TimeDuration readFrom:'1h'
TimeDuration readFrom:'1h 35m'
@@ -332,7 +355,7 @@
TimeDuration readFrom:'3d'
TimeDuration readFrom:'1w'
TimeDuration readFrom:'120s'
- TimeDuration readFrom:'1500ms
+ TimeDuration readFrom:'1500ms'
TimeDuration readFrom:'3ms'
TimeDuration readFrom:'1yr 5d'
TimeDuration readFrom:'1mon'
@@ -340,6 +363,11 @@
TimeDuration readFrom:'05:10:5'
TimeDuration readFrom:'05:10:5.150'
+ TimeDuration readFrom:'-1h'
+ TimeDuration readFrom:'-1h 10m'
+ TimeDuration readFrom:'1h -10m'
+ TimeDuration readFrom:'-(1h 10m)'
+
TimeDuration readFrom:(TimeDuration new storeString)
"
@@ -472,7 +500,15 @@
days
"get the number of days"
- ^ timeEncoding // 1000 // 3600 // 24
+ ^ self
+ possiblyNegatedValueFromTimeEncodingInto:[:t |
+ t // 1000 // 3600 // 24
+ ].
+
+ "
+ (Duration days: 9 hours: 1 minutes: 2 seconds: 3) days
+ (Duration days: -9 hours: -1 minutes: -2 seconds: -3) days
+ "
!
hours
@@ -480,7 +516,14 @@
(notice: that is NOT the total number of hours,
but the fractional part only. Use this only for printing"
- ^ timeEncoding // 1000 // 3600 \\ 24
+ ^ self
+ possiblyNegatedValueFromTimeEncodingInto:[:t |
+ (t // 1000 // 3600 \\ 24)
+ ]
+ "
+ (Duration days: 9 hours: 1 minutes: 2 seconds: 3) hours
+ (Duration days: -9 hours: -1 minutes: -2 seconds: -3) hours
+ "
!
milliseconds
@@ -489,7 +532,14 @@
but the fractional part only. Use this only for printing.
asMilliseconds or getMilliseconds is probably what you want"
- ^ timeEncoding \\ 1000
+ ^ self
+ possiblyNegatedValueFromTimeEncodingInto:[:t |
+ t \\ 1000
+ ].
+ "
+ (Duration milliseconds:10) milliseconds
+ (Duration milliseconds:-10) milliseconds
+ "
"Modified: / 05-05-2010 / 14:22:04 / cg"
!
@@ -499,7 +549,15 @@
(notice: that is NOT the total number of minutes,
but the fractional part only. Use this only for printing"
- ^ timeEncoding // 1000 // 60 \\ 60
+ ^ self
+ possiblyNegatedValueFromTimeEncodingInto:[:t |
+ t // 1000 // 60 \\ 60
+ ]
+
+ "
+ (Duration days: 9 hours: 1 minutes: 2 seconds: 3) minutes
+ (Duration days: -9 hours: -1 minutes: -2 seconds: -3) minutes
+ "
!
seconds
@@ -508,7 +566,15 @@
but the fractional part only. Use this only for printing.
asSeconds or getSeconds is probably what you want"
- ^ timeEncoding // 1000 \\ 60
+ ^ self
+ possiblyNegatedValueFromTimeEncodingInto:[:t |
+ t // 1000 \\ 60
+ ]
+
+ "
+ (Duration days: 9 hours: 1 minutes: 2 seconds: 3) seconds
+ (Duration days: -9 hours: -1 minutes: -2 seconds: -3) seconds
+ "
! !
!TimeDuration methodsFor:'arithmetic'!
@@ -524,6 +590,10 @@
"
(TimeDuration fromString:'10s') * 5
+ (TimeDuration fromString:'10s') * 10
+ (TimeDuration fromString:'10s') * 100
+ (TimeDuration fromString:'10s') * 1000
+ (TimeDuration fromString:'-10s') * 1000
"
!
@@ -537,7 +607,10 @@
^ self species basicNew
setMilliseconds:(self getMilliseconds + aTimeDurationOrNumberOfSeconds getMilliseconds)
- "Created: / 04-10-2007 / 14:12:40 / cg"
+ "
+ (TimeDuration fromString:'1m') + (TimeDuration fromString:'10s')
+ 1 minutes + 10 seconds
+ "
!
/ aTimeDurationOrNumberOfSeconds
@@ -575,6 +648,16 @@
^ self class new timeEncoding:(timeEncoding negated)
!
+productFromFloat:aFloat
+ "return a new timeDuration"
+
+ ^ self productFromNumber:aFloat
+
+ "
+ 5.1 * (TimeDuration fromString:'10s')
+ "
+!
+
productFromFraction:aNumber
"return a new timeDuration"
@@ -585,6 +668,16 @@
"
!
+productFromInteger:anInteger
+ "return a new timeDuration"
+
+ ^ self productFromNumber:anInteger
+
+ "
+ 5 * (TimeDuration fromString:'10s')
+ "
+!
+
productFromNumber:aNumber
"return a new timeDuration"
@@ -592,7 +685,7 @@
setMilliseconds:(self getMilliseconds * aNumber) asInteger
"
- (TimeDuration fromString:'10s') * 5
+ 5.1 * (TimeDuration fromString:'10s')
"
! !
@@ -906,8 +999,9 @@
The format is suitable for a human - not meant to be read back."
timeEncoding negative ifTrue:[
- aStream nextPutAll:'-'.
+ aStream nextPutAll:'-('.
(self class basicNew timeEncoding:timeEncoding negated) printOn:aStream.
+ aStream nextPutAll:')'.
^ self
].
^ self
@@ -986,8 +1080,7 @@
minutes rounded into the hour or hidden, if its more than a few hours etc.
The way this is done is pure magic heuristics - let me know, if you have a better algorithm."
- ^ self
- printStringFormat:(self formatForApproximatePrinting).
+ ^ self printStringFormat:(self formatForApproximatePrinting).
"
(TimeDuration hours:0 minutes:0 seconds:0 milliseconds:123) printStringForApproximation
@@ -1151,6 +1244,13 @@
"Modified: / 18-07-2007 / 13:44:37 / cg"
!
+possiblyNegatedValueFromTimeEncodingInto:aBlock
+ timeEncoding < 0 ifTrue:[
+ ^ (aBlock value:(timeEncoding negated)) negated
+ ].
+ ^ aBlock value:timeEncoding
+!
+
setHours:h minutes:m seconds:s millis:millis
<resource: #obsolete>
"set my time given individual values"
--- a/Timestamp.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Timestamp.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -107,6 +105,10 @@
!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.
@@ -1576,7 +1578,7 @@
'IDLW' -720 false "/ international date line west
'IDLE' 720 false "/ international date line east
- 'MEZ' 60 false "/ mittel europäische Zeit / central european (german)
+ 'MEZ' 60 false "/ mittel europäische Zeit / central european (german)
'MESZ' 120 true "/ central european summer (german)
'WESZ' 60 true "/ west european summer (german)
@@ -3834,87 +3836,87 @@
peek := stream peekOrNil.
peek isNil ifTrue: [^self].
(peek == $:) ifTrue: [
- "/ read minutes
- stream next.
- minute := self nextDigits: 2.
+ "/ read minutes
+ stream next.
+ minute := self nextDigits: 2.
] ifFalse: [
- peek isDigit ifTrue: [
- "/ read minutes
- minute := self nextDigits: 2.
- ] ifFalse:[
- (peek == $. or:[peek == $,]) ifTrue:[
- stream next.
- minute := self readFraction * 60.
- ] ifFalse:[
- ^ self.
- ].
- ]
+ peek isDigit ifTrue: [
+ "/ read minutes
+ minute := self nextDigits: 2.
+ ] ifFalse:[
+ (peek == $. or:[peek == $,]) ifTrue:[
+ stream next.
+ minute := self readFraction * 60.
+ ] ifFalse:[
+ ^ self.
+ ].
+ ]
].
minute isInteger ifFalse:[
- f := minute.
- minute := f truncated.
- second := (f - minute) * 60.
- second isInteger ifFalse:[
- f := second.
- second := f truncated.
- millisecond := (f - second) * 1000.
- millisecond := millisecond rounded.
- ].
+ f := minute.
+ minute := f truncated.
+ second := (f - minute) * 60.
+ second isInteger ifFalse:[
+ f := second.
+ second := f truncated.
+ millisecond := (f - second) * 1000.
+ millisecond := millisecond rounded.
+ ].
].
(minute between: 0 and: 59) ifFalse: [self malformed: 'Bad minute: ' , minute printString].
peek := stream peekOrNil.
peek isNil ifTrue: [^self].
(peek == $:) ifTrue: [
- "/ read seconds
- stream next.
- second := self nextDigits: 2.
+ "/ read seconds
+ stream next.
+ second := self nextDigits: 2.
] ifFalse: [
- peek isDigit ifTrue: [
- "/ read seconds
- second := self nextDigits: 2.
- ] ifFalse:[
- (peek == $. or:[peek == $,]) ifTrue:[
- stream next.
- second := self readFraction * 60.
- ] ifFalse:[
- ^ self.
- ].
- ]
+ peek isDigit ifTrue: [
+ "/ read seconds
+ second := self nextDigits: 2.
+ ] ifFalse:[
+ (peek == $. or:[peek == $,]) ifTrue:[
+ stream next.
+ second := self readFraction * 60.
+ ] ifFalse:[
+ ^ self.
+ ].
+ ]
].
second isInteger ifFalse:[
- f := second.
- second := f truncated.
- millisecond := (f - second) * 1000.
- millisecond := millisecond rounded.
+ f := second.
+ second := f truncated.
+ millisecond := (f - second) * 1000.
+ millisecond := millisecond rounded.
].
(second between: 0 and: 59) ifFalse: [
- "Seconds are usually in this range, do a special check for leap seconds."
- second <= 61
- ifTrue: [
- "Leap seconds can occur only on midnight on 31.12. or 30.6. Dont' check year
- as it's not deterministic."
- (minute = 59 and: [hour = 23 and: [(month = 12 and: [day = 31]) or: [month = 6 and: [day = 30]]]])
- ifFalse: [self malformed: 'Bad leap second']]
- ifFalse: [self malformed: 'Bad second: ' , second printString]
+ "Seconds are usually in this range, do a special check for leap seconds."
+ second <= 61
+ ifTrue: [
+ "Leap seconds can occur only on midnight on 31.12. or 30.6. Don't check year
+ as it's not deterministic."
+ (minute = 59 and: [hour = 23 and: [(month = 12 and: [day = 31]) or: [month = 6 and: [day = 30]]]])
+ ifFalse: [self malformed: 'Bad leap second']]
+ ifFalse: [self malformed: 'Bad second: ' , second printString]
].
"Hour, minute and second read. Read appendices."
((peek := stream peekOrNil) == $. or:[peek == $,])
- ifTrue: [
- "Read dot. Skip it and read milliseconds."
- stream next.
- self readMilliseconds].
+ ifTrue: [
+ "Read dot. Skip it and read milliseconds."
+ stream next.
+ self readMilliseconds].
hour = 24 ifTrue: [
- (minute = 0 and: [second = 0 and: [millisecond = 0]])
- ifTrue: [
- "On 24 hour, advance to the next day."
- "hour := 0.
- self addMinutes: 1440"]
- ifFalse: [self malformed: 'Bad 24 hour (minutes, seconds and millis not 0)']
+ (minute = 0 and: [second = 0 and: [millisecond = 0]])
+ ifTrue: [
+ "On 24 hour, advance to the next day."
+ "hour := 0.
+ self addMinutes: 1440"]
+ ifFalse: [self malformed: 'Bad 24 hour (minutes, seconds and millis not 0)']
]
"Created: / 14-06-2005 / 17:27:00 / masca"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/UnboxedIntegerArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,118 @@
+"
+ COPYRIGHT (c) 2003 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 }"
+
+AbstractNumberVector subclass:#UnboxedIntegerArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!UnboxedIntegerArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2003 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
+"
+ An abstract superclass for all unboxed integer classes.
+ In contrast to normal arrays (which store pointers to their elements),
+ unboxedIntegerArrays store the values in a dense & compact way.
+ Since the representation fits corresponding underlying C-language representations,
+ these are also useful to pass bulk data to c primitive code.
+
+ [see also:]
+ ByteArray WordArray BooleanArray FloatArray DoubleArray Array
+ IntegerArray LongIntegerArray SignedLongIntegerArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!UnboxedIntegerArray class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned for UnboxedIntegerArray here; false for subclasses.
+ Abstract subclasses must redefine this again."
+
+ ^ self == UnboxedIntegerArray
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me"
+
+ ^ self subclassResponsibility.
+!
+
+minVal
+ "the minimum value which can be stored in instances of me"
+
+ ^ self subclassResponsibility.
+! !
+
+!UnboxedIntegerArray methodsFor:'printing'!
+
+printOn:aStream base:radix showRadix:showRadix
+ "append a printed representation to aStream in the given number base."
+
+ (self class == WordArray or:[self class == LongIntegerArray])
+ ifTrue:[ "/ care for subclasses
+ aStream nextPutAll:'#('.
+ self
+ do:[:word | word printOn:aStream base:radix showRadix:showRadix]
+ separatedBy:[aStream space].
+ aStream nextPut:$).
+ ^ self
+ ].
+ ^ self printOn:aStream
+! !
+
+!UnboxedIntegerArray methodsFor:'queries'!
+
+defaultElement
+ ^ 0
+!
+
+isValidElement:anObject
+ "return true, if I can hold this kind of object"
+
+ ^ anObject isInteger
+ and:[ (anObject >= self class minVal)
+ and:[ (anObject <= self class maxVal) ]]
+! !
+
+!UnboxedIntegerArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/UndefinedObject.st Wed Oct 19 09:22:53 2016 +0100
+++ b/UndefinedObject.st Fri Dec 09 22:31:28 2016 +0000
@@ -110,7 +110,6 @@
"Modified: 3.1.1997 / 15:06:15 / cg"
! !
-
!UndefinedObject class methodsFor:'queries'!
canBeSubclassed
@@ -154,8 +153,6 @@
! !
-
-
!UndefinedObject methodsFor:'Compatibility-Squeak'!
subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString category:cat
@@ -251,15 +248,15 @@
!UndefinedObject methodsFor:'error catching'!
basicAt:index
- "catch array access - its illegal
- defined here since basicAt: in Object ommits the nil-check"
+ "catch array access - it's illegal.
+ Redefined here since basicAt: in Object ommits the nil-check"
^ self notIndexed
!
basicAt:index put:anObject
- "catch array access - its illegal
- defined here since basicAt:put: in Object ommits the nil-check"
+ "catch array access - it's illegal.
+ Redefined here since basicAt:put: in Object ommits the nil-check"
^ self notIndexed
! !
@@ -741,7 +738,6 @@
^ aVisitor visitNilWith:aParameter
! !
-
!UndefinedObject class methodsFor:'documentation'!
version
--- a/UninterpretedBytes.st Wed Oct 19 09:22:53 2016 +0100
+++ b/UninterpretedBytes.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -429,7 +431,7 @@
RETURN (false);
# else
/*
- * I dont like ifdefs - you always forget some ...
+ * I don't like ifdefs - you always forget some ...
* therefore we look into a structure at run-time.
* (also, there are CPUs around [mips], where the byteorder
* is programmable, and which come in different flavours)
@@ -467,6 +469,193 @@
"Modified: / 5.3.1998 / 14:56:22 / stefan"
! !
+!UninterpretedBytes methodsFor:'@ OLE Extensions'!
+
+addressAtOffset: index0Based
+ "Answer the bytes starting at index0Based (0 based offset)
+ as anExternalAddress. Answer nil if there is no address.
+ Notice: Offsets are zero relative."
+
+ | address |
+
+ address := self pointerValueAt: index0Based + 1.
+ ^ address = 0
+ ifTrue: [ nil ]
+ ifFalse: [ ExternalAddress newAddress: address ]
+
+ "Modified: / 30-03-2016 / 11:00:19 / cg"
+!
+
+addressAtOffset: index0Based put: anExternalAddress
+ "Set the bytes starting at index0Based (0 based offset)
+ from the contents of anExternalAddress.
+ Notice: Offsets are zero relative."
+
+ |anAddress |
+
+ anAddress := anExternalAddress isNil
+ ifTrue:[0]
+ ifFalse:[anExternalAddress address].
+ self pointerAt: index0Based + 1 put: anAddress
+!
+
+addressValueAtOffset: index0Based
+ "Answer the pointer-value starting at index0Based (0 based offset)
+ as unsigned integer.
+ Notice: Offsets are zero relative."
+
+ ^ self pointerValueAt: index0Based + 1.
+!
+
+addressValueAtOffset: index0Based put:anAddress
+ "Set the pointer-value starting at index0Based (0 based offset)
+ as unsigned integer.
+ Notice: Offsets are zero relative."
+
+ self pointerAt: index0Based + 1 put:anAddress.
+!
+
+byteAtOffset:index0Based
+ "return the byte at index0Based.
+ For ByteArray, this is the same as basicAt:
+ however, for strings or symbols,
+ this returns a numeric byteValue instead of a character.
+ Notice: Offsets are zero relative."
+
+ ^ self byteAt:(index0Based + 1)
+!
+
+byteAtOffset:index0Based put:value
+ "set the byte at index. For ByteArray, this is the same as basicAt:put:.
+ However, for Strings, this expects a byteValue to be stored.
+ Notice: Offsets are zero relative."
+
+ ^ self byteAt:(index0Based + 1) put:value
+!
+
+bytesAtOffset: index0Based count: count
+ "Answer a ByteArray with count bytes copied
+ from the receiver starting at index0Based.
+ Notice: Offsets are zero relative."
+
+ |newBytes |
+
+ newBytes := ByteArray new: count.
+ newBytes replaceBytesFrom:1 to:count with:self startingAt:(index0Based + 1).
+ ^newBytes
+
+ "
+ #[83 0 0 0 0 0 0 0 120 237 14 0 4 0 0 ] bytesAtOffset: 9 count: 3
+ "
+
+ "Modified (comment): / 30-03-2016 / 11:24:41 / cg"
+!
+
+bytesAtOffset: index0Based put: aByteObject
+ "Store aByteObject at anInteger in the receiver.
+ Notice: Offsets are zero relative."
+
+ ^ self
+ replaceBytesFrom:(index0Based + 1) to:(index0Based + aByteObject size)
+ with:aByteObject startingAt:1.
+!
+
+fillFromAddress: anAddress
+ "Fill the receiver by copying mySize bytes from host memory at anAddress.
+ Warning: because anAddress might not know, how big it is,
+ the size of the receiver must already be correct.
+ (i.e. the receiver must have been allocated from a returned size value)"
+
+ self
+ replaceFrom:1 to:self size
+ with:anAddress asExternalBytes
+ startingAt:1
+!
+
+longAtOffset: index0Based
+ "same as longAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self signedInt32At:(index0Based + 1)
+!
+
+longAtOffset: index0Based put: value
+ "same as longAtput::, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self signedInt32At:index0Based +1 put:value
+!
+
+shortAtOffset: index0Based
+ "same as shortAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self signedInt16At: index0Based + 1
+!
+
+shortAtOffset: index0Based put: value
+ "same as shortAt:put:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self signedInt16At: index0Based + 1 put: value
+!
+
+uLongAtOffset: index0Based
+ "same as unsignedLongAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^ self unsignedInt32At:(index0Based + 1)
+!
+
+uLongAtOffset: index0Based put: value
+ "same as unsignedLongAt:put:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^ self unsignedInt32At:(index0Based + 1) put: value
+!
+
+uShortAtOffset: index0Based
+ "same as unsignedShortAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^ self unsignedInt16At:(index0Based + 1)
+!
+
+uShortAtOffset: index0Based put: value
+ "same as unsignedShortAt:put:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^ self unsignedInt16At:(index0Based + 1) put: value
+!
+
+unsignedLongAtOffset: index0Based
+ "same as unsignedLongAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self unsignedInt32At: index0Based + 1
+!
+
+unsignedLongAtOffset: index0Based put: value
+ "same as unsignedLongAt:put:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self unsignedInt32At: index0Based + 1 put: value
+!
+
+unsignedShortAtOffset: index0Based
+ "same as unsignedShortAt:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self unsignedInt16At: index0Based + 1
+!
+
+unsignedShortAtOffset: index0Based put: value
+ "same as unsignedShortAt:put:, but with a 0-based offset.
+ Notice: Offsets are zero relative."
+
+ ^self unsignedInt16At:(index0Based + 1) put: value
+! !
+
!UninterpretedBytes methodsFor:'Compatibility'!
doubleWordAt:index
@@ -743,7 +932,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
@@ -1499,7 +1688,7 @@
cp += idx;
#if defined(__i386__)
/*
- * aligned or not, we dont care (i386 can do both)
+ * aligned or not, we don't care (i386 can do both)
*/
{
INT iVal = ((INT *)cp)[0];
@@ -2552,179 +2741,6 @@
!UninterpretedBytes methodsFor:'accessing-longs (32bit)'!
-pointerAt:index
- "get a pointer starting at index as ExternalAddress.
- The index is a smalltalk index (i.e. 1-based).
- Only aligned accesses are allowed."
-
-%{
- if (__isSmallInteger(index)) {
- unsigned char *cp;
- INT sz;
-
- __fetchBytePointerAndSize__(self, &cp, &sz);
- if (cp) {
- INT idx = __smallIntegerVal(index) - 1;
- char *pointer;
-
- if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
- cp += idx;
- /*
- * aligned
- */
- if (((INT)cp & (sizeof(pointer)-1)) == 0) {
- pointer = ((char **)cp)[0];
- RETURN (__MKEXTERNALADDRESS(pointer));
- } else {
-#if 0
- printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
-#endif
- }
- } else {
-#if 0
- printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
- idx, (int)(sizeof(pointer)-1), sz);
-#endif
- }
- } else {
-#if 0
- printf("cp is NULL\n");
-#endif
- }
- } else {
-#if 0
- printf("bad index\n");
-#endif
- }
-bad:;
-%}.
-
- self primitiveFailed.
-
- "
- |b|
- b := ByteArray new:(ExternalAddress pointerSize).
- b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
- Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
- Transcript showCR:((b pointerAt:1)).
- "
-!
-
-pointerAt:index put:value
- "set the pointer starting at index from the integer or externalAddress value.
- The index is a smalltalk index (i.e. 1-based).
- Only aligned accesses are allowed.
- The value is either an ExternalAddress, ExternalBytes or an Integer"
-
-%{
- OBJ *pointer;
-
- if (__isExternalAddressLike(value)) {
- pointer = __externalAddressVal(value);
- } else if (__isExternalBytesLike(value)) {
- pointer = __externalBytesVal(value);
- if (pointer == (OBJ *)0)
- pointer = 0;
- } else if (value == nil) {
- pointer = 0;
- } else if (__isSmallInteger(value)) {
- pointer = (OBJ *)__intVal(value);
- } else {
- if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
- goto bad;
- }
- }
-
- if (__isSmallInteger(index)) {
- unsigned char *cp;
- INT sz;
-
- __fetchBytePointerAndSize__(self, &cp, &sz);
- if (cp) {
- INT idx = __smallIntegerVal(index) - 1;
-
- if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
- cp += idx;
- /*
- * aligned
- */
- if (((INT)cp & (sizeof(pointer)-1)) == 0) {
- ((char **)cp)[0] = (char *) pointer;
- RETURN (value);
- }
- }
- }
- }
-bad:;
-%}.
-
- self primitiveFailed.
-
- "
- |b|
- b := ByteArray new:ExternalAddress pointerSize.
- b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
- (b unsignedLongAt:1) printStringRadix:16
- "
-
- "Modified: / 1.7.1996 / 21:11:39 / cg"
- "Created: / 5.3.1998 / 10:57:18 / stefan"
-!
-
-pointerValueAt:index
- "get a pointer value starting at index as unsigned integer.
- The index is a smalltalk index (i.e. 1-based).
- Only aligned accesses are allowed.
- This returns an int with sizeof the machines's native pointer (4 or 8 bytes)"
-
-%{
- if (__isSmallInteger(index)) {
- unsigned char *cp;
- INT sz;
-
- __fetchBytePointerAndSize__(self, &cp, &sz);
- if (cp) {
- INT idx = __smallIntegerVal(index) - 1;
- char *pointer;
-
- if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
- cp += idx;
- /*
- * aligned
- */
- if (((INT)cp & (sizeof(pointer)-1)) == 0) {
- pointer = ((char **)cp)[0];
- RETURN (__MKUINT((INT)(pointer)));
- } else {
- // printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
- }
- } else {
- // printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
- // idx, (int)(sizeof(pointer)-1), sz);
- }
- } else {
- // printf("cp is NULL\n");
- }
- } else {
- // printf("bad index\n");
- }
-bad:;
-%}.
-
- self primitiveFailed.
-
- "
- |b|
- b := ByteArray new:(ExternalAddress pointerSize).
- b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
- Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
- Transcript showCR:((b pointerAt:1)).
- Transcript showCR:((b pointerValueAt:1)).
- "
-
- "Modified (comment): / 30-03-2016 / 11:01:55 / cg"
-!
-
signedInt32At:byteIndex
"return the 4-bytes starting at byteIndex as a signed Integer.
The index is a smalltalk index (i.e. 1-based).
@@ -3126,7 +3142,7 @@
} else {
#if defined(__i386__) || (defined(UNALIGNED_FETCH_OK) && defined(__LSBFIRST__))
/*
- * aligned or not - we dont care
+ * aligned or not - we don't care
* (i386 can fetch unaligned)
*/
iVal = ((unsigned int *)cp)[0];
@@ -3343,6 +3359,192 @@
^ self unsignedInt32At:byteIndex put:anInteger MSB:true
! !
+!UninterpretedBytes methodsFor:'accessing-pointers'!
+
+pointerAt:byteIndex
+ "get a pointer starting at byteIndex as ExternalAddress.
+ The byteIndex is a smalltalk index (i.e. 1-based).
+ Only aligned accesses are allowed.
+ The pointer is of native cpu's size (4 or 8 bytes)"
+
+%{
+ if (__isSmallInteger(byteIndex)) {
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ INT idx = __smallIntegerVal(byteIndex) - 1;
+ char *pointer;
+
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+ cp += idx;
+ /*
+ * aligned
+ */
+ if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+ pointer = ((char **)cp)[0];
+ RETURN (__MKEXTERNALADDRESS(pointer));
+ } else {
+#if 0
+ printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
+#endif
+ }
+ } else {
+#if 0
+ printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
+ idx, (int)(sizeof(pointer)-1), sz);
+#endif
+ }
+ } else {
+#if 0
+ printf("cp is NULL\n");
+#endif
+ }
+ } else {
+#if 0
+ printf("bad index\n");
+#endif
+ }
+bad:;
+%}.
+
+ self primitiveFailed.
+
+ "
+ |b|
+ b := ByteArray new:(ExternalAddress pointerSize).
+ b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+ Transcript showCR:((b unsignedInt32At:1) printStringRadix:16).
+ Transcript showCR:((b pointerAt:1)).
+
+ |b|
+ b := ByteArray new:(ExternalAddress pointerSize).
+ b pointerAt:1 put:(ExternalAddress newAddress:16r12345678abcdef).
+ Transcript showCR:((b unsignedInt64At:1) printStringRadix:16).
+ Transcript showCR:((b pointerAt:1)).
+ "
+
+ "Modified (comment): / 14-11-2016 / 17:32:23 / cg"
+!
+
+pointerAt:byteIndex put:value
+ "set the pointer starting at byteIndex from the integer or externalAddress value.
+ The byteIndex is a smalltalk index (i.e. 1-based).
+ Only aligned accesses are allowed.
+ The pointer is of native cpu's size (4 or 8 bytes).
+ The value may be either an ExternalAddress, ExternalBytes or an Integer"
+
+%{
+ OBJ *pointer;
+
+ if (__isExternalAddressLike(value)) {
+ pointer = __externalAddressVal(value);
+ } else if (__isExternalBytesLike(value)) {
+ pointer = __externalBytesVal(value);
+ if (pointer == (OBJ *)0)
+ pointer = 0;
+ } else if (value == nil) {
+ pointer = 0;
+ } else if (__isSmallInteger(value)) {
+ pointer = (OBJ *)__intVal(value);
+ } else {
+ if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
+ goto bad;
+ }
+ }
+
+ if (__isSmallInteger(byteIndex)) {
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ INT idx = __smallIntegerVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+ cp += idx;
+ /*
+ * aligned
+ */
+ if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+ ((char **)cp)[0] = (char *) pointer;
+ RETURN (value);
+ }
+ }
+ }
+ }
+bad:;
+%}.
+
+ self primitiveFailed.
+
+ "
+ |b|
+ b := ByteArray new:ExternalAddress pointerSize.
+ b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+ (b unsignedLongAt:1) printStringRadix:16
+ "
+
+ "Created: / 05-03-1998 / 10:57:18 / stefan"
+ "Modified (comment): / 14-11-2016 / 17:28:27 / cg"
+!
+
+pointerValueAt:byteIndex
+ "get a pointer value starting at byteIndex as unsigned integer.
+ The byteIndex is a smalltalk index (i.e. 1-based).
+ Only aligned accesses are allowed.
+ The pointer is of native cpu's size (4 or 8 bytes).
+ This returns an int with sizeof the machines's native pointer (4 or 8 bytes)"
+
+%{
+ if (__isSmallInteger(byteIndex)) {
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ INT idx = __smallIntegerVal(byteIndex) - 1;
+ char *pointer;
+
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+ cp += idx;
+ /*
+ * aligned
+ */
+ if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+ pointer = ((char **)cp)[0];
+ RETURN (__MKUINT((INT)(pointer)));
+ } else {
+ // printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
+ }
+ } else {
+ // printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
+ // idx, (int)(sizeof(pointer)-1), sz);
+ }
+ } else {
+ // printf("cp is NULL\n");
+ }
+ } else {
+ // printf("bad index\n");
+ }
+bad:;
+%}.
+
+ self primitiveFailed.
+
+ "
+ |b|
+ b := ByteArray new:(ExternalAddress pointerSize).
+ b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+ Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
+ Transcript showCR:((b pointerAt:1)).
+ Transcript showCR:((b pointerValueAt:1)).
+ "
+
+ "Modified (comment): / 14-11-2016 / 17:28:33 / cg"
+! !
+
!UninterpretedBytes methodsFor:'accessing-shorts (16bit)'!
signedInt16At:byteIndex
@@ -3393,7 +3595,7 @@
if (msb == false) {
#if defined(__i386__) || (defined(__LSBFIRST__) && defined(UNALIGNED_FETCH_OK))
/*
- * aligned or not, we dont care (i386 can do both)
+ * aligned or not, we don't care (i386 can do both)
*/
sVal = ((short *)cp)[0];
#else
@@ -3614,7 +3816,7 @@
if (msb == false) {
#if defined(__i386__) || (defined(__LSBFIRST__) && defined(UNALIGNED_FETCH_OK))
/*
- * aligned or not, we dont care (i386 can do both)
+ * aligned or not, we don't care (i386 can do both)
*/
iVal = ((unsigned short *)cp)[0];
#else
@@ -4562,6 +4764,14 @@
"
! !
+!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'!
--- a/UnixFilename.st Wed Oct 19 09:22:53 2016 +0100
+++ b/UnixFilename.st Fri Dec 09 22:31:28 2016 +0000
@@ -61,8 +61,7 @@
tempDirString notNil ifTrue:[
tempDir := self named:tempDirString.
(tempDir exists and:[ tempDir isWritable ]) ifTrue:[
- ('Filename [info]: using tmp folder "%1" as specified by environment: "%2"'
- bindWith:tempDir pathName with:envVar) infoPrintCR.
+ Logger info: 'using tmp folder "%1" as specified by environment: "%2"' with:tempDir pathName with:envVar.
^ tempDir asFilename.
].
].
@@ -77,6 +76,8 @@
Filename defaultTempDirectoryName exists
Filename defaultTempDirectoryName isWritable
"
+
+ "Modified: / 27-10-2016 / 23:09:08 / jv"
! !
!UnixFilename class methodsFor:'queries'!
--- a/UnixOperatingSystem.st Wed Oct 19 09:22:53 2016 +0100
+++ b/UnixOperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
@@ -504,6 +504,7 @@
# endif
# if defined(HAS_SYSINFO)
+# include <sys/sysinfo.h>
# include <sys/systeminfo.h>
# endif
@@ -540,7 +541,7 @@
* on some systems errno is a macro ... check for it here
*/
#ifndef errno
- extern errno;
+ extern int errno;
#endif
/*
@@ -689,13 +690,15 @@
# if !defined (__sigemptyset)
# define __sigemptyset sigemptyset
+# endif
+# if !defined (__sigaction)
# define __sigaction sigaction
# define __sigaddset sigaddset
# define __sigprocmask sigprocmask
# define __execve execve
# define __wait wait
# define __waitpid waitpid
-# endif /* ! LINUX */
+# endif /* ! LINUX */
# define __sigprocmask sigprocmask
# define __execve execve
@@ -705,8 +708,7 @@
static int
-mySystem(line)
- register CONST char *line;
+mySystem(const char *line)
{
int status, save;
pid_t pid;
@@ -991,35 +993,51 @@
documentation
"
- this class realizes access to most (all?) required operating system services;
- some of it is very specific for unix, so do not depend on
- things available here in your applications
- - some may not be found in other OS's or be slightly different ...
-
- (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).
- You decide - portability vs. functionality)
-
+ This class realizes access to most (all?) required operating system services.
+ At startup, the global 'OperatingSystem' will be bound to either me, or one of
+ my sibling classes, Win32OperatingSystem, VMSOperatinSystem or OSXOperatingSystem.
+
+ 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
+ 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).
+ You decide - portability vs. functionality.
+
+ 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
"
!
@@ -3527,13 +3545,14 @@
fork
"fork a new (HEAVY-weight) unix process.
Not supported with MSDOS & VMS systems.
- Dont 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) to the parent (original) process.
-
- In normal situations, you dont need to use this low level entry; see
- #startProcess: and #executCommand: for higher level interfaces."
+ 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)
+ to the parent (original) process.
+
+ In normal situations, you don't need to use this low level entry;
+ see #startProcess: and #executeCommand: for higher level interfaces."
%{ /* NOCONTEXT */
int pid;
@@ -3547,13 +3566,16 @@
^ UnsupportedOperationSignal raise
"
- |id|
-
+ |id t1 t2 t3|
+
+ t1 := Timestamp now.
id := OperatingSystem fork.
id == 0 ifTrue:[
- 'I am the child process' printCR.
- OperatingSystem exit
- ]
+ 'Child t=' print. (Timestamp now - t1) printCR.
+ 'I am the child process' printCR.
+ OperatingSystem exit
+ ].
+ 'Parent t=' print. (Timestamp now - t1) printCR.
"
!
@@ -3634,6 +3656,127 @@
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
@@ -3648,109 +3791,10 @@
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:true "/ false
- 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"
+ ^ self
+ startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+ errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
+ environment:anEvironmentDictionary inDirectory:dir newPgrp:true showWindow:ignoredHere
! !
!UnixOperatingSystem class methodsFor:'executing OS commands-queries'!
@@ -3831,7 +3875,7 @@
].
"/ command is a single word, not relative and not absolute.
- "/ search along PATH environment variable to see what a shoell would do.
+ "/ 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 |
@@ -3896,13 +3940,16 @@
%{
#if defined(HAS_SENDFILE)
+# include <sys/sendfile.h>
+
if (__isSmallInteger(inFd)
&& __isSmallInteger(outFd)
&& __isSmallInteger(startIdx)
&& __isSmallInteger(count)) {
- int nWritten;
-
- nWritten = sendfile(__intVal(outFd), __intVal(inFd), __intVal(startIdx), __intVal(count));
+ off_t startOffset = __intVal(startIdx);
+ ssize_t nWritten;
+
+ nWritten = sendfile(__intVal(outFd), __intVal(inFd), &startOffset, __intVal(count));
if (nWritten < 0) {
@global(LastErrorNumber) = __mkSmallInteger(errno);
}
@@ -3932,25 +3979,31 @@
createDirectory:aPathName withAccess:umask
"create a new directory with name 'aPathName', which may be an absolute
path, or relative to the current directory.
- Return true if successful (or the directory existed already), false if failed.
+ Return nil if successful (or the directory existed already), an OsErrorHolder otherwise.
This is a low-level entry - use Filename protocol for compatibility."
- |encodedPathName|
+ |encodedPathName error|
encodedPathName := self encodePath:aPathName.
%{
if (__isStringLike(encodedPathName) && __isSmallInteger(umask)) {
- if (mkdir(__stringVal(encodedPathName), __smallIntegerVal(umask)) >= 0) {
- RETURN(true);
- }
- @global(LastErrorNumber) = __mkSmallInteger(errno);
+ if (mkdir(__stringVal(encodedPathName), __smallIntegerVal(umask)) >= 0) {
+ RETURN(nil);
+ }
+ error = __mkSmallInteger(errno);
}
%}.
"/ could not create - if it already existed this is ok
- (self isDirectory:aPathName) ifTrue:[^ true].
- ^ false.
+ (self isDirectory:aPathName) ifTrue:[^ nil].
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
+ ^ self primitiveFailed
"
@@ -3979,7 +4032,7 @@
"link the file 'oldPath' to 'newPath'. The link will be a hard link.
Return true if successful, false if not."
- |encodedOldPathName encodedNewPathName|
+ |encodedOldPathName encodedNewPathName error|
encodedOldPathName := self encodePath:oldPath.
encodedNewPathName := self encodePath:newPath.
@@ -3988,18 +4041,23 @@
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN (true);
- }
-%}.
+ __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.
+ ].
+
"/
"/ bad argument(s) given
"/
@@ -4013,9 +4071,9 @@
createSymbolicLinkFrom:oldPath to:newPath
"make a symbolic link for 'newPath' to the file 'oldPath'.
The link will be a soft (symbolic) link.
- Raise an error on error."
-
- |error encodedOldPathName encodedNewPathName|
+ Answer nil on success and an OSErrorHolder on error."
+
+ |encodedOldPathName encodedNewPathName error|
encodedOldPathName := self encodePath:oldPath.
encodedNewPathName := self encodePath:newPath.
@@ -4024,32 +4082,35 @@
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 (true);
- }
- @global(LastErrorNumber) = error = __mkSmallInteger(errno);
- }
-#endif
-%}.
+ __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.
+ ].
+
(encodedOldPathName isString not or:[encodedNewPathName isString not]) ifTrue:[
- "/
- "/ bad argument(s) given
- "/
- ^ self primitiveFailed
- ].
- error notNil ifTrue:[
- (self errorHolderForNumber:error) reportError
+ "/
+ "/ bad argument(s) given
+ "/
+ ^ self primitiveFailed
].
"/
"/ this Unix does not seem to support symbolic links
"/
- ^ UnsupportedOperationSignal raise
+ ^ OSErrorHolder unsupportedOperation
"
OperatingSystem createSymbolicLinkFrom:'foo' to:'/tmp/bar'
@@ -4233,28 +4294,33 @@
Return true if successful, false if directory is not empty or no permission.
This is a lowLevel entry - use Filename protocol for compatibility."
- |encodedPathName|
+ |encodedPathName error|
encodedPathName := self encodePath:fullPathName.
%{
int ret;
if (__isStringLike(encodedPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = rmdir((char *) __stringVal(encodedPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN (true);
- }
-%}.
+ __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.
+ ].
+
"/
- "/ either not a string argument,
- "/ or not supported by OS
+ "/ either not a string argument
"/
^ self primitiveFailed
@@ -4268,25 +4334,32 @@
"remove the file named 'fullPathName'; return true if successful.
This is a lowLevel entry - use Filename protocol for compatibility."
- |encodedPathName|
+ |encodedPathName error|
encodedPathName := self encodePath:fullPathName.
%{
int ret;
if (__isStringLike(encodedPathName)) {
- __BEGIN_INTERRUPTABLE__
- do {
- ret = unlink((char *) __stringVal(encodedPathName));
- } while (ret < 0 && errno == EINTR);
- __END_INTERRUPTABLE__
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN (true);
- }
-%}.
+ __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.
+ ].
+
+
^ self primitiveFailed
!
@@ -4296,9 +4369,9 @@
correct for the OS used - therefore, this should not be called
directly. Instead, use Filename protocol to rename; this cares for
any invalid names.
- Returns true if successful, false if not"
-
- |encodedOldPathName encodedNewPathName|
+ Returns nil if successful, an OsErrorHolder if not"
+
+ |encodedOldPathName encodedNewPathName error|
encodedOldPathName := self encodePath:oldPath.
encodedNewPathName := self encodePath:newPath.
@@ -4307,29 +4380,34 @@
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN (true);
- }
-%}.
+ 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.
+ ].
+
^ self primitiveFailed
"
@@ -4342,9 +4420,8 @@
%{
sync();
- RETURN (self);
-%}.
- ^ self primitiveFailed
+%}.
+ ^ nil
!
syncFileSystem:handle
@@ -4377,12 +4454,12 @@
!
truncateFile:aPathName to:newSize
- "change a files size return true on success, false on failure.
+ "change a files size return nil on success, an OSErrorHolder on failure.
This may not be supported on all architectures.
This is a low-level entry - use Filename protocol."
- |encodedPathName|
+ |encodedPathName error|
encodedPathName := self encodePath:aPathName.
@@ -4392,62 +4469,70 @@
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__
-#else
-# ifdef HAS_FTRUNCATE
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = truncate((char *) __stringVal(encodedPathName), truncateSize);
+ } while (ret < 0 && errno == EINTR);
+ __END_INTERRUPTABLE__
+
+#elif defined(HAS_FTRUNCATE)
{
- int fd;
-
- do {
- fd = open((char *) __stringVal(encodedPathName), 2);
- } while (fd < 0 && errno == EINTR);
- if (fd < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
-
- ret = ftruncate(fd, truncateSize);
- close(fd);
- }
-# endif /* HAS_FTRUNCATE */
-#endif
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN (true);
+ 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);
+
getOutOfHere:;
-#endif
-%}.
+#else
+ error = __mkSmallInteger(ENOTSUP);
+#endif
+%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
^ self primitiveFailed
+
+ "
+ self truncateFile:'foo' to:2222222
+ "
! !
!UnixOperatingSystem class methodsFor:'file access rights'!
@@ -4523,17 +4608,17 @@
accessModeOf:aPathName
"return a number representing access rights rwxrwxrwx for owner,
- group and others. Return nil if such a file does not exist.
+ group and others. Return an OSErrorHolder if such a file does not exist.
Notice that the returned number is OS dependent - use the
modeMasks as returned by OperatingSystem>>accessMaskFor:"
"
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
"
- |encodedPathName|
+ |encodedPathName error|
encodedPathName := self encodePath:aPathName.
%{
@@ -4542,21 +4627,26 @@
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( nil );
- }
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
-%}.
+ 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.
+ ].
+
^ self primitiveFailed
"
@@ -4570,32 +4660,39 @@
Notice that the returned number is OS dependent - use the
modeMasks as returned by OperatingSystem>>accessMaskFor:"
+ |error|
+
%{
struct stat buf;
int ret;
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( nil );
- }
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
-%}.
- ^ self primitiveFailed
+ 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.
+ ].
+
+ ^ self primitiveFailed
"
'/' asFilename readingFileDo:[:s|
- (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8
+ (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8
].
"
!
@@ -4603,54 +4700,72 @@
changeAccessModeOf:aPathName to:modeBits
"change the access rights of aPathName to the OS dependent modeBits.
You should construct this mask using accessMaskFor, to be OS
- independent. Return true if changed,
- false if such a file does not exist or change was not allowd."
-
- |encodedPathName|
+ independent. Return nil if changed,
+ anOSErrorHolder if such a file does not exist or change was not allowd."
+
+ |encodedPathName error|
encodedPathName := self encodePath:aPathName.
%{
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN ( true );
- }
-%}.
+ __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.
+ ].
+
^ self primitiveFailed
+
+ "
+ self changeAccessModeOf:'foo' to:8r666
+ "
!
changeAccessModeOfFd:aFileDescriptor to:modeBits
"change the access rights of the file referenced by aFileDescriptor
to the OS dependent modeBits.
You should construct this mask using accessMaskFor, to be OS
- independent. Return true if changed,
- false if such a file does not exist or change was not allowd."
+ independent. Return nil if changed,
+ an OSErrorHolder if such a file does not exist or change was not allowed."
+
+ |error|
%{
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) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN ( false );
- }
- RETURN ( true );
- }
-%}.
+ __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.
+ ].
+
^ self primitiveFailed
! !
@@ -4748,29 +4863,12 @@
^ false
!
-supportsFileLinks
- "return true, if the OS supports file links (hard links).
- Typically, only unix returns true here."
-
- ^ true
-
- "Modified: / 5.6.1998 / 18:35:01 / cg"
-!
-
supportsFileLocks
"return true, if the OS supports file locking"
%{ /* NOCONTEXT */
-#if defined(F_SETLK)
- RETURN (true);
-#else
-# if defined(LOCK_EX) && defined(LOCK_UN)
+#if defined(F_SETLK) || (defined(LOCK_EX) && defined(LOCK_UN)) || defined(F_LOCK) && defined(F_UNLOCK)
RETURN (true);
-# else
-# if defined(F_LOCK) && defined(F_UNLOCK)
- RETURN (true);
-# endif
-# endif
#endif
%}.
^ false
@@ -4785,12 +4883,8 @@
(i.e. with immediate return instead of waiting for the lock)"
%{ /* NOCONTEXT */
-#if defined(F_SETLK) && defined(F_SETLKW)
+#if (defined(F_SETLK) && defined(F_SETLKW)) || (defined(LOCK_EX) && defined(LOCK_UN) && defined(LOCK_NB))
RETURN (true);
-#else
-# if defined(LOCK_EX) && defined(LOCK_UN) && defined(LOCK_NB)
- RETURN (true);
-# endif
#endif
%}.
^ false
@@ -5118,15 +5212,15 @@
!
getObjectFileInfoFor:aStringOrFilename
- "Return and info object for given executable or shared object
+ "Return an info object for a given executable or shared object
or throw an error if given file is not a valid an executable now
shared object.
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
@@ -6108,7 +6202,7 @@
defaultSignal:signalNumber
"revert to the default action on arrival of a (Unix-)signal.
- Dont confuse Unix signals with smalltalk signals.
+ Don't confuse Unix signals with smalltalk signals.
WARNING: for some signals, it is no good idea to revert to default;
for example, the default for SIGINT (i.e. ^C) is to exit; while the
default for SIGQUIT (^ \) is to dump core.
@@ -6120,8 +6214,8 @@
if (__isSmallInteger(signalNumber)) {
#ifdef SIG_DFL
- signal(__intVal(signalNumber), SIG_DFL);
- RETURN (self);
+ signal(__intVal(signalNumber), SIG_DFL);
+ RETURN (self);
#endif
}
%}.
@@ -6177,7 +6271,7 @@
disableSignal:signalNumber
"disable (Unix-) signal processing for signalNumber.
- Dont confuse Unix signals with smalltalk signals.
+ Don't confuse Unix signals with smalltalk signals.
WARNING: for some signals, it is no good idea to disable
them; for example, disabling the SIGINT signal turns off ^C
handling.
@@ -6189,23 +6283,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
@@ -6963,7 +7057,9 @@
#if defined(HAS_UNIX98_PTY)
int _fdM, _fdS;
char *slaveName;
- extern char *ptsname(); /* also in #include <stdlib.h> */
+ extern char *ptsname(int); /* also in #include <stdlib.h> */
+ extern int grantpt(int);
+ extern int unlockpt(int);
_fdM = open("/dev/ptmx", O_RDWR | O_NOCTTY);
@@ -8439,8 +8535,8 @@
instructionSets extendedInstructions platform|
%{ /* STACK: 4096 */
-#ifdef LINUX
-# ifdef ELF /* old a.out unixes do not have this ... */
+#if defined(linux) && defined(ELF) /* old a.out unixes do not have this ... */
+# include <sys/sysinfo.h>
/*
* additional info available ...
*/
@@ -8453,7 +8549,6 @@
swapSize = __MKUINT(infoBuffer.totalswap);
freeSwap = __MKUINT(infoBuffer.freeswap);
}
-# endif
#endif /* LINUX */
#if defined(hpux) && !defined(__GNUC__)
@@ -9056,7 +9151,7 @@
"return a string giving the type of system we're running on.
This is almost the same as getOSType, but the returned string
is slightly different for some systems (i.e. iris vs. irix).
- Don't depend on this - use getOSType. I dont really see a point
+ Don't depend on this - use getOSType. I don't really see a point
here ...
(except for slight differences between next/mach and other machs)"
@@ -9078,7 +9173,7 @@
%}.
sys isNil ifTrue:[
- ^ self getOSType
+ ^ self getOSType
].
^ sys
@@ -9575,6 +9670,15 @@
"
!
+supportsFileLinks
+ "return true, if the OS supports file links (hard links).
+ Typically, only unix returns true here."
+
+ ^ true
+
+ "Modified: / 5.6.1998 / 18:35:01 / cg"
+!
+
supportsIOInterrupts
"return true, if the OS supports IO availability interrupts
(i.e. SIGPOLL/SIGIO).
@@ -9652,30 +9756,32 @@
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
@@ -10158,7 +10264,7 @@
unsigned INT t = 0;
# if defined(_POSIX_MONOTONIC_CLOCK) && defined(CLOCK_MONOTONIC) && !defined(NO_CLOCK_GETTIME)
- static has_clock_gettime = 1;
+ static int has_clock_gettime = 1;
struct timespec ts;
if (has_clock_gettime) {
@@ -10697,7 +10803,7 @@
%{ /* NOCONTEXT */
static char cachedName[128];
- static firstCall = 1;
+ static int firstCall = 1;
extern char *getenv();
extern char *getlogin();
@@ -10726,7 +10832,7 @@
}
/*
- * nope - I really dont know who you are.
+ * nope - I really don't know who you are.
*/
if (! name || (name[0] == 0) ) {
name = "you";
@@ -13241,94 +13347,90 @@
type := OperatingSystem socketTypeCodeOf:typeArg.
proto := self protocolCodeOf:protoArg.
serviceNameArg notNil ifTrue:[
- serviceName := serviceNameArg printString. "convert integer port numbers"
+ serviceName := serviceNameArg printString. "convert integer port numbers"
].
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.
+ |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:'localhost' serviceName:nil
- domain:#inet type:#stream protocol:nil flags:nil
+ domain:#inet 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
+ domain:#inet type:nil protocol:nil flags:nil
self getAddressInfo:'www.google.de' serviceName:nil
- domain:nil type:nil protocol:nil flags:nil
- self getAddressInfo:'www.exept.de' serviceName:nil
- domain:nil type:nil protocol:nil flags: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:nil
-<<<<<<< UnixOperatingSystem.st
+ 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
+ self getAddressInfo:'www.baden-württemberg.de' serviceName:nil
domain:#'AF_INET' type:#stream protocol:nil flags: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
->>>>>>> 1.489
+ domain:#'AF_INET6' type:#stream protocol:nil flags:nil
"
!
--- a/UserPreferences.st Wed Oct 19 09:22:53 2016 +0100
+++ b/UserPreferences.st Fri Dec 09 22:31:28 2016 +0000
@@ -693,7 +693,7 @@
nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.';
nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.';
- "/ claus - I dont think its a good idea to save those ...
+ "/ claus - I don't think its a good idea to save those ...
"/ nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.';
"/ nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.';
@@ -909,14 +909,22 @@
"toDo: migrate from ClassVar in Number;
use this for new applications"
- ^ $.
+ ^ self at:#decimalPointCharacter ifAbsent:[ $. ]
+!
+
+decimalPointCharacter:aCharacter
+ ^ self at:#decimalPointCharacter put:aCharacter
!
thousandsSeparatorCharacter
"toDo: migrate from ClassVar elsewhere;
use this for new applications"
- ^ $'
+ ^ self at:#thousandsSeparatorCharacter ifAbsent:[ $, ]
+!
+
+thousandsSeparatorCharacter:aCharacter
+ ^ self at:#thousandsSeparatorCharacter put:aCharacter
! !
!UserPreferences methodsFor:'accessing-misc'!
@@ -1131,7 +1139,9 @@
!
soapLoggingLevel
- ^ self at:#soapLoggingLevel ifAbsent:nil
+ ^ self at:#soapLoggingLevel ifAbsent:[0]
+
+ "Modified: / 16-10-2016 / 23:55:34 / cg"
!
soapLoggingLevel:anIntegerBetween0_and_3
@@ -1859,8 +1869,9 @@
enableVMWareDrawingBugWorkaround:aBoolean
"change the flag which enables a workaround for a redraw bug when running X/Linux in the VMWare virtual machine"
+ "/ self assert:(aBoolean isBoolean).
self at:#enableVMWareDrawingBugWorkaround put:aBoolean.
- (Screen notNil and:[Screen current notNil and:[Screen current platformName == #X11]]) ifTrue:[
+ (Screen notNil and:[Screen current notNil and:[Screen current isX11Platform]]) ifTrue:[
Screen current maxOperationsUntilFlush:(aBoolean ifTrue:[1] ifFalse:[nil])
].
@@ -2239,6 +2250,7 @@
"
UserPreferences current onlyShowTooltipsForActiveWindow
+ UserPreferences current onlyShowTooltipsForActiveWindow:false
"
!
@@ -2448,12 +2460,12 @@
!
toolTipAutoHideDelay:aTimeDuration
- "set the time, tooltips are shown. 0 means: dont hide"
+ "set the time, tooltips are shown. 0 means: don't hide"
self at:#toolTipAutoHideDelay put:aTimeDuration.
FlyByHelp showTime: (aTimeDuration isInteger
- ifTrue:[aTimeDuration]
- ifFalse:[aTimeDuration asSeconds]).
+ ifTrue:[aTimeDuration]
+ ifFalse:[aTimeDuration asSeconds]).
"
UserPreferences current toolTipAutoHideDelay:10 seconds
@@ -2570,6 +2582,28 @@
"
!
+viewStyle
+ ^ self at:#viewStyle ifAbsent:[ nil ]
+
+ "
+ UserPreferences current viewStyle
+ UserPreferences current viewStyle:(ViewStyle adwaita)
+ "
+
+ "Created: / 24-11-2016 / 17:58:30 / cg"
+!
+
+viewStyle:aStyleSymbol
+ self at:#viewStyle put:aStyleSymbol
+
+ "
+ UserPreferences current viewStyle
+ UserPreferences current viewStyle:(ViewStyle adwaita)
+ "
+
+ "Created: / 24-11-2016 / 17:58:51 / cg"
+!
+
waitCursorVisibleTime
"anser the time (in ms), how long a wait cursor should be visible at least"
@@ -2671,6 +2705,30 @@
"
!
+confirmCheckinOfPrivateClasses
+ "If set, a confirmation dialog is shown when attempting to checkin a private class."
+
+ ^ self at:#confirmCheckinOfPrivateClasses ifAbsent:[true].
+
+ "
+ UserPreferences current confirmCheckinOfPrivateClasses
+ UserPreferences current confirmCheckinOfPrivateClasses:true
+ UserPreferences current confirmCheckinOfPrivateClasses:false
+ "
+!
+
+confirmCheckinOfPrivateClasses:aBoolean
+ "If set, a confirmation dialog is shown when attempting to checkin a private class."
+
+ self at:#confirmCheckinOfPrivateClasses put:aBoolean.
+
+ "
+ UserPreferences current confirmCheckinOfPrivateClasses
+ UserPreferences current confirmCheckinOfPrivateClasses:true
+ UserPreferences current confirmCheckinOfPrivateClasses:false
+ "
+!
+
enforceCodeStyle
"return the flag which controls enforcing a certain code style (in some browsers)"
@@ -2768,6 +2826,34 @@
"
!
+showMarqueeInfo
+ "If set, show multiline infos in the info area as a scrolling marquee text"
+
+ ^ self at:#showMarqueeInfo ifAbsent:[true].
+
+ "
+ UserPreferences current showMarqueeInfo
+ UserPreferences current showMarqueeInfo:true
+ UserPreferences current showMarqueeInfo:false
+ "
+
+ "Created: / 04-04-2012 / 14:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+showMarqueeInfo:aBoolean
+ "If set, show multiline infos in the info area as a scrolling marquee text"
+
+ self at:#showMarqueeInfo put:aBoolean.
+
+ "
+ UserPreferences current showMarqueeInfo
+ UserPreferences current showMarqueeInfo:true
+ UserPreferences current showMarqueeInfo:false
+ "
+
+ "Created: / 04-04-2012 / 14:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
syntaxColoring
"return the flag which controls syntax coloring (in the browsers)"
@@ -3426,42 +3512,6 @@
"Modified: / 21-04-2011 / 12:34:46 / cg"
!
-doesNotUnderstand:aMessage
- |k def numArgs|
-
- k := aMessage selector.
- (numArgs := aMessage numArgs) == 0 ifTrue:[
- (self includesKey:k) ifTrue:[
- ^ self at:k
- ].
- ((def := self class default) includesKey:k) ifTrue:[
- ^ def at:k
- ].
- ^ self defaultValue
- ].
-
- "/ this is needed, if a setting is loaded (via the settings.stx) at a time
- "/ when the corresponding package which uses that setting is not yet loaded;
- "/ for example: libsvn settings, with no libsvn being present.
- "/ if obsolete keys accumulate over time, we might need a settings cleanup GUI to
- "/ care for that.
-
- ((numArgs == 1) and:[ (k endsWith:$:)])
- ifTrue:[
- k := (k copyButLast) asSymbol.
- ^ self at:k put:(aMessage arg1)
- ].
-
- numArgs == 1 ifTrue:[
- ('UserPreferences [info]: obsolete settings key: ' , aMessage selector , ' - ignored.') infoPrintCR.
- ^ nil
- ].
-
- ^ super doesNotUnderstand:aMessage
-
- "Modified (comment): / 19-08-2011 / 14:01:56 / cg"
-!
-
emphasis:e andColor:c
^ Text addEmphasis:e to:(#color->c).
@@ -4679,9 +4729,13 @@
st80EditMode
"editing as in st80 (do not allow cursor beyond endOfLine/endOftext)."
- ^ self at:#st80EditMode ifAbsent:false
-
- "
+ ^ self at:#st80EditMode ifAbsent:[false]
+
+ "
+ UserPreferences current st80EditMode
+ UserPreferences current st80EditMode:true
+ UserPreferences current st80EditMode
+ UserPreferences current st80EditMode:false
UserPreferences current st80EditMode
"
!
@@ -4693,6 +4747,7 @@
"
UserPreferences current st80EditMode:true
+ UserPreferences current st80EditMode:false
"
!
@@ -4700,7 +4755,7 @@
"select mode, when double clicking as in st80
(select to corresponding lparen/double-quote) ?"
- ^ self at:#st80SelectMode ifAbsent:false
+ ^ self at:#st80SelectMode ifAbsent:[false]
"
UserPreferences current st80SelectMode
@@ -4723,6 +4778,34 @@
"Created: / 03-07-2006 / 16:25:27 / cg"
!
+trimBlankLines
+ "if true, blank lines are trimmed to zero size in the editor"
+
+ ^ self at:#trimBlankLines ifAbsent:[true]
+
+ "
+ UserPreferences current trimBlankLines
+ UserPreferences current trimBlankLines:true
+ UserPreferences current trimBlankLines
+ UserPreferences current trimBlankLines:false
+ UserPreferences current trimBlankLines
+ "
+!
+
+trimBlankLines:aBoolean
+ "if true, blank lines are trimmed to zero size in the editor"
+
+ self at:#trimBlankLines put:aBoolean
+
+ "
+ UserPreferences current trimBlankLines
+ UserPreferences current trimBlankLines:true
+ UserPreferences current trimBlankLines
+ UserPreferences current trimBlankLines:false
+ UserPreferences current trimBlankLines
+ "
+!
+
whitespaceWordSelectMode
"when double clicking, treat ANY non-whitespace as word-characters ?
(default is off)"
@@ -4818,6 +4901,12 @@
!
workspaceDirectory
+ "this is the folder where snapshot images, the change file and any stc-compiled
+ object files are stored.
+ The idea is to keep that stuff together, so we can move it as a bunch.
+ These used to be in the bin-folder of st/x, but that would not work with readonly/shared
+ st/x installations."
+
^ self at:#workspaceDirectory ifAbsent:[self class defaultWorkspaceDirectory]
!
@@ -5789,6 +5878,41 @@
!UserPreferences methodsFor:'misc'!
+doesNotUnderstand:aMessage
+ |k def numArgs|
+
+ k := aMessage selector.
+ (numArgs := aMessage numArgs) == 0 ifTrue:[
+ (self includesKey:k) ifTrue:[
+ ^ self at:k
+ ].
+ ((def := self class default) includesKey:k) ifTrue:[
+ ^ def at:k
+ ].
+ ^ self defaultValue
+ ].
+
+ "/ this is needed, if a setting is loaded (via the settings.stx) at a time
+ "/ when the corresponding package which uses that setting is not yet loaded;
+ "/ for example: libsvn settings, with no libsvn being present.
+ "/ if obsolete keys accumulate over time, we might need a settings cleanup GUI to
+ "/ care for that.
+
+ (numArgs == 1 and:[k endsWith:$:]) ifTrue:[
+ k := k copyButLast asSymbol.
+ ^ self at:k put:(aMessage arg1)
+ ].
+
+ numArgs == 1 ifTrue:[
+ Logger info:'obsolete settings key ignored: %1' with:aMessage selector.
+ ^ nil
+ ].
+
+ ^ super doesNotUnderstand:aMessage
+
+ "Modified (comment): / 19-08-2011 / 14:01:56 / cg"
+!
+
flyByHelpSettingChanged
FlyByHelp notNil ifTrue:[
(self at:#flyByHelpActive ifAbsent:true) ifTrue:[
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/VoidObject.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,104 @@
+"
+ COPYRIGHT (c) 2016 by Claus Gittinger
+ 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:#VoidObject
+ instanceVariableNames:''
+ classVariableNames:'TheOneAndOnlyVoid'
+ poolDictionaries:''
+ category:'Kernel-Objects'
+!
+
+!VoidObject class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2016 by Claus Gittinger
+ 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
+"
+ there is only one instance of this class: void,
+ representing a void value.
+
+ This is mainly present for Scheme-like read-eval-print loops,
+ in which methods may return void to prevent it from being printed.
+
+ It may also be useful to represent void values as returned from calls
+ to external functions (C-void functions) or from remote procedure calls.
+
+ Smalltalk code does not normally use it.
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!VoidObject class methodsFor:'instance creation'!
+
+basicNew
+ TheOneAndOnlyVoid isNil ifTrue:[
+ TheOneAndOnlyVoid := super basicNew.
+ ].
+ ^ TheOneAndOnlyVoid
+
+ "
+ VoidObject basicNew
+ VoidObject new
+ "
+! !
+
+!VoidObject class methodsFor:'class initialization'!
+
+initialize
+ Smalltalk at:#void put:(self basicNew).
+! !
+
+!VoidObject methodsFor:'printing & storing'!
+
+printOn:aStream
+ aStream nextPutAll:'void'.
+! !
+
+!VoidObject methodsFor:'queries'!
+
+isVoid
+ ^ true
+
+ "
+ void isVoid
+ "
+! !
+
+!VoidObject class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
+
+VoidObject initialize!
--- a/WeakArray.st Wed Oct 19 09:22:53 2016 +0100
+++ b/WeakArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -180,71 +180,71 @@
ok = __addShadowObject(self, 0);
if (ok == false) {
- /*
- * the behavior of __addShadowObject() in case of overflowing
- * VM-table space can be controlled by the second argument:
- * if its 0, the weakObject is not registered, and false
- * is returned.
- * if its 1, the tables are reallocated, registration proceeds,
- * and true is returned.
- * This allows for the caller to have an influence on the VM's
- * shadow table allocation.
- *
- * If addShadowObject() returned false, too many shadow objects are
- * already there. Then collect garbage to get rid of
- * obsolete ones, and try again.
- * Since a full collect is expensive, we try
- * a scavenge first, doing a full collect only if
- * that does not help.
- *
- * THIS MAY OR MAY NOT BE A GOOD IDEA: although it reduces
- * the number of shadow objects that have to be
- * processed at GC time, it may create a long delay here,
- * at shadow object creation time.
- * Dont know which is better ...
- */
- __nonTenuringScavenge(__context);
- ok = __addShadowObject(self, 0);
+ /*
+ * the behavior of __addShadowObject() in case of overflowing
+ * VM-table space can be controlled by the second argument:
+ * if its 0, the weakObject is not registered, and false
+ * is returned.
+ * if its 1, the tables are reallocated, registration proceeds,
+ * and true is returned.
+ * This allows for the caller to have an influence on the VM's
+ * shadow table allocation.
+ *
+ * If addShadowObject() returned false, too many shadow objects are
+ * already there. Then collect garbage to get rid of
+ * obsolete ones, and try again.
+ * Since a full collect is expensive, we try
+ * a scavenge first, doing a full collect only if
+ * that does not help.
+ *
+ * THIS MAY OR MAY NOT BE A GOOD IDEA: although it reduces
+ * the number of shadow objects that have to be
+ * processed at GC time, it may create a long delay here,
+ * at shadow object creation time.
+ * Don't know which is better ...
+ */
+ __nonTenuringScavenge(__context);
+ ok = __addShadowObject(self, 0);
- if (ok == false) {
- /*
- * hard stuff - need full collect
- * if this is the very first GC, assume that we are in
- * the startup phase (where all weak stuff is allocated).
- * Then do no GC.
- * Heuristics showed, that this GC does not find much ...
- */
- if ((__garbageCollectCount() != 0)
- || (__incrementalGCCount() != 0)) {
- __markAndSweepIfUseful(__context);
- ok = __addShadowObject(self, 0);
- }
- if (ok == false) {
- /*
- * mhmh - it seems that there are really many shadow
- * objects around - force creation
- */
- ok = __addShadowObject(self, 1);
- if (ok == false) {
- /*
- * no chance - something must be wrong
- * lets fall into the exception and see.
- */
- }
- }
- }
+ if (ok == false) {
+ /*
+ * hard stuff - need full collect
+ * if this is the very first GC, assume that we are in
+ * the startup phase (where all weak stuff is allocated).
+ * Then do no GC.
+ * Heuristics showed, that this GC does not find much ...
+ */
+ if ((__garbageCollectCount() != 0)
+ || (__incrementalGCCount() != 0)) {
+ __markAndSweepIfUseful(__context);
+ ok = __addShadowObject(self, 0);
+ }
+ if (ok == false) {
+ /*
+ * mhmh - it seems that there are really many shadow
+ * objects around - force creation
+ */
+ ok = __addShadowObject(self, 1);
+ if (ok == false) {
+ /*
+ * no chance - something must be wrong
+ * lets fall into the exception and see.
+ */
+ }
+ }
+ }
}
%}.
ok ifFalse:[
- "
- the VM was not able to register the new weakArray
- This can only happen, if the VM has to resize its tables,
- and a malloc request failed. Usually, this smells like big
- trouble being on the way (soon running out of memory in
- other places as well).
- Configure your OS for more swap space.
- "
- ^ RegistrationFailedSignal raiseRequestWith:self
+ "
+ the VM was not able to register the new weakArray
+ This can only happen, if the VM has to resize its tables,
+ and a malloc request failed. Usually, this smells like big
+ trouble being on the way (soon running out of memory in
+ other places as well).
+ Configure your OS for more swap space.
+ "
+ ^ RegistrationFailedSignal raiseRequestWith:self
]
! !
@@ -253,7 +253,7 @@
at:index
"return the indexed instance variable with index, anInteger.
Reimplemented here for IGC readBarrier.
- (You dont have to understand this.)"
+ (You don't have to understand this.)"
^ self basicAt:index
@@ -264,7 +264,7 @@
"return the indexed instance variable with index, anInteger,
or exceptionValue if the index is invalid.
Reimplemented here for IGC readBarrier.
- (You dont have to understand this.)"
+ (You don't have to understand this.)"
(index < 0 or:[index > self size]) ifTrue:[^ exceptionValue].
^ self at:index
@@ -474,31 +474,34 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps sz dep|
+ |deps sz dep|
- deps := dependents.
- deps notNil ifTrue:[
- deps isCollection ifTrue:[
- deps remove:anObject ifAbsent:[].
- (sz := deps size) == 0 ifTrue:[
- dependents := nil
- ] ifFalse:[
- sz == 1 ifTrue:[
- (dep := deps first) isCollection ifFalse:[
- dependents := dep
- ]
- ]
- ]
- ] ifFalse:[
- deps == anObject ifTrue:[
- dependents := nil
- ]
- ]
- ]
+ deps := dependents.
+ deps notNil ifTrue:[
+ deps isCollection ifTrue:[
+ dep := deps remove:anObject ifAbsent:[].
+ "if dep is nil, nothing has changed"
+ dep notNil ifTrue:[
+ (sz := deps size) == 0 ifTrue:[
+ dependents := nil
+ ] ifFalse:[
+ sz == 1 ifTrue:[
+ (dep := deps first) isCollection ifFalse:[
+ dependents := dep
+ ]
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ deps == anObject ifTrue:[
+ dependents := nil
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
! !
--- a/WeakIdentityDictionary.st Wed Oct 19 09:22:53 2016 +0100
+++ b/WeakIdentityDictionary.st Fri Dec 09 22:31:28 2016 +0000
@@ -67,6 +67,26 @@
"
! !
+!WeakIdentityDictionary methodsFor:'accessing'!
+
+keys
+ "return a collection containing all valid keys of the receiver"
+
+ |keySet|
+
+ keySet := self emptyCollectionForKeys.
+ keyArray validElementsDo:[:key |
+ (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
+ key == NilEntry ifTrue:[
+ keySet add:nil.
+ ] ifFalse:[
+ keySet add:key.
+ ]
+ ]
+ ].
+ ^ keySet
+! !
+
!WeakIdentityDictionary methodsFor:'adding & removing'!
at:key ifAbsent:exceptionBlock
@@ -213,7 +233,7 @@
!WeakIdentityDictionary methodsFor:'element disposal'!
clearDeadSlots
- |wasBlocked|
+ |wasBlocked anyChange|
"
have to block here - dispose may be done at a low priority
@@ -221,16 +241,21 @@
higher prio process, the dictionary might get corrupted otherwise
"
wasBlocked := OperatingSystem blockInterrupts.
+ anyChange := false.
[
- keyArray
- forAllDeadIndicesDo:[:idx |
- valueArray basicAt:idx put:nil.
- tally := tally - 1.
- ]
- replacingCorpsesWith:DeletedEntry.
+ keyArray
+ forAllDeadIndicesDo:[:idx |
+ valueArray basicAt:idx put:nil.
+ tally := tally - 1.
+ anyChange := true.
+ ]
+ replacingCorpsesWith:DeletedEntry.
] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
+ anyChange ifTrue:[
+ self changed:#ElementExpired
+ ].
"Modified: / 13.12.2001 / 14:18:17 / martin"
!
@@ -247,6 +272,25 @@
"Modified: / 13.12.2001 / 14:17:58 / martin"
! !
+!WeakIdentityDictionary methodsFor:'enumerating'!
+
+keysDo:aBlock
+ "evaluate aBlock for each registered object"
+
+ "#Dictionary>>keysDo: would not work, since the keyArray instvar may change if
+ elements are unregistered while looping."
+
+ ^ keyArray validElementsDo:[:each|
+ each ~~ DeletedEntry ifTrue:[
+ each == NilEntry ifTrue:[
+ aBlock value:nil.
+ ] ifFalse:[
+ aBlock value:each.
+ ]
+ ].
+ ]
+! !
+
!WeakIdentityDictionary methodsFor:'private'!
findKeyOrNil:key
@@ -523,5 +567,9 @@
version
^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
! !
--- a/Win32OperatingSystem.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Win32OperatingSystem.st Fri Dec 09 22:31:28 2016 +0000
@@ -18,8 +18,8 @@
AbstractOperatingSystem subclass:#Win32OperatingSystem
instanceVariableNames:''
- classVariableNames:'Initialized HostName DomainName CurrentDirectory LastOsTimeLow
- LastOsTimeHi LastTimeInfoIsLocal LastTimeInfo'
+ classVariableNames:'CurrentDirectory DomainName HostName Initialized LastOsTimeHi
+ LastOsTimeLow LastTimeInfo LastTimeInfoIsLocal'
poolDictionaries:'Win32Constants'
category:'OS-Windows'
!
@@ -295,7 +295,7 @@
# define _FCNTL_H_INCLUDED_
# endif
-// # define PROCESSDEBUGWIN32
+# define PROCESSDEBUGWIN32
// # define PROCESS1DEBUGWIN32
// # define PROCESS2DEBUGWIN32
// # define PROCESSDEBUG_CHILDPROCESSWAIT
@@ -564,6 +564,10 @@
#endif /* BORLAND */
+#ifdef PROCESSDEBUGWIN32
+static int flag_PROCESSDEBUGWIN32 = 0;
+#endif
+
%}
! !
@@ -987,6 +991,7 @@
"Modified: 7.1.1997 / 19:36:11 / stefan"
! !
+
!Win32OperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -1722,6 +1727,16 @@
result = 0 ifTrue: [ ^self error ].
! !
+!Win32OperatingSystem class methodsFor:'debugging'!
+
+verbose:aBoolean
+%{
+#ifdef PROCESSDEBUGWIN32
+ flag_PROCESSDEBUGWIN32 = (aBoolean == true);
+#endif
+%}
+! !
+
!Win32OperatingSystem class methodsFor:'directory access'!
linkInfoFor:osPathname fileSize:fileSize fileAttributes:osFileAttributes osCrtTime:osCrtTime osAccTime:osAccTime osModTime:osModTime
@@ -1787,46 +1802,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 {
- error = __mkSmallInteger( __threadErrno );
- }
- }
-%}.
- (error notNil and:[error ~~ 0]) ifTrue:[
- ^ StreamIOError newException
- errorCode:error;
- osErrorHolder:(OperatingSystem errorHolderForNumber:error);
- parameter:aDirectoryStream;
- raiseRequest
+ // __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
].
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'!
@@ -1863,874 +1879,874 @@
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;
+
+ 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]).
- ].
- ].
- holder errorSymbol:sym errorCategory:(typ ? #defaultOsErrorSignal).
+ 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
@@ -3675,67 +3691,72 @@
!
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."
+ 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
- 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
- "Modified: / 31.1.1998 / 10:54:24 / md"
- "Modified: / 15.5.1999 / 18:07:51 / cg"
+ "Modified: / 31-01-1998 / 10:54:24 / md"
+ "Modified: / 15-05-1999 / 18:07:51 / cg"
+ "Modified (comment): / 18-10-2016 / 16:00:26 / cg"
!
getStatusOfProcess:aProcessId
@@ -3761,9 +3782,13 @@
if (GetExitCodeProcess(handle,&endStatus)) {
status = endStatus;
#ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "getexitcode status = %d\n",status);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "getexitcode status = %d\n",status);
+ }
} else {
- console_fprintf(stderr, "getexitcode failed.\n");
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "getexitcode failed.\n");
+ }
#endif
}
}
@@ -3858,7 +3883,8 @@
!
-primExec:commandPath commandLine:commandLine fileDescriptors:fdArray fork:doFork newPgrp:newPgrp
+primExec:commandPath commandLine:commandLine environment:environmentOrNil
+ fileDescriptors:fdArray fork:doFork newPgrp:newPgrp
inPath:dirName createFlags:flagsOrNil inheritHandles:inheritHandles
showWindow:showWindowBooleanOrNil
"Internal lowLevel entry for combined fork & exec for WIN32
@@ -3867,9 +3893,12 @@
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."
-
- |handle commandPathUni16 commandLineUni16 dirNameUni16|
+ if a window is shown.
+ #default
+ - same as nil
+ "
+
+ |handle commandPathUni16 commandLineUni16 dirNameUni16 envString16|
handle := Win32ProcessHandle new.
@@ -3886,9 +3915,26 @@
dirNameUni16 notNil ifTrue:[
dirNameUni16 := dirNameUni16 asUnicode16String.
].
-
-
-%{
+ environmentOrNil notNil ifTrue:[
+ |newEnv|
+
+ "/ take my current environment; add the definitions given by the argument.
+ newEnv := Dictionary new
+ declareAllFrom:(OperatingSystem getEnvironment);
+ declareAllFrom:environmentOrNil;
+ yourself.
+
+ envString16 :=
+ Unicode16String streamContents:[:s |
+ newEnv keysSorted do:[:k |
+ s nextPutAll:k; nextPutAll:'='; nextPutAll:(newEnv at:k).
+ s nextPut:(Character value:0).
+ ].
+ s nextPut:(Character value:0).
+ ].
+ ].
+
+%{ /* STACK: 32000 */
/*
* if fork is false, chain to another command (not yet supported)
@@ -3914,6 +3960,7 @@
wchar_t *cmdPathWP = NULL;
wchar_t *cmdLineWP = NULL;
wchar_t *dirNameWP = NULL;
+ wchar_t *envWP = NULL;
DWORD fdwCreate = 0;
STARTUPINFOW lpsiStartInfo;
@@ -3936,9 +3983,11 @@
if (commandPathUni16 != nil) {
l = __unicode16StringSize(commandPathUni16);
if (l >= 4096) { // >= need 1 space for terminator
- #ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "argument #commandPathUni16 is to long\n");
- #endif
+# ifdef PROCESSDEBUGWIN32
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "argument #commandPathUni16 is to long\n");
+ }
+# endif
RETURN(nil);
}
for (i = 0; i < l; i++) {
@@ -3951,9 +4000,11 @@
// commandLineUni16
l = __unicode16StringSize(commandLineUni16);
if (l >= 4096) { // >= need 1 space for terminator
- #ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "argument #commandLineUni16 is to long\n");
- #endif
+# ifdef PROCESSDEBUGWIN32
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "argument #commandLineUni16 is to long\n");
+ }
+# endif
RETURN(nil);
}
for (i = 0; i < l; i++) {
@@ -3966,9 +4017,11 @@
if (__isUnicode16String(dirNameUni16)) {
l = __unicode16StringSize(dirNameUni16);
if (l >= 4096) { // >= need 1 space for terminator
- #ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "argument #dirNameUni16 is to long\n");
- #endif
+# ifdef PROCESSDEBUGWIN32
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "argument #dirNameUni16 is to long\n");
+ }
+# endif
RETURN(nil);
}
for (i = 0; i < l; i++) {
@@ -3978,6 +4031,10 @@
dirNameWP = &dirNameW[0];
}
+ if (envString16 != nil) {
+ envWP = __unicode16StringVal(envString16);
+ }
+
/*
* create descriptors as req'd
*/
@@ -3989,7 +4046,6 @@
SetSecurityDescriptorDacl(&securityDescriptor, -1, 0, 0);
securityAttributes.lpSecurityDescriptor = &securityDescriptor;
- memset(&lppiProcInfo, 0, sizeof (lppiProcInfo));
memset(&lpsiStartInfo, 0, sizeof(lpsiStartInfo));
lpsiStartInfo.cb = sizeof(lpsiStartInfo);
@@ -4004,7 +4060,7 @@
lpsiStartInfo.dwYCountChars = 0;
lpsiStartInfo.dwFillAttribute = 0;
lpsiStartInfo.dwFlags = STARTF_USESTDHANDLES /*| STARTF_USEPOSITION*/;
- if (showWindowBooleanOrNil != nil) {
+ if ((showWindowBooleanOrNil != nil) && (showWindowBooleanOrNil != @symbol(default))) {
lpsiStartInfo.dwFlags |= STARTF_USESHOWWINDOW;
lpsiStartInfo.wShowWindow = showWindowBooleanOrNil == true ? SW_SHOWNORMAL : SW_HIDE;
}
@@ -4060,9 +4116,11 @@
}
#if defined(PROCESSDEBUGWIN32)
- console_fprintf(stderr, "stdin %x\n", stdinHandle);
- console_fprintf(stderr, "stdout %x\n", stdoutHandle);
- console_fprintf(stderr, "stderr %x\n", stderrHandle);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "stdin %x\n", stdinHandle);
+ console_fprintf(stderr, "stdout %x\n", stdoutHandle);
+ console_fprintf(stderr, "stderr %x\n", stderrHandle);
+ }
#endif
{
@@ -4132,14 +4190,19 @@
if (doFork == true) {
#ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "create process cmdPath:<%s> cmdLine:<%s> in <%s>\n", cmdPath, cmdLine, dir);
-#endif
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "create process cmdPath:<%s> cmdLine:<%s> in <%s>\n", __stringVal(commandPath), __stringVal(commandLine), __stringVal(dirName));
+ }
+#endif
+ memset(&lppiProcInfo, 0, sizeof (lppiProcInfo));
+
if (CreateProcessW( cmdPathWP,
cmdLineWP,
- &securityAttributes, NULL /* &securityAttributes */,
+ &securityAttributes, NULL /* &securityAttributes */,
securityAttributes.bInheritHandle, /* inherit handles */
- fdwCreate | CREATE_SUSPENDED, /* resume after setting affinity */
- NULL, /* env */
+ fdwCreate | CREATE_SUSPENDED /* resume after setting affinity */
+ | CREATE_UNICODE_ENVIRONMENT,
+ envWP, /* env */
dirNameWP,
&lpsiStartInfo,
&lppiProcInfo ))
@@ -4182,7 +4245,9 @@
CloseHandle(stderrHandle);
}
#ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "created process hProcess=%x\n", lppiProcInfo.hProcess);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "created process hProcess=%x pid=%d\n", lppiProcInfo.hProcess, lppiProcInfo.dwProcessId);
+ }
#endif
__externalAddressVal(handle) = lppiProcInfo.hProcess;
@@ -4190,7 +4255,9 @@
RETURN (handle);
}
#ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "created process error %d\n", GetLastError());
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "created process error %d\n", GetLastError());
+ }
#endif
RETURN (nil);
} else {
@@ -4205,6 +4272,20 @@
or not supported by OS
"
^ self primitiveFailed
+
+ "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
@@ -4320,7 +4401,7 @@
startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
errorTo:anExternalErrStream auxFrom:anAuxiliaryStream
environment:anEvironmentDictionary inDirectory:dir
- showWindow:showWindowBooleanOrNil
+ 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.
@@ -4342,32 +4423,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:true
- 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
@@ -4393,7 +4474,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.
@@ -4408,10 +4489,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'
@@ -4423,10 +4504,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.
@@ -4439,20 +4520,17 @@
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.
Transcript showCR:'terminated'
END"
- "Modified: / 21-03-1997 / 10:04:35 / dq"
- "Modified: / 15-07-1997 / 16:03:51 / stefan"
- "Created: / 12-11-1998 / 14:39:20 / cg"
- "Modified: / 30-06-2016 / 17:43:46 / cg"
+ "Created: / 08-11-2016 / 21:23:17 / cg"
! !
!Win32OperatingSystem class methodsFor:'file access'!
@@ -4478,15 +4556,17 @@
createDirectory:aPathName
"create a new directory with name 'aPathName', which may be an absolute
path, or relative to the current directory.
- Return true if successful (or the directory existed already), false if failed.
+ Return nil if successful (or the directory existed already), an OsErrorHolder otherwise.
This is a low-level entry - use Filename protocol for compatibility."
+ |error|
+
"/ if it already exists this is ok
-
- (self isDirectory:aPathName) ifTrue:[^ true].
+ (self isDirectory:aPathName) ifTrue:[^ nil].
%{
SECURITY_ATTRIBUTES sa;
+ int success;
sa.nLength = sizeof( sa );
sa.lpSecurityDescriptor = NULL;
@@ -4494,30 +4574,29 @@
sa.bInheritHandle = FALSE;
if (__isStringLike(aPathName)) {
- int ret;
-
- ret = CreateDirectoryA(__stringVal(aPathName), &sa);
- if (ret != TRUE) {
- __threadErrno = __WIN32_ERR(GetLastError());
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
- }
- if (__isUnicode16String(aPathName)) {
- int ret;
- wchar_t _wPathName[MAXPATHLEN+1];
-
- _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
- ret = CreateDirectoryW(_wPathName, &sa);
- if (ret != TRUE) {
- __threadErrno = __WIN32_ERR(GetLastError());
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
- }
-%}.
+ success = CreateDirectoryA(__stringVal(aPathName), &sa);
+ } else if (__isUnicode16String(aPathName)) {
+ wchar_t _wPathName[MAXPATHLEN+1];
+
+ _makeWchar(aPathName, _wPathName, sizeof(_wPathName));
+ success = CreateDirectoryW(_wPathName, &sa);
+ } else
+ goto err;
+
+ if (success == TRUE) {
+ RETURN (nil);
+ }
+
+ error = __mkSmallInteger(__WIN32_ERR(GetLastError()));
+
+err:;
+%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
^ self primitiveFailed
"
@@ -4538,9 +4617,12 @@
createHardLinkFrom:oldPath to:newPath
"link the file 'oldPath' to 'newPath'. The link will be a hard link.
- Return true if successful, false if not."
-
- self executeCommand:('mklink/h "%1" "%2"' bindWith:newPath with:oldPath)
+ 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.
+ ].
+ ^ nil.
"Created: / 19-01-2011 / 08:42:11 / cg"
!
@@ -4548,9 +4630,21 @@
createSymbolicLinkFrom:oldPath to:newPath
"make a link from the file 'oldPath' to the file 'newPath'.
The link will be a soft (symbolic) link.
- Return true if successful, false if not."
-
- self executeCommand:('mklink "%1" "%2"' bindWith:newPath with:oldPath)
+ Return nil if successful, an OsErrorHolder if not.
+
+ Note: mklink needs special permissions or Administrator rights."
+
+ |dirFlag|
+
+ dirFlag := ''.
+ (self isDirectory:oldPath) ifTrue:[
+ dirFlag := '/d'.
+ ].
+
+ (self executeCommand:('mklink %3 "%1" "%2"' bindWith:newPath with:oldPath with:dirFlag)) ifFalse:[
+ ^ OSErrorHolder errorSymbol:'mklink failed' errorCategory:nil.
+ ].
+ ^ nil.
"Created: / 19-01-2011 / 08:41:44 / cg"
!
@@ -4645,26 +4739,6 @@
"Modified: / 07-02-2007 / 10:37:48 / cg"
!
-linkFile:oldPath to:newPath
- "link the file 'oldPath' to 'newPath'. The link will be a hard link.
- Return true if successful, false if not."
-
- (oldPath isString not or:[newPath isString not]) ifTrue:[
- "/
- "/ bad argument(s) given
- "/
- ^ self primitiveFailed
- ].
-
- ^ self createHardLinkFrom:oldPath to:newPath
-
- "
- OperatingSystem linkFile:'foo' to:'bar'
- "
-
- "Modified: / 19-01-2011 / 08:42:53 / cg"
-!
-
openFile:pathName attributes:attributeSpec
"non public internal helper.
open a file, return an os specific fileHandle.
@@ -4753,8 +4827,10 @@
goto badArgument;
}
#ifdef PROCESSDEBUGWIN32
- console_fprintf(stderr, "name:<%s> access:%x share:%x create:%x attr:%x\n",
- name, access, share, create, attr);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_fprintf(stderr, "name:<%s> access:%x share:%x create:%x attr:%x\n",
+ name, access, share, create, attr);
+ }
#endif
if (__isStringLike(pathName)) {
h = CreateFileA(name, access, share, 0 /* sa */, create, attr, 0 /* hTempl */);
@@ -4816,56 +4892,58 @@
removeDirectory:fullPathName
"remove the directory named 'fullPathName'.
The directory must be empty and you must have appropriate access rights.
- Return true if successful, false if directory is not empty or no permission.
+ Return nil if successful, an OSErrorHolder if directory is not empty or no permission.
This is a lowLevel entry - use Filename protocol for compatibility."
-%{
- int ret;
+ |error|
+
+%{
+ int success;
if (__isStringLike(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = (int)(STX_API_NOINT_CALL1( "RemoveDirectoryA", RemoveDirectoryA, _aPathName));
- } while ((ret < 0) && (__threadErrno == EINTR));
- }
-#else
- ret = RemoveDirectoryA((char *)__stringVal(fullPathName));
- __threadErrno = __WIN32_ERR(GetLastError());
-#endif
- if (ret != TRUE) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
+ {
+ 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 {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = (int)(STX_API_NOINT_CALL1( "RemoveDirectoryW", RemoveDirectoryW, _wPathName));
- } while ((ret < 0) && (__threadErrno == EINTR));
- }
-#else
- ret = RemoveDirectoryW((wchar_t *)__unicode16StringVal(fullPathName));
- __threadErrno = __WIN32_ERR(GetLastError());
-#endif
- if (ret != TRUE) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
- }
-%}.
+ {
+ 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);
+ }
+
+ error = __mkSmallInteger(__threadErrno);
+%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
"/
"/ either not a string argument,
"/ or not supported by OS
@@ -4879,58 +4957,58 @@
!
removeFile:fullPathName
- "remove the file named 'fullPathName'; return true if successful.
+ "remove the file named 'fullPathName'; return nil if successful, an OSErrorHolder on errror.
This is a lowLevel entry - use Filename protocol for compatibility."
-%{
- int ret;
+ |error|
+
+%{
+ int success;
if (__isStringLike(fullPathName)) {
#ifdef DO_WRAP_CALLS
- {
- char _aPathName[MAXPATHLEN];
-
- strncpy(_aPathName, __stringVal(fullPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = (int)(STX_API_NOINT_CALL1( "DeleteFileA", DeleteFileA, _aPathName));
- } while ((ret < 0) && (__threadErrno == EINTR));
- }
-#else
- ret = DeleteFileA((char *)__stringVal(fullPathName));
- __threadErrno = __WIN32_ERR(GetLastError());
-#endif
- if (ret != TRUE) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
- }
- if (__isUnicode16String(fullPathName)) {
+ {
+ 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 {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = (int)(STX_API_NOINT_CALL1( "DeleteFileW", DeleteFileW, _wPathName));
- } while ((ret < 0) && (__threadErrno == EINTR));
- }
-#else
- ret = DeleteFileW((wchar_t *)__unicode16StringVal(fullPathName));
- __threadErrno = __WIN32_ERR(GetLastError());
-#endif
- if (ret != TRUE) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
- }
-
-%}.
+ {
+ 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);
+ }
+
+ error = __mkSmallInteger(__threadErrno);
+%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
^ self primitiveFailed
!
@@ -4940,73 +5018,67 @@
correct for the OS used - therefore, this should not be called
directlt. Instead, use Filename protocol to rename; this cares for
any invalid names.
- Returns true if successful, false if not"
-
-%{
- int ret;
+ Returns nil if successful, an OsErrorHolder if not"
+
+ |error|
+
+%{
+ int success;
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 {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = STX_API_NOINT_CALL2("MoveFileA", MoveFileA, _oldPath, _newPath);
- } while ((ret == 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = MoveFileA((char *) __stringVal(oldPath), (char *) __stringVal(newPath));
- } while ((ret == 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
-
- if (ret == 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
+ 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 {
- __threadErrno = 0;
- // do not cast to INT - will loose sign bit then!
- ret = STX_API_NOINT_CALL2( "MoveFileW", MoveFileW, _oldPathW, _newPathW);
- } while ((ret == 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = MoveFileW(_oldPathW, _newPathW);
- } while ((ret == 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret == 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- RETURN(false);
- }
-#endif
- }
- if (ret == 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN (false);
- }
- RETURN (true);
+ 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);
+ }
+ error = __mkSmallInteger(__threadErrno);
err:;
%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
^ self primitiveFailed
"
OperatingSystem renameFile:'foo' to:'bar'
+ OperatingSystem renameFile:'c:\windows' to:'c:\win'
"
!
@@ -5114,76 +5186,82 @@
"
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
"
+ |error|
+
%{
struct stat buf;
int ret;
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());
- }
-#endif
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN ( nil );
- }
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ 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());
- }
-#endif
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN ( nil );
- }
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
-%}.
- ^ self primitiveFailed
+ 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;
+
+ if (ret >= 0) {
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ }
+ error = __mkSmallInteger(__threadErrno);
+out:;
+%}.
+
+ error notNil ifTrue:[
+ LastErrorNumber := error.
+ ^ self errorHolderForNumber:error.
+ ].
+
+ ^ self primitiveFailed
"
(OperatingSystem accessModeOf:'/') printStringRadix:8
+ (OperatingSystem accessModeOf:'foo') printStringRadix:8
(OperatingSystem accessModeOf:'Make.proto') printStringRadix:8
- (OperatingSystem changeAccessModeOf:'Make.proto' to:8r644)
+ (OperatingSystem changeAccessModeOf:'foo' to:8r644)
'Make.proto' asUnicode16String asFilename accessRights printStringRadix:8
"
!
@@ -5196,49 +5274,57 @@
"
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
"
+ |error|
+
%{
struct stat buf;
int ret;
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());
- }
-#endif
-
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN ( nil );
- }
- RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
- }
-%}.
- ^ self primitiveFailed
+ 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;
+
+ if (ret >= 0) {
+ RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+ }
+ error = __mkSmallInteger(__threadErrno);
+out:;
+%}.
+
+ error notNil ifTrue:[
+ 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)
"
@@ -5247,71 +5333,66 @@
changeAccessModeOf:aPathName to:modeBits
"change the access rights of aPathName to the OS dependent modeBits.
You should construct this mask using accessMaskFor, to be OS
- independent. Return true if changed,
- false if such a file does not exist or change was not allowd."
+ independent. Return nil if changed,
+ an OsErrorHolder if such a file does not exist or change was not allowd."
+
+ |error|
%{
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)) {
#ifdef DO_WRAP_CALLS
- int _chmod();
- 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( "_chmod", _chmod, _aPathName, __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = _chmod((char *)__stringVal(aPathName), __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
-#endif
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN ( false );
- }
- RETURN ( true );
-
- } else if (__isUnicode16String(aPathName)) {
-#ifdef DO_WRAP_CALLS
- int _wchmod();
- 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( "_wchmod", _wchmod, _wPathName, __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
-#else
- __BEGIN_INTERRUPTABLE__
- do {
- __threadErrno = 0;
- ret = _chmod((wchar_t *)__unicode16StringVal(fullPathName), __intVal(modeBits));
- } while ((ret < 0) && (__threadErrno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
-#endif
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
- RETURN ( false );
- }
- RETURN ( true );
- }
- }
-%}.
+ 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.
+ ].
+
^ self primitiveFailed:#argumentError
"
@@ -7463,8 +7544,10 @@
* make fileDescriptors from handles
*/
# ifdef PROCESSDEBUGWIN32
- console_printf("piperead %x\n",pipeRead);
- console_printf("pipewrite %x\n",pipeWrite);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_printf("piperead %x\n",pipeRead);
+ console_printf("pipewrite %x\n",pipeWrite);
+ }
# endif
fd1 = __mkSmallInteger(_open_osfhandle(pipeRead, O_BINARY));
fd2 = __mkSmallInteger(_open_osfhandle(pipeWrite, O_BINARY));
@@ -7490,7 +7573,9 @@
if (__pid != 0) {
#ifdef PROCESSDEBUGWIN32
- console_printf("Close ProcessHandle %x\n", __pid);
+ if (flag_PROCESSDEBUGWIN32) {
+ console_printf("Close ProcessHandle %x\n", __pid);
+ }
#endif
CloseHandle(__pid);
_SETHANDLEVal(pid, 0);
@@ -7800,7 +7885,7 @@
"/ <apicall: dword "GetLastError" () module: "kernel32.dll" >
"
- self primGetLastError
+ self primGetLastError
"
!
@@ -7927,25 +8012,25 @@
%{
if (__isString(lpName)
&& ((bInitialOwner == true) || (bInitialOwner == false))) {
- void *c_descr = NULL;
- char *c_name;
- HANDLE c_handle;
-
- c_name = __stringVal(lpName);
-
- if (lpSecurityDescriptor != nil) {
- if (__isExternalAddressLike(lpSecurityDescriptor)
- || __isExternalBytesLike(lpSecurityDescriptor) ) {
- c_descr = __externalAddressVal(lpSecurityDescriptor);
- } else
- goto badArg;
- }
- c_handle = CreateMutexA(c_descr, bInitialOwner == true, c_name);
- if (c_handle == NULL) {
- RETURN(nil);
- }
- __externalAddressVal(handle) = c_handle;
- RETURN(handle);
+ void *c_descr = NULL;
+ char *c_name;
+ HANDLE c_handle;
+
+ c_name = __stringVal(lpName);
+
+ if (lpSecurityDescriptor != nil) {
+ if (__isExternalAddressLike(lpSecurityDescriptor)
+ || __isExternalBytesLike(lpSecurityDescriptor) ) {
+ c_descr = __externalAddressVal(lpSecurityDescriptor);
+ } else
+ goto badArg;
+ }
+ c_handle = CreateMutexA(c_descr, bInitialOwner == true, c_name);
+ if (c_handle == NULL) {
+ RETURN(nil);
+ }
+ __externalAddressVal(handle) = c_handle;
+ RETURN(handle);
}
badArg: ;
%}.
@@ -7966,25 +8051,25 @@
%{
if (__isString(lpName)
&& ((bInitialOwner == true) || (bInitialOwner == false))) {
- DWORD c_dwDesiredAccess = 0;
- char *c_name;
- BOOL c_initialOwner = (bInitialOwner == true);
- HANDLE c_handle;
-
- c_name = __stringVal(lpName);
-
- if (dwDesiredAccess != nil) {
- if (! __isSmallInteger(dwDesiredAccess)) {
- goto badArg;
- }
- c_dwDesiredAccess = __intVal(dwDesiredAccess);
- }
- c_handle = OpenMutexA(c_dwDesiredAccess, c_initialOwner, c_name);
- if (c_handle == NULL) {
- RETURN(nil);
- }
- __externalAddressVal(handle) = c_handle;
- RETURN(handle);
+ DWORD c_dwDesiredAccess = 0;
+ char *c_name;
+ BOOL c_initialOwner = (bInitialOwner == true);
+ HANDLE c_handle;
+
+ c_name = __stringVal(lpName);
+
+ if (dwDesiredAccess != nil) {
+ if (! __isSmallInteger(dwDesiredAccess)) {
+ goto badArg;
+ }
+ c_dwDesiredAccess = __intVal(dwDesiredAccess);
+ }
+ c_handle = OpenMutexA(c_dwDesiredAccess, c_initialOwner, c_name);
+ if (c_handle == NULL) {
+ RETURN(nil);
+ }
+ __externalAddressVal(handle) = c_handle;
+ RETURN(handle);
}
badArg: ;
%}.
@@ -8226,8 +8311,55 @@
"Modified: 26.4.1996 / 10:04:54 / stefan"
!
+getEnvironment
+ "get all environment variables as a dictionary of key-value associations.
+ You will find a few strange name-keys starting wth a $=.
+ These are leftovers of cmd.com, which are used for keeping track of per-drive current dirs.
+ It was reported, that some batch/apps depend on them, so they should probably
+ be preserved when forking off new programs.
+ Read: 'What are these strange =C: environment variables?'
+ (https://blogs.msdn.microsoft.com/oldnewthing/20100506-00/?p=14133/) for more info."
+
+ |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;
+ }
+ }
+%}.
+
+ 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.
+ ].
+ ^ envDict
+
+ "
+ OperatingSystem getEnvironment
+ "
+
+ "Created: / 15-11-2016 / 16:10:12 / cg"
+!
+
getEnvironment:aStringOrSymbol
- "get an environment string"
+ "get the whole environment as a dictionary"
%{ /* NOCONTEXT */
# define ENV_BUFSIZE 2048
@@ -8238,35 +8370,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);
@@ -8278,7 +8410,7 @@
OperatingSystem getEnvironment:'PATH'
"
- "Modified: / 09-01-2007 / 20:14:35 / cg"
+ "Modified: / 15-11-2016 / 16:10:27 / cg"
!
getHostName
@@ -9279,44 +9411,45 @@
DWORD exitCode;
if (__isExternalAddressLike(processHandleOrPid) ) {
- processHandle = _HANDLEVal(processHandleOrPid);
- if (processHandle == 0) {
- 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)
- CloseHandle(processHandleToClose);
- if (exitCode == STILL_ACTIVE) {
- RETURN(true);
- } else {
- RETURN(false);
- }
- } else if (processHandleToClose) {
- CloseHandle(processHandleToClose);
+ if (processHandleToClose != 0)
+ CloseHandle(processHandleToClose);
+ if (exitCode == STILL_ACTIVE) {
+ RETURN(true);
+ } else {
+ RETURN(false);
+ }
+ } else if (processHandleToClose != 0) {
+ 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
--- a/Win32Process.st Wed Oct 19 09:22:53 2016 +0100
+++ b/Win32Process.st Fri Dec 09 22:31:28 2016 +0000
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#Win32Process
instanceVariableNames:'command environment directory inStream outStream errorStream pid
exitStatus finishSema'
@@ -193,7 +195,10 @@
inputFrom:inStream
outputTo:outStream
errorTo:errorStream
- inDirectory:directory.
+ auxFrom:nil
+ environment:nil
+ inDirectory:directory
+ showWindow:false.
]
action:[:status |
status stillAlive ifFalse:[
@@ -220,10 +225,10 @@
!Win32Process class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.3 2013-03-27 18:19:55 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.3 2013-03-27 18:19:55 cg Exp $'
+ ^ '$Header$'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/WordArray.st Fri Dec 09 22:31:28 2016 +0000
@@ -0,0 +1,138 @@
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ 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 }"
+
+UnboxedIntegerArray variableWordSubclass:#WordArray
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Arrayed'
+!
+
+!WordArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ 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
+"
+ WordArrays store integers in the range 0..16rFFFF.
+ In contrast to normal arrays (which store pointers to their elements),
+ wordArrays store the values in a dense & compact way.
+ Since the representation fits the underlying C-language systems representation
+ of unsigned int16's, this is also useful to pass bulk data to c primitive code.
+
+ WordArrays can be used to hold bulk integer data in a more compact way.
+ For example:
+ Array new:100000 withAll:1
+ requires 400k of object memory;
+
+ in contrast,
+ WordArray new:100000 withAll:1
+ only requires half of it.
+
+ [memory requirements:]
+ OBJ-HEADER + (size * 2)
+
+ [see also:]
+ ByteArray BooleanArray FloatArray DoubleArray Array
+ SignedWordArray
+
+ [author:]
+ Claus Gittinger
+"
+! !
+
+!WordArray class methodsFor:'queries'!
+
+elementByteSize
+ "for bit-like containers, return the number of bytes stored per element.
+ Here, 2 is returned"
+
+ ^ 2
+
+ "Created: / 15-09-2011 / 14:10:54 / cg"
+!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For WordArrays, this is 16rFFFF (largest 16bit unsigned int)"
+
+ ^ 16rFFFF
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For WordArrays, this is 0"
+
+ ^ 0
+! !
+
+!WordArray methodsFor:'accessing'!
+
+unsignedInt16At:index MSB:msb
+ "return the 2-bytes starting at index as an (unsigned) Integer.
+ The index is a smalltalk index (i.e. 1-based).
+ The value is retrieved MSB (high 8 bits at lower index) if msb is true;
+ LSB-first (i.e. low 8-bits at lower byte index) if its false.
+ Notice:
+ the index is a byte index; thus, this allows for unaligned access to
+ words on any boundary"
+
+ |w|
+
+ index odd ifTrue:[
+ "/ aligned fetch
+ w := self at:(index // 2) + 1.
+ (msb ~~ UninterpretedBytes isBigEndian) ifTrue:[
+ w := w swapBytes
+ ].
+ ^ w
+ ].
+ ^ super unsignedInt16At:index MSB:msb
+
+ "
+ #(16r0201 16r0403 16r0605) asWordArray wordAt:1 MSB:false
+ #(16r0201 16r0403 16r0605) asWordArray wordAt:3 MSB:false
+ #(16r0201 16r0403 16r0605) asWordArray wordAt:5 MSB:false
+
+ #(16r0201 16r0403 16r0605) asWordArray wordAt:2 MSB:false
+ #(16r0201 16r0403 16r0605) asWordArray wordAt:4 MSB:false
+
+ #(16rFFEE 16r0403 16r0605) asWordArray wordAt:1 MSB:false
+ #(16rFFEE 16r0403 16r0605) asWordArray wordAt:1 MSB:true
+ "
+! !
+
+!WordArray class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/abbrev.stc Wed Oct 19 09:22:53 2016 +0100
+++ b/abbrev.stc Fri Dec 09 22:31:28 2016 +0000
@@ -54,6 +54,7 @@
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
AbstractTime AbstractTime stx:libbasic 'Magnitude-Time' 0
@@ -418,3 +419,12 @@
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 Wed Oct 19 09:22:53 2016 +0100
+++ b/bc.mak Fri Dec 09 22:31:28 2016 +0000
@@ -125,6 +125,7 @@
$(OUTDIR)UndefinedObject.$(O) UndefinedObject.$(C) UndefinedObject.$(H): UndefinedObject.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)UserMessage.$(O) UserMessage.$(C) UserMessage.$(H): UserMessage.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Visitor.$(O) Visitor.$(C) Visitor.$(H): Visitor.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)VoidObject.$(O) VoidObject.$(C) VoidObject.$(H): VoidObject.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)AbstractTime.$(O) AbstractTime.$(C) AbstractTime.$(H): AbstractTime.st $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ApplicationDefinition.$(O) ApplicationDefinition.$(C) ApplicationDefinition.$(H): ApplicationDefinition.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
$(OUTDIR)ArithmeticValue.$(O) ArithmeticValue.$(C) ArithmeticValue.$(H): ArithmeticValue.st $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -243,6 +244,7 @@
$(OUTDIR)AbstractSourceFileWriter.$(O) AbstractSourceFileWriter.$(C) AbstractSourceFileWriter.$(H): AbstractSourceFileWriter.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Notification.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Query.$(H) $(STCHDR)
$(OUTDIR)ActivityNotification.$(O) ActivityNotification.$(C) ActivityNotification.$(H): ActivityNotification.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Notification.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\UserNotification.$(H) $(STCHDR)
$(OUTDIR)Array.$(O) Array.$(C) Array.$(H): Array.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(STCHDR)
+$(OUTDIR)BitArray.$(O) BitArray.$(C) BitArray.$(H): BitArray.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(STCHDR)
$(OUTDIR)BreakPointInterrupt.$(O) BreakPointInterrupt.$(C) BreakPointInterrupt.$(H): BreakPointInterrupt.st $(INCLUDE_TOP)\stx\libbasic\ControlInterrupt.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\HaltInterrupt.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(O) CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(C) CharacterEncoderImplementations__ISO10646_to_UTF16LE.$(H): CharacterEncoderImplementations__ISO10646_to_UTF16LE.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoder.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderImplementations__ISO10646_to_UTF16BE.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderImplementations__TwoByteEncoder.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(O) CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(C) CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.$(H): CharacterEncoderImplementations__ISO10646_to_UTF8_MAC.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoder.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderImplementations__ISO10646_to_UTF8.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderImplementations__TwoByteEncoder.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -297,6 +299,7 @@
$(OUTDIR)AbstractNumberVector.$(O) AbstractNumberVector.$(C) AbstractNumberVector.$(H): AbstractNumberVector.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)AllocationFailure.$(O) AllocationFailure.$(C) AllocationFailure.$(H): AllocationFailure.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)AutoloadMetaclass.$(O) AutoloadMetaclass.$(C) AutoloadMetaclass.$(H): AutoloadMetaclass.st $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\Metaclass.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)BooleanArray.$(O) BooleanArray.$(C) BooleanArray.$(H): BooleanArray.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\BitArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(STCHDR)
$(OUTDIR)ByteArray.$(O) ByteArray.$(C) ByteArray.$(H): ByteArray.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)CharacterArray.$(O) CharacterArray.$(C) CharacterArray.$(H): CharacterArray.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)CharacterWriteStream.$(O) CharacterWriteStream.$(C) CharacterWriteStream.$(H): CharacterWriteStream.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(STCHDR)
@@ -380,6 +383,7 @@
$(OUTDIR)SubclassResponsibilityError.$(O) SubclassResponsibilityError.$(C) SubclassResponsibilityError.$(H): SubclassResponsibilityError.st $(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)TimeConversionError.$(O) TimeConversionError.$(C) TimeConversionError.$(H): TimeConversionError.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\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)TwoByteString.$(O) TwoByteString.$(C) TwoByteString.$(H): TwoByteString.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)UnboxedIntegerArray.$(O) UnboxedIntegerArray.$(C) UnboxedIntegerArray.$(H): UnboxedIntegerArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)UnimplementedFunctionalityError.$(O) UnimplementedFunctionalityError.$(C) UnimplementedFunctionalityError.$(H): UnimplementedFunctionalityError.st $(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)UnprotectedExternalBytes.$(O) UnprotectedExternalBytes.$(C) UnprotectedExternalBytes.$(H): UnprotectedExternalBytes.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)WeakDependencyDictionary.$(O) WeakDependencyDictionary.$(C) WeakDependencyDictionary.$(H): WeakDependencyDictionary.st $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Dictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\IdentityDictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Set.$(H) $(INCLUDE_TOP)\stx\libbasic\WeakIdentityDictionary.$(H) $(STCHDR)
@@ -397,11 +401,13 @@
$(OUTDIR)HandleRegistry.$(O) HandleRegistry.$(C) HandleRegistry.$(H): HandleRegistry.st $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Dictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\IdentityDictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Registry.$(H) $(INCLUDE_TOP)\stx\libbasic\Set.$(H) $(INCLUDE_TOP)\stx\libbasic\WeakIdentityDictionary.$(H) $(STCHDR)
$(OUTDIR)ImmutableString.$(O) ImmutableString.$(C) ImmutableString.$(H): ImmutableString.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\String.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)IndexNotFoundError.$(O) IndexNotFoundError.$(C) IndexNotFoundError.$(H): IndexNotFoundError.st $(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\NotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
+$(OUTDIR)IntegerArray.$(O) IntegerArray.$(C) IntegerArray.$(H): IntegerArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)InvalidByteCodeError.$(O) InvalidByteCodeError.$(C) InvalidByteCodeError.$(H): InvalidByteCodeError.st $(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\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)InvalidInstructionError.$(O) InvalidInstructionError.$(C) InvalidInstructionError.$(H): InvalidInstructionError.st $(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\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)InvalidReadError.$(O) InvalidReadError.$(C) InvalidReadError.$(H): InvalidReadError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadError.$(H) $(INCLUDE_TOP)\stx\libbasic\StreamError.$(H) $(STCHDR)
$(OUTDIR)InvalidWriteError.$(O) InvalidWriteError.$(C) InvalidWriteError.$(H): InvalidWriteError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\StreamError.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteError.$(H) $(STCHDR)
$(OUTDIR)KeyNotFoundError.$(O) KeyNotFoundError.$(C) KeyNotFoundError.$(H): KeyNotFoundError.st $(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\NotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
+$(OUTDIR)LongIntegerArray.$(O) LongIntegerArray.$(C) LongIntegerArray.$(H): LongIntegerArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)MissingClassInLiteralArrayErrorSignal.$(O) MissingClassInLiteralArrayErrorSignal.$(C) MissingClassInLiteralArrayErrorSignal.$(H): MissingClassInLiteralArrayErrorSignal.st $(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\NotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NoByteCodeError.$(O) NoByteCodeError.$(C) NoByteCodeError.$(H): NoByteCodeError.st $(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\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NonPositionableExternalStream.$(O) NonPositionableExternalStream.$(C) NonPositionableExternalStream.$(H): NonPositionableExternalStream.st $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(STCHDR)
@@ -409,13 +415,19 @@
$(OUTDIR)PTYOpenError.$(O) PTYOpenError.$(C) PTYOpenError.$(H): PTYOpenError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\OpenError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\StreamError.$(H) $(STCHDR)
$(OUTDIR)PackageNotCompatibleError.$(O) PackageNotCompatibleError.$(C) PackageNotCompatibleError.$(H): PackageNotCompatibleError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PackageLoadError.$(H) $(INCLUDE_TOP)\stx\libbasic\PackageNotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)RangeError.$(O) RangeError.$(C) RangeError.$(H): RangeError.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) $(STCHDR)
+$(OUTDIR)SignedIntegerArray.$(O) SignedIntegerArray.$(C) SignedIntegerArray.$(H): SignedIntegerArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)SignedLongIntegerArray.$(O) SignedLongIntegerArray.$(C) SignedLongIntegerArray.$(H): SignedLongIntegerArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)SignedWordArray.$(O) SignedWordArray.$(C) SignedWordArray.$(H): SignedWordArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)Symbol.$(O) Symbol.$(C) Symbol.$(H): Symbol.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\String.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
+$(OUTDIR)UnboundedExternalStream.$(O) UnboundedExternalStream.$(C) UnboundedExternalStream.$(H): UnboundedExternalStream.st $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(STCHDR)
$(OUTDIR)Unicode16String.$(O) Unicode16String.$(C) Unicode16String.$(H): Unicode16String.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\TwoByteString.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)UnorderedNumbersError.$(O) UnorderedNumbersError.$(C) UnorderedNumbersError.$(H): UnorderedNumbersError.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) $(STCHDR)
+$(OUTDIR)WordArray.$(O) WordArray.$(C) WordArray.$(H): WordArray.st $(INCLUDE_TOP)\stx\libbasic\AbstractNumberVector.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UnboxedIntegerArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
$(OUTDIR)WrongNumberOfArgumentsError.$(O) WrongNumberOfArgumentsError.$(C) WrongNumberOfArgumentsError.$(H): WrongNumberOfArgumentsError.st $(INCLUDE_TOP)\stx\libbasic\ArgumentError.$(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)WrongProceedabilityError.$(O) WrongProceedabilityError.$(C) WrongProceedabilityError.$(H): WrongProceedabilityError.st $(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\SignalError.$(H) $(STCHDR)
$(OUTDIR)CharacterRangeError.$(O) CharacterRangeError.$(C) CharacterRangeError.$(H): CharacterRangeError.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderError.$(H) $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\DecodingError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)DirectoryStream.$(O) DirectoryStream.$(C) DirectoryStream.$(H): DirectoryStream.st $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\FileStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(STCHDR)
+$(OUTDIR)ImaginaryResultError.$(O) ImaginaryResultError.$(C) ImaginaryResultError.$(H): ImaginaryResultError.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)InvalidEncodingError.$(O) InvalidEncodingError.$(C) InvalidEncodingError.$(H): InvalidEncodingError.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderError.$(H) $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\DecodingError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)NonIntegerIndexError.$(O) NonIntegerIndexError.$(C) NonIntegerIndexError.$(H): NonIntegerIndexError.st $(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\IndexNotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\NotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(OUTDIR)OverflowError.$(O) OverflowError.$(C) OverflowError.$(H): OverflowError.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)
@@ -424,6 +436,7 @@
$(OUTDIR)SubscriptOutOfBoundsError.$(O) SubscriptOutOfBoundsError.$(C) SubscriptOutOfBoundsError.$(H): SubscriptOutOfBoundsError.st $(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\IndexNotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\NotFoundError.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(STCHDR)
$(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)
--- a/libInit.cc Wed Oct 19 09:22:53 2016 +0100
+++ b/libInit.cc Fri Dec 09 22:31:28 2016 +0000
@@ -71,6 +71,7 @@
extern void _UndefinedObject_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UserMessage_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Visitor_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _VoidObject_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _AbstractTime_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ApplicationDefinition_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ArithmeticValue_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -189,6 +190,7 @@
extern void _AbstractSourceFileWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ActivityNotification_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Array_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _BitArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _BreakPointInterrupt_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _CharacterEncoderImplementations__ISO10646_137to_137UTF16LE_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _CharacterEncoderImplementations__ISO10646_137to_137UTF8_137MAC_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -243,6 +245,7 @@
extern void _AbstractNumberVector_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _AllocationFailure_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _AutoloadMetaclass_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _BooleanArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ByteArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _CharacterArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _CharacterWriteStream_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -326,6 +329,7 @@
extern void _SubclassResponsibilityError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _TimeConversionError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _TwoByteString_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _UnboxedIntegerArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UnimplementedFunctionalityError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UnprotectedExternalBytes_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _WeakDependencyDictionary_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -343,11 +347,13 @@
extern void _HandleRegistry_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ImmutableString_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _IndexNotFoundError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _IntegerArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _InvalidByteCodeError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _InvalidInstructionError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _InvalidReadError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _InvalidWriteError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _KeyNotFoundError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _LongIntegerArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _MissingClassInLiteralArrayErrorSignal_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NoByteCodeError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NonPositionableExternalStream_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -355,13 +361,19 @@
extern void _PTYOpenError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _PackageNotCompatibleError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _RangeError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _SignedIntegerArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _SignedLongIntegerArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _SignedWordArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Symbol_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _UnboundedExternalStream_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Unicode16String_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UnorderedNumbersError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _WordArray_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _WrongNumberOfArgumentsError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _WrongProceedabilityError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _CharacterRangeError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _DirectoryStream_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _ImaginaryResultError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _InvalidEncodingError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _NonIntegerIndexError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _OverflowError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -370,6 +382,7 @@
extern void _SubscriptOutOfBoundsError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UnderflowError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ZeroDivide_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _BadRomanNumberFormatError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
#ifdef UNIX
extern void _UnixFileDescriptorHandle_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _UnixFileHandle_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -457,6 +470,7 @@
_UndefinedObject_Init(pass,__pRT__,snd);
_UserMessage_Init(pass,__pRT__,snd);
_Visitor_Init(pass,__pRT__,snd);
+ _VoidObject_Init(pass,__pRT__,snd);
_AbstractTime_Init(pass,__pRT__,snd);
_ApplicationDefinition_Init(pass,__pRT__,snd);
_ArithmeticValue_Init(pass,__pRT__,snd);
@@ -575,6 +589,7 @@
_AbstractSourceFileWriter_Init(pass,__pRT__,snd);
_ActivityNotification_Init(pass,__pRT__,snd);
_Array_Init(pass,__pRT__,snd);
+ _BitArray_Init(pass,__pRT__,snd);
_BreakPointInterrupt_Init(pass,__pRT__,snd);
_CharacterEncoderImplementations__ISO10646_137to_137UTF16LE_Init(pass,__pRT__,snd);
_CharacterEncoderImplementations__ISO10646_137to_137UTF8_137MAC_Init(pass,__pRT__,snd);
@@ -629,6 +644,7 @@
_AbstractNumberVector_Init(pass,__pRT__,snd);
_AllocationFailure_Init(pass,__pRT__,snd);
_AutoloadMetaclass_Init(pass,__pRT__,snd);
+ _BooleanArray_Init(pass,__pRT__,snd);
_ByteArray_Init(pass,__pRT__,snd);
_CharacterArray_Init(pass,__pRT__,snd);
_CharacterWriteStream_Init(pass,__pRT__,snd);
@@ -712,6 +728,7 @@
_SubclassResponsibilityError_Init(pass,__pRT__,snd);
_TimeConversionError_Init(pass,__pRT__,snd);
_TwoByteString_Init(pass,__pRT__,snd);
+ _UnboxedIntegerArray_Init(pass,__pRT__,snd);
_UnimplementedFunctionalityError_Init(pass,__pRT__,snd);
_UnprotectedExternalBytes_Init(pass,__pRT__,snd);
_WeakDependencyDictionary_Init(pass,__pRT__,snd);
@@ -729,11 +746,13 @@
_HandleRegistry_Init(pass,__pRT__,snd);
_ImmutableString_Init(pass,__pRT__,snd);
_IndexNotFoundError_Init(pass,__pRT__,snd);
+ _IntegerArray_Init(pass,__pRT__,snd);
_InvalidByteCodeError_Init(pass,__pRT__,snd);
_InvalidInstructionError_Init(pass,__pRT__,snd);
_InvalidReadError_Init(pass,__pRT__,snd);
_InvalidWriteError_Init(pass,__pRT__,snd);
_KeyNotFoundError_Init(pass,__pRT__,snd);
+ _LongIntegerArray_Init(pass,__pRT__,snd);
_MissingClassInLiteralArrayErrorSignal_Init(pass,__pRT__,snd);
_NoByteCodeError_Init(pass,__pRT__,snd);
_NonPositionableExternalStream_Init(pass,__pRT__,snd);
@@ -741,13 +760,19 @@
_PTYOpenError_Init(pass,__pRT__,snd);
_PackageNotCompatibleError_Init(pass,__pRT__,snd);
_RangeError_Init(pass,__pRT__,snd);
+ _SignedIntegerArray_Init(pass,__pRT__,snd);
+ _SignedLongIntegerArray_Init(pass,__pRT__,snd);
+ _SignedWordArray_Init(pass,__pRT__,snd);
_Symbol_Init(pass,__pRT__,snd);
+ _UnboundedExternalStream_Init(pass,__pRT__,snd);
_Unicode16String_Init(pass,__pRT__,snd);
_UnorderedNumbersError_Init(pass,__pRT__,snd);
+ _WordArray_Init(pass,__pRT__,snd);
_WrongNumberOfArgumentsError_Init(pass,__pRT__,snd);
_WrongProceedabilityError_Init(pass,__pRT__,snd);
_CharacterRangeError_Init(pass,__pRT__,snd);
_DirectoryStream_Init(pass,__pRT__,snd);
+ _ImaginaryResultError_Init(pass,__pRT__,snd);
_InvalidEncodingError_Init(pass,__pRT__,snd);
_NonIntegerIndexError_Init(pass,__pRT__,snd);
_OverflowError_Init(pass,__pRT__,snd);
@@ -756,6 +781,7 @@
_SubscriptOutOfBoundsError_Init(pass,__pRT__,snd);
_UnderflowError_Init(pass,__pRT__,snd);
_ZeroDivide_Init(pass,__pRT__,snd);
+ _BadRomanNumberFormatError_Init(pass,__pRT__,snd);
#ifdef UNIX
_UnixFileDescriptorHandle_Init(pass,__pRT__,snd);
_UnixFileHandle_Init(pass,__pRT__,snd);
--- a/stx_libbasic.st Wed Oct 19 09:22:53 2016 +0100
+++ b/stx_libbasic.st Fri Dec 09 22:31:28 2016 +0000
@@ -1,8 +1,6 @@
-"{ Encoding: utf8 }"
-
"
- COPYRIGHT (c) 2006 by eXept Software AG
- All Rights Reserved
+ COPYRIGHT (c) Claus Gittinger / 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
@@ -26,8 +24,8 @@
copyright
"
- COPYRIGHT (c) 2006 by eXept Software AG
- All Rights Reserved
+ COPYRIGHT (c) Claus Gittinger / 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
@@ -55,6 +53,12 @@
Also no developer support classes are found here
(i.e. Change/History support, compiler etc.).
+
+ [author:]
+ cg
+
+ [primary maintainer:]
+ cg
"
! !
@@ -94,7 +98,8 @@
are extended by myself.
They are mandatory, because we need these packages as a prerequisite for loading and compiling.
This method is generated automatically,
- by searching along the inheritance chain of all of my classes."
+ by searching along the inheritance chain of all of my classes.
+ Please take a look at the #referencedPreRequisites method as well."
^ #(
)
@@ -103,12 +108,13 @@
referencedPreRequisites
"list packages which are a prerequisite, because they contain
classes which are referenced by my classes.
- We do not need these packages as a prerequisite for compiling or loading,
+ These packages are NOT needed as a prerequisite for compiling or loading,
however, a class from it may be referenced during execution and having it
unloaded then may lead to a runtime doesNotUnderstand error, unless the caller
includes explicit checks for the package being present.
This method is generated automatically,
- by searching all classes (and their packages) which are referenced by my classes."
+ by searching all classes (and their packages) which are referenced by my classes.
+ Please also take a look at the #mandatoryPreRequisites method"
^ #(
)
@@ -225,6 +231,7 @@
Stream
SystemChangeNotifier
UndefinedObject
+ VoidObject
UserMessage
Visitor
AbstractTime
@@ -543,7 +550,7 @@
(SimpleExternalLibraryFunction autoload)
(QualifiedName autoload)
(AbstractDesktop autoload)
- (BadRomanNumberFormatError autoload)
+ BadRomanNumberFormatError
(#'CharacterEncoderImplementations::BIG5' autoload)
(#'CharacterEncoderImplementations::CNS11643' autoload)
(#'CharacterEncoderImplementations::GB2313_1980' autoload)
@@ -577,7 +584,7 @@
(#'CharacterEncoderImplementations::NEXT' autoload)
(CmdLineParserTest autoload)
(GNOMEDesktop autoload)
- (ImaginaryResultError autoload)
+ ImaginaryResultError
(LargeFloat autoload)
(MacFilename macos autoload)
(MappedExternalBytes autoload)
@@ -585,10 +592,19 @@
(SmalltalkDesktop autoload)
(SystemNotification autoload)
(TextCollectorStream autoload)
- (UnboundedExternalStream autoload)
+ UnboundedExternalStream
(UnixDesktop autoload)
(WindowsDesktop autoload)
(XDGDesktop autoload)
+ UnboxedIntegerArray
+ WordArray
+ IntegerArray
+ LongIntegerArray
+ SignedIntegerArray
+ SignedLongIntegerArray
+ SignedWordArray
+ BitArray
+ BooleanArray
)
!
@@ -607,7 +623,9 @@
companyName
"Return a companyname which will appear in <lib>.rc"
- ^ 'eXept Software AG'
+ ^ 'Claus Gittinger / eXept Software AG'
+
+ "Modified: / 18-11-2016 / 11:48:38 / cg"
!
description
@@ -619,9 +637,9 @@
legalCopyright
"Return a copyright string which will appear in <lib>.rc"
- ^ 'Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 2013'
+ ^ 'Copyright Claus Gittinger 1988\nCopyright eXept Software AG 2013'
- "Modified: / 18-07-2012 / 19:10:19 / cg"
+ "Modified: / 18-11-2016 / 12:17:34 / cg"
!
productName
--- a/stx_libbasicWINrc.rc Wed Oct 19 09:22:53 2016 +0100
+++ b/stx_libbasicWINrc.rc Fri Dec 09 22:31:28 2016 +0000
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libbasic.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 7,1,1,163
+ FILEVERSION 7,1,1,165
PRODUCTVERSION 7,1,0,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -20,12 +20,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Basic Classes (LIB)\0"
- VALUE "FileVersion", "7.1.1.163\0"
+ VALUE "FileVersion", "7.1.1.165\0"
VALUE "InternalName", "stx:libbasic\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 2013\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "7.1.0.0\0"
- VALUE "ProductDate", "Tue, 27 Sep 2016 18:13:36 GMT\0"
+ VALUE "ProductDate", "Tue, 08 Nov 2016 23:35:29 GMT\0"
END
END