Merge jv
authorMerge Script
Wed, 12 Oct 2016 07:05:13 +0200
branchjv
changeset 20600 222ed6c9364e
parent 20599 c7eebeef73a8 (current diff)
parent 20597 592b6415b9ae (diff)
child 20727 fb8c5591428b
child 23071 77ad9497363c
Merge
ApplicationDefinition.st
Autoload.st
StandaloneStartup.st
String.st
UninterpretedBytes.st
Win32OperatingSystem.st
--- a/ApplicationDefinition.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/ApplicationDefinition.st	Wed Oct 12 07:05:13 2016 +0200
@@ -162,18 +162,28 @@
     "redefined to add application stuff, such as definitions for the app-icon, 
      startup class and installation directory"
 
+    |spec1 spec2|
+    
     super forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition.
 
-    #(
-        (applicationIconFileNameWindows applicationIconFileNameWindows_code 'description - project information')
-        (applicationIconFileNameLinux applicationIconFileNameLinux_code 'description - project information')
-        (applicationIconFileNameOSX applicationIconFileNameOSX_code 'description - project information')
-        "/ Not needed, done in ProjectDefinition>>forEachMethodsCodeToCompileDo:ignoreOldDefinition:
-        "/ (subProjects subProjects_code 'description')
-        (productInstallDirBaseName productInstallDirBaseName_code 'description - project information')
-        (startupClassName startupClassName_code 'description - startup')
-        (startupSelector startupSelector_code 'description - startup')
-    ) triplesDo:[:selector :codeMethodSelector :category|
+    spec1 := #().
+    self isGUIApplication ifTrue:[
+        spec1 := 
+            #(
+                (applicationIconFileNameWindows applicationIconFileNameWindows_code 'description - project information')
+                (applicationIconFileNameLinux applicationIconFileNameLinux_code 'description - project information')
+                (applicationIconFileNameOSX applicationIconFileNameOSX_code 'description - project information')
+            )
+    ].
+    spec2 := 
+        #(
+            "/ Not needed, done in ProjectDefinition>>forEachMethodsCodeToCompileDo:ignoreOldDefinition:
+            "/ (subProjects subProjects_code 'description')
+            (productInstallDirBaseName productInstallDirBaseName_code 'description - project information')
+            (startupClassName startupClassName_code 'description - startup')
+            (startupSelector startupSelector_code 'description - startup')
+        ).
+    (spec1 , spec2) triplesDo:[:selector :codeMethodSelector :category|
         (self class includesSelector:selector) ifFalse:[
             aTwoArgBlock
                 value: (self perform:codeMethodSelector)
--- a/Autoload.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/Autoload.st	Wed Oct 12 07:05:13 2016 +0200
@@ -73,7 +73,11 @@
     As you can imagine, this takes a long time and makes the initial startup quite slow.
     Therefore, this scheme is no longer the recommended one and we (at exept)
     always start ST/X with the '--quick' option, which skips this scan operation.
-
+    Late note: 
+        --quick is now (7.1.1) the default. 
+        To force an autoload scan, start stx with a --autoload argument.
+    
+    
     Advantage of Autoload stubs:
     Autoload stubs make it easier for a beginner to ST/X, to see what frameworks and classes
     are there, as they appear in the browser with category and class name (although no
--- a/StandaloneStartup.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/StandaloneStartup.st	Wed Oct 12 07:05:13 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 2006 by eXept Software AG
               All Rights Reserved
@@ -577,7 +579,7 @@
 
     OperatingSystem isMSDOSlike ifTrue:[
         self verboseInfo:('create mutex...').
-        handleAndLastErrorCode := OperatingSystem createMutexNamed: (self applicationUUID printString).
+        handleAndLastErrorCode := OperatingSystem createMutexNamed:(self applicationUUID printString).
         MutexHandle := handleAndLastErrorCode first.
         lastErrorCode := handleAndLastErrorCode second.
         "/ self assert: lastErrorCode == 0.
@@ -587,8 +589,17 @@
             or:[lastErrorCode == 5 "ERROR_ACCESS_DENIED"]].
 
         self verboseInfo:('alreadyExists = ',alreadyExists printString).
-        alreadyExists ifFalse:[OperatingSystem waitForSingleObject: MutexHandle].
-        ^ alreadyExists
+        alreadyExists ifTrue:[
+            "we do not own the Mutex, so we cannot release it"
+            MutexHandle notNil ifTrue:[
+                OperatingSystem primCloseHandle: MutexHandle.
+                MutexHandle := nil.
+            ].
+        ] ifFalse:[
+            "no need to wait, createMutex sets initialOwner = true"    
+"/            OperatingSystem waitForSingleObject: MutexHandle.
+        ].
+        ^ alreadyExists.
     ].
 
     ^ false.
@@ -641,7 +652,6 @@
 !
 
 releaseApplicationMutex
-
     (MutexHandle notNil and:[OperatingSystem isMSDOSlike]) ifTrue:[
         OperatingSystem releaseMutex: MutexHandle.
         OperatingSystem primCloseHandle: MutexHandle.
--- a/String.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/String.st	Wed Oct 12 07:05:13 2016 +0200
@@ -519,7 +519,6 @@
 ! !
 
 
-
 !String class methodsFor:'queries'!
 
 defaultPlatformClass
@@ -540,11 +539,6 @@
 ! !
 
 
-
-
-
-
-
 !String methodsFor:'accessing'!
 
 at:index
@@ -3043,9 +3037,7 @@
 
 %{  /* NOCONTEXT */
 
-#if !defined(FAST_MEMCPY)
     REGISTER unsigned char *srcp;
-#endif
     REGISTER unsigned char *dstp;
     REGISTER int count;
     int len, index1, sz;
@@ -3068,11 +3060,11 @@
                     __InstPtr(newString)->o_class = String;
                     __qSTORE(newString, String);
                     dstp = __stringVal(newString);
+                    srcp = __stringVal(self) + index1 - 1;
 #ifdef FAST_MEMCPY
-                    memcpy(dstp, __stringVal(self) + index1 - 1, count);
+                    memcpy(dstp, srcp, count);
                     dstp[count] = '\0';
 #else
-                    srcp = __stringVal(self) + index1 - 1;
                     while (count--) {
                         *dstp++ = *srcp++;
                     }
@@ -3092,6 +3084,8 @@
 
     "
         '12345' copyFrom:3
+        '12345678' copyFrom:9 -> empty string 
+        '12345678' copyFrom:0 -> error 
     "
 !
 
@@ -3177,6 +3171,17 @@
 
     "
         '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
     "
 !
 
@@ -3244,10 +3249,15 @@
     }
 #endif
 %}.
-    "fall back in case of non-character arg;
-     will eventually lead to an bad element signal raise"
+    "fall back in case of non-character arg or non-single-byte character.
+     will lead to an bad element signal raise or a UnicodeString to be returned"
 
     ^ super copyWith:aCharacter
+
+    "
+     '1234567' copyWith:$8
+     '1234567' copyWith:(Character value:16r220)
+    "
 !
 
 deepCopy
@@ -4266,7 +4276,6 @@
     ^ super reverse
 ! !
 
-
 !String methodsFor:'substring searching'!
 
 indexOfSubCollection:aSubString startingAt:startIndex ifAbsent:exceptionValue caseSensitive:caseSensitive
@@ -4943,7 +4952,6 @@
 
 ! !
 
-
 !String class methodsFor:'documentation'!
 
 version
--- a/UninterpretedBytes.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/UninterpretedBytes.st	Wed Oct 12 07:05:13 2016 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1993 by Claus Gittinger
               All Rights Reserved
@@ -745,7 +743,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
@@ -2491,7 +2489,9 @@
     |bIdx  "{ Class: SmallInteger }"
      delta "{ Class: SmallInteger }"|
 
-    ((anInteger < 0) or:[anInteger > 16rFFFFFFFFFFFFFFFF]) ifTrue:[
+    ((anInteger < 0) 
+     or:[anInteger class ~~ SmallInteger 
+         and:[anInteger > 16rFFFFFFFFFFFFFFFF]]) ifTrue:[
         ^ self elementBoundsError:anInteger
     ].
 
--- a/Win32OperatingSystem.st	Tue Oct 11 17:03:52 2016 +0100
+++ b/Win32OperatingSystem.st	Wed Oct 12 07:05:13 2016 +0200
@@ -173,6 +173,13 @@
 	privateIn:Win32OperatingSystem
 !
 
+Win32Handle subclass:#Win32MutexHandle
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:Win32OperatingSystem
+!
+
 Win32Handle subclass:#Win32NetworkResourceHandle
 	instanceVariableNames:''
 	classVariableNames:'ScopeMappingTable TypeMappingTable DisplayTypeMappingTable
@@ -980,7 +987,6 @@
     "Modified: 7.1.1997 / 19:36:11 / stefan"
 ! !
 
-
 !Win32OperatingSystem class methodsFor:'OS signal constants'!
 
 sigABRT
@@ -7787,16 +7793,14 @@
 primGetLastError
     "get the last error code"
 %{  /* NOCONTEXT */
-    DWORD e;
-
-    e = GetLastError();
+    DWORD e = GetLastError();
     RETURN(__MKUINT(e));
 %}.
 
     "/ <apicall: dword "GetLastError" () module: "kernel32.dll" >
 
     "
-	self primGetLastError
+        self primGetLastError
     "
 !
 
@@ -7858,25 +7862,20 @@
 
     |handle lastErrorCode|
 
-    "/ "Without clear reasons, before creating the mutex we must call #printCR"
-    "/ 'Creating mutex' printCR.
     self primSetLastError:0.
     self primGetLastError.
     handle := self primCreateMutex:nil initialOwner:true name:name.
     lastErrorCode := self primGetLastError.
     "/ lastErrorCode printCR.
-
-    "/    self assert: lastErrorCode == 0.
     "/    lastErrorCode == 5 "ERROR_ACCESS_DENIED" ifTrue:[Transcript showCR: 'Mutex not accesible (GetLastError = ERROR_ACCESS_DENIED)'.].
     "/    lastErrorCode == 183 "ERROR_ALREADY_EXISTS" ifTrue:[Transcript showCR: 'Mutex already exists (GetLastError = ERROR_ALREADY_EXISTS)'.].
-    (handle isNil or:[handle address ~~ 0]) ifFalse:[
-	Transcript showCR: 'CreateMutexNamed: "', name printString, '" failed'.
-	handle := nil.
-    ].
     ^ Array with: handle with: lastErrorCode
 
     "
-     self createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
+     |arr|
+     arr := self createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'.
+     self releaseMutex: arr first.
+
      self releaseMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
     "
 
@@ -7908,10 +7907,6 @@
     "/    lastErrorCode := self primGetLastError.
     "/    lastErrorCode = 2 ifTrue:[Transcript showCR: 'Mutex does not exist (GetLastError = ERROR_FILE_NOT_FOUND)'.].
     "/    lastErrorCode = 5 ifTrue:[Transcript showCR: 'Mutex not accessable (GetLastError = ERROR_ACCESS_DENIED)'.].
-    (handle isNil or:[handle address ~~ 0]) ifFalse:[
-	Transcript showCR: 'OpenMutexNamed: "', name printString, '" failed'.
-	^ nil.
-    ].
     ^ handle
 
     "
@@ -7923,32 +7918,34 @@
 
 primCreateMutex:lpSecurityDescriptor initialOwner:bInitialOwner name:lpName
     "If the function succeeds, the return value is a handle to the newly created mutex object.
-     If the function fails, the return value is NULL.
+     If the function fails, the return value is nil.
      If the mutex is a named mutex and the object existed before this function call, the return value is a handle to the existing object."
 
     |handle|
 
-    handle := Win32Handle new.
+    handle := Win32MutexHandle new.
 %{
     if (__isString(lpName)
      && ((bInitialOwner == true) || (bInitialOwner == false))) {
-	void *c_descr = NULL;
-	char *c_name;
-	BOOL c_initialOwner = (bInitialOwner == true);
-	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, c_initialOwner, c_name);
-	__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: ;
 %}.
@@ -7960,31 +7957,34 @@
 
 primOpenMutex:dwDesiredAccess initialOwner:bInitialOwner name:lpName
     "If the function succeeds, the return value is a handle to the mutex object.
-     If the function fails, the return value is NULL. To get extended error information, call GetLastError.
+     If the function fails, the return value is nil. To get extended error information, call GetLastError.
      If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND."
 
     |handle|
 
-    handle := Win32Handle new.
+    handle := Win32MutexHandle new.
 %{
     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);
-	__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: ;
 %}.
@@ -17136,6 +17136,15 @@
     self unregisterForFinalization.
 ! !
 
+!Win32OperatingSystem::Win32MutexHandle class methodsFor:'documentation'!
+
+documentation
+"
+    I represent a mutex (can be used from more than a single OS processe).
+    I can be waited upon in a WaitForHandle / WaitForMultipleObjects call.
+"
+! !
+
 !Win32OperatingSystem::Win32NetworkResourceHandle class methodsFor:'accessing - types'!
 
 displayTypeMappingTable