--- a/AbstractDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/AbstractDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/AbstractLock.st Wed Jun 13 14:39:23 2018 +0000
@@ -0,0 +1,297 @@
+"
+ Copyright (c) 2017 Jan Vrany
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ 'Software'), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MeERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#AbstractLock
+ instanceVariableNames:'process sema count'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Processes'
+!
+
+!AbstractLock class methodsFor:'documentation'!
+
+copyright
+"
+ Copyright (c) 2017 Jan Vrany
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ 'Software'), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MeERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+"
+
+!
+
+documentation
+"
+ A base superclass for owned reentrant locks. It provides generic and somewhat
+ slow implementation of:
+
+ * `#acquire` and `#acquireWithTimeoutMs:`
+ * `#release`
+ * `#critical:` and `#critical:timeoutMs:ifBlocking:`
+
+ Subclasses may (an should) override (some) of these with optimized versions
+ and eventually fall back to implementation defined here. See subclasses.
+
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+ process <Process | ni> a process that currently owns the
+ lock or nil (if no process owns it)
+ count <SmallInteger> nesting depth
+ sema <Semaphore> a semaphore to signal waiter in case
+ of contention
+
+ [class variables:]
+
+ [see also:]
+ RecursionLock
+ JavaMonitor
+
+"
+! !
+
+!AbstractLock class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+
+! !
+
+!AbstractLock class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine this again."
+
+ ^ self == AbstractLock.
+! !
+
+!AbstractLock methodsFor:'accessing'!
+
+count
+ ^ count
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ sema name
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name:aString
+ sema name:aString
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+owner
+ ^ process
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'acquire & release'!
+
+acquire
+ "
+ Acquire the lock:
+
+ * If the lock is not owned by any process, lock it and return immediately.
+ * If the lock is already owned by the calling process, return immediately.
+ * Otherwise, wait until owning process release it (by means of #release).
+
+ Return `true` (always)
+ "
+ ^self acquireWithTimeoutMs: nil
+
+
+ "Created: / 25-08-2017 / 08:34:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+acquireWithTimeoutMs: timeout
+ "
+ Acquire the lock:
+
+ * If the lock is not owned by any process, lock it and return immediately.
+ * If the lock is already owned by the calling process, return immediately.
+ * Otherwise, wait until owning process release it (by means of #release)
+ at most `timeout` milliseconds. If `timeout` is nil, wait forever.
+
+ Return `true` if the lock has been acquired or `false` if bot (e.g. wait
+ timed out)
+ "
+
+ | active wasBlocked acquired |
+ acquired := nil.
+ active := Processor activeProcess.
+ process == active ifTrue:[
+ "/ Process already ackquired the monitor, increase the
+ "/ count and continue...
+ count := count + 1.
+ ^true.
+ ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ (process notNil and:[ process isDead ]) ifTrue:[
+ "/ Process that acquired the monitor died without releasing it.
+ "/ This should not happen.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self assert: false description: 'Process that acquired the lock died without releasing it'.
+ process := nil.
+ count := 0.
+ ].
+ "/ We need to know that we already waited on and got semaphore
+ "/ in case the Semaphore >> #wait is prematurely terminated.
+ "/ Q: Can this actually happen? If so, how?
+ acquired := sema waitWithTimeoutMs: timeout.
+ acquired notNil ifTrue:[
+ process := active.
+ count := 1.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ] ifCurtailed:[
+ acquired notNil ifTrue:[
+ OperatingSystem blockInterrupts.
+ count := 0.
+ process := nil.
+ sema signal.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^acquired notNil.
+
+ "Created: / 25-08-2017 / 22:55:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 11-12-2017 / 14:11:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+release
+ "
+ Release the lock. Return true of lock has been released, `false` if
+ not (because calling process does not own it).
+ "
+ | active wasBlocked |
+
+ active := Processor activeProcess.
+ process == active ifFalse:[
+ "/ Oops, calling thread does not own the monitor. return false
+ "/ immediately.
+ ^ false.
+ ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ count == 1 ifTrue:[
+ process := nil.
+ count := 0.
+ sema signal.
+ ] ifFalse:[
+ count := count - 1.
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ ^ true
+
+
+ "Created: / 25-08-2017 / 08:38:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'initialization'!
+
+initialize
+ process := nil.
+ sema := Semaphore new: 1.
+ sema name:'Lock@' , self identityHash printString.
+ count := 0.
+
+ "Modified: / 29-08-2017 / 09:53:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'synchronized evaluation'!
+
+critical:aBlock
+ "Evaluate aBlock as a critical region. Same process may
+ enter critical region again, i.e., nesting allowed.
+
+ Returns the (return) value of `aBlock`
+ "
+ ^self critical: aBlock timeoutMs: nil ifBlocking: nil
+
+ "Modified (comment): / 25-08-2017 / 09:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+critical:aBlock ifBlocking:blockingBlock
+ "Like #critical:, but do not block if the lock cannot be acquired.
+ Instead, return the value of the second argument, `blockingBlock`."
+
+ ^ self critical:aBlock timeoutMs:0 ifBlocking:blockingBlock.
+!
+
+critical:aBlock timeoutMs:timeoutMs ifBlocking:blockingBlock
+ "Like #critical:, but do not block if the lock cannot be acquired
+ within `timeoutMs` milliseconds. Instead, return the value of `blockingBlock.`"
+
+ | acquired retval |
+
+ [
+ acquired := self acquireWithTimeoutMs: timeoutMs.
+ acquired ifTrue:[
+ retval := aBlock value
+ ] ifFalse:[
+ retval := blockingBlock value.
+ ]
+ ] ensure:[
+ acquired ifTrue:[
+ self release.
+ ]
+ ].
+ ^retval
+! !
+
+!AbstractLock class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/AbstractOperatingSystem.st Fri May 11 12:12:57 2018 +0100
+++ b/AbstractOperatingSystem.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2017 Patrik Svestka
All Rights Reserved
This software is furnished under a license and may be used
@@ -16,7 +18,8 @@
Object subclass:#AbstractOperatingSystem
instanceVariableNames:''
classVariableNames:'ConcreteClass ErrorSignal LastErrorNumber LocaleInfo OSSignals
- PipeFailed Resources'
+ PipeFailed Resources Language LanguageTerritory LanguageModifier
+ LanguageCodeset'
poolDictionaries:''
category:'System-Support'
!
@@ -59,6 +62,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2017 Patrik Svestka
All Rights Reserved
This software is furnished under a license and may be used
@@ -247,6 +252,14 @@
initializeConcreteClass
OperatingSystem := ConcreteClass := self getConcreteClass.
+!
+
+initializeLocale
+ "Initializes locale variables (Language, LanguageTerritory an so on)"
+
+ self subclassResponsibility
+
+ "Created: / 19-11-2017 / 14:53:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!AbstractOperatingSystem class methodsFor:'OS signal constants'!
@@ -4356,9 +4369,21 @@
!
getLanguage
- "get the LANGUAGE setting (example: de_DE.iso8859-15@euro)"
-
- ^ self getEnvironment:'LANG'.
+ Language isNil ifTrue:[
+ self initializeLocale.
+ ].
+ ^ Language
+
+ "Created: / 19-11-2017 / 14:21:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getLanguageTerritory
+ LanguageTerritory isNil ifTrue:[
+ self initializeLocale.
+ ].
+ ^ LanguageTerritory
+
+ "Created: / 19-11-2017 / 14:22:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
getLocaleInfo
--- a/AbstractSourceFileWriter.st Fri May 11 12:12:57 2018 +0100
+++ b/AbstractSourceFileWriter.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -32,6 +33,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/AbstractTime.st Fri May 11 12:12:57 2018 +0100
+++ b/AbstractTime.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/AmbiguousMessage.st Fri May 11 12:12:57 2018 +0100
+++ b/AmbiguousMessage.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,7 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
@@ -41,6 +42,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
--- a/Annotation.st Fri May 11 12:12:57 2018 +0100
+++ b/Annotation.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
@@ -60,6 +61,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
--- a/ApplicationDefinition.st Fri May 11 12:12:57 2018 +0100
+++ b/ApplicationDefinition.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2010-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2010-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -2133,8 +2137,7 @@
stx_RESOURCES: \
keyboard.rc \
keyboardMacros.rc \
- host.rc \
- h_win32.rc \
+ host.rc \
display.rc \
d_win32.rc \
libbasic_RESOURCES \
@@ -2162,9 +2165,6 @@
host.rc: $(TOP)\projects\smalltalk\host.rc
copy $(TOP)\projects\smalltalk\host.rc *.*
-h_win32.rc: $(TOP)\projects\smalltalk\h_win32.rc
- copy $(TOP)\projects\smalltalk\h_win32.rc *.*
-
display.rc: $(TOP)\projects\smalltalk\display.rc
copy $(TOP)\projects\smalltalk\display.rc *.*
--- a/Array.st Fri May 11 12:12:57 2018 +0100
+++ b/Array.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,8 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +29,8 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -703,15 +707,7 @@
#endif
) {
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
/*
@@ -821,14 +817,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
for (; index < nIndex; index++) {
REGISTER OBJFUNC codeVal;
@@ -930,15 +920,7 @@
&& (! ((INT)(__BlockInstPtr(__aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
#endif
) {
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(__aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
REGISTER OBJ el;
@@ -1094,14 +1076,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
while (n > 0) {
REGISTER OBJFUNC codeVal;
OBJ el;
@@ -1188,13 +1164,8 @@
if (__isBlockLike(aBlock)
&& (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
for (index=indexHigh; index >= indexLow; index--) {
REGISTER OBJFUNC codeVal;
@@ -1281,15 +1252,7 @@
#endif
) {
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
OBJ el;
@@ -1316,14 +1279,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
while (index < actualSize) {
REGISTER OBJFUNC codeVal;
OBJ el;
@@ -1449,14 +1406,8 @@
if (__isBlockLike(aBlock)
&& (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
for (index=nIndex-1; index >= endIndex; index--) {
REGISTER OBJFUNC codeVal;
--- a/Behavior.st Fri May 11 12:12:57 2018 +0100
+++ b/Behavior.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,8 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -26,6 +29,9 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -4535,7 +4541,7 @@
%{
INT nBytes = __intVal(nInstvars) * sizeof(OBJ) + OHDR_SIZE;
if (__isSmallInteger(n)) {
- int nIndex;
+ unsigned INT nIndex;
nIndex = __intVal(n);
switch (__intVal(__INST(flags)) & ARRAYMASK) {
--- a/Block.st Fri May 11 12:12:57 2018 +0100
+++ b/Block.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -973,7 +977,6 @@
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
/* compiled machine code */
RETURN ( (*thecode)(self) );
@@ -984,19 +987,6 @@
# else
RETURN ( __interpret(self, 0, nil, nil, nil, nil) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- /* compiled machine code */
- RETURN ( (*thecode)(home) );
- }
- /* interpreted code */
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 0, nil, home, nil, nil) );
-# else
- RETURN ( __interpret(self, 0, nil, home, nil, nil) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1022,7 +1012,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg) );
}
@@ -1032,18 +1021,6 @@
# else
RETURN ( __interpret(self, 1, nil, nil, nil, nil, arg) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg) );
- }
- /* interpreted code */
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 1, nil, home, nil, nil, &arg) );
-# else
- RETURN ( __interpret(self, 1, nil, home, nil, nil, arg) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1211,7 +1188,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2) );
}
@@ -1220,17 +1196,6 @@
# else
RETURN ( __interpret(self, 2, nil, nil, nil, nil, arg1, arg2) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 2, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 2, nil, home, nil, nil, arg1, arg2) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1266,7 +1231,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3) );
}
@@ -1275,17 +1239,6 @@
# else
RETURN ( __interpret(self, 3, nil, nil, nil, nil, arg1, arg2, arg3) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 3, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 3, nil, home, nil, nil, arg1, arg2, arg3) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1321,7 +1274,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4) );
}
@@ -1330,17 +1282,6 @@
# else
RETURN ( __interpret(self, 4, nil, nil, nil, nil, arg1, arg2, arg3, arg4) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 4, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 4, nil, home, nil, nil, arg1, arg2, arg3, arg4) );
-# endif
-# endif
}
#endif
%}.
@@ -1366,7 +1307,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5) );
}
@@ -1375,17 +1315,6 @@
# else
RETURN ( __interpret(self, 5, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 5, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 5, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1411,7 +1340,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6) );
}
@@ -1420,17 +1348,6 @@
# else
RETURN ( __interpret(self, 6, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 6, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 6, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
-# endif
-# endif
}
#endif /* not SCHTEAM */
%}.
@@ -1456,7 +1373,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
# endif
thecode = __BlockInstPtr(self)->b_code;
-# ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
}
@@ -1465,17 +1381,6 @@
# else
RETURN ( __interpret(self, 7, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
# endif
-# else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 7, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 7, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
-# endif
-# endif
}
#endif
%}.
@@ -1497,7 +1402,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
}
@@ -1506,17 +1410,6 @@
# else
RETURN ( __interpret(self, 8, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
# endif
-#else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 8, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 8, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
-# endif
-#endif
}
%}.
^ self wrongNumberOfArguments:8
@@ -1537,7 +1430,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) );
}
@@ -1546,17 +1438,6 @@
# else
RETURN ( __interpret(self, 9, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) );
# endif
-#else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 9, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 9, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) );
-# endif
-#endif
}
%}.
^ self wrongNumberOfArguments:9
@@ -1577,7 +1458,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) );
}
@@ -1586,17 +1466,6 @@
# else
RETURN ( __interpret(self, 10, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) );
# endif
-#else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 10, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 10, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) );
-# endif
-#endif
}
%}.
^ self wrongNumberOfArguments:10
@@ -1617,7 +1486,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) );
}
@@ -1626,17 +1494,6 @@
# else
RETURN ( __interpret(self, 11, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) );
# endif
-#else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 11, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 11, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) );
-# endif
-#endif
}
%}.
^ self wrongNumberOfArguments:11
@@ -1657,7 +1514,6 @@
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) );
}
@@ -1666,17 +1522,6 @@
# else
RETURN ( __interpret(self, 12, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) );
# endif
-#else
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) );
- }
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, 12, nil, home, nil, nil, &arg1) );
-# else
- RETURN ( __interpret(self, 12, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) );
-# endif
-#endif
}
%}.
^ self wrongNumberOfArguments:12
@@ -1742,56 +1587,6 @@
nA = __INST(nargs);
-#ifndef NEW_BLOCK_CALL
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- /* the most common case (0 args) here (without a switch) */
-
- if (nA == __mkSmallInteger(0)) {
- RETURN ( (*thecode)(home) );
- }
-
- ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
- switch ((INT)(nA)) {
- default:
- goto error;
- case (INT)__mkSmallInteger(15):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) );
- case (INT)__mkSmallInteger(14):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) );
- case (INT)__mkSmallInteger(13):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) );
- case (INT)__mkSmallInteger(12):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) );
- case (INT)__mkSmallInteger(11):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) );
- case (INT)__mkSmallInteger(10):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) );
- case (INT)__mkSmallInteger(9):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
- case (INT)__mkSmallInteger(8):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
- case (INT)__mkSmallInteger(7):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
- case (INT)__mkSmallInteger(6):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
- case (INT)__mkSmallInteger(5):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) );
- case (INT)__mkSmallInteger(4):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) );
- case (INT)__mkSmallInteger(3):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) );
- case (INT)__mkSmallInteger(2):
- RETURN ( (*thecode)(home, ap[0], ap[1]) );
- case (INT)__mkSmallInteger(1):
- RETURN ( (*thecode)(home, ap[0]) );
- case (INT)__mkSmallInteger(0):
- RETURN ( (*thecode)(home) );
- break;
- }
- }
-#endif
-
if (nA != __mkSmallInteger(0)) {
ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
switch ((INT)nA) {
@@ -1832,7 +1627,6 @@
}
}
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
}
@@ -1841,17 +1635,6 @@
# else
RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
# endif
-
-#else
-
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, &a1) );
-# else
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
-# endif
-
-#endif
-
error: ;
%}.
"
@@ -2013,56 +1796,6 @@
} else {
ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
}
-
-#ifndef NEW_BLOCK_CALL
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- /* the most common case (0 args) here (without a switch) */
-
- if (nA == __mkSmallInteger(0)) {
- RETURN ( (*thecode)(home) );
- }
-
- switch ((INT)(nA)) {
- default:
- goto error;
- case (INT)__mkSmallInteger(15):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) );
- case (INT)__mkSmallInteger(14):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) );
- case (INT)__mkSmallInteger(13):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) );
- case (INT)__mkSmallInteger(12):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) );
- case (INT)__mkSmallInteger(11):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) );
- case (INT)__mkSmallInteger(10):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) );
- case (INT)__mkSmallInteger(9):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
- case (INT)__mkSmallInteger(8):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
- case (INT)__mkSmallInteger(7):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
- case (INT)__mkSmallInteger(6):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
- case (INT)__mkSmallInteger(5):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) );
- case (INT)__mkSmallInteger(4):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) );
- case (INT)__mkSmallInteger(3):
- RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) );
- case (INT)__mkSmallInteger(2):
- RETURN ( (*thecode)(home, ap[0], ap[1]) );
- case (INT)__mkSmallInteger(1):
- RETURN ( (*thecode)(home, ap[0]) );
- case (INT)__mkSmallInteger(0):
- RETURN ( (*thecode)(home) );
- break;
- }
- }
-#endif
-
if (nA != __mkSmallInteger(0)) {
ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
switch ((INT)nA) {
@@ -2102,7 +1835,6 @@
break;
}
}
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
}
@@ -2111,17 +1843,6 @@
# else
RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
# endif
-
-#else
-
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, &a1) );
-# else
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
-# endif
-
-#endif
-
error: ;
%}.
"
@@ -2195,57 +1916,6 @@
case 1: a1 = ap[0];
case 0: ;
}
-
-#ifndef NEW_BLOCK_CALL
- home = __BlockInstPtr(self)->b_home;
- if (thecode != (OBJFUNC)nil) {
- /* the most common case (0 args) here (without a switch) */
-
- if (nA == __mkSmallInteger(0)) {
- RETURN ( (*thecode)(home) );
- }
-
- switch ((INT)(nA)) {
- default:
- goto error;
- case (INT)__mkSmallInteger(15):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
- case (INT)__mkSmallInteger(14):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) );
- case (INT)__mkSmallInteger(13):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) );
- case (INT)__mkSmallInteger(12):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
- case (INT)__mkSmallInteger(11):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) );
- case (INT)__mkSmallInteger(10):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) );
- case (INT)__mkSmallInteger(9):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9) );
- case (INT)__mkSmallInteger(8):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8) );
- case (INT)__mkSmallInteger(7):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7) );
- case (INT)__mkSmallInteger(6):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6) );
- case (INT)__mkSmallInteger(5):
- RETURN ( (*thecode)(home, a1, a2, a3, a4, a5) );
- case (INT)__mkSmallInteger(4):
- RETURN ( (*thecode)(home, a1, a2, a3, a4) );
- case (INT)__mkSmallInteger(3):
- RETURN ( (*thecode)(home, a1, a2, a3) );
- case (INT)__mkSmallInteger(2):
- RETURN ( (*thecode)(home, a1, a2) );
- case (INT)__mkSmallInteger(1):
- RETURN ( (*thecode)(home, a1) );
- case (INT)__mkSmallInteger(0):
- RETURN ( (*thecode)(home) );
- break;
- }
- }
-#endif
-
-#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
}
@@ -2254,17 +1924,6 @@
# else
RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
# endif
-
-#else
-
-# ifdef PASS_ARG_POINTER
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, &a1) );
-# else
- RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) );
-# endif
-
-#endif
-
error: ;
%}.
"
--- a/BuiltinLookup.st Fri May 11 12:12:57 2018 +0100
+++ b/BuiltinLookup.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
@@ -37,6 +38,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
--- a/ByteArray.st Fri May 11 12:12:57 2018 +0100
+++ b/ByteArray.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -232,10 +234,10 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
REGISTER OBJ cls;
- REGISTER int nIndex;
+ REGISTER INT nIndex;
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
@@ -249,7 +251,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
RETURN ( __mkSmallInteger((__ByteArrayInstPtr(slf)->ba_element[indx])) );
}
}
@@ -266,8 +268,8 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
- int nIndex;
+ REGISTER INT indx;
+ unsigned INT nIndex;
int val;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -286,7 +288,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__ByteArrayInstPtr(slf)->ba_element[indx] = val;
RETURN ( value );
}
@@ -306,9 +308,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER int byte;
- int nIndex;
+ unsigned INT nIndex;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -324,7 +326,7 @@
byte += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)byte < (unsigned)nIndex) {
+ if ((unsigned)byte < (unsigned INT)nIndex) {
RETURN ( __mkSmallInteger(((__ByteArrayInstPtr(slf)->ba_element[byte] & (1 << indx)) != 0)) );
}
}
@@ -349,9 +351,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER int byte;
- int nIndex;
+ unsigned INT nIndex;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -367,7 +369,7 @@
byte += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)byte < (unsigned)nIndex) {
+ if ((unsigned)byte < (unsigned INT)nIndex) {
__ByteArrayInstPtr(slf)->ba_element[byte] &= ~(1 << indx);
RETURN (slf);
}
@@ -414,13 +416,13 @@
if (indx >= 0) {
int byteIndex;
int bitIndex;
- int nIndex;
+ unsigned INT nIndex;
byteIndex = indx / 8;
bitIndex = indx % 8;
nIndex = __byteArraySize(self);
- if ((unsigned)byteIndex < (unsigned)nIndex) {
+ if ((unsigned)byteIndex < (unsigned INT)nIndex) {
__ByteArrayInstPtr(self)->ba_element[byteIndex] |= (1 << bitIndex);
RETURN (self);
}
@@ -462,8 +464,8 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
- int nIndex;
+ REGISTER INT indx;
+ unsigned INT nIndex;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -475,7 +477,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
RETURN ( __mkSmallInteger((__ByteArrayInstPtr(slf)->ba_element[indx])) );
}
}
@@ -490,8 +492,8 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
- int nIndex;
+ REGISTER INT indx;
+ unsigned INT nIndex;
int val;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -507,7 +509,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__ByteArrayInstPtr(slf)->ba_element[indx] = val;
RETURN ( value );
}
@@ -532,7 +534,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
union {
unsigned char u_char[4];
unsigned int u_uint;
@@ -596,7 +598,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
int val;
OBJ cls;
unsigned char *byteP;
@@ -688,7 +690,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
union {
unsigned char u_char[2];
unsigned short u_ushort;
@@ -728,7 +730,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
int val;
unsigned char *byteP;
@@ -805,7 +807,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
int v;
union {
unsigned char u_char[2];
@@ -874,7 +876,7 @@
%{ /* NOCONTEXT */
REGISTER INT indx;
- int nIndex;
+ unsigned INT nIndex;
int val;
OBJ cls;
unsigned char *byteP;
--- a/CharacterArray.st Fri May 11 12:12:57 2018 +0100
+++ b/CharacterArray.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,8 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -29,6 +31,8 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CharacterEncoder.st Fri May 11 12:12:57 2018 +0100
+++ b/CharacterEncoder.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -70,6 +71,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CharacterEncoderImplementations__ISO10646_to_JavaText.st Fri May 11 12:12:57 2018 +0100
+++ b/CharacterEncoderImplementations__ISO10646_to_JavaText.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CharacterEncoderImplementations__ISO10646_to_UTF8.st Fri May 11 12:12:57 2018 +0100
+++ b/CharacterEncoderImplementations__ISO10646_to_UTF8.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -32,6 +33,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CharacterEncoderImplementations__JIS0208_to_SJIS.st Fri May 11 12:12:57 2018 +0100
+++ b/CharacterEncoderImplementations__JIS0208_to_SJIS.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,7 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +28,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Class.st Fri May 11 12:12:57 2018 +0100
+++ b/Class.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -60,6 +62,8 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ClassBuilder.st Fri May 11 12:12:57 2018 +0100
+++ b/ClassBuilder.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2001 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -33,6 +34,7 @@
copyright
"
COPYRIGHT (c) 2001 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ClassDescription.st Fri May 11 12:12:57 2018 +0100
+++ b/ClassDescription.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -57,6 +59,8 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CmdLineOption.st Fri May 11 12:12:57 2018 +0100
+++ b/CmdLineOption.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CmdLineOptionError.st Fri May 11 12:12:57 2018 +0100
+++ b/CmdLineOptionError.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CmdLineParser.st Fri May 11 12:12:57 2018 +0100
+++ b/CmdLineParser.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CmdLineParserTest.st Fri May 11 12:12:57 2018 +0100
+++ b/CmdLineParserTest.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/CompiledCode.st Fri May 11 12:12:57 2018 +0100
+++ b/CompiledCode.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Context.st Fri May 11 12:12:57 2018 +0100
+++ b/Context.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -26,6 +28,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -798,13 +802,6 @@
__PATCHUPCONTEXT(theContext);
}
if (! __isNonLIFO(theContext)) {
- /*
- * to be prepared for the worst situation
- * (the sender is not stored, so the trap won't catch it)
- * make the writeBarrier trigger manually.
- * We'll see, if this is really required.
- */
- theContext->o_space |= CATCHMARK;
__markNonLIFO(theContext);
}
}
@@ -2308,19 +2305,6 @@
if (__isLazy(theContext)) {
__PATCHUPCONTEXT(theContext);
}
-
- if (! __isNonLIFO(theContext)) {
- /*
- * to be prepared for the worst situation
- * (the sender is not stored, so the trap won't catch it)
- * make the writeBarrier trigger manually.
- * We'll see, if this is really required.
- */
- theContext->o_space |= CATCHMARK;
-# if 0
- __markNonLIFO(theContext);
-# endif
- }
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
@@ -2406,17 +2390,6 @@
if (__isLazy(theContext)) {
__PATCHUPCONTEXT(theContext);
}
-
- if (! __isNonLIFO(theContext)) {
- /*
- * to be prepared for the worst situation
- * (the sender is not stored, so the trap won't catch it)
- * make the writeBarrier trigger manually.
- * We'll see, if this is really required.
- */
- theContext->o_space |= CATCHMARK;
- __markNonLIFO(theContext);
- }
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
@@ -2492,18 +2465,6 @@
if (__isLazy(theContext)) {
__PATCHUPCONTEXT(theContext);
}
- if (! __isNonLIFO(theContext)) {
- /*
- * to be prepared for the worst situation
- * (the sender is not stored, so the trap won't catch it)
- * make the writeBarrier trigger manually.
- * We'll see, if this is really required.
- */
- theContext->o_space |= CATCHMARK;
-# if 0
- __markNonLIFO(theContext);
-# endif
- }
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
@@ -2575,19 +2536,6 @@
if (__isLazy(theContext)) {
__PATCHUPCONTEXT(theContext);
}
-
- if (! __isNonLIFO(theContext)) {
- /*
- * to be prepared for the worst situation
- * (the sender is not stored, so the trap won't catch it)
- * make the writeBarrier trigger manually.
- * We'll see, if this is really required.
- */
- theContext->o_space |= CATCHMARK;
-# if 0
- __markNonLIFO(theContext);
-# endif
- }
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
--- a/DirectoryStream.st Fri May 11 12:12:57 2018 +0100
+++ b/DirectoryStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -445,6 +446,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/DoubleArray.st Fri May 11 12:12:57 2018 +0100
+++ b/DoubleArray.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/EncodedStream.st Fri May 11 12:12:57 2018 +0100
+++ b/EncodedStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ExecutableFunction.st Fri May 11 12:12:57 2018 +0100
+++ b/ExecutableFunction.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,7 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +28,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ExternalBytes.st Fri May 11 12:12:57 2018 +0100
+++ b/ExternalBytes.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -179,6 +180,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -799,15 +801,15 @@
%{ /* NOCONTEXT */
unsigned char *cp = (unsigned char *)(__INST(address_));
- int idx;
+ INT indx;
OBJ sz;
if (cp && __isSmallInteger(index)) {
- idx = __intVal(index);
- if (idx > 0) {
+ indx = __intVal(index);
+ if (indx > 0) {
if (((sz = __INST(size)) == nil)
- || (__intVal(sz) >= idx)) {
- cp = cp + idx - 1;
+ || (__intVal(sz) >= indx)) {
+ cp = cp + indx - 1;
RETURN ( __mkSmallInteger((*cp)) );
}
}
@@ -832,7 +834,7 @@
unsigned char *cp = (unsigned char *)(__INST(address_));
int val;
- int idx;
+ INT indx;
OBJ sz;
if (__isSmallInteger(value)) {
@@ -843,12 +845,12 @@
goto badArg;
if (cp && __isSmallInteger(index)) {
- idx = __intVal(index);
- if (idx > 0) {
+ indx = __intVal(index);
+ if (indx > 0) {
if (((sz = __INST(size)) == nil)
- || (__intVal(sz) >= idx)) {
+ || (__intVal(sz) >= indx)) {
if ((val & ~0xFF) == 0) /* i.e. (val >= 0) && (val <= 255) */ {
- cp[idx-1] = val;
+ cp[indx-1] = val;
RETURN ( value );
}
}
@@ -967,7 +969,7 @@
%{ /* NOCONTEXT */
- int nIndex, repNIndex;
+ unsigned INT nIndex, repNIndex;
int startIndex, stopIndex;
REGISTER unsigned char *src;
REGISTER int repStartIndex;
--- a/ExternalFunctionCallback.st Fri May 11 12:12:57 2018 +0100
+++ b/ExternalFunctionCallback.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2007 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -248,6 +249,7 @@
copyright
"
COPYRIGHT (c) 2007 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ExternalLibraryFunction.st Fri May 11 12:12:57 2018 +0100
+++ b/ExternalLibraryFunction.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -156,6 +157,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ExternalStream.st Fri May 11 12:12:57 2018 +0100
+++ b/ExternalStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -1362,6 +1363,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015-2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/FileStream.st Fri May 11 12:12:57 2018 +0100
+++ b/FileStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -204,6 +206,8 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Filename.st Fri May 11 12:12:57 2018 +0100
+++ b/Filename.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,8 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +29,8 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Float.st Fri May 11 12:12:57 2018 +0100
+++ b/Float.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -187,6 +188,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -2173,7 +2175,7 @@
%{ /* NOCONTEXT */
- register int indx;
+ REGISTER INT indx;
unsigned char *cp;
/*
@@ -2183,7 +2185,7 @@
*/
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(double)) {
+ if (((unsigned INT)(indx)) < sizeof(double)) {
cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
}
@@ -2206,7 +2208,7 @@
values as if this filler wasnt present."
%{ /* NOCONTEXT */
- register int indx, val;
+ REGISTER INT indx, val;
unsigned char *cp;
/*
@@ -2218,7 +2220,7 @@
val = __intVal(value);
if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(double)) {
+ if (((unsigned INT)(indx)) < sizeof(double)) {
cp = (unsigned char *)(& (__FloatInstPtr(self)->f_floatvalue));
cp[indx] = val;
RETURN ( value );
--- a/GNOMEDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/GNOMEDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Integer.st Fri May 11 12:12:57 2018 +0100
+++ b/Integer.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -32,6 +33,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -5416,6 +5418,7 @@
copyright
"
COPYRIGHT (c) 1999 by eXept Software AG
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/JavaPackage.st Fri May 11 12:12:57 2018 +0100
+++ b/JavaPackage.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,9 +1,11 @@
"
COPYRIGHT (c) 1996-2011 by Claus Gittinger
+ COPYRIGHT (c) 2015-2016 Jan Vrany
New code and modifications done at SWING Research Group [1]:
COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
+ COPYRIGHT (c) 2015-2016 Jan Vrany
SWING Research Group, Czech Technical University in Prague
This software is furnished under a license and may be used
@@ -34,10 +36,12 @@
copyright
"
COPYRIGHT (c) 1996-2011 by Claus Gittinger
+ COPYRIGHT (c) 2015-2016 Jan Vrany
New code and modifications done at SWING Research Group [1]:
COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
+ COPYRIGHT (c) 2015-2016 Jan Vrany
SWING Research Group, Czech Technical University in Prague
This software is furnished under a license and may be used
--- a/LargeInteger.st Fri May 11 12:12:57 2018 +0100
+++ b/LargeInteger.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/LibraryDefinition.st Fri May 11 12:12:57 2018 +0100
+++ b/LibraryDefinition.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,7 @@
"
COPYRIGHT (c) 2006-2013 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +28,7 @@
copyright
"
COPYRIGHT (c) 2006-2013 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/LongFloat.st Fri May 11 12:12:57 2018 +0100
+++ b/LongFloat.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,7 @@
"
COPYRIGHT (c) 1999 by eXept Software AG
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -229,6 +230,7 @@
copyright
"
COPYRIGHT (c) 1999 by eXept Software AG
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -1789,7 +1791,7 @@
%{ /* NOCONTEXT */
- register int indx;
+ REGISTER INT indx;
unsigned char *cp;
/*
@@ -1799,7 +1801,7 @@
*/
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(LONGFLOAT)) {
+ if (((unsigned INT)(indx)) < sizeof(LONGFLOAT)) {
cp = (unsigned char *)(& (__LongFloatInstPtr(self)->f_longfloatvalue));
RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
}
@@ -1822,7 +1824,7 @@
values as if this filler wasnt present."
%{ /* NOCONTEXT */
- register int indx, val;
+ REGISTER INT indx, val;
unsigned char *cp;
/*
@@ -1834,7 +1836,7 @@
val = __intVal(value);
if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(LONGFLOAT)) {
+ if (((unsigned INT)(indx)) < sizeof(LONGFLOAT)) {
cp = (unsigned char *)(& (__LongFloatInstPtr(self)->f_longfloatvalue));
cp[indx] = val;
RETURN ( value );
--- a/Lookup.st Fri May 11 12:12:57 2018 +0100
+++ b/Lookup.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
@@ -39,6 +40,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
--- a/Make.spec Fri May 11 12:12:57 2018 +0100
+++ b/Make.spec Wed Jun 13 14:39:23 2018 +0000
@@ -94,6 +94,7 @@
Project \
ProjectDefinition \
ReadEvalPrintLoop \
+ AbstractLock \
RecursionLock \
Semaphore \
SharedPool \
@@ -487,6 +488,7 @@
$(OUTDIR_SLASH)Project.$(O) \
$(OUTDIR_SLASH)ProjectDefinition.$(O) \
$(OUTDIR_SLASH)ReadEvalPrintLoop.$(O) \
+ $(OUTDIR_SLASH)AbstractLock.$(O) \
$(OUTDIR_SLASH)RecursionLock.$(O) \
$(OUTDIR_SLASH)Semaphore.$(O) \
$(OUTDIR_SLASH)SharedPool.$(O) \
@@ -814,7 +816,7 @@
$(OUTDIR_SLASH)UnderflowError.$(O) \
$(OUTDIR_SLASH)ZeroDivide.$(O) \
$(OUTDIR_SLASH)BadRomanNumberFormatError.$(O) \
-
+
WIN32_OBJS= \
$(OUTDIR_SLASH)PCFilename.$(O) \
$(OUTDIR_SLASH)Win32Constants.$(O) \
--- a/Metaclass.st Fri May 11 12:12:57 2018 +0100
+++ b/Metaclass.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Method.st Fri May 11 12:12:57 2018 +0100
+++ b/Method.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,8 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
+ COPYRIGHT (c) 2017 Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
@@ -49,6 +52,9 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
+ COPYRIGHT (c) 2017 Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
--- a/MethodDictionary.st Fri May 11 12:12:57 2018 +0100
+++ b/MethodDictionary.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1995 by eXept Software AG
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1995 by eXept Software AG
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/NameSpace.st Fri May 11 12:12:57 2018 +0100
+++ b/NameSpace.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1996 by Claus Gittinger
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1996 by Claus Gittinger
+ COPYRIGHT (c) 2010 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/NamespaceAwareLookup.st Fri May 11 12:12:57 2018 +0100
+++ b/NamespaceAwareLookup.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
@@ -39,6 +41,8 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
+ COPYRIGHT (c) 2010 Jan Vrany
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
Permission is hereby granted, free of charge, to any person
--- a/NonPositionableExternalStream.st Fri May 11 12:12:57 2018 +0100
+++ b/NonPositionableExternalStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -47,6 +48,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/OSErrorHolder.st Fri May 11 12:12:57 2018 +0100
+++ b/OSErrorHolder.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Object.st Fri May 11 12:12:57 2018 +0100
+++ b/Object.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,9 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -37,6 +41,10 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -749,7 +757,8 @@
}
/* NOTREACHED */
#else
- REGISTER int nbytes, indx;
+ REGISTER INT indx;
+ REGISTER INT nBytes;
OBJ myClass;
REGISTER char *pFirst;
REGISTER int n;
@@ -764,7 +773,7 @@
indx = __intVal(index) - 1;
n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
- nbytes = __qSize(self) - n /* nInstBytes */;
+ nBytes = __qSize(self) - n /* nInstBytes */;
pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
@@ -772,7 +781,7 @@
/*
* pointers
*/
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ if ((unsigned INT)indx < (unsigned INT)(__BYTES2OBJS__(nBytes))) {
OBJ *op;
op = (OBJ *)pFirst + indx;
@@ -781,7 +790,7 @@
break;
case __MASKSMALLINT(WKPOINTERARRAY):
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ if ((unsigned INT)indx < (unsigned INT)(__BYTES2OBJS__(nBytes))) {
OBJ *op;
OBJ el;
@@ -796,7 +805,7 @@
/*
* (unsigned) bytes
*/
- if ((unsigned)indx < nbytes) {
+ if ((unsigned INT)indx < (unsigned INT)nBytes) {
unsigned char *cp;
cp = (unsigned char *)pFirst + indx;
@@ -813,10 +822,10 @@
int delta = __FLOATARRAY_ALIGN - ((INT)pFirst & (__FLOATARRAY_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes / sizeof(float))) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes / sizeof(float))) {
float *fp;
float f;
OBJ v;
@@ -841,10 +850,10 @@
int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes / sizeof(double))) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes / sizeof(double))) {
double *dp;
double d;
OBJ v;
@@ -867,7 +876,7 @@
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the short-size of the machine
*/
- if ((unsigned)indx < (nbytes>>1)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>1)) {
unsigned short *sp;
sp = (unsigned short *)(pFirst + (indx<<1));
@@ -882,7 +891,7 @@
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the short-size of the machine
*/
- if ((unsigned)indx < (nbytes>>1)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>1)) {
short *ssp;
ssp = (short *)(pFirst + (indx<<1));
@@ -897,7 +906,7 @@
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the int-size of the machine
*/
- if ((unsigned)indx < (nbytes>>2)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>2)) {
unsigned int32 ul;
unsigned int32 *lp;
@@ -924,7 +933,7 @@
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the int-size of the machine
*/
- if ((unsigned)indx < (nbytes>>2)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>2)) {
int32 *slp;
int32 l;
@@ -953,13 +962,13 @@
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the long/longlong-size of the machine
*/
- if ((unsigned)indx < (nbytes>>3)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>3)) {
# if __POINTER_SIZE__ == 8
INT *slp, ll;
@@ -987,13 +996,13 @@
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the long/longlong-size of the machine
*/
- if ((unsigned)indx < (nbytes>>3)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>3)) {
# if __POINTER_SIZE__ == 8
unsigned INT *ulp, ul;
@@ -1035,9 +1044,10 @@
}
/* NOTREACHED */
#else
- register int nbytes, indx;
+ REGISTER INT indx;
+ REGISTER INT nBytes;
OBJ myClass;
- register char *pFirst;
+ REGISTER char *pFirst;
/* int nInstBytes, ninstvars, flags; */
REGISTER int n;
unsigned int u;
@@ -1052,12 +1062,12 @@
myClass = __qClass(self);
n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
- nbytes = __qSize(self) - n /* nInstBytes */;
+ nBytes = __qSize(self) - n /* nInstBytes */;
pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
case __MASKSMALLINT(POINTERARRAY):
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ if ((unsigned INT)indx < (unsigned INT)(__BYTES2OBJS__(nBytes))) {
OBJ *op;
op = (OBJ *)pFirst + indx;
@@ -1068,7 +1078,7 @@
break;
case __MASKSMALLINT(WKPOINTERARRAY):
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ if ((unsigned INT)indx < (unsigned INT)(__BYTES2OBJS__(nBytes))) {
OBJ *op;
op = (OBJ *)pFirst + indx;
@@ -1083,7 +1093,7 @@
if (__isSmallInteger(anObject)) {
val = __intVal(anObject);
if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
- if ((unsigned)indx < nbytes) {
+ if ((unsigned INT)indx < (unsigned INT)nBytes) {
char *cp;
cp = pFirst + indx;
@@ -1100,10 +1110,10 @@
int delta = __FLOATARRAY_ALIGN - ((INT)pFirst & (__FLOATARRAY_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes / sizeof(float))) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes / sizeof(float))) {
float *fp;
fp = (float *)pFirst + indx;
@@ -1131,10 +1141,10 @@
int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes / sizeof(double))) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes / sizeof(double))) {
double *dp;
dp = (double *)pFirst + indx;
@@ -1160,7 +1170,7 @@
if (__isSmallInteger(anObject)) {
val = __intVal(anObject);
if ((unsigned)val <= 0xFFFF) {
- if ((unsigned)indx < (nbytes>>1)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>1)) {
unsigned short *sp;
sp = (unsigned short *)(pFirst + (indx<<1));
@@ -1175,7 +1185,7 @@
if (__isSmallInteger(anObject)) {
val = __intVal(anObject);
if ((val >= -32768) && (val < 32768)) {
- if ((unsigned)indx < (nbytes>>1)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>1)) {
short *ssp;
ssp = (short *)(pFirst + (indx<<1));
@@ -1187,7 +1197,7 @@
break;
case __MASKSMALLINT(SLONGARRAY):
- if ((unsigned)indx < (nbytes>>2)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>2)) {
int32 *slp;
slp = (int32 *)(pFirst + (indx<<2));
@@ -1213,7 +1223,7 @@
break;
case __MASKSMALLINT(LONGARRAY):
- if ((unsigned)indx < (nbytes>>2)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>2)) {
unsigned int32 *lp;
lp = (unsigned int32 *)(pFirst + (indx<<2));
@@ -1244,10 +1254,10 @@
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes>>3)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>3)) {
__int64__ ll;
__int64__ *sllp;
@@ -1283,10 +1293,10 @@
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
- nbytes -= delta;
+ nBytes -= delta;
}
# endif
- if ((unsigned)indx < (nbytes>>3)) {
+ if ((unsigned INT)indx < (unsigned INT)(nBytes>>3)) {
__uint64__ ll;
__uint64__ *llp;
@@ -1412,7 +1422,7 @@
case __MASKSMALLINT(SWORDARRAY):
case __MASKSMALLINT(SLONGARRAY):
common:
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
}
break;
@@ -1446,7 +1456,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int val, nIndex;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -1488,7 +1498,7 @@
common:
indx += nInstBytes;
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__ByteArrayInstPtr(slf)->ba_element[indx] = val;
RETURN ( byteValue );
}
@@ -7942,7 +7952,7 @@
#ifdef __SCHTEAM__
return context._RETURN( STInteger._new( self.basicSize() ) );
#else
- REGISTER INT nbytes;
+ REGISTER INT nBytes;
REGISTER OBJ myClass;
int nInstBytes;
@@ -7952,50 +7962,50 @@
* and SmallInteger
*/
myClass = __qClass(self);
- nbytes = __qSize(self);
+ nBytes = __qSize(self);
nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
case __MASKSMALLINT(POINTERARRAY):
case __MASKSMALLINT(WKPOINTERARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(__BYTES2OBJS__(nBytes)) );
case __MASKSMALLINT(BYTEARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes / sizeof(char)) );
case __MASKSMALLINT(FLOATARRAY):
# ifdef __NEED_FLOATARRAY_ALIGN
nInstBytes = (nInstBytes-1+__FLOATARRAY_ALIGN) &~ (__FLOATARRAY_ALIGN-1);
# endif
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes / sizeof(float)) );
case __MASKSMALLINT(DOUBLEARRAY):
# ifdef __NEED_DOUBLE_ALIGN
nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
# endif
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes / sizeof(double)) );
case __MASKSMALLINT(WORDARRAY):
case __MASKSMALLINT(SWORDARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
case __MASKSMALLINT(LONGARRAY):
case __MASKSMALLINT(SLONGARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
case __MASKSMALLINT(LONGLONGARRAY):
case __MASKSMALLINT(SLONGLONGARRAY):
# ifdef __NEED_LONGLONG_ALIGN
nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
# endif
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
+ nBytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nBytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
}
#endif /* not __SCHTEAM__ */
%}.
--- a/ObjectMemory.st Fri May 11 12:12:57 2018 +0100
+++ b/ObjectMemory.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2010-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -100,6 +102,8 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2010-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -3435,12 +3439,28 @@
!
newSpaceSize:newSize
- "change the size of the newSpace. To do this, the current contents
- of the newSpace may have to be tenured (if size is smaller).
- Returns false, if it failed for any reason.
- Experimental: this interface may valish without notice.
-
- DANGER ALERT:
+ "
+ Change the size of the newSpace. Returns true if newspace
+ has been resized, false otherwise.
+
+ NOTE:
+ Making newspace smaller forces objects in newspace to tenure.
+ The tenuring may fail for various reasons, most notably:
+
+ (i) there's not enough old space to tenure objects to or
+ (ii) there are so many non-tenurable objects.
+
+ The former being most likely. Therefore, if shrinking newspace
+ fails, you may want to allocate more oldspace (#moreOldSpace:)
+ and try again, like:
+
+ (ObjectMemory newSpaceSize: desiredSize) ifFalse:[
+ (ObjectMemory moreOldSpace: ObjectMemory newSpaceSize) ifTrue:[
+ ObjectMemory newSpaceSize: desiredSize
+ ]
+ ].
+
+ WARNING
be careful too big of a size may lead to longer scavenge pauses.
Too small of a newSpace may lead to more CPU overhead, due to
excessive scavenges. You have been warned."
@@ -4628,12 +4648,10 @@
"evaluates aBlock for all pages in the prev. oldSpace, passing
the pages address as argument.
For internal & debugging use only."
-%{
- if (__collectedOldSpacePagesDo(&aBlock) < 0) {
- RETURN (false);
- }
-%}.
- ^ true
+
+ <resource: #obsolete>
+
+ ^ self error: 'Not supported since Smalltalk/X 8.0.0'.
!
newSpacePagesDo:aBlock
--- a/PackageId.st Fri May 11 12:12:57 2018 +0100
+++ b/PackageId.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/PositionableStream.st Fri May 11 12:12:57 2018 +0100
+++ b/PositionableStream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Process.st Fri May 11 12:12:57 2018 +0100
+++ b/Process.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -19,7 +20,7 @@
singleStepping emergencySignalHandler suspendActions creatorId
processGroupId interruptsDisabled priorityRange
exceptionHandlerSet processType environment startTimestamp'
- classVariableNames:'TerminateSignal RestartSignal CaughtSignals'
+ classVariableNames:'TerminateSignal RestartSignal CaughtSignals SysProcessId'
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -29,6 +30,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -335,9 +337,22 @@
with:AbortAllOperationRequest
with:TerminateProcessRequest
with:RestartProcessRequest.
- ]
+ ].
+ self initializeVMProcessIdConstants.
"Modified: / 17.11.2001 / 11:07:29 / cg"
+
+!
+
+initializeVMProcessIdConstants
+
+%{
+#ifndef __SCHTEAM__
+ @global(Process:SysProcessId) = __MKSMALLINT(SYS_PROCESS_ID);
+ RETURN (self);
+#endif /* not SCHTEAM */
+%}.
+ self primitiveFailed
! !
!Process class methodsFor:'instance creation'!
@@ -562,7 +577,7 @@
To prevent any daemon processes from preventing this exit,
you should make them systemProcesses"
- processGroupId := 0
+ processGroupId := SysProcessId
"Created: 17.1.1997 / 21:42:46 / cg"
!
@@ -1259,13 +1274,13 @@
].
creatorId := active id.
processGroupId := active processGroupId.
- (processGroupId isNil or:[processGroupId == 0]) ifTrue:[
+ (processGroupId isNil or:[processGroupId == SysProcessId]) ifTrue:[
processGroupId := creatorId.
].
- "/ since groupId is used to detect a systemProcess (0),
+ "/ since groupId is used to detect a systemProcess (SysProcessId),
"/ do not allow a 0 here; need an explicit beSystemProcess.
- processGroupId == 0 ifTrue:[processGroupId := nil].
+ processGroupId == SysProcessId ifTrue:[processGroupId := nil].
"Modified: 25.1.1997 / 01:28:54 / cg"
! !
@@ -1276,7 +1291,7 @@
"set id and state - not for public use"
id := idNumber.
- creatorId := 0.
+ creatorId := SysProcessId.
processGroupId := nil.
state := stateSymbol.
singleStepping isNil ifTrue:[
@@ -1370,8 +1385,8 @@
which should not be suspended/terminated etc.."
^ (Processor isPureEventDriven
- or:[id == 0
- or:[processGroupId == 0
+ or:[id == SysProcessId
+ or:[processGroupId == SysProcessId
or:[(Display notNil and:[Display dispatchProcess == self])
]]])
@@ -1385,7 +1400,7 @@
isUserProcess
"return true if aProcess is a user process."
- ^ processGroupId ~~ 0 and:[id ~~ 0]
+ ^ processGroupId ~~ SysProcessId and:[id ~~ SysProcessId]
!
nameOrId
@@ -2066,7 +2081,7 @@
errorString:'process is already dead - cannot determine child processes'.
^ self
].
- processGroupId == 0 ifTrue:[
+ processGroupId == SysProcessId ifTrue:[
ProcessorScheduler invalidProcessSignal
raiseWith:self errorString:'trying to terminate the system process group'.
].
--- a/ProcessorScheduler.st Fri May 11 12:12:57 2018 +0100
+++ b/ProcessorScheduler.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2016-2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -31,7 +32,7 @@
UserSchedulingPriority UserInterruptPriority TimingPriority
HighestPriority SchedulingPriority MaxNumberOfProcesses
InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
- EventPollingInterval MaxProcessId'
+ EventPollingInterval MinProcessId MaxProcessId SysProcessId'
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -41,6 +42,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2016-2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -263,6 +265,8 @@
HighestPriority := 30.
SchedulingPriority := 31.
+ self initializeVMProcessIdConstants.
+
InvalidProcessSignal isNil ifTrue:[
InvalidProcessSignal := Error newSignalMayProceed:true.
InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
@@ -283,30 +287,27 @@
PureEventDriven ifTrue:[
'Processor [error]: no process support - running event driven' errorPrintCR
].
- self initializeVMMaxProcessId
+
"Modified: / 23-09-1996 / 14:24:50 / stefan"
"Modified: / 10-01-1997 / 18:03:03 / cg"
"Modified: / 19-09-2014 / 12:47:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-initializeVMMaxProcessId
+initializeVMProcessIdConstants
"/ for java locks, the VM may reserve some bits
"/ and reduce the maximum processID to be able to
"/ encode the id in an object's header field.
%{
#ifndef __SCHTEAM__
-
-# ifndef MAX_PROCESS_ID
-# define MAX_PROCESS_ID _MAX_INT
-# endif
-
+ @global(ProcessorScheduler:MinProcessId) = __MKSMALLINT(MIN_PROCESS_ID);
@global(ProcessorScheduler:MaxProcessId) = __MKSMALLINT(MAX_PROCESS_ID);
+ @global(ProcessorScheduler:SysProcessId) = __MKSMALLINT(SYS_PROCESS_ID);
RETURN (self);
#endif /* not SCHTEAM */
%}.
- MaxProcessId := SmallInteger maxVal.
+ self primitiveFailed
! !
!ProcessorScheduler class methodsFor:'instance creation'!
@@ -967,13 +968,13 @@
currentPriority := SchedulingPriority.
p := Process basicNew.
p
- setId:0 state:#run;
+ setId:SysProcessId state:#run;
setPriority:currentPriority;
name:'scheduler';
- beSystemProcess.
+ beSystemProcess.
scheduler := activeProcess := p.
- activeProcessId := 0.
+ activeProcessId := SysProcessId.
quiescentProcessLists at:currentPriority put:(l := LinkedList new).
l add:p.
@@ -1328,7 +1329,7 @@
actions (win32 only)
"
id := p id.
- (id ~~ 0 and:[id notNil]) ifTrue:[
+ (id ~~ SysProcessId and:[id notNil]) ifTrue:[
'Processor [warning]: problem with process ' errorPrint.
id errorPrint.
(nm := p name) notNil ifTrue:[
--- a/ProgrammingLanguage.st Fri May 11 12:12:57 2018 +0100
+++ b/ProgrammingLanguage.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -32,6 +33,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/ProjectDefinition.st Fri May 11 12:12:57 2018 +0100
+++ b/ProjectDefinition.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -68,6 +70,8 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -3438,7 +3442,11 @@
present in the resource files."
self module = 'stx' ifTrue:[
- ^ #(en de)
+ "/ I'm sorry, but for Smalltalk/X jv-branch, we require
+ "/ only English. I (JV) can't speak Germang, sadly.
+ (Smalltalk releaseIdentification = 'Smalltalk/X jv')
+ ifTrue:[ ^ #(en) ]
+ ifFalse:[ ^ #(en de) ]
].
^ #(en)
@@ -3446,6 +3454,8 @@
stx_goodies_rdoit supportedLanguages
cg_tools supportedLanguages
"
+
+ "Modified: / 05-03-2018 / 10:42:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
versionNumber
--- a/RecursionLock.st Fri May 11 12:12:57 2018 +0100
+++ b/RecursionLock.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -13,18 +14,32 @@
"{ NameSpace: Smalltalk }"
-Object subclass:#RecursionLock
- instanceVariableNames:'process sema'
+AbstractLock subclass:#RecursionLock
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
!
+!RecursionLock primitiveDefinitions!
+%{
+#define THINLOCKING
+#ifdef THINLOCKING
+# include <thinlocks.h>
+static inline unsigned INT* stxGetLockwordPtr(OBJ o) {
+ return (unsigned INT*)(&__OINST(o, process));
+}
+
+#endif
+%}
+! !
+
!RecursionLock class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -39,23 +54,47 @@
documentation
"
- like a Semaphore for mutual exclusion, but avoids the deadlock
+ Like a Semaphore for mutual exclusion, but avoids the deadlock
if a critical region is reentered by the same process again.
- I.e. allows reentering the critical region IFF the current process
+ I.e. allows reentering the critical region IFF the current process
is the one which did the original locking.
+ NOTE:
+ The recursion lock is not only reentrant (same process may enter the
+ critical section multiple times) but also much faster than using
+ semaphore (`lock := Semaphore forMutualExclusion. lock critical:[...]`)
+
+ Therefore you're encouraged to use `RecursonLock` rather than
+ `Semaphore forMutualExclusion` whenever possible.
+
WARNING:
- for now, recursionLocks are not unlocked when an image is
+ For now, recursionLocks are not unlocked when an image is
restarted. You may have to recreate them to avoid a deadLock.
(this may change in the future, but recreating a recursionLock in
the #earlyRestart handling does not hurt)
+ Thinlocks
+
+ RecursionLocks uses `thinlocks`[1] to optimize locking in the common
+ case - this makes it much faster.
+ The `lockword` is stored in `process` instvar - when a `process` instvar
+ contains a small integer, recursion lock is `thin`, value of `count` instvas
+ is invalid (out of sync).
+
+ [1]: David F. Bacon, Ravi Konuru, Chet Murthy, Mauricio Serrano:
+ Thin locks: featherweight synchronization for Java, ACM SIGPLAN 1998
+
+
+
[author:]
- Claus Gittinger
+ Claus Gittinger
+ Jan Vrany (thinlock suppot)
[see also:]
- Semaphore
- Process ProcessorScheduler
+ Semaphore
+ Process ProcessorScheduler
+ AbstractLock
+ thinlocks.h
"
!
@@ -96,12 +135,90 @@
forMutualExclusion
"same as new, for easy exchangability with regular mutual-exclusion Semaphores."
- ^ self new
+ ^ self new
+! !
+
+!RecursionLock methodsFor:'accessing'!
+
+count
+ ^ self processAndCount at: 2.
+
!
-new
- ^ self basicNew initialize
+owner
+ ^ self processAndCount at: 1.
+
+! !
+
+!RecursionLock methodsFor:'acquire & release'!
+
+acquireWithTimeoutMs: timeout
+ "
+ Acquire the lock:
+
+ * If the lock is not owned by any process, lock it and return immediately.
+ * If the lock is already owned by the calling process, return immediately.
+ * Otherwise, wait until owning process release it (by means of #release)
+ at most `timeout` milliseconds. If `timeout` is nil, wait forever.
+ Return `true` if the lock has been acquired or `false` if bot (e.g. wait
+ timed out)
+ "
+%{ /* NOCONTEXT */
+#ifdef THINLOCKING
+ if ( stxThinLock( stxGetLockwordPtr(self) ) == StxThinlockSuccess ) {
+ return (true);
+ }
+#endif
+%}.
+ "/ Inflate the lock if it's not yet inflated.
+ "/
+ "/ Note that #inflate method checks again if it's inflated or not,
+ "/ it may haopen some other thread inflated the lock in between the check
+ "/ here and code in #inflate.
+ "/
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change.
+ process class == SmallInteger ifTrue:[ self inflate ].
+ ^ super acquireWithTimeoutMs: timeout
+!
+
+release
+ "
+ Release the lock. Return true of lock has been released, `false` if
+ not (because calling process does not own it).
+ "
+%{ /* NOCONTEXT */
+#ifdef THINLOCKING
+ if ( stxThinUnlock( stxGetLockwordPtr(self) ) == StxThinlockSuccess ) {
+ return (true);
+ }
+#endif
+%}.
+ "/ Inflate the lock if it's not yet inflated.
+ "/
+ "/ Note that #inflate method checks again if it's inflated or not,
+ "/ it may haopen some other thread inflated the lock in between the check
+ "/ here and code in #inflate
+ "/
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change.
+ process class == SmallInteger ifTrue:[ self inflate ].
+ super release ifFalse:[
+ self error: ('Calling process does not own the lock (caller: %1, owner: %2)' bindWith: Processor activeProcess id with: (process isNil ifTrue:['<no owner>'] ifFalse:[process id])).
+ ].
+! !
+
+!RecursionLock methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ process := 0.
+
+ "Modified: / 25-01-1997 / 00:19:15 / cg"
+ "Modified: / 29-08-2017 / 09:53:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock methodsFor:'printing & storing'!
@@ -122,32 +239,89 @@
aGCOrStream nextPutAll:' name: '.
(self name ? 'unnamed') printOn:aGCOrStream.
aGCOrStream nextPut:$).
-!
+! !
+
+!RecursionLock methodsFor:'private'!
+
+inflate
+ "Inflates (thin) lock (into fat lock). If the lock is already a fat lock,
+ #inflate is no-op.
-name
- "return the semaphores userFriendly name"
+ Called by:
+
+ * #acquire* in case of contention or if maximum nesting count
+ is exceeded (unlikely)
+ * #release in case of contention
+
+
+ "
- ^ sema name
+ | processAndCount wasBlocked |
+
- "Created: / 28.6.1997 / 16:19:40 / cg"
- "Modified: / 14.12.1999 / 21:03:46 / cg"
+ processAndCount := Array new: 2.
+ wasBlocked := OperatingSystem blockInterrupts.
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change
+ process class == SmallInteger ifTrue:[
+ self processAndCountInto: processAndCount.
+ process := processAndCount at: 1.
+ count := processAndCount at: 2.
+ process notNil ifTrue:[
+ sema setCount: 0.
+ ].
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+
+ "Modified: / 11-12-2017 / 21:40:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-name:aString
- "set the semaphores userFriendly name"
+processAndCount
+ | processAndCount |
+
+ processAndCount := Array new: 2.
+ self processAndCountInto: processAndCount.
+ ^ processAndCount
- sema name:aString
+!
+
+processAndCountInto: anArray
+ "Fills in `anArray` with owning process and nesting count.
+
+ Note that by the time this method returns, the data in given array may
+ be already obsolete.
+ "
+ | pid cnt proc |
- "Created: / 28.6.1997 / 16:19:47 / cg"
- "Modified: / 14.12.1999 / 21:03:52 / cg"
-! !
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change!
+ process class == SmallInteger ifTrue:[
+ %{
+#ifdef THINLOCKING
+ unsigned INT _pid = stxLockwordGetPid( *stxGetLockwordPtr(self) );
+ unsigned INT _cnt = stxLockwordGetCnt( *stxGetLockwordPtr(self) );
-!RecursionLock methodsFor:'private-initialization'!
+ if (_pid == INV_PROCESS_ID) {
+ pid = nil;
+ cnt = __MKINT(0);
+ } else {
+ pid = __MKINT(_pid);
+ cnt = __MKINT(_cnt);
+ }
+#endif
+ %}.
+ pid notNil ifTrue:[
+ proc := ObjectMemory processesKnownInVM detect:[:p|p id == pid] ifNone:[nil].
+ ].
+ ] ifFalse:[
+ proc := process.
+ cnt := count.
+ ].
+ anArray at: 1 put: proc.
+ anArray at: 2 put: cnt.
-initialize
- sema := Semaphore forMutualExclusion name:'recursionLock'
-
- "Modified: 25.1.1997 / 00:19:15 / cg"
! !
!RecursionLock methodsFor:'queries'!
@@ -160,190 +334,82 @@
"Created: 18.4.1996 / 17:18:08 / cg"
!
-owner
- "return the owning processes (or nil)"
-
- ^ process
-!
-
wouldBlock
- "Check if the resource represented by the receiver is
+ "Check if the resource represented by the receiver is
already in use by another process.
Attention: if asked without some global lock (blockedInterrupts),
the returned value may be outdated right away."
|p|
-
- ^ (p := process) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
+
+ ^ (p := self owner) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
! !
!RecursionLock methodsFor:'signaling'!
signal
- |wasBlocked|
+ self breakPoint: #jv.
+ self release ifFalse:[
+ self error: 'Attempt to release a (recursion) lock by process the does not own it!!'
+ ]
+
+ "Modified: / 25-08-2017 / 08:41:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!RecursionLock methodsFor:'synchronized evaluation'!
+
+critical:aBlock
+ "Evaluate aBlock as a critical region. Same process may
+ enter critical region again, i.e., nesting allowed.
+
+ Returns the (return) value of `aBlock`
+ "
+
+ <exception: #unwind>
+
+ | retval |
- process ~~ Processor activeProcess ifTrue:[
- self error:'RecursionLock - signaling process doesn''t own the lock'.
+ self acquireWithTimeoutMs: nil.
+ retval := aBlock value.
+ thisContext unmarkForUnwind.
+ self release.
+ ^ retval
+
+ "Created: / 31-08-2017 / 10:12:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!RecursionLock methodsFor:'unwinding'!
+
+unwindHandlerInContext:aContext
+ aContext selector == #critical: ifTrue:[
+ ^ [
+ "/ When unwiding a #critical: frame, there are two (only two?)
+ "/ cases:
+ "/
+ "/ 1. the critical section is executing aand being unwound
+ "/ 2. the process calling #critical: is waiting inside #acquire...
+ "/ for some other process to release it.
+ "/
+ "/ In the first case we have to call #release, in the second
+ "/ we MUST NOT since other process owns the lock.
+ "/ To distinguish, we check whether we own the lock or not
+ "/ by `self owner == Processor activeProcess`.
+ self owner == Processor activeProcess ifTrue:[ self release ].
+ ]
].
+ self shouldNeverBeReached.
- wasBlocked := OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ "Created: / 31-08-2017 / 10:11:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 11-12-2017 / 11:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock methodsFor:'waiting'!
-critical:aBlock
- "evaluate aBlock as a critical region, but do not block
- if this lock is already held by the current process."
-
- |active retVal wasBlocked gotSema|
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ aBlock value
- ].
-
- "/
- "/ sema wait & process := active
- "/ and:
- "/ proces := nil & sema signal
- "/ must both be done atomic
- "/ Scenario:
- "/ ... recLock critical
- "/ got lock
- "/ evaluated
- "/ set process to nil
- "/ -> timer interrupt
- "/ recLock critical in timeOut action
- "/ process isNil
- "/ sema wait !!!!!! DEADLOCK
- "/
- wasBlocked := OperatingSystem blockInterrupts.
- [
- (process notNil and:[process isDead]) ifTrue:[
- process := nil.
- 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- sema signal.
- ].
- gotSema := sema wait.
- process := active.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := aBlock value.
- ] ifCurtailed:[
- "be careful - the unwind may occur both while waiting
- AND while evaluating the block"
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ retVal.
-!
-
-critical:aBlock ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be acquired.
- Instead, return the value of the second argument, blockingBlock."
-
- ^ self critical:aBlock timeoutMs:0 ifBlocking:blockingBlock.
-!
-
-critical:aBlock timeoutMs:timeoutMs ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be acquired
- within timeoutMs milliseconds.
- Instead, return the value of blockingBlock."
-
- |active retVal wasBlocked gotSema|
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ aBlock value
- ].
+wait
+ self breakPoint: #jv.
+ self acquire.
- "/
- "/ sema wait & process := active
- "/ and:
- "/ proces := nil & sema signal
- "/ must both be done atomic
- "/ Scenario:
- "/ ... recLock critical
- "/ got lock
- "/ evaluated
- "/ set process to nil
- "/ -> timer interrupt
- "/ recLock critical in timeOut action
- "/ process isNil
- "/ sema wait !!!!!! DEADLOCK
- "/
- wasBlocked := OperatingSystem blockInterrupts.
- [
- (process notNil and:[process isDead]) ifTrue:[
- process := nil.
- 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- sema signal.
- ].
- gotSema := sema waitWithTimeoutMs:timeoutMs.
- gotSema notNil ifTrue:[
- process := active.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := aBlock value.
- ].
- ] ifCurtailed:[
- "be careful - the unwind may occur both while waiting
- AND while evaluating the block"
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ] ifFalse:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := blockingBlock value.
- ].
-
- ^ retVal.
-!
-
-wait
- "wait, but do not block,
- if this lock is already held by the current process.
- Answer false, if already locked, true if lock has been just acquired."
-
- |active wasBlocked|
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ false.
- ].
-
- wasBlocked := OperatingSystem blockInterrupts.
- (process notNil and:[process isDead]) ifTrue:[
- "/ 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.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "Modified: / 25-08-2017 / 08:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock class methodsFor:'documentation'!
@@ -354,5 +420,10 @@
version_CVS
^ '$Header$'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/Registry.st Fri May 11 12:12:57 2018 +0100
+++ b/Registry.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993,2015 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1993,2015 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Semaphore.st Fri May 11 12:12:57 2018 +0100
+++ b/Semaphore.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -75,6 +77,10 @@
to a deadlock.
Use a RecursionLock instead, to avoid this.
+ NOTE:
+ You're encouraged to use `RecursionLock` for guarding a critical section.
+ `RecursionLock` is not only reentrant but also much faster.
+
Hint:
now (Jul2002), Semaphores now allow for a negative count; this allows for
a sync-point to be implemented easily (i.e. to wait for multiple other processes
@@ -355,7 +361,7 @@
"an optional reference to someone who owns this semaphore,
typically a shared queue or a windowgroup or similar.
This has no semantic meaning and is only used to support debugging"
-
+
^ owner
!
--- a/ShortFloat.st Fri May 11 12:12:57 2018 +0100
+++ b/ShortFloat.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1996 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -165,6 +166,7 @@
copyright
"
COPYRIGHT (c) 1996 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -1486,7 +1488,7 @@
%{ /* NOCONTEXT */
- register int indx;
+ REGISTER INT indx;
unsigned char *cp;
/*
@@ -1496,7 +1498,7 @@
*/
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(float)) {
+ if (((unsigned INT)(indx)) < sizeof(float)) {
cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
}
@@ -1519,7 +1521,7 @@
values as if this filler wasnt present."
%{ /* NOCONTEXT */
- register int indx, val;
+ REGISTER INT indx, val;
unsigned char *cp;
/*
@@ -1531,7 +1533,7 @@
val = __intVal(value);
if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(float)) {
+ if (((unsigned INT)(indx)) < sizeof(float)) {
cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
cp[indx] = val;
RETURN ( value );
--- a/SignedByteArray.st Fri May 11 12:12:57 2018 +0100
+++ b/SignedByteArray.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2016 by eXept Sofware AG
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 2016 by eXept Sofware AG
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -73,10 +75,10 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
REGISTER OBJ cls;
- REGISTER int nIndex;
+ REGISTER INT nIndex;
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
@@ -90,7 +92,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
int byte = ((signed char *)__ByteArrayInstPtr(slf)->ba_element)[indx];
RETURN ( __mkSmallInteger(byte));
}
@@ -111,8 +113,8 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
- int nIndex;
+ REGISTER INT indx;
+ unsigned INT nIndex;
int val;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -131,7 +133,7 @@
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__ByteArrayInstPtr(slf)->ba_element[indx] = val;
RETURN ( value );
}
--- a/SmallInteger.st Fri May 11 12:12:57 2018 +0100
+++ b/SmallInteger.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -31,6 +32,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -3290,22 +3292,7 @@
&& (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
# endif
) {
-
-# ifdef NEW_BLOCK_CALL
-
# define BLOCK_ARG aBlock
-
-# else
-
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- /*
- * home on stack - no need to refetch
- */
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-# endif
{
# ifdef __UNROLL_LOOPS__
@@ -3375,13 +3362,8 @@
# undef BLOCK_ARG
-# ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-# else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# endif
/*
* sorry - must check for the blocks code within the loops;
@@ -3478,18 +3460,7 @@
# endif
) {
-# ifdef NEW_BLOCK_CALL
-
# define BLOCK_ARG aBlock
-
-# else
-
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-
-# endif
{
if (step < 0) {
if (step == -1) {
@@ -3532,13 +3503,8 @@
# undef BLOCK_ARG
-# ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-# else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# endif
if (step < 0) {
while (tmp >= final) {
@@ -3688,17 +3654,7 @@
if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
-# ifdef NEW_BLOCK_CALL
-
# define BLOCK_ARG aBlock
-
-# else
-
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-# endif
{
# ifdef PARANOIA
@@ -3865,13 +3821,8 @@
# undef BLOCK_ARG
-# ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-# else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# endif
/*
* sorry - must check for the blocks code within the loops;
--- a/Smalltalk.st Fri May 11 12:12:57 2018 +0100
+++ b/Smalltalk.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -41,6 +43,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -238,7 +242,7 @@
case the show starts in Smalltalk>>restart."
OrderedCollection initialize.
-
+
Smalltalk at:#Compiler put:ByteCodeCompiler.
Compiler isNil ifTrue:[
"
@@ -322,65 +326,11 @@
initGlobalsFromEnvironment
"setup globals from the shell-environment"
- |envString i langString terrString|
-
StandAlone isNil ifTrue:[
- StandAlone := false.
+ StandAlone := false.
].
HeadlessOperation isNil ifTrue:[
- HeadlessOperation := false.
- ].
-
- "
- extract Language and LanguageTerritory from LANG variable.
- valid are for example:
- en_en / en
- en_us
- en_gb
- de_de / de
- de_at (for Austria)
- "
-
- Language := #en.
- LanguageTerritory := #us.
-
-
- "Format of LANG is: language[_territory][.codeset][@modifier]
- language ISO-639 Language code
- territory ISO-3166 Contry code"
-
- envString := OperatingSystem getLanguage.
- envString size > 0 ifTrue:[
- i := envString indexOf:$@.
- (i ~~ 0) ifTrue:[
- LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- envString := envString copyTo:(i - 1).
- ] ifFalse:[
- LanguageModifier := nil.
- ].
- i := envString indexOf:$..
- (i ~~ 0) ifTrue:[
- LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- envString := envString copyTo:(i - 1).
- ] ifFalse:[
- LanguageCodeset := #'iso8859-1'.
- ].
- i := envString indexOf:$_.
- (i == 0) ifTrue:[
- langString := envString.
- terrString := envString
- ] ifFalse:[
- langString := envString copyTo:(i - 1).
- terrString := envString copyFrom:(i + 1)
- ].
- langString := langString asLowercase.
- terrString := terrString asLowercase.
- (langString = 'c' or:[terrString = 'c']) ifTrue:[
- ('Smalltalk [info]: ignoring wrong LANG setting (',langString,'_',terrString,') - using english') infoPrintCR.
- ] ifFalse:[
- Language := langString asSymbol.
- LanguageTerritory := terrString asSymbol
- ]
+ HeadlessOperation := false.
].
"
@@ -388,6 +338,7 @@
"
"Modified: / 14-02-2012 / 15:25:08 / cg"
+ "Modified: / 21-11-2017 / 21:29:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
initInterrupts
@@ -659,7 +610,7 @@
idx := CommandLineArguments indexOfAny:#('--noShellArgs' '--noshellargs').
(idx ~~ 0) ifTrue:[
CommandLineArguments removeIndex:idx.
- ] ifFalse:[
+ ] ifFalse:[
CommandLineArguments isEmpty ifTrue:[
shellArgs := OperatingSystem getEnvironment:'STX_DEFAULT_ARGS'.
shellArgs notEmptyOrNil ifTrue:[
@@ -676,7 +627,7 @@
].
].
- self initializeVerboseFlags.
+ self initializeVerboseFlags.
Error handle:[:ex |
StandAlone ifTrue:[
@@ -704,8 +655,8 @@
IgnoreAssertions := true.
] ifFalse:[
IgnoreAssertions := false.
- ].
-
+ ].
+
(idx := CommandLineArguments indexOf:'--ignoreHalt') ~~ 0 ifTrue:[
IgnoreHalt := true.
CommandLineArguments removeIndex:idx
@@ -753,7 +704,7 @@
VerboseStartup := true.
Logger notNil ifTrue:[
Logger loggingThreshold: Logger severityALL.
- ].
+ ].
CommandLineArguments removeIndex:idx.
].
@@ -767,7 +718,7 @@
Verbose := VerboseLoading := VerboseStartup := false.
Logger notNil ifTrue:[
Logger loggingThreshold: Logger severityNONE
- ].
+ ].
].
idx := CommandLineArguments indexOf:'--debug'.
@@ -1253,7 +1204,7 @@
|keys|
- keys := IdentitySet new.
+ keys := IdentitySet new: self size.
self keysDo:[:k | keys add:k].
^ keys
!
@@ -1290,7 +1241,7 @@
|values|
- values := OrderedCollection new.
+ values := OrderedCollection new: self size.
self do:[:v | values add:v].
^ values
@@ -1443,8 +1394,8 @@
wrongName := true.
].
- aClass isBuiltInClass ifTrue:[
- self error: 'Cannot remove builtin class!!'.
+ aClass isBuiltInClass ifTrue:[
+ self error: 'Cannot remove builtin class!!'.
].
self at:sym put:nil. "nil it out for compiled accesses"
@@ -1602,7 +1553,7 @@
|tuples|
tuples := aCollectionOfClasses collect:[:eachClass|
- Array
+ Array
with:eachClass name asSymbol
with:eachClass nameSpace
with:(
@@ -2094,7 +2045,7 @@
].
already size > numClassesHintTimes2 ifTrue:[
NumberOfClassesHint := (already size // 2) + 10
- ].
+ ].
].
!
@@ -2419,7 +2370,7 @@
aBlock value.
^ self.
].
-
+
sav := SilentLoading.
SilentLoading := true.
aBlock ensure:[ SilentLoading := sav ].
@@ -2455,14 +2406,14 @@
The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
Answer true, if the load succeeded, false if it failed"
- |packageDirOrNil binaryClassLibraryFilename projectDefinitionFilename
+ |packageDirOrNil binaryClassLibraryFilename projectDefinitionFilename
projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
loadOK errorInInitialize|
packageDirOrStringOrNil notNil ifTrue:[
packageDirOrNil := packageDirOrStringOrNil asFilename.
].
- silent := VerboseLoading not
+ silent := VerboseLoading not
and:[SilentLoading or:[StandAlone or:[InfoPrinting not]]].
"For now: have to read the project definition first!!
@@ -2503,7 +2454,7 @@
projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
projectDefinitionClass notNil ifTrue:[
projectDefinitionClass
- checkForLoad;
+ checkForLoad;
loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
].
].
@@ -2526,8 +2477,8 @@
Error handle:[:ex |
"/ catch error during initialization;
ex suspendedContext withAllSendersDo:[:sender |
- (sender selector == #initialize
- and:[sender receiver isBehavior
+ (sender selector == #initialize
+ and:[sender receiver isBehavior
and:[sender receiver name = projectDefinitionClassName]]
) ifTrue:[
errorInInitialize := true
@@ -2591,7 +2542,7 @@
extensionsLoaded := false.
ProgrammingLanguage allDo:[:programmingLanguage|
- "/ evaluating or here - want all extensions to be loaded
+ "/ evaluating or here - want all extensions to be loaded
extensionsLoaded := extensionsLoaded | (self loadExtensionsForPackage:aPackageId language: programmingLanguage)
].
^ extensionsLoaded
@@ -2690,7 +2641,7 @@
extensionsLoaded := false.
ProgrammingLanguage allDo:[:programmingLanguage|
- "/ evaluating or here - want all extensions to be loaded
+ "/ evaluating or here - want all extensions to be loaded
extensionsLoaded := extensionsLoaded | (self loadExtensionsFromDirectory: packageDirOrString language: programmingLanguage)
].
^ extensionsLoaded
@@ -2759,7 +2710,7 @@
sourceCodeManager notNil ifTrue:[
PackageLoadError handle:[:ex2 |
ex reject
- ] do:[
+ ] do:[
^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
].
].
@@ -3087,8 +3038,8 @@
^ implementors
"
- Smalltalk allImplementorsOf:#isNil
- (Smalltalk allImplementorsOf:#add:) size
+ Smalltalk allImplementorsOf:#isNil
+ (Smalltalk allImplementorsOf:#add:) size
"
"Modified: / 30-04-2016 / 17:37:39 / cg"
@@ -3691,6 +3642,17 @@
"Modified: / 14.6.1998 / 15:54:03 / cg"
!
+size
+ "Return the number of globals"
+
+%{ /* NOCONTEXT */
+ return ( __MKINT( __GLOBALS_SIZE() ) );
+%}.
+ self primitiveFailed.
+
+ "Created: / 03-07-2017 / 21:47:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
someImplementorOf:aSelector
"return any class, which implement the given selector. Nil if there is none.
(useful to search, if there is one at all)"
@@ -3875,7 +3837,7 @@
ParserFlags warnDollarInIdentifier:false.
ParserFlags warnUnderscoreInIdentifier:false.
ParserFlags allowOldStyleAssignment:false.
-
+
"/ add bindings for arguments
Workspace workspaceVariableAt:('_$0') put:CommandName.
Workspace workspaceVariableAt:('_$n') put:CommandLineArguments size.
@@ -3898,7 +3860,7 @@
startBlocks notNil ifTrue:[
Logger info: 'Executing start blocks'.
startBlocks copy do:[:aBlock|
- startBlocks remove: aBlock.
+ startBlocks remove: aBlock.
aBlock on: Error do:[:ex |
Logger error: 'Error when executing start block: %1' with: ex description.
InfoPrinting == true ifTrue:[
@@ -3926,14 +3888,14 @@
lateOpenDisplay
"this is called when a view is opened without a display being already opened."
-
+
Smalltalk openDisplay.
- Display notNil ifTrue:[
+ Display notNil ifTrue:[
IsRepl ifFalse:[
Display exitOnLastClose:true.
].
"/ Processor exitWhenNoMoreUserProcesses:true.
- ].
+ ].
!
mainStartup:graphicalMode
@@ -4183,13 +4145,13 @@
"/ provide a Display, if needed
(Smalltalk at:#Screen) currentScreenQuerySignal handle:[:ex |
Display isNil ifTrue:[ self lateOpenDisplay ].
- ex proceedWith:Display.
- ] do:aBlock
+ ex proceedWith:Display.
+ ] do:aBlock
!
readEvalPrintLoop
"say hello, then go into a read-eval-print loop"
-
+
"{ Pragma: +optSpace }"
Transcript showCR:(self hello).
@@ -4443,14 +4405,14 @@
start
"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
+ 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:
+ Caveat:
this has become too complicated and desperately needs a rewrite.
Also:
- Be very careful when changing things here;
+ 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.
"
@@ -4464,8 +4426,8 @@
idx := CommandLineArguments indexOf:'--debug'.
(idx ~~ 0) ifTrue:[
- CommandLineArguments removeAtIndex:idx.
- ].
+ CommandLineArguments removeAtIndex:idx.
+ ].
"
while reading patches- and rc-file, do not add things into change-file
@@ -4503,7 +4465,7 @@
arg := CommandLineArguments at:idx + 1.
CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
(arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
- self packagePath addLast:each.
+ self packagePath addLast:each.
VerboseStartup ifTrue:[
('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
].
@@ -4553,7 +4515,7 @@
"/ set workspace variables
self defineCommandLineAsWorkspaceVariablesForScripts.
-
+
"/ provide a Display, if needed
self providingDisplayDo:[
VerboseStartup ifTrue:[
@@ -4580,7 +4542,7 @@
"/ thisContext fullPrintAll.
MiniDebugger enterException:ex.
ex proceed.
- ].
+ ].
Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
self exit:128+(OperatingSystem sigINT).
] do:[
@@ -4599,7 +4561,7 @@
].
].
].
-
+
"/ after the script, if Screen has been opened and there are any open windows,
"/ then do not exit
false ifTrue:[
@@ -4644,7 +4606,7 @@
idx := CommandLineArguments indexOfAny:#('-F' '--filter').
(isFilter := (idx ~~ 0)) ifFalse:[
idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- (isRepl := (idx ~~ 0)) ifFalse:[
+ (isRepl := (idx ~~ 0)) ifFalse:[
idx := CommandLineArguments indexOfAny:#('--run').
isRunMain := (idx ~~ 0)
].
@@ -4654,7 +4616,7 @@
(isEval | isPrint | isFilter | isRepl | isRunMain) ifTrue:[
|args|
-
+
VerboseStartup ifTrue:[
('Smalltalk [info]: eval/filter/print or repl') infoPrintCR.
].
@@ -4710,7 +4672,7 @@
Debugger := nil.
].
].
-
+
process := [
self providingDisplayDo:[
isRepl ifTrue:[
@@ -4719,7 +4681,7 @@
self readEvalPrintLoop.
self exit.
].
-
+
Processor exitWhenNoMoreUserProcesses:true.
NoHandlerError handle:[:ex |
@@ -4728,7 +4690,7 @@
] ifFalse:[
Silent ifFalse:[
'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
- ].
+ ].
(VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
ex suspendedContext fullPrintAll.
].
@@ -4748,7 +4710,7 @@
self exit:128+(OperatingSystem sigINT).
] do:[
|filterCode filterStart filterEnd|
-
+
isFilter ifTrue:[
"/ --filter - apply code to each input line.
"/ compile code only once
@@ -4769,13 +4731,13 @@
StandAlone := true.
self exitWithErrorMessage:'--filter must be followed by 1 or 3 expression arg(s)'
].
- ].
- filterStart notEmptyOrNil ifTrue:[
+ ].
+ filterStart notEmptyOrNil ifTrue:[
VerboseStartup ifTrue:[
('Smalltalk [info]: eval: "', filterStart, '"...') infoPrintCR.
].
- Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
- ].
+ Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
+ ].
VerboseStartup ifTrue:[
('Smalltalk [info]: compile: "', filterCode, '"...') infoPrintCR.
].
@@ -4790,12 +4752,12 @@
line := Stdin nextLine.
line doIt:line.
].
- filterEnd notEmptyOrNil ifTrue:[
+ filterEnd notEmptyOrNil ifTrue:[
VerboseStartup ifTrue:[
('Smalltalk [info]: eval: "', filterEnd, '"...') infoPrintCR.
].
- Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
- ].
+ Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
+ ].
] ifFalse:[
(isPrint | isEval) ifTrue:[
"/ --print or --eval
@@ -4820,24 +4782,24 @@
].
(class respondsTo:#main:) ifTrue:[
class main:CommandLineArguments.
- ] ifFalse:[
+ ] ifFalse:[
(class respondsTo:#main) ifTrue:[
class main.
- ] ifFalse:[
+ ] ifFalse:[
(class respondsTo:#start) ifTrue:[
class start.
- ] ifFalse:[
+ ] 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:[
@@ -4858,8 +4820,8 @@
VerboseStartup ifTrue:[
('Smalltalk [info]: script/repl/eval finished.') infoPrintCR.
].
-
- ] newProcess.
+
+ ] newProcess.
process priority:(Processor userSchedulingPriority).
process name:'main'.
process beGroupLeader.
@@ -5395,40 +5357,29 @@
!Smalltalk class methodsFor:'system environment'!
language
- "return the language setting"
-
- ^ Language
+ ^ UserPreferences current language
"
Smalltalk language
"
- "Modified: 26.4.1996 / 17:10:05 / cg"
+ "Modified: / 26-04-1996 / 17:10:05 / cg"
+ "Modified: / 20-11-2017 / 14:12:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
language:aLanguageSymbol
- "set the language - send out change notifications"
-
- aLanguageSymbol ~= Language ifTrue:[
- Language := aLanguageSymbol asSymbol.
- self changed:#Language
- ].
-
- "
- Smalltalk language:#de
- "
+ <resource: #obsolete>
+
+ self obsoleteFeatureWarning:'Use `UserPreferences current language: ...`'
"Modified: / 19-10-2006 / 23:17:29 / cg"
+ "Modified: / 20-11-2017 / 14:10:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
language:aLanguageSymbol territory:aTerritorySymbol
- "set the language & territory - send out change notifications"
-
- ((Language ~= aLanguageSymbol) or:[ LanguageTerritory ~= aTerritorySymbol]) ifTrue:[
- Language := aLanguageSymbol asSymbol.
- LanguageTerritory := aTerritorySymbol asSymbol.
- self changed:#Language
- ].
+ <resource: #obsolete>
+
+ self obsoleteFeatureWarning:'Use `UserPreferences current language: ...; languageTerritory:`' .
"
Smalltalk language:#de territory:#de
@@ -5436,18 +5387,20 @@
"Created: / 19-10-2006 / 22:16:22 / cg"
"Modified: / 19-10-2006 / 23:17:36 / cg"
+ "Modified: / 20-11-2017 / 14:11:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
languageAndTerritory
"return the language and territory in the format lang-terr (i.e. de-de, en-us)"
- ^ Language , '-' , (LanguageTerritory ? Language)
+ ^ self language , '-' , self languageTerritory
"
Smalltalk languageAndTerritory
"
"Created: / 16-01-2011 / 10:19:42 / cg"
+ "Modified (comment): / 20-11-2017 / 14:13:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
languageCodeset
@@ -5461,17 +5414,16 @@
languageTerritory
"return the language territory setting"
- ^ LanguageTerritory
+ ^ UserPreferences current languageTerritory
+
+ "Modified: / 20-11-2017 / 14:13:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
languageTerritory:aTerritorySymbol
- "set the language territory - send out change notifications"
-
- aTerritorySymbol ~= LanguageTerritory ifTrue:[
- LanguageTerritory := aTerritorySymbol asSymbol.
- self changed:#LanguageTerritory
- ].
-
+ <resource: #obsolete>
+
+ self obsoleteFeatureWarning:'Use `UserPreferences current languageTerritory: ...`' .
+
"
Time now
@@ -5483,19 +5435,21 @@
"
"Modified: / 19-10-2006 / 23:17:40 / cg"
+ "Modified: / 20-11-2017 / 14:12:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setLanguage:aLanguageSymbol
- "set the language without change notification"
-
- Language := aLanguageSymbol.
+ <resource: #obsolete>
+ self obsoleteFeatureWarning
+
+ "Modified: / 20-11-2017 / 14:16:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setLanguage:aLanguageSymbol territory:aTerritorySymbol
- "set the language & territory - no change notification"
-
- Language := aLanguageSymbol asSymbol.
- LanguageTerritory := aTerritorySymbol asSymbol.
+ <resource: #obsolete>
+ self obsoleteFeatureWarning.
+
+ "Modified (format): / 28-11-2017 / 00:03:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Smalltalk class methodsFor:'system management'!
@@ -5784,7 +5738,7 @@
"
self installAutoloadedClassesFromAbbrevFile:('../../goodies/communication/abbrev.stc' asFilename)
"
-
+
"Created: / 29-07-2011 / 20:39:21 / cg"
!
@@ -6979,7 +6933,7 @@
oldRealPath := RealSystemPath.
RealSystemPath := nil.
].
-
+
[
(Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
"JV: Changed to give ProgrammingLanguage to choose
@@ -7091,29 +7045,29 @@
"{ Pragma: +optSpace }"
|topDirectory|
-
+
(topDirectory := OperatingSystem pathOfSTXExecutable) notNil ifTrue:[
topDirectory := topDirectory asFilename.
(topDirectory directory / 'stc') exists ifTrue:[
topDirectory := topDirectory directory.
- ] ifFalse:[
+ ] ifFalse:[
(topDirectory directory directory / 'stc') exists ifTrue:[
topDirectory := topDirectory directory directory.
- ] ifFalse:[
+ ] 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.
+ topDirectory := topDirectory directory pathName.
(PackagePath includes:topDirectory) ifFalse:[
PackagePath add:topDirectory
- ]
- ]
+ ]
+ ]
].
!
@@ -7121,14 +7075,14 @@
"{ Pragma: +optSpace }"
|workspaceDirectory|
-
+
(workspaceDirectory := UserPreferences current workspaceDirectory) notNil ifTrue:[
(workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
- workspaceDirectory := workspaceDirectory pathName.
+ workspaceDirectory := workspaceDirectory pathName.
(PackagePath includes:workspaceDirectory) ifFalse:[
PackagePath addFirst:workspaceDirectory
- ]
- ]
+ ]
+ ]
].
!
@@ -8468,17 +8422,17 @@
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
+ |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:[
+ ((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).
@@ -8496,19 +8450,19 @@
(fn suffix = 'mcz') ifTrue:[
packageName := fn withoutSuffix.
target := fn.
- ] ifFalse:[
+ ] 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 .
@@ -8618,11 +8572,11 @@
this smalltalk was compiled."
%{ /* NOCONTEXT */
- extern char *__getConfigurationString();
-
- RETURN (__MKSTRING(__getConfigurationString() COMMA_SND));
+ extern char *__getBuildTargetString(void);
+
+ RETURN (__MKSTRING(__getBuildTargetString()));
%}.
- ^ 'unknownOS/unknownCONF:unknownPACK'
+ self primitiveFailed.
"
Smalltalk configuration
@@ -8704,7 +8658,7 @@
with:(self versionDate)
"
- Smalltalk fullVersionString
+ Smalltalk fullVersionString
"
"Created: / 27.10.1997 / 17:03:09 / cg"
@@ -8748,7 +8702,7 @@
bitsPerWordString := (ExternalAddress pointerSize * 8) printString,bit,' '.
] ifFalse:[
bitsPerWordString := ''
- ].
+ ].
^ proto bindWith:('Smalltalk/X jv-branch' allBold)
with:(self versionString)
@@ -8757,7 +8711,7 @@
"
Smalltalk language:#us.
- Smalltalk hello
+ Smalltalk hello
Smalltalk language:#de.
Smalltalk hello
@@ -8824,7 +8778,7 @@
ST/X revision Naming is:
<major>.<minor>.<revision>.<release>"
- ^ 6
+ ^ 8
"
Smalltalk majorVersionNr
@@ -8844,7 +8798,7 @@
ST/X revision Naming is:
<major>.<minor>.<revision>.<release>"
- ^ 2
+ ^ 0
"
Smalltalk minorVersionNr
@@ -8908,7 +8862,7 @@
ST/X revision Naming is:
<major>.<minor>.<revision>.<release>"
- ^ 6
+ ^ 0
"
Smalltalk revisionNr
@@ -8976,7 +8930,6 @@
%{ /* NOCONTEXT */
extern char *__getBuildDateString();
-
RETURN (__MKSTRING(__getBuildDateString() COMMA_SND) );
%}.
^ 'today'
--- a/SmalltalkChunkFileSourceReader.st Fri May 11 12:12:57 2018 +0100
+++ b/SmalltalkChunkFileSourceReader.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2009 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2009 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/SmalltalkChunkFileSourceWriter.st Fri May 11 12:12:57 2018 +0100
+++ b/SmalltalkChunkFileSourceWriter.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/SmalltalkDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/SmalltalkDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/SmalltalkLanguage.st Fri May 11 12:12:57 2018 +0100
+++ b/SmalltalkLanguage.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 2009 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2011 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 2009 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
+ COPYRIGHT (c) 2011 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Stream.st Fri May 11 12:12:57 2018 +0100
+++ b/Stream.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -27,6 +28,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/String.st Fri May 11 12:12:57 2018 +0100
+++ b/String.st Wed Jun 13 14:39:23 2018 +0000
@@ -2,6 +2,8 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -110,6 +112,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -555,7 +559,7 @@
return context._RETURN( self.basicAt( idx1Based ));
}
#else
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf, cls;
if (__isSmallInteger(index)) {
@@ -564,7 +568,7 @@
indx = __intVal(index) - 1;
if (cls == String) {
fetch:
- if ((unsigned)indx < (unsigned)(__stringSize(slf))) {
+ if ((unsigned INT)indx < (unsigned)(__stringSize(slf))) {
RETURN ( __MKCHARACTER(__stringVal(slf)[indx] & 0xFF) );
}
goto badIndex;
@@ -606,7 +610,7 @@
if (((unsigned)value <= 0xFF)
&& __isSmallInteger(index)) {
indx = __intVal(index) - 1;
- if ((unsigned)indx < (unsigned)(__stringSize(slf))) {
+ if ((unsigned INT)indx < (unsigned)(__stringSize(slf))) {
__stringVal(slf)[indx] = value;
RETURN ( aCharacter );
}
@@ -629,7 +633,7 @@
return context._RETURN( self.basicAt( idx1Based ));
}
#else
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf, cls;
if (__isSmallInteger(index)) {
@@ -640,7 +644,7 @@
if (indx < 0) goto badIndex;
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
- if ((unsigned)indx < (unsigned)(__stringSize(slf))) {
+ if ((unsigned INT)indx < (unsigned)(__stringSize(slf))) {
RETURN ( __MKCHARACTER(__stringVal(slf)[indx] & 0xFF) );
}
}
@@ -686,7 +690,7 @@
if (indx < 0) goto badIndex;
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
- if ((unsigned)indx < (unsigned)(__stringSize(slf))) {
+ if ((unsigned INT)indx < (unsigned)(__stringSize(slf))) {
__stringVal(slf)[indx] = value;
RETURN ( aCharacter );
}
@@ -726,7 +730,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf, cls;
slf = self;
@@ -736,7 +740,7 @@
if (indx < 0) goto badIndex;
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
}
- if ((unsigned)indx < (unsigned)(__stringSize(slf))) {
+ if ((unsigned INT)indx < (unsigned)(__stringSize(slf))) {
RETURN ( __MKCHARACTER(__stringVal(slf)[indx] & 0xFF) );
}
badIndex: ;
@@ -2803,10 +2807,10 @@
*/
if (__qIsStringLike(self)) {
char *cp1 = (char *) __stringVal(self);
- int l1 = __stringSize(self);
- int l2;
+ INT l1 = __stringSize(self);
+ INT l2;
char *cp2 = 0;
- int sz;
+ INT sz;
OBJ newString;
char character;
@@ -2822,6 +2826,9 @@
} else
goto out;
+ /*
+ * FIXME: check for overflow!!!
+ */
sz = OHDR_SIZE + l1 + l2 + 1;
__qNew(newString, sz); /* OBJECT ALLOCATION */
@@ -2844,7 +2851,7 @@
* by 10% on a P5/200.
*/
{
- int nw = l1 >> 2;
+ INT nw = l1 >> 2;
if (l1 & 3) nw++;
bcopy4(cp1, dstp, nw);
@@ -2864,7 +2871,7 @@
# ifdef bcopy4
if (((INT)dstp & 3) == 0) {
- int nw = l2 >> 2;
+ INT nw = l2 >> 2;
if (l2 & 3) nw++;
bcopy4(cp2, dstp, nw);
--- a/StringCollection.st Fri May 11 12:12:57 2018 +0100
+++ b/StringCollection.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Symbol.st Fri May 11 12:12:57 2018 +0100
+++ b/Symbol.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2009-2010 Jan Vrany
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/TTYAttributes.st Fri May 11 12:12:57 2018 +0100
+++ b/TTYAttributes.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,5 @@
"
-Copyright (c) 2017-now Jan Vrany
+Copyright (c) 2017 Jan Vrany
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
@@ -35,7 +35,7 @@
copyright
"
-Copyright (c) 2017-now Jan Vrany
+Copyright (c) 2017 Jan Vrany
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
--- a/TTYConstants.st Fri May 11 12:12:57 2018 +0100
+++ b/TTYConstants.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,5 @@
"
-Copyright (c) 2017-now Jan Vrany
+Copyright (c) 2017 Jan Vrany
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
@@ -58,7 +58,7 @@
copyright
"
-Copyright (c) 2017-now Jan Vrany
+Copyright (c) 2017 Jan Vrany
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
--- a/UndefinedObject.st Fri May 11 12:12:57 2018 +0100
+++ b/UndefinedObject.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/UninterpretedBytes.st Fri May 11 12:12:57 2018 +0100
+++ b/UninterpretedBytes.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -66,6 +67,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -4321,7 +4323,7 @@
%{ /* NOCONTEXT */
- int nIndex, repNIndex;
+ unsigned INT nIndex, repNIndex;
int startIndex, stopIndex;
REGISTER unsigned char *src;
REGISTER int repStartIndex;
--- a/UnixDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/UnixDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/UnixFilename.st Fri May 11 12:12:57 2018 +0100
+++ b/UnixFilename.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 2016 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/UnixOperatingSystem.st Fri May 11 12:12:57 2018 +0100
+++ b/UnixOperatingSystem.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -984,6 +986,8 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
+ COPYRIGHT (c) 2015 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -1137,6 +1141,8 @@
SlowFork := false.
CurrentDirectory := nil.
self initializeCodeset.
+
+ "Modified: / 19-11-2017 / 14:52:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
initializeCodeset
@@ -1172,6 +1178,59 @@
"
!
+initializeLocale
+ | locale |
+
+ "/ Defaults
+ Language := #en.
+ LanguageTerritory := #us.
+
+ "/ Extract locale information from LC_ALL / LANG env variables.
+ "/ Format of locale is: language[_territory][.codeset][@modifier]
+ "/ language ISO-639 Language code
+ "/ territory ISO-3166 Contry code
+ locale := self getEnvironment: 'LC_ALL'.
+ locale isNil ifTrue:[ locale := self getEnvironment: 'LANG' ].
+ locale isNil ifTrue:[ locale := 'en' ].
+ locale notNil ifTrue:[
+ | i lang territory |
+
+ i := locale indexOf:$@.
+ (i ~~ 0) ifTrue:[
+ LanguageModifier := (locale copyFrom:(i + 1)) asLowercase asSymbol.
+ locale := locale copyTo:(i - 1).
+ ] ifFalse:[
+ LanguageModifier := nil.
+ ].
+ i := locale indexOf:$..
+ (i ~~ 0) ifTrue:[
+ LanguageCodeset := (locale copyFrom:(i + 1)) asLowercase asSymbol.
+ locale := locale copyTo:(i - 1).
+ ] ifFalse:[
+ LanguageCodeset := #'iso8859-1'.
+ ].
+ i := locale indexOf:$_.
+ (i == 0) ifTrue:[
+ lang := locale.
+ territory := locale
+ ] ifFalse:[
+ lang := locale copyTo:(i - 1).
+ territory := locale copyFrom:(i + 1)
+ ].
+ lang := lang asLowercase.
+ territory := territory asLowercase.
+ (lang = 'c') ifTrue:[
+ Language := #en.
+ LanguageTerritory := #us.
+ ] ifFalse:[
+ Language := lang asSymbol.
+ LanguageTerritory := territory asSymbol
+ ]
+ ].
+
+ "Created: / 19-11-2017 / 14:26:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
update:something with:aParameter from:changedObject
"catch image restart and flush some cached data"
--- a/UserPreferences.st Fri May 11 12:12:57 2018 +0100
+++ b/UserPreferences.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) 1998 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) 1998 by eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -148,7 +152,7 @@
].
"/ The #value message allows CurrentPrefences to be a block (or anything
"/ that responds to #value) that returns different preferences in different
- "/ contexts. For example, each screen might have different user with
+ "/ contexts. For example, each screen might have different user with
"/ different settings.
^ CurrentPreferences value.
@@ -489,7 +493,7 @@
defaultUserSettingsFile
"Return default user settings file."
- ^self defaultUserSettingsFileLocations first.
+ ^self defaultUserSettingsFileLocations first.
"
UserPreferences defaultUserSettingsFile
"
@@ -503,13 +507,13 @@
"Return list of files which are probed when looking for
saved user settings.
- The location changed over the time. To be backward
- compatible, return all of them.
+ The location changed over the time. To be backward
+ compatible, return all of them.
"
^ {
(Filename usersPrivateSmalltalkDirectory / 'settings.stx') . "/ per-user settings file (new default?)
(Filename usersPrivateSmalltalkDirectory / 'settings.rc') . "/ for backward compatibility with jv-branch
- } , (
+ } , (
Smalltalk realSystemPath collect: [ :e|e asFilename / 'settings.stx']"/ per-user settings file (new default?)
) , (
Smalltalk realSystemPath collect: [ :e|e asFilename / 'settings.rc'] "/ for backward compatibility with jv-branch
@@ -569,13 +573,13 @@
"
self defaultUserSettingsFileLocations do:[:file |
- file exists ifTrue:[
- file isDirectory ifTrue:[
+ file exists ifTrue:[
+ file isDirectory ifTrue:[
Logger warning: 'user settings file is actually a directory: %1' with: file pathName.
] ifFalse:[
- file isReadable ifFalse:[
+ file isReadable ifFalse:[
Logger warning: 'user settings file is not readable, skipping: %1' with: file pathName.
- ] ifTrue:[
+ ] ifTrue:[
^ self loadSettingsFrom: file
].
]
@@ -597,41 +601,41 @@
| prefsFile prefs currentProcess currentPrefs |
prefsFile := aStringOrFilename.
- (prefsFile isReadable not or:[prefsFile isRegularFile not]) ifTrue:[
+ (prefsFile isReadable not or:[prefsFile isRegularFile not]) ifTrue:[
self error: 'File not readable or not a regular file'
].
"/ Currently format of user preferences is actually an executable
"/ smalltalk code that is evaluated. That code fills in values in
"/ `UserPreferences current`. This way, it's not possible to load
"/ previously saved preferences to some other objects.
- "/
+ "/
"/ So, in order to load preferences we need to temporarily
"/ swap `UserPreferences current` to pristine instance, load
"/ preferences and then restore old preferences.
- "/
+ "/
"/ Things are more complicated since someone may access preferences
"/ while loading. Therefore, answer old preferences except for
"/ current process which is loading new ones.
- "/
+ "/
"/ What a hack!!
currentPrefs := CurrentPreferences.
currentProcess := Processor activeProcess.
[
prefs := self new.
- CurrentPreferences := [
- Processor activeProcess == currentProcess
+ CurrentPreferences := [
+ Processor activeProcess == currentProcess
ifTrue:[ prefs ]
ifFalse:[ currentPrefs value ]
].
- prefsFile fileIn.
- prefs at:#settingsFilename put: prefsFile pathName.
- ] ensure:[
+ prefsFile fileIn.
+ prefs at:#settingsFilename put: prefsFile pathName.
+ ] ensure:[
CurrentPreferences := currentPrefs.
].
^ prefs
"
- UserPreferences loadSettingsFrom: self defaultUserSettingsFile.
+ UserPreferences loadSettingsFrom: self defaultUserSettingsFile.
| file |
@@ -639,7 +643,7 @@
[
file writingFileDo:[:s| s nextPutLine: 'UserPreferences current at: #xxx put: #yyy' ].
UserPreferences loadSettingsFrom: file
- ] ensure:[
+ ] ensure:[
file remove.
].
"
@@ -895,10 +899,6 @@
eachManager savePreferencesOn:s
].
- userPrefs useSystemLanguage ifFalse:[
- s nextPutAll:('Smalltalk language:',UserPreferences current language storeString).
- s nextPutLine:(' territory:',UserPreferences current languageTerritory storeString,'.').
- ].
s syncData.
userPrefs beUnmodified.
].
@@ -984,13 +984,13 @@
"this is not needed for settings applications, which notice any modifications
themself. Howvever, if someone else modifies the settings (programmatically),
the change should be remembered, so that the user can be warned at session end"
-
+
modified := true
!
beUnmodified
"done when saved"
-
+
modified := false
!
@@ -2758,7 +2758,7 @@
However, we found that the danger of pressing cancel by accident
was too high, so we changed the default.
If you want to go back, return #acceptCancelCompare here"
-
+
^ self at:#acceptCancelBarOrder ifAbsent:#acceptCompareCancel
"
@@ -2773,7 +2773,7 @@
However, we found that the danger of pressing cancel by accident
was too high, so we changed the default.
If you want to go back, return #acceptCancelCompare here"
-
+
self at:#acceptCancelBarOrder put:aSymbol
"
@@ -2933,7 +2933,7 @@
"this is a little confusing: the codeview2 has its own accept/cancel bar
which can be turned on separately.
The codeview2 will suppress the regular accept/cancel bar, if it uses its own."
-
+
^ self at:#showAcceptCancelBarInBrowser ifAbsent:true
"
@@ -4196,7 +4196,7 @@
historyManagerAllowEditOfHistory:aBoolean
"useful if you have 'beginner students', to prevent them from changing the history"
- self
+ self
at: #'history-manager.allow-edit-of-history'
put:aBoolean
!
@@ -4204,17 +4204,17 @@
historyManagerEnabled
"automatically add history line comments to accepted methods"
- ^self
+ ^self
at: #'history-manager.enabled'
- ifAbsent: true
+ ifAbsent: true
!
historyManagerEnabled:aBoolean
"automatically add history line comments to accepted methods"
- ^self
+ ^self
at: #'history-manager.enabled'
- put: aBoolean
+ put: aBoolean
"
@@ -5015,10 +5015,10 @@
"
UserPreferences current osFileExplorerCommand
-
+
osx:
UserPreferences current osFileExplorerCommand:'open %1'
-
+
linux:
UserPreferences current osFileExplorerCommand:'nautilus %1'
UserPreferences current osFileExplorerCommand:'dolphin %1'
@@ -5030,9 +5030,9 @@
changeFileName
"were to keep changes"
- ^ self
- at: #'changeFileName'
- ifAbsent: [nil]
+ ^ self
+ at: #'changeFileName'
+ ifAbsent: [nil]
!
changeFileName:aFilename
@@ -5045,7 +5045,7 @@
usersModuleName
"this will be taken as the user's module in the workspace and as a default for new projects"
-
+
^ self at:#usersModuleName ifAbsent:[OperatingSystem getLoginName ]
!
@@ -5059,16 +5059,16 @@
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]
!
workspaceDirectory:aDirectoryOrNilForDefault
|d|
-
+
(d := aDirectoryOrNilForDefault) notNil ifTrue:[
d := d asFilename
- ].
+ ].
self at:#workspaceDirectory put:d
! !
@@ -5081,13 +5081,18 @@
"/ For now, forward to smalltalk, until all references to "Smalltalk-language"
"/ are replaced with "UserPreferences current language"
- ^ self at:#language ifAbsent:[Smalltalk language].
+ self useSystemLanguage ifTrue:[
+ ^ OperatingSystem getLanguage
+ ] ifFalse:[
+ ^ self at:#language ifAbsent:[OperatingSystem getLanguage].
+ ].
"
UserPreferences current language
"
"Created: / 20-09-2006 / 23:55:01 / cg"
+ "Modified: / 20-11-2017 / 14:02:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
language:aLanguageSymbol
@@ -5097,8 +5102,14 @@
"/ For now, forward to smalltalk, until all references to "Smalltalk-language"
"/ are replaced with "UserPreferences current language"
+ | changed |
+
+ changed := self language ~= aLanguageSymbol.
self at:#language put:aLanguageSymbol.
- Smalltalk language:aLanguageSymbol
+ changed ifTrue:[
+ Smalltalk changed: #Language; changed: #LanguageTerritory.
+ ].
+
"
UserPreferences current language
@@ -5106,6 +5117,7 @@
"
"Created: / 20-09-2006 / 23:55:01 / cg"
+ "Modified: / 21-11-2017 / 21:29:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
languageTerritory
@@ -5115,13 +5127,19 @@
"/ for now, forward to smalltalk, while all references to "Smalltalk-language"
"/ are replaced with "UserPreferences current language"
- ^ self at:#languageTerritory ifAbsent:[Smalltalk languageTerritory]
+ self useSystemLanguage ifTrue:[
+ ^ OperatingSystem getLanguageTerritory
+ ] ifFalse:[
+ ^ self at:#languageTerritory ifAbsent:[self language].
+ ].
+
"
UserPreferences current languageTerritory
"
"Created: / 20-09-2006 / 23:55:01 / cg"
+ "Modified: / 20-11-2017 / 14:13:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
languageTerritory:aLanguageSymbol
@@ -5131,8 +5149,13 @@
"/ For now, forward to smalltalk, until all references to "Smalltalk-language"
"/ are replaced with "UserPreferences current language"
+ | changed |
+
+ changed := self language ~= aLanguageSymbol.
self at:#languageTerritory put:aLanguageSymbol.
- Smalltalk languageTerritory:aLanguageSymbol
+ changed ifTrue:[
+ Smalltalk changed: #LanguageTerritory
+ ].
"
UserPreferences current languageTerritory
@@ -5140,6 +5163,7 @@
"
"Created: / 20-09-2006 / 23:55:01 / cg"
+ "Modified: / 21-11-2017 / 21:29:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
unitForFileSize
@@ -5175,12 +5199,23 @@
when the system comes up. If false, the setting here is used.
The default is true."
+ | changed |
+
+ changed := self useSystemLanguage ~= aBoolean.
self at:#useSystemLanguage put:aBoolean.
+ changed ifTrue:[
+ Smalltalk changed: #Language; changed: #LanguageTerritory.
+ ].
+
+
+
"
UserPreferences current useSystemLanguage
UserPreferences current useSystemLanguage:false
"
+
+ "Modified: / 21-11-2017 / 21:29:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-prefs-startup'!
@@ -5361,7 +5396,7 @@
debuggerLogFile
"if non nil, any entered debugger writes a backrace to that logfile.
This is useful to record all session-problems"
-
+
^ self at:#debuggerLogFile ifAbsent:nil
"
--- a/WeakArray.st Fri May 11 12:12:57 2018 +0100
+++ b/WeakArray.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1991 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1991 by Claus Gittinger
+ COPYRIGHT (c) 2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -296,8 +298,8 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
- REGISTER unsigned int nIndex;
+ REGISTER INT indx;
+ REGISTER unsigned INT nIndex;
OBJ el;
if (__isSmallInteger(index)) {
@@ -329,8 +331,8 @@
"store someObject in the weakArray at some index."
%{ /* NOCONTEXT */
- REGISTER int indx;
- REGISTER unsigned int nIndex;
+ REGISTER INT indx;
+ REGISTER unsigned INT nIndex;
if (__isSmallInteger(index)) {
indx = __intVal(index) - 1;
@@ -516,7 +518,7 @@
%{
REGISTER int index;
- unsigned int nIndex;
+ unsigned INT nIndex;
static struct inlineCache val = _ILC1;
index = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -533,15 +535,7 @@
if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
for (; index < nIndex; index++) {
if (InterruptPending != nil) __interruptL(@line);
@@ -569,14 +563,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
for (; index < nIndex; index++) {
REGISTER OBJFUNC codeVal;
@@ -700,7 +688,7 @@
|element|
%{
REGISTER int index;
- int nIndex;
+ unsigned INT nIndex;
static struct inlineCache val = _ILC1;
index = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -716,15 +704,8 @@
if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
-#ifdef NEW_BLOCK_CALL
+
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
for (; index < nIndex; index++) {
element = __InstPtr(self)->i_instvars[index];
@@ -759,14 +740,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
for (; index < nIndex; index++) {
REGISTER OBJFUNC codeVal;
@@ -857,7 +832,7 @@
|element|
%{
REGISTER int index;
- int nIndex;
+ unsigned INT nIndex;
static struct inlineCache val = _ILC1;
index = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -873,15 +848,8 @@
if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
-#ifdef NEW_BLOCK_CALL
+
# define BLOCK_ARG aBlock
-#else
-# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
-
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
-#endif
{
for (; index < nIndex; index++) {
element = __InstPtr(self)->i_instvars[index];
@@ -916,14 +884,8 @@
* it could be recompiled or flushed
*/
# undef BLOCK_ARG
-#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
# define IBLOCK_ARG nil
-#else
-# define BLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
-#endif
-
for (; index < nIndex; index++) {
REGISTER OBJFUNC codeVal;
--- a/WeakIdentityDictionary.st Fri May 11 12:12:57 2018 +0100
+++ b/WeakIdentityDictionary.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +26,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/Win32OperatingSystem.st Fri May 11 12:12:57 2018 +0100
+++ b/Win32OperatingSystem.st Wed Jun 13 14:39:23 2018 +0000
@@ -3,6 +3,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
COPYRIGHT (c) 1998-2004 by eXept Software AG
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -586,28 +587,45 @@
!Win32OperatingSystem primitiveFunctions!
%{
-int
-_makeWchar(OBJ string, wchar_t *buffer, int bufferSize)
+
+/**
+ * The `_makeWchar()` function copies contents of a string object `srcObj` to a
+ * (wide char) buffer `dst`. At most `n` **bytes** including null terminator
+ * are copied to destination buffer `dst`.
+ *
+ * Returns the number of **bytes** copied (including null terminator). If
+ * source string object is not an instance of `String` or `Unicode16String`,
+ * returns `-1`.
+ */
+static int
+_makeWchar(OBJ srcObj, wchar_t *dst, int n/* in bytes!!! */)
{
- int i, len;
-
- if (__isStringLike(string)) {
- len = __stringSize(string);
- if (len > bufferSize) len = bufferSize;
- for (i=0; i<len; i++) {
- buffer[i] = __stringVal(string)[i];
- }
- } else if (__isUnicode16String(string)) {
- len = __unicode16StringSize(string);
- if (len > bufferSize) len = bufferSize;
- for (i=0; i<len; i++) {
- buffer[i] = __unicode16StringVal(string)[i];
- }
+ int i;
+ int srcLen; /* length of string to be copied, in **characters** */
+ int dstLen; /* length of destination buffer, in **characters** */
+
+ dstLen = n / sizeof(wchar_t);
+
+ if (__isStringLike(srcObj)) {
+ srcLen = __stringSize(srcObj);
+
+ if (srcLen >= dstLen) srcLen = dstLen - 1;
+
+ for (i=0; i<srcLen; i++) {
+ dst[i] = __stringVal(srcObj)[i];
+ }
+ } else if (__isUnicode16String(srcObj)) {
+ srcLen = __unicode16StringSize(srcObj);
+
+ if (srcLen >= dstLen) srcLen = dstLen - 1;
+
+ memcpy(dst, __unicode16StringVal(srcObj), srcLen * sizeof(wchar_t));
} else {
+ dst[0] = 0;
return(-1);
}
- buffer[len] = 0;
- return(len);
+ dst[srcLen] = 0;
+ return(srcLen * sizeof(wchar_t));
}
@@ -804,6 +822,7 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
COPYRIGHT (c) 1998-2004 by eXept Software AG
+ COPYRIGHT (c) 2015-2018 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -979,6 +998,47 @@
"Modified: 13.9.1997 / 10:47:32 / cg"
!
+initializeLocale
+ | lang territory |
+
+ "/ Defaults
+ Language := #en.
+ LanguageTerritory := #us.
+
+%{
+ char str_buf[9];
+ int str_len = 0;
+
+ /*
+ * While the documentation says we should use GetLocaleInfoEx(),
+ * we by purpose use (discourage) GetLocaleInfo() in order to run
+ * also on Windows XP. Not sure it makes much sense these days,
+ * but there was a request recently some XP fixes.
+ */
+ str_len = GetLocaleInfoA(LOCALE_NAME_USER_DEFAULT, LOCALE_SISO639LANGNAME, str_buf, sizeof(str_buf));
+ if (str_len) {
+ lang = __MKSTRING_L(str_buf, str_len);
+ }
+ str_len = GetLocaleInfoA(LOCALE_NAME_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, str_buf, sizeof(str_buf));
+ if (str_len) {
+ territory = __MKSTRING_L(str_buf, str_len);
+ }
+%}.
+ "/ Since this may be called early during initialization, do not make
+ "/ `#primitiveFailed` when `GetLocaleInfoEx()` fails. Otherwise smalltalk
+ "/ may fail to compe up.
+ "/ Instead, log an error and proceed with `en-us` locale.
+ lang isNil ifTrue:[
+ Logger error: 'GetLocaleInfoEx(..., LOCALE_SISO639LANGNAME, ...) failed'.
+ ].
+ territory isNil ifTrue:[
+ Logger error: 'GetLocaleInfoEx(..., LOCALE_SISO3166CTRYNAME, ...) failed'.
+ ].
+ Language := lang asSymbol.
+ LanguageTerritory := territory asLowercase asSymbol.
+
+!
+
update:something with:aParameter from:changedObject
"catch image restart and flush some cached data"
@@ -1568,7 +1628,7 @@
getTTYAttributes: fd
OsError raiseErrorString: 'TTYs / PTYs not supported on Windows'
-!
+!
isTTY: fd
"Return true, if given filedescriptor refers to a character device (console). See _isatty()
@@ -3742,66 +3802,77 @@
"Modified: / 11-02-2007 / 20:51:08 / cg"
!
-exec:aCommandPath withArguments:argString environment:environment fileDescriptors:fdArray fork:doFork
- newPgrp:newPgrp inDirectory:aDirectory
- showWindow:showWindowBooleanOrNil
+exec:commandPath withArguments:argumentsOrCommandLine environment:environment fileDescriptors:fdArray fork:doFork
+ newPgrp:newPgrp inDirectory:aDirectory
+ showWindow:showWindowBooleanOrNil
"Internal lowLevel entry for combined fork & exec for WIN32
If fork is false (chain a command):
- execute the OS command specified by the argument, aCommandPath, with
- arguments in argArray (no arguments, if nil).
- If successful, this method does not return and smalltalk is gone.
- If not successful, it does return.
- Normal use is with forkForCommand.
+ execute the OS command specified by the argument, aCommandPath, with
+ arguments in argArray (no arguments, if nil).
+ If successful, this method does not return and smalltalk is gone.
+ If not successful, it does return.
+ Normal use is with forkForCommand.
If fork is true (subprocess command execution):
- fork a child to do the above.
- The Win32ProcessHandle of the child process is returned; nil if the fork failed.
+ fork a child to do the above.
+ The Win32ProcessHandle of the child process is returned; nil if the fork failed.
fdArray contains the filedescriptors, to be used for the child (if fork is true).
- fdArray[1] = 15 -> use fd 15 as stdin.
- If an element of the array is set to nil, the corresponding filedescriptor
- will be closed for the child.
- fdArray[0] == StdIn for child
- fdArray[1] == StdOut for child
- fdArray[2] == StdErr for child
+ fdArray[1] = 15 -> use fd 15 as stdin.
+ If an element of the array is set to nil, the corresponding filedescriptor
+ will be closed for the child.
+ fdArray[0] == StdIn for child
+ fdArray[1] == StdOut for child
+ fdArray[2] == StdErr for child
NOTE that in WIN32 the fds are HANDLES.
If newPgrp is true, the subprocess will be established in a new process group.
- The processgroup will be equal to id.
- newPgrp is not used on WIN32 and VMS systems.
+ The processgroup will be equal to id.
+ newPgrp is not used on WIN32 and VMS systems.
showWindowOrBoolean may be:
- true - a window is shown on start of the command
- false - the command window is hidden
- nil - the nCmdShown parameter of the commans's winmain function determins,
- if a window is shown.
- #default
- - same as nil
- "
-
- |dirPath rslt|
-
+ 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
+ "
+
+ |commandLine dirPath rslt|
+
+ argumentsOrCommandLine isString ifTrue:[
+ commandLine := argumentsOrCommandLine
+ ] ifFalse:[
+ argumentsOrCommandLine isSequenceable ifTrue:[
+ commandLine := String streamContents:[:s|
+ argumentsOrCommandLine
+ do:[:p |self quoteCommandParameter: p on: s]
+ separatedBy:[ s space ]
+ ].
+ ].
+ ].
aDirectory notNil ifTrue:[
- dirPath := aDirectory asFilename asAbsoluteFilename osNameForDirectory.
- (dirPath endsWith:':') ifTrue:[
- dirPath := dirPath , '\'.
- ].
+ dirPath := aDirectory asFilename asAbsoluteFilename osNameForDirectory.
+ (dirPath endsWith:':') ifTrue:[
+ dirPath := dirPath , '\'.
+ ].
].
rslt := self
- primExec:aCommandPath
- commandLine:argString
- environment:environment
- fileDescriptors:fdArray
- fork:doFork
- newPgrp:newPgrp
- inPath:dirPath
- createFlags:nil
- inheritHandles:true
- showWindow:showWindowBooleanOrNil.
+ primExec:commandPath
+ commandLine:commandLine
+ environment:environment
+ fileDescriptors:fdArray
+ fork:doFork
+ newPgrp:newPgrp
+ inPath:dirPath
+ createFlags:nil
+ inheritHandles:true
+ showWindow:showWindowBooleanOrNil.
"/ 'created ' print. cmdLine print. ' -> ' print. rslt printCR.
^ rslt
@@ -3809,6 +3880,7 @@
"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"
+ "Modified: / 11-01-2018 / 23:31:55 / jv"
!
getStatusOfProcess:aProcessId
@@ -6647,7 +6719,7 @@
if (__isSmallInteger(anInteger)) {
if (__isStringLike(aPathName)) {
#ifdef DO_WRAP_CALLS
- char _aPathName[MAXPATHLEN];
+ char _aPathName[MAXPATHLEN+1];
strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
do {
@@ -8485,31 +8557,6 @@
"
!
-getLanguage
- "get the LANGUAGE setting (example: de_DE.iso8859-15@euro).
- An environment value has higher preceedence than the system language setting."
-
- |lang|
-
- lang := self getEnvironment:'LANG'.
- (lang isNil or:[lang = 'default']) ifTrue:[
- "/ ok, search the registry ...
- "/ under XP, it is found there ...
- lang := RegistryEntry
- stringValueFor:'sLanguage'
- atKey:'HKEY_CURRENT_USER\Control Panel\International'.
- lang notNil ifTrue:[
- lang := self mapLanguage:lang.
- ].
- ].
- ^ lang
-
- "
- OperatingSystem getLanguage
- "
- "Modified: 26.4.1996 / 10:04:54 / stefan"
-!
-
getLocaleInfo
"return a dictionary filled with values from the locale information;
Not all fields may be present, depending on the OS's setup and capabilities.
@@ -10637,6 +10684,50 @@
"
self primExpandEnvironmentStringsW:'%ProgramFiles%\test\x' asUnicodeString into:(Unicode16String new:256) inspect size:256
"
+!
+
+quoteCommandParameter: parameter on: stream
+ "Quotes the parameter as neccesary on Windows"
+
+ "/ Adapted version of ArgvQuote,
+ "/ see http://blogs.msdn.com/b/twistylittlepassagesallalike/archive/2011/04/23/everyone-quotes-arguments-the-wrong-way.aspx
+
+ | parameterS |
+
+ stream nextPut: $".
+ parameterS := parameter readStream.
+ [ parameterS atEnd ] whileFalse:[
+ | numBackSlashes |
+
+ numBackSlashes := 0.
+
+ [ parameterS atEnd not and:[ parameterS peek == $\ ] ] whileTrue:[
+ numBackSlashes := numBackSlashes + 1.
+ parameterS next.
+ ].
+ parameterS atEnd ifTrue:[
+ "/ Escape all backslashes, but let the terminating
+ "/ double quotation mark we add below be interpreted
+ "/ as a metacharacter.
+ stream next: numBackSlashes * 2 put: $\
+ ] ifFalse:[
+ parameterS peek == $" ifTrue:[
+ "/ Escape all backslashes and the following
+ "/ double quotation mark.
+ stream next: numBackSlashes * 2 put: $\.
+ stream nextPut: $\.
+ stream nextPut: $".
+ ] ifFalse:[
+ "/ Backslashes aren't special here.
+ stream next: numBackSlashes put: $\.
+ stream nextPut: parameterS peek.
+ ].
+ parameterS next.
+ ].
+ ].
+ stream nextPut: $".
+
+ "Created: / 11-01-2018 / 23:24:07 / jv"
! !
!Win32OperatingSystem class methodsFor:'regional settings'!
--- a/WindowsDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/WindowsDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/XDGDesktop.st Fri May 11 12:12:57 2018 +0100
+++ b/XDGDesktop.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,6 @@
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -23,6 +24,7 @@
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
+ COPYRIGHT (c) 2009 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
--- a/libInit.cc Fri May 11 12:12:57 2018 +0100
+++ b/libInit.cc Wed Jun 13 14:39:23 2018 +0000
@@ -59,6 +59,7 @@
extern void _Project_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ProjectDefinition_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ReadEvalPrintLoop_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _AbstractLock_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _RecursionLock_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Semaphore_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _SharedPool_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -460,6 +461,7 @@
_Project_Init(pass,__pRT__,snd);
_ProjectDefinition_Init(pass,__pRT__,snd);
_ReadEvalPrintLoop_Init(pass,__pRT__,snd);
+ _AbstractLock_Init(pass,__pRT__,snd);
_RecursionLock_Init(pass,__pRT__,snd);
_Semaphore_Init(pass,__pRT__,snd);
_SharedPool_Init(pass,__pRT__,snd);
--- a/stx_libbasic.st Fri May 11 12:12:57 2018 +0100
+++ b/stx_libbasic.st Wed Jun 13 14:39:23 2018 +0000
@@ -1,5 +1,7 @@
"
COPYRIGHT (c) Claus Gittinger / eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -25,6 +27,8 @@
copyright
"
COPYRIGHT (c) Claus Gittinger / eXept Software AG
+ COPYRIGHT (c) 2009-2011 Jan Vrany
+ COPYRIGHT (c) 2017 Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
@@ -41,17 +45,17 @@
Package documentation:
This library contains basic (nonGUI) classes.
-
+
These are the fundamental classes which are required for any Smalltalk,
whether scripting, non-GUI, repl, IDE or end user application.
Things you find here are mostly classes as described in the ANSI standard.
- There are no GUI dependencies here
- (some conditional code deals with the non-presence of UI classes;
+ There are no GUI dependencies here
+ (some conditional code deals with the non-presence of UI classes;
for example, debugging, for which a non-UI version is provided here)
- Also no developer support classes are found here
+ Also no developer support classes are found here
(i.e. Change/History support, compiler etc.).
[author:]
@@ -146,7 +150,7 @@
^ '
# for LINUX-32bit we need also librt.so, in order to resolve clock_gettime@GLIBC_2.2 (see linuxIntern.h)
# for LINUX-64bit we need also librt.so, in order to resolve clock_gettime@GLIBC_2.2.5 (see linuxIntern.h)
-ifneq (,$(findstring LINUX,$(CFLAGS)))
+ifneq (,$(findstring LINUX,$(CFLAGS)))
LOCAL_SHARED_LIBS=-lrt
endif
'
@@ -221,6 +225,7 @@
Project
ProjectDefinition
ReadEvalPrintLoop
+ AbstractLock
RecursionLock
Semaphore
SharedPool