--- a/.hgtags Mon Jun 06 10:37:21 2016 +0100
+++ b/.hgtags Mon Jun 06 10:56:12 2016 +0100
@@ -17,6 +17,8 @@
41f8a86105f0bc8209fae8b44e7979c8a084fc3c expecco_2_7_5a
4306fb61b9f8004278974861ad3d1fb0cc9a9529 expecco_1_6_0rc5
43bb5d8495e0048a1ba8f299b56d6411394dc6d1 expecco_1_7_0rc1
+484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_0
+484307b07a7b64f21b0a6dd83d5856556904a435 expecco_2_9_0_a
508e9e5d9254027c7f4aed4fe7734dab793e5230 expecco_ALM_1_9_7
59d0cc49b9442979ff138bc2424f588e8a533c2f expecco_1_7_0rc3
602e61cb64a3aaa674fbaf01705064701f2f5c14 expecco_2_2_5
@@ -57,7 +59,6 @@
aa93e348e5d3c964977d1571451e24069a17f88a expecco_1_8_2rc1
aebca3972774d3331f0bcedbaef81aec29ff2026 expecco_1_7_0rc5
b2c6e6d23adc8a68c359806eefdda97535773e31 expeccoNET_1_4_0rc1
-b536693fa9736495ad401244a3caf3ebcfdf7d86 expecco_2_9_0
ba5f4421848f248753a0e2454ffee0c055040a45 rel5_2_2
bf65bdad3827b0eb8d7763ffbaf5eb7bee41219d expecco_1_7_0b3
c12795ed7ddc998f7f9ad0fa8ae47fc06a9f1aec rel4_1_7
--- a/AbstractNumberVector.st Mon Jun 06 10:37:21 2016 +0100
+++ b/AbstractNumberVector.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2011 by Claus Gittinger
All Rights Reserved
@@ -215,9 +217,13 @@
!AbstractNumberVector methodsFor:'destructive arithmetic support'!
primAbs
- "low performance fall back: destructive replace each element by its absolute value"
+ "low performance fall back: destructive replace each element by its absolute value.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) abs].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at:i put: (self at:i) abs].
"
|f|
@@ -232,11 +238,15 @@
"
!
-primAddArray: floatArray
+primAddArray:anArray
"low performance fallback: destructively add the vector argument into the receiver.
- The argument must be another vector"
+ The argument must be another vector.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to:sz do:[:i| self at:i put: (self at:i) + (anArray at:i)].
"
|f1 f2|
@@ -249,16 +259,24 @@
!
primAddScalar: aScalar
- "low performance fallback: destructively add the scalar argument into the receiver."
+ "low performance fallback: destructively add the scalar argument into the receiver.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) + aScalar].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to:sz do:[:i| self at:i put:(self at:i) + aScalar].
!
primDivArray: floatArray
"low performance fallback: destructively divide the vector argument into the receiver.
- The argument must be another vector"
+ The argument must be another vector.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) / (floatArray at: i)].
"
|f1 f2|
@@ -271,16 +289,25 @@
!
primDivScalar: aScalar
- "low performace fallback: destructively divide each element of the receiver by the scalar argument."
+ "low performace fallback: destructively divide each element of the receiver
+ by the scalar argument.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) / aScalar ].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) / aScalar ].
!
primMulArray: floatArray
"low performance fallback: destructively multiply the vector argument into the receiver.
- The argument must be another vector"
+ The argument must be another vector.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) * (floatArray at: i)].
"
|f1 f2|
@@ -293,15 +320,24 @@
!
primMulScalar: aScalar
- "low performace fallback: destructively multiply each element of the receiver by the scalar argument."
+ "low performace fallback: destructively multiply each element of the receiver
+ by the scalar argument.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) * aScalar ].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) * aScalar ].
!
primNegated
- "low performance fallback: destructively negative value of each element"
+ "low performance fallback: destructively negative value of each element.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) negated].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) negated].
"
|f|
@@ -314,9 +350,13 @@
primSubtractArray: floatArray
"low performance fallback: destructively subtract the vector argument into the receiver.
- The argument must be another vector"
+ The argument must be another vector.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) - (floatArray at: i)].
"
|f1 f2|
@@ -329,9 +369,14 @@
!
primSubtractScalar: aScalar
- "low performace fallback: destructively subtract the scalar argument from each element of the receiver."
+ "low performace fallback: destructively subtract the scalar argument
+ from each element of the receiver.
+ May be redefined in subclasses to use vector instructions"
- 1 to: self size do:[:i| self at: i put: (self at: i) - aScalar ].
+ |sz "{ Class: SmallInteger }"|
+
+ sz := self size.
+ 1 to: sz do:[:i| self at: i put: (self at: i) - aScalar ].
! !
!AbstractNumberVector methodsFor:'queries'!
--- a/Behavior.st Mon Jun 06 10:37:21 2016 +0100
+++ b/Behavior.st Mon Jun 06 10:56:12 2016 +0100
@@ -14,7 +14,8 @@
"{ NameSpace: Smalltalk }"
Object subclass:#Behavior
- instanceVariableNames:'superclass flags methodDictionary lookupObject instSize'
+ instanceVariableNames:'superclass flags methodDictionary
+ lookupObject instSize'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes'
@@ -50,10 +51,10 @@
Behavior provides minimum support for all class-like objects, which define behavior
- of other objects. Additional stuff (meta info) is found in ClassDescription and Class.
- Behavior provides all mechanisms needed to create instances (on the class side),
- and send messages to them.
- However, Behavior does not provide the (symbolic) information needed to compile methods
+ of other objects. Additional stuff (meta info) is found in ClassDescription and Class.
+ Behavior provides all mechanisms needed to create instances (on the class side),
+ and send messages to them.
+ However, Behavior does not provide the (symbolic) information needed to compile methods
for a class or to get useful information in inspectors or browsers.
For experts:
@@ -71,25 +72,25 @@
[Instance variables:]
- superclass <Class> the classes superclass
-
- methodDictionary <MethodDictionary> inst-selectors and methods
-
- instSize <SmallInteger> the number of instance variables
-
- flags <SmallInteger> special flag bits coded in a number
- not for application use
+ superclass <Class> the classes superclass
+
+ methodDictionary <MethodDictionary> inst-selectors and methods
+
+ instSize <SmallInteger> the number of instance variables
+
+ flags <SmallInteger> special flag bits coded in a number
+ not for application use
flag bits (see stc.h):
NOTICE: layout known by compiler and runtime system; be careful when changing
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Class ClassDescription Metaclass
- Method MethodDictionary
+ Class ClassDescription Metaclass
+ Method MethodDictionary
"
!
@@ -2670,10 +2671,10 @@
goto nilIt;
# else
op = __InstPtr(newobj)->i_instvars;
- while (nInstVars-- != 0)
+ while (nInstVars-- != 0)
*op++ = nil;
fp = (float *)op;
- while (nindexedinstvars-- != 0)
+ while (nindexedinstvars-- != 0)
*fp++ = 0.0;
# endif
RETURN ( newobj );
@@ -2700,7 +2701,7 @@
goto nilIt;
# else
op = __InstPtr(newobj)->i_instvars;
- while (nInstVars-- != 0)
+ while (nInstVars-- != 0)
*op++ = nil;
# ifdef __NEED_DOUBLE_ALIGN
@@ -2713,7 +2714,7 @@
}
# endif
dp = (double *)op;
- while (nindexedinstvars-- != 0)
+ while (nindexedinstvars-- != 0)
*dp++ = 0.0;
# endif
RETURN ( newobj );
@@ -2756,7 +2757,7 @@
nInstVars -= 8;
}
}
- while (nInstVars != 0) {
+ while (nInstVars != 0) {
*op++ = 0;
nInstVars--;
}
@@ -2775,7 +2776,7 @@
nInstVars -= 8;
}
}
- while (nInstVars != 0) {
+ while (nInstVars != 0) {
*op++ = 0;
nInstVars--;
}
@@ -2792,7 +2793,7 @@
op[6] = nil; op[7] = nil;
op += 8;
}
- while (nInstVars-- != 0)
+ while (nInstVars-- != 0)
*op++ = nil;
# endif
# endif
@@ -2830,7 +2831,7 @@
op = __InstPtr(newobj)->i_instvars;
do {
*op++ = nil;
- } while (--nInstVars != 0);
+ } while (--nInstVars != 0);
# endif
# endif
}
@@ -2939,13 +2940,13 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ self
- readFrom:aStream
- onError:[ self conversionErrorSignal
- raiseWith:aStream errorString:' for: ' , self name ]
+ readFrom:aStream
+ onError:[ self conversionErrorSignal
+ raiseWith:aStream errorString:' for: ' , self name ]
"
|s|
@@ -2966,16 +2967,16 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ [
- |newObject|
-
- newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
- ((newObject class == self) or:[newObject isKindOf:self])
- ifTrue:[newObject]
- ifFalse:[exceptionBlock value].
+ |newObject|
+
+ newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
+ ((newObject class == self) or:[newObject isKindOf:self])
+ ifTrue:[newObject]
+ ifFalse:[exceptionBlock value].
] on:Error do:exceptionBlock.
"
@@ -2983,7 +2984,7 @@
s := WriteStream on:String new.
#(1 2 3 4) storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -2991,7 +2992,7 @@
s := WriteStream on:String new.
#[1 2 3 4] storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -3009,10 +3010,10 @@
Behavior>>readFrom: and Behavior>>readFrom:onError:"
^ self
- readFromString:aString
+ readFromString:aString
onError:[
- self conversionErrorSignal raiseWith:aString errorString:' - expected: ' , self name
- ]
+ self conversionErrorSignal raiseWith:aString errorString:' - expected: ' , self name
+ ]
"
Integer readFromString:'12345678901234567890'
@@ -3490,7 +3491,7 @@
Usually, this means that it only provides shared protocol for its
subclasses, which should be used.
Notice: this does not have any semantic effect;
- it is purely for the browser (shows an 'A'-Indicator)
+ it is purely for the browser (shows an 'A'-Indicator)
and for documentation.
To enforce abstractness, a subclass should redefine new, to raise an exception.
(which some do, but many are too lazy to do)"
@@ -4616,7 +4617,7 @@
"return true, if the receiver or one of its superclasses implements aSelector.
(i.e. true if my instances understand aSelector).
I think this is a bad name (it sounds more like instance protocol,
- and something like #instancesRespondTo: would have been better),
+ and something like #instancesRespondTo: would have been better),
but well, we are compatible (sigh)."
^ (self lookupMethodFor:aSelector) notNil
@@ -4801,14 +4802,14 @@
This is semantically equivalent to implements: (ST/80/Squeak compatibility).
Hint:
- Don't use this method to check if someone responds to a message -
- use #canUnderstand: on the class or #respondsTo: on the instance
- to do this.
+ Don't use this method to check if someone responds to a message -
+ use #canUnderstand: on the class or #respondsTo: on the instance
+ to do this.
Caveat:
- This simply checks for the selector being present in the classes
- selector table - therefore, it does not care for ignoredMethods.
- (but: you should not use this method for protocol-testing, anyway)."
+ This simply checks for the selector being present in the classes
+ selector table - therefore, it does not care for ignoredMethods.
+ (but: you should not use this method for protocol-testing, anyway)."
^ methodDictionary includesIdenticalKey:aSelector
@@ -5169,12 +5170,12 @@
|setOfSelectors|
self methodDictionary keysAndValuesDo:[:sel :mthd |
- (mthd referencesLiteral:someLiteralConstant) ifTrue:[
- setOfSelectors isNil ifTrue:[
- setOfSelectors := IdentitySet new.
- ].
- setOfSelectors add:sel
- ].
+ (mthd referencesLiteral:someLiteralConstant) ifTrue:[
+ setOfSelectors isNil ifTrue:[
+ setOfSelectors := IdentitySet new.
+ ].
+ setOfSelectors add:sel
+ ].
].
^ setOfSelectors ? #()
@@ -5277,4 +5278,3 @@
version_CVS
^ '$Header$'
! !
-
--- a/ByteArray.st Mon Jun 06 10:37:21 2016 +0100
+++ b/ByteArray.st Mon Jun 06 10:56:12 2016 +0100
@@ -164,7 +164,6 @@
! !
-
!ByteArray class methodsFor:'queries'!
elementByteSize
@@ -183,9 +182,22 @@
^ self == ByteArray
"Modified: 23.4.1996 / 15:56:25 / cg"
+!
+
+maxVal
+ "the minimum value which can be stored in instances of me.
+ For ByteArrays, this is 255"
+
+ ^ 255
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For ByteArrays, this is 0"
+
+ ^ 0
! !
-
!ByteArray methodsFor:'Compatibility-Squeak'!
bitXor:aByteArray
@@ -198,22 +210,24 @@
size := self size.
size1 := aByteArray size.
size1 < size ifTrue:[
- size := size1.
+ size := size1.
].
^ self copy
- bitXorBytesFrom:1 to:size with:aByteArray startingAt:1;
- yourself.
+ bitXorBytesFrom:1 to:size with:aByteArray startingAt:1;
+ yourself.
"
- #[0 1 2 3 4] bitXor:#[0 1 2 3 4]
- #[0 1 2 3 4] bitXor:#[0 1 2 3]
+ #[0 1 2 3 4] bitXor:#[0 1 2 3 4]
+ #[0 1 2 3 4] bitXor:#[0 1 2 3]
"
! !
!ByteArray methodsFor:'Compatibility-VW'!
asByteString
+ "same as asString, for visualworks compatibility"
+
^ self asString
! !
@@ -3092,7 +3106,6 @@
"
! !
-
!ByteArray methodsFor:'searching'!
indexOf:aByte startingAt:start
@@ -3158,7 +3171,6 @@
"
! !
-
!ByteArray methodsFor:'testing'!
isByteArray
--- a/CharacterArray.st Mon Jun 06 10:37:21 2016 +0100
+++ b/CharacterArray.st Mon Jun 06 10:56:12 2016 +0100
@@ -549,7 +549,6 @@
"
! !
-
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -955,7 +954,6 @@
^ Unicode32String
! !
-
!CharacterArray methodsFor:'Compatibility-ANSI'!
addLineDelimiters
@@ -6238,7 +6236,6 @@
"Modified: 17.4.1997 / 12:50:23 / cg"
! !
-
!CharacterArray methodsFor:'special string converting'!
asUnixFilenameString
@@ -7286,7 +7283,6 @@
"
! !
-
!CharacterArray methodsFor:'substring searching'!
findRangeOfString:subString
@@ -7944,10 +7940,17 @@
!
isUnicode32String
+ "true if this is a 4-byte unicode string"
+
^ false
!
isUnicodeString
+ "true if this is a 2- or 4-byte unicode string
+ (i.e. not a single byte string).
+ Notice, that the name is misleading:
+ all strings are use unicode encoding"
+
^ false
!
--- a/ClassDescription.st Mon Jun 06 10:37:21 2016 +0100
+++ b/ClassDescription.st Mon Jun 06 10:56:12 2016 +0100
@@ -1129,6 +1129,13 @@
^ nil
!
+projectDefinitionClass
+ "return the project definition of the classes' package.
+ Here, nil is returned. Only full classes have one."
+
+ ^ nil
+!
+
renameCategory:oldCategory to:newCategory
"{ Pragma: +optSpace }"
@@ -1159,10 +1166,9 @@
typeOfClassVarNamed:classVarName
"option to return a collection of types which are considered
legal for classVarName.
- This is pure documentation, and has (currently) no semantic
- implications.
- If present, it is used by the code completer's type inferer, to make better
- guesses.
+ This is pure documentation, and has (currently) no semantic implications.
+ If present, it is used by the code completer's type inferer,
+ to make better guesses.
Subclasses may redefine it to return a class, interface or a set of classes."
^ nil
@@ -1171,10 +1177,9 @@
typeOfInstVarNamed:instVarName
"option to return a collection of types which are considered
legal for instVarName.
- This is pure documentation, and has (currently) no semantic
- implications.
- If present, it is used by the code completer's type inferer, to make better
- guesses.
+ This is pure documentation, and has (currently) no semantic implications.
+ If present, it is used by the code completer's type inferer,
+ to make better guesses.
Subclasses may redefine it to return a class, interface or a set of classes."
^ nil
--- a/ExternalLibraryFunction.st Mon Jun 06 10:37:21 2016 +0100
+++ b/ExternalLibraryFunction.st Mon Jun 06 10:56:12 2016 +0100
@@ -51,7 +51,9 @@
# define __get_ffi_type_double() &ffi_type_double
# define __get_ffi_type_void() &ffi_type_void
# define __get_ffi_type_pointer() &ffi_type_pointer
+
# else
+
extern ffi_type *__get_ffi_type_sint();
extern ffi_type *__get_ffi_type_sint8();
extern ffi_type *__get_ffi_type_sint16();
@@ -74,6 +76,46 @@
# endif
# endif
+# define TYPE_UINT __get_ffi_type_uint()
+# define TYPE_UINT8 __get_ffi_type_uint8()
+# define TYPE_UINT16 __get_ffi_type_uint16()
+# define TYPE_UINT32 __get_ffi_type_uint32()
+# define TYPE_UINT64 __get_ffi_type_uint64()
+
+# define TYPE_SINT __get_ffi_type_sint()
+# define TYPE_SINT8 __get_ffi_type_sint8()
+# define TYPE_SINT16 __get_ffi_type_sint16()
+# define TYPE_SINT32 __get_ffi_type_sint32()
+# define TYPE_SINT64 __get_ffi_type_sint64()
+
+# define TYPE_POINTER __get_ffi_type_pointer()
+# define TYPE_FLOAT __get_ffi_type_float();
+# define TYPE_DOUBLE __get_ffi_type_double();
+# define TYPE_VOID __get_ffi_type_void();
+
+#else /* NO FFI */
+
+# define MAX_ARGS 15
+# define TYPE_UINT 1
+# define TYPE_UINT8 2
+# define TYPE_UINT16 3
+# define TYPE_UINT32 4
+# define TYPE_UINT64 5
+
+# define TYPE_SINT 11
+# define TYPE_SINT8 12
+# define TYPE_SINT16 13
+# define TYPE_SINT32 14
+# define TYPE_SINT64 15
+
+# define TYPE_POINTER 20
+# define TYPE_FLOAT 30
+# define TYPE_DOUBLE 31
+# define TYPE_VOID 40
+
+# define FFI_DEFAULT_ABI 0
+# define CALLTYPE_FFI_STDCALL 0
+
#endif
%}
@@ -98,12 +140,18 @@
documentation
"
instances of me are used to interface to external library functions (as found in a dll/shared object).
-
+ Foreign function calls are based on the FFI library if available.
+ A limited fallback implementation is provided for systems with no libffi.
+ (this may have limitations on the supported argument types; for example,
+ the x86_64 fallback does not support float/double arguments).
+ Therefore the fallback should be considered a temporary workaround,
+ until libffi has been ported.
+
Inside a method, when a special external-call pragma such as:
- <api: bool MessageBeep(uint)>
+ <api: bool MessageBeep(uint)>
is encountered by the parser, the compiler generates a call via
- <correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray.
+ <correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray.
and the correspondingExternalLibraryFunctionObject is kept in the literal array.
In the invoke method, the library is checked to be loaded (and loaded if not already),
@@ -111,22 +159,22 @@
and finally, the return value is converted back from C to a smalltalk object.
The parser supports the call-syntax of various other smalltalk dialects:
- Squeak / ST-X:
- <cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >
- <apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >
+ Squeak / ST-X:
+ <cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >
+ <apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >
- Dolphin:
- <stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>
- <cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>
+ Dolphin:
+ <stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>
+ <cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>
- ST/V:
- <api: functionName argType1 .. argTypeN returnType>
- <ccall: functionName argType1 .. argTypeN returnType>
- <ole: vFunctionIndex argType1 .. argTypeN returnType>
+ ST/V:
+ <api: functionName argType1 .. argTypeN returnType>
+ <ccall: functionName argType1 .. argTypeN returnType>
+ <ole: vFunctionIndex argType1 .. argTypeN returnType>
- VisualWorks:
- <c: ...>
- <c: #define NAME value>
+ VisualWorks:
+ <c: ...>
+ <c: #define NAME value>
"
!
@@ -1008,7 +1056,10 @@
%{ /* STACK: 100000 */
+#define VERBOSE
+
#ifdef HAVE_FFI
+
# ifdef __GNUC__
# ifndef HAS_LONGLONG
# define HAS_LONGLONG
@@ -1021,11 +1072,24 @@
# define __HI32(ll) (((ll)>>32) & 0xFFFFFFFFL)
# endif
# endif
-#define VERBOSE
+
+
ffi_cif __cif;
ffi_type *__argTypesIncludingThis[MAX_ARGS+1];
ffi_type **__argTypes = __argTypesIncludingThis;
ffi_type *__returnType = NULL;
+ ffi_type *thisType;
+ ffi_abi __callType = FFI_DEFAULT_ABI;
+
+#else
+
+ int __argTypesIncludingThis[MAX_ARGS+1];
+ int *__argTypes = __argTypesIncludingThis;
+ int __returnType = 0;
+ int thisType;
+ int __callType = FFI_DEFAULT_ABI;
+ int __anyFloatOrDoubleArg = 0;
+#endif
union u {
INT iVal;
@@ -1047,7 +1111,6 @@
int __numArgs, __numArgsIncludingThis;
static INT null = 0;
int i = -1;
- ffi_abi __callType = FFI_DEFAULT_ABI;
VOIDFUNC codeAddress = (VOIDFUNC)__INST(code_);
int __numArgsWanted;
@@ -1090,36 +1153,36 @@
}
if (returnTypeSymbol == @symbol(int)) {
- __returnType = __get_ffi_type_sint();
+ __returnType = TYPE_SINT;
} else if (returnTypeSymbol == @symbol(uint)) {
- __returnType = __get_ffi_type_uint();
+ __returnType = TYPE_UINT;
} else if (returnTypeSymbol == @symbol(uint8)) {
- __returnType = __get_ffi_type_uint8();
+ __returnType = TYPE_UINT8;
} else if (returnTypeSymbol == @symbol(uint16)) {
- __returnType = __get_ffi_type_uint16();
+ __returnType = TYPE_UINT16;
} else if (returnTypeSymbol == @symbol(uint32)) {
- __returnType = __get_ffi_type_uint32();
+ __returnType = TYPE_UINT32;
} else if (returnTypeSymbol == @symbol(uint64)) {
- __returnType = __get_ffi_type_uint64();
+ __returnType = TYPE_UINT64;
} else if (returnTypeSymbol == @symbol(sint)) {
- __returnType = __get_ffi_type_sint();
+ __returnType = TYPE_SINT;
} else if (returnTypeSymbol == @symbol(sint8)) {
- __returnType = __get_ffi_type_sint8();
+ __returnType = TYPE_SINT8;
} else if (returnTypeSymbol == @symbol(sint16)) {
- __returnType = __get_ffi_type_sint16();
+ __returnType = TYPE_SINT16;
} else if (returnTypeSymbol == @symbol(sint32)) {
- __returnType = __get_ffi_type_sint32();
+ __returnType = TYPE_SINT32;
} else if (returnTypeSymbol == @symbol(sint64)) {
- __returnType = __get_ffi_type_sint64();
+ __returnType = TYPE_SINT64;
} else if (returnTypeSymbol == @symbol(long)) {
if (sizeof(long) == 4) {
returnTypeSymbol = @symbol(sint32);
- __returnType = __get_ffi_type_sint32();
+ __returnType = TYPE_SINT32;
} else if (sizeof(long) == 8) {
returnTypeSymbol = @symbol(sint64);
- __returnType = __get_ffi_type_sint64();
+ __returnType = TYPE_SINT64;
} else {
__FAIL__(@symbol(UnknownReturnType))
}
@@ -1127,24 +1190,24 @@
} else if (returnTypeSymbol == @symbol(ulong)) {
if (sizeof(long) == 4) {
returnTypeSymbol = @symbol(uint32);
- __returnType = __get_ffi_type_uint32();
+ __returnType = TYPE_UINT32;
}else if (sizeof(long) == 8) {
returnTypeSymbol = @symbol(uint64);
- __returnType = __get_ffi_type_uint64();
+ __returnType = TYPE_UINT64;
} else {
__FAIL__(@symbol(UnknownReturnType))
}
} else if (returnTypeSymbol == @symbol(bool)) {
- __returnType = __get_ffi_type_uint();
+ __returnType = TYPE_UINT;
} else if (returnTypeSymbol == @symbol(float)) {
- __returnType = __get_ffi_type_float();
+ __returnType = TYPE_FLOAT;
} else if (returnTypeSymbol == @symbol(double)) {
- __returnType = __get_ffi_type_double();
+ __returnType = TYPE_DOUBLE;
} else if (returnTypeSymbol == @symbol(void)) {
- __returnType = __get_ffi_type_void();
+ __returnType = TYPE_VOID;
__returnValuePointer = NULL;
} else if ((returnTypeSymbol == @symbol(pointer))
|| (returnTypeSymbol == @symbol(handle))
@@ -1155,7 +1218,7 @@
|| (returnTypeSymbol == @symbol(intPointer))
|| (returnTypeSymbol == @symbol(shortPointer))
|| (returnTypeSymbol == @symbol(wcharPointer))) {
- __returnType = __get_ffi_type_pointer();
+ __returnType = TYPE_POINTER;
} else {
if (__isSymbol(returnTypeSymbol)
&& ((returnValueClass = __GLOBAL_GET(returnTypeSymbol)) != nil)) {
@@ -1165,7 +1228,7 @@
if (! __qIsSubclassOfExternalAddress(returnValueClass)) {
__FAIL__(@symbol(NonExternalAddressReturnType))
}
- __returnType = __get_ffi_type_pointer();
+ __returnType = TYPE_POINTER;
returnTypeSymbol = @symbol(pointer);
} else {
__FAIL__(@symbol(UnknownReturnType))
@@ -1190,7 +1253,7 @@
}
__argValues[0].pointerVal = inst;
__argValuePointersIncludingThis[0] = &(__argValues[0]);
- __argTypes[0] = __get_ffi_type_pointer();
+ __argTypes[0] = TYPE_POINTER;
__argValuePointers = &__argValuePointersIncludingThis[1];
__argTypes = &__argTypesIncludingThis[1];
@@ -1204,7 +1267,7 @@
codeAddress = inst->vTable[__intVal(vtOffset)];
# ifdef VERBOSE
if (@global(Verbose) == true) {
- printf("virtual %d codeAddress: %"_lx_"\n", __intVal(vtOffset), (INT)codeAddress);
+ printf("virtual %"_ld_" codeAddress: %"_lx_"\n", (INT)(__intVal(vtOffset)), (INT)codeAddress);
}
# endif
}
@@ -1221,7 +1284,6 @@
* validate all arg types, map each to an ffi_type, and setup arg-buffers
*/
for (i=0; i<__numArgs; i++) {
- ffi_type *thisType;
void *argValuePtr;
OBJ typeSymbol;
OBJ arg;
@@ -1263,7 +1325,7 @@
}
if (typeSymbol == @symbol(int) || typeSymbol == @symbol(sint)) {
- thisType = __get_ffi_type_sint();
+ thisType = TYPE_SINT;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
} else {
@@ -1280,7 +1342,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(uint)) {
- thisType = __get_ffi_type_uint();
+ thisType = TYPE_UINT;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
@@ -1298,7 +1360,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(uint8)) {
- thisType = __get_ffi_type_uint8();
+ thisType = TYPE_UINT8;
if (! __isSmallInteger(arg)) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
@@ -1319,7 +1381,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(sint8)) {
- thisType = __get_ffi_type_sint8();
+ thisType = TYPE_SINT8;
if (! __isSmallInteger(arg)) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
@@ -1340,7 +1402,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(uint16)) {
- thisType = __get_ffi_type_uint16();
+ thisType = TYPE_UINT16;
if (! __isSmallInteger(arg)) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
@@ -1361,7 +1423,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(sint16)) {
- thisType = __get_ffi_type_sint16();
+ thisType = TYPE_SINT16;
if (! __isSmallInteger(arg)) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
@@ -1382,7 +1444,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(uint32)) {
- thisType = __get_ffi_type_uint32();
+ thisType = TYPE_UINT32;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
} else {
@@ -1409,7 +1471,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(sint32)) {
- thisType = __get_ffi_type_uint32();
+ thisType = TYPE_SINT32;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
} else {
@@ -1436,7 +1498,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(uint64)) {
- thisType = __get_ffi_type_uint64();
+ thisType = TYPE_UINT64;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
} else {
@@ -1453,7 +1515,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(sint64)) {
- thisType = __get_ffi_type_sint64();
+ thisType = TYPE_SINT64;
if (__isSmallInteger(arg)) {
__argValues[i].iVal = __intVal(arg);
} else {
@@ -1470,7 +1532,7 @@
argValuePtr = &(__argValues[i].iVal);
} else if (typeSymbol == @symbol(float)) {
- thisType = __get_ffi_type_float();
+ thisType = TYPE_FLOAT;
if (__isSmallInteger(arg)) {
__argValues[i].fVal = (float)(__intVal(arg));
} else if (__isFloat(arg)) {
@@ -1486,9 +1548,8 @@
__FAIL__(@symbol(InvalidArgument))
}
argValuePtr = &(__argValues[i].fVal);
-
} else if (typeSymbol == @symbol(double)) {
- thisType = __get_ffi_type_double();
+ thisType = TYPE_DOUBLE;
if (__isSmallInteger(arg)) {
__argValues[i].dVal = (double)(__intVal(arg));
} else if (__isFloat(arg)) {
@@ -1506,11 +1567,11 @@
argValuePtr = &(__argValues[i].dVal);
} else if (typeSymbol == @symbol(void)) {
- thisType = __get_ffi_type_void();
+ thisType = TYPE_VOID;
argValuePtr = &null;
} else if (typeSymbol == @symbol(charPointer)) {
- thisType = __get_ffi_type_pointer();
+ thisType = TYPE_POINTER;
if (__isStringLike(arg)) {
if (async == true) goto badArgForAsyncCall;
__argValues[i].pointerVal = (void *)(__stringVal(arg));
@@ -1536,7 +1597,7 @@
argValuePtr = &(__argValues[i].pointerVal);;
} else if (typeSymbol == @symbol(wcharPointer)) {
- thisType = __get_ffi_type_pointer();
+ thisType = TYPE_POINTER;
if (__isUnicode16String(arg)) {
if (async == true) goto badArgForAsyncCall;
__argValues[i].pointerVal = (void *)(__unicode16StringVal(arg));
@@ -1562,7 +1623,7 @@
argValuePtr = &(__argValues[i].pointerVal);;
} else if (typeSymbol == @symbol(floatPointer)) {
- thisType = __get_ffi_type_pointer();
+ thisType = TYPE_POINTER;
if (__isBytes(arg)) {
if (async == true) goto badArgForAsyncCall;
__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
@@ -1595,7 +1656,7 @@
argValuePtr = &(__argValues[i].pointerVal);;
} else if (typeSymbol == @symbol(doublePointer)) {
- thisType = __get_ffi_type_pointer();
+ thisType = TYPE_POINTER;
if (__isBytes(arg)) {
if (async == true) goto badArgForAsyncCall;
__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
@@ -1636,7 +1697,7 @@
} else if (typeSymbol == @symbol(pointer)) {
commonPointerTypeArg: ;
- thisType = __get_ffi_type_pointer();
+ thisType = TYPE_POINTER;
if (arg == nil) {
__argValues[i].pointerVal = NULL;
} else if (__isExternalAddressLike(arg)) {
@@ -1687,7 +1748,7 @@
argValuePtr = &(__argValues[i].pointerVal);;
} else if (typeSymbol == @symbol(bool)) {
- thisType = __get_ffi_type_uint();
+ thisType = TYPE_UINT;
if (arg == true) {
__argValues[i].iVal = 1;
@@ -1725,6 +1786,9 @@
__argTypes[i] = thisType;
__argValuePointers[i] = argValuePtr;
+ if ((thisType == TYPE_FLOAT) || (thisType == TYPE_DOUBLE)) {
+ __anyFloatOrDoubleArg = 1;
+ }
# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("arg%d: %"_lx_" type:%"_lx_"\n", i+1, (INT)(__argValues[i].iVal), (INT)thisType);
@@ -1733,67 +1797,289 @@
}
failureInfo = nil;
- __callType = FFI_DEFAULT_ABI;
-
-# ifdef CALLTYPE_FFI_STDCALL
if (callTypeNumber == @global(CALLTYPE_API)) {
+# ifdef CALLTYPE_FFI_STDCALL
__callType = CALLTYPE_FFI_STDCALL;
-# ifdef VERBOSE
+# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("STDCALL\n");
}
-# endif
+# endif
+# else
+ failureCode = @symbol(FFICallTypeNotSupported);
+ goto getOutOfHere;
+# endif
}
-# endif
-# ifdef CALLTYPE_FFI_V8
+
+ // these calltypes are only supported on some systems; others report an error
if (callTypeNumber == @global(CALLTYPE_V8)) {
+# ifdef CALLTYPE_FFI_V8
__callType = CALLTYPE_FFI_V8;
+# else
+ failureCode = @symbol(FFICallTypeNotSupported);
+ goto getOutOfHere;
+# endif
}
-# endif
-# ifdef CALLTYPE_FFI_V9
+
if (callTypeNumber == @global(CALLTYPE_V9)) {
+# ifdef CALLTYPE_FFI_V9
__callType = CALLTYPE_FFI_V9;
+# else
+ failureCode = @symbol(FFICallTypeNotSupported);
+ goto getOutOfHere;
+# endif
}
-# endif
-# ifdef CALLTYPE_FFI_UNIX64
+
if (callTypeNumber == @global(CALLTYPE_UNIX64)) {
+# ifdef CALLTYPE_FFI_UNIX64
__callType = CALLTYPE_FFI_UNIX64;
+# else
+ failureCode = @symbol(FFICallTypeNotSupported);
+ goto getOutOfHere;
+# endif
}
-# endif
+# ifdef HAVE_FFI
if (ffi_prep_cif(&__cif, __callType, __numArgsIncludingThis, __returnType, __argTypesIncludingThis) != FFI_OK) {
__FAIL__(@symbol(FFIPrepareFailed))
}
if (async == true) {
-# ifdef VERBOSE
+# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("async call 0x%"_lx_"\n", (INT)codeAddress);
}
-# endif
-# ifdef __win32__
+# endif
+# ifdef __win32__
__STX_C_CALL4( "ffi_call", ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
-# else
+# else
__BEGIN_INTERRUPTABLE__
ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
__END_INTERRUPTABLE__
-# endif
+# endif
} else {
if (unlimitedStack == true) {
-# ifdef VERBOSE
+# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("UNLIMITEDSTACKCALL call 0x%"_lx_"\n", (INT)codeAddress);
}
-# endif
+# endif
__UNLIMITEDSTACKCALL4__((OBJFUNC)ffi_call, (INT)(&__cif), (INT)codeAddress, (INT)__returnValuePointer, (INT)__argValuePointersIncludingThis);
} else {
-# ifdef VERBOSE
+# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("call 0x%"_lx_"\n", (INT)codeAddress);
}
-# endif
+# endif
ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
}
}
+
+# else /* NO FFI */
+
+ // this is a fallback; simply assume that pointer and regular args
+ // can be passed in the same registers, and that all args are casted to the same
+ // (pointer-) size.
+ // Also, that float/doubles are passed down in regular registers,
+ // and the return types float and double are handled diferently from ints.
+ // If that is not correct for your CPU/architecture, an ifndef is required here.
+
+# if defined(__x86_64__)
+ if (__anyFloatOrDoubleArg) {
+# ifdef VERBOSE
+ if (@global(Verbose) == true) {
+ printf("float/double args currently not supported\n");
+ }
+# endif
+ failureCode = @symbol(FFIDoubleArgNotSupported);
+ goto getOutOfHere;
+ }
+# endif
+
+# if !defined(SomeArchitechtureForWhichAboveIsNotTrue)
+ {
+ VOIDPTRFUNC fi = (VOIDPTRFUNC)codeAddress;
+ DOUBLEFUNC fd = (DOUBLEFUNC)codeAddress;
+
+ switch (__returnType) {
+ case TYPE_FLOAT:
+ case TYPE_DOUBLE:
+ switch (__numArgsIncludingThis) {
+ case 0:
+ __returnValue.dVal = (*fd)();
+ break;
+ case 1:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal );
+ break;
+ case 2:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal );
+ break;
+ case 3:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal );
+ break;
+ case 4:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal );
+ break;
+ case 5:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal );
+ break;
+ case 6:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal );
+ break;
+ case 7:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal );
+ break;
+ case 8:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal );
+ break;
+ case 9:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal );
+ break;
+ case 10:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal );
+ break;
+ case 11:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal );
+ break;
+ case 12:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal );
+ break;
+ case 13:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal );
+ break;
+ case 14:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal, __argValues[13].pointerVal );
+ break;
+ case 15:
+ __returnValue.dVal = (*fd)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal, __argValues[13].pointerVal, __argValues[14].pointerVal );
+ break;
+ default:
+ failureCode = @symbol(TooManyArguments);
+ goto getOutOfHere;
+ }
+ break;
+
+ default:
+ switch (__numArgsIncludingThis) {
+ case 0:
+ __returnValue.pointerVal = (*fi)();
+ break;
+ case 1:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal );
+ break;
+ case 2:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal );
+ break;
+ case 3:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal );
+ break;
+ case 4:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal );
+ break;
+ case 5:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal );
+ break;
+ case 6:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal );
+ break;
+ case 7:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal );
+ break;
+ case 8:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal );
+ break;
+ case 9:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal );
+ break;
+ case 10:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal );
+ break;
+ case 11:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal );
+ break;
+ case 12:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal );
+ break;
+ case 13:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal );
+ break;
+ case 14:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal, __argValues[13].pointerVal );
+ break;
+ case 15:
+ __returnValue.pointerVal = (*fi)( __argValues[0].pointerVal, __argValues[1].pointerVal, __argValues[2].pointerVal,
+ __argValues[3].pointerVal, __argValues[4].pointerVal, __argValues[5].pointerVal,
+ __argValues[6].pointerVal, __argValues[7].pointerVal, __argValues[8].pointerVal,
+ __argValues[9].pointerVal, __argValues[10].pointerVal, __argValues[11].pointerVal,
+ __argValues[12].pointerVal, __argValues[13].pointerVal, __argValues[14].pointerVal );
+ break;
+ default:
+ failureCode = @symbol(TooManyArguments);
+ goto getOutOfHere;
+ }
+ }
+ }
+# else
+ failureCode = @symbol(FFINotSupported);
+ goto getOutOfHere;
+# endif
+# endif
+
# ifdef VERBOSE
if (@global(Verbose) == true) {
printf("retval is %"_ld_" (0x%"_lx_")\n", (INT)(__returnValue.iVal), (INT)(__returnValue.iVal));
@@ -1807,7 +2093,7 @@
|| (returnTypeSymbol == @symbol(sint32))) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
- printf("return int: %x\n", __returnValue.iVal);
+ printf("return int: %"_lx_"\n", (INT)(__returnValue.iVal));
}
# endif
RETURN ( __MKINT(__returnValue.iVal) );
@@ -1818,7 +2104,7 @@
|| (returnTypeSymbol == @symbol(uint32))) {
# ifdef VERBOSE
if (@global(Verbose) == true) {
- printf("return uint: %x\n", __returnValue.iVal);
+ printf("return uint: %"_lx_"\n", (INT)(__returnValue.iVal));
}
# endif
RETURN ( __MKUINT(__returnValue.iVal) );
@@ -1905,9 +2191,10 @@
} else {
__FAIL__(@symbol(UnknownReturnType2))
}
-#else /* no FFI support */
- failureCode = @symbol(FFINotSupported);
-#endif /* HAVE_FFI */
+//#else /* no FFI support */
+// failureCode = @symbol(FFINotSupported);
+//#endif /* HAVE_FFI */
+
getOutOfHere: ;
%}.
failureCode notNil ifTrue:[
--- a/MiniDebugger.st Mon Jun 06 10:37:21 2016 +0100
+++ b/MiniDebugger.st Mon Jun 06 10:56:12 2016 +0100
@@ -826,6 +826,7 @@
^ false
].
(cmd == $Y) ifTrue:[
+ Display := nil.
Smalltalk openDisplay.
NewLauncher open.
^ true
--- a/ReadStream.st Mon Jun 06 10:37:21 2016 +0100
+++ b/ReadStream.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -73,8 +75,8 @@
next: n into: aCollection startingAt: startIndex
"Read n objects into the given collection.
- Return aCollection or a partial copy if less than
- n elements have been read."
+ Return aCollection or a partial copy if less than
+ n elements have been read."
| max |
@@ -259,20 +261,22 @@
|answer|
- self contentsSpecies == collection class ifTrue:[
- ((position + count) > readLimit) ifFalse:[
- answer := collection copyFrom:position+1 to:position+count.
- position := position+count.
- ^ answer
- ].
+ collection notNil ifTrue:[
+ self contentsSpecies == collection class ifTrue:[
+ ((position + count) > readLimit) ifFalse:[
+ answer := collection copyFrom:position+1 to:position+count.
+ position := position+count.
+ ^ answer
+ ].
+ ].
].
^ super next:count
"
#[1 2 3 4 5 6 7 8 9] readStream
- next;
- next:5;
- next.
+ next;
+ next:5;
+ next.
"
!
--- a/Semaphore.st Mon Jun 06 10:37:21 2016 +0100
+++ b/Semaphore.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -14,7 +16,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#Semaphore
- instanceVariableNames:'count waitingProcesses lastOwnerId name'
+ instanceVariableNames:'count waitingProcesses lastOwnerId name owner'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
@@ -349,6 +351,24 @@
^ self waitWithTimeout:seconds
! !
+!Semaphore methodsFor:'accessing'!
+
+owner
+ "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
+!
+
+owner:something
+ "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 := something.
+! !
+
!Semaphore methodsFor:'printing & storing'!
displayOn:aGCOrStream
--- a/SignedByteArray.st Mon Jun 06 10:37:21 2016 +0100
+++ b/SignedByteArray.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2016 by eXept Sofware AG
All Rights Reserved
@@ -51,6 +49,22 @@
"
! !
+!SignedByteArray class methodsFor:'queries'!
+
+maxVal
+ "the maximum value which can be stored in instances of me.
+ For SignedByteArrays, this is 127 (largest 8bit signed int)"
+
+ ^ 127
+!
+
+minVal
+ "the minimum value which can be stored in instances of me.
+ For SignedByteArrays, this is -128 (smallest 8bit signed int)"
+
+ ^ -128
+! !
+
!SignedByteArray methodsFor:'accessing'!
basicAt:index
--- a/Time.st Mon Jun 06 10:37:21 2016 +0100
+++ b/Time.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -196,6 +198,7 @@
%m minutes, 00..59 0-padded to length 2
%s seconds, 00..59 0-padded to length 2
%i milliseconds, 000..999 0-padded to length 3
+ %f fractional seconds any length, but only milliseconds are read
%a am/pm
an optional length after the % gives a field length;
@@ -206,7 +209,7 @@
|hour minute second millisecond
utcOffset inStream formatStream error fChar format itemHandler
- len s|
+ len s fraction fractionString|
error := [:msg |
exceptionalValue isBlock ifTrue:[
@@ -236,6 +239,10 @@
] ifFalse:[ ( format = 'i' or:[ format = 'I' ]) ifTrue:[
millisecond := Integer readFrom:input onError:[ error value:'invalid millsecond' ].
+ ] ifFalse:[ ( format = 'f' or:[ format = 'F' ]) ifTrue:[
+ fractionString := input upToMatching:[:ch | ch isDigit not].
+ fraction := FixedPoint readFrom:'0.',fractionString.
+ millisecond := (fraction * 1000) truncated.
] ifFalse:[ ( format = 'tz' ) ifTrue:[
utcOffset := Timestamp utcOffsetFrom:input.
utcOffset isNil ifTrue:[ error value:'invalid timezone' ]
@@ -254,7 +261,7 @@
] ifFalse:[
error value:'unhandled format:',format
- ]]]]]]]
+ ]]]]]]]]
].
hour := 0.
@@ -309,6 +316,12 @@
Time readFrom:'131106' format:'%2h%2m%2s' language:nil onError:[self halt]
Time readFrom:'7:30pm EST' format:'%u:%m%a %tz' language:#en onError:[self halt]
Time readFrom:'7:30pm UTC' format:'%u:%m%a %tz' language:#en onError:[self halt]
+
+ Time readFrom:'13:11:06.111' format:'%h:%m:%s.%i' language:nil onError:[self halt]
+ Time readFrom:'13:11:06.1' format:'%h:%m:%s.%f' language:nil onError:[self halt]
+ Time readFrom:'13:11:06.01' format:'%h:%m:%s.%f' language:nil onError:[self halt]
+ Time readFrom:'13:11:06.001' format:'%h:%m:%s.%f' language:nil onError:[self halt]
+ Time readFrom:'13:11:06.1234567' format:'%h:%m:%s.%f' language:nil onError:[self halt]
"
!
--- a/TimeDuration.st Mon Jun 06 10:37:21 2016 +0100
+++ b/TimeDuration.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -685,15 +687,18 @@
%(Hd) hours in day (i.e. 0..23)
%(hd) hours in day padded to 2 chars (i.e. 00..23)
- %(yrR) years rounded (i.e. for 730 days, we get 2 asFixed:1 )
- %(monR) month rounded (i.e. for 45 days, we get 1.5 asFixed:1 )
- %(dR) days rounded (i.e. for 36 hours, we get 1.5 asFixed:1 )
- %(hR) hours rounded (i.e. for 3h 30m, we get 3.5 asFixed:1 )
- %(mR) minutes rounded (i.e. for 2m 30s, we get 2.5 asFixed:1 )
- %(sR) seconds rounded to 1 postDecimal (i.e. for 2s 100ms, we get 2.1 asFixed:1 )
+ %(yrR) years rounded (i.e. for 730 days, we get 2 asFixedPoint:1 )
+ %(monR) month rounded (i.e. for 45 days, we get 1.5 asFixedPoint:1 )
+ %(w) weeks
+ %(wR) weeks rounded (i.e. for 45 days, we get 6.xxx asFixedPoint:1 )
+ %(dR) days rounded (i.e. for 36 hours, we get 1.5 asFixedPoint:1 )
+ %(dw) days in week
+ %(hR) hours rounded (i.e. for 3h 30m, we get 3.5 asFixedPoint:1 )
+ %(mR) minutes rounded (i.e. for 2m 30s, we get 2.5 asFixedPoint:1 )
+ %(sR) seconds rounded to 1 postDecimal (i.e. for 2s 100ms, we get 2.1 asFixedPoint:1 )
"
- |hoursInDay s yearsRounded monthsRounded daysRounded hoursRounded minutesRounded secondsRounded|
+ |hoursInDay s yearsRounded monthsRounded weeksRounded daysRounded hoursRounded minutesRounded secondsRounded|
self addBasicPrintBindingsTo:aDictionary language:languageOrNil.
aDictionary at:$d put:self days.
@@ -702,13 +707,15 @@
aDictionary at:#Hd put:(s := hoursInDay printString).
aDictionary at:#hd put:(s leftPaddedTo:2 with:$0).
+ aDictionary at:#dw put:(self days \\ 7).
+
yearsRounded := (self hours / 24 / 365).
yearsRounded isInteger ifFalse:[
yearsRounded := yearsRounded asFixedPoint:1.
].
aDictionary at:#yrR put:yearsRounded.
- monthsRounded := (self hours / 24 / 30).
+ monthsRounded := self days / 30.
monthsRounded isInteger ifFalse:[
monthsRounded := monthsRounded asFixedPoint:1.
monthsRounded roundedToScale = monthsRounded asInteger ifTrue:[
@@ -717,6 +724,16 @@
].
aDictionary at:#monR put:monthsRounded.
+ aDictionary at:#w put:(self days // 7).
+ weeksRounded := self days / 7.
+ weeksRounded isInteger ifFalse:[
+ weeksRounded := weeksRounded asFixedPoint:1.
+ weeksRounded roundedToScale = weeksRounded asInteger ifTrue:[
+ weeksRounded := weeksRounded truncated
+ ].
+ ].
+ aDictionary at:#wR put:weeksRounded.
+
daysRounded := (self hours / 24).
daysRounded isInteger ifFalse:[
daysRounded := daysRounded asFixedPoint:1.
@@ -844,6 +861,7 @@
(TimeDuration readFrom:'10h 3s') formatForPrinting
(TimeDuration readFrom:'3s') formatForPrinting
(TimeDuration readFrom:'1d 2ms') formatForPrinting
+ (TimeDuration readFrom:'1 week') formatForPrinting
"
!
@@ -993,15 +1011,30 @@
"Return a format which is suitable for a human - not meant to be read back.
If shortFlag is true, some millisecond-info is ommitted for longer times."
- |fmt days hours mins secs overAllSeconds millis|
+ |fmt days weeks hours mins secs overAllSeconds millis|
days := self days.
+ weeks := days // 7.
hours := self hours.
mins := self minutes.
secs := self seconds.
millis := self milliseconds.
- ((days > 0) or:[hours >= 24]) ifTrue:[
+ weeks > 0 ifTrue:[
+ fmt := '%(w)w %(dw)d %(Hd)h %Mm'.
+ secs = 0 ifTrue:[
+ fmt := '%(w)w %(dw)d %(Hd)h %Mm'.
+ mins = 0 ifTrue:[
+ fmt := '%(w)w %(dw)d %(Hd)h'.
+ (hours \\ 24) = 0 ifTrue:[
+ fmt := '%(w)w %(dw)d'.
+ (days \\ 7) = 0 ifTrue:[
+ fmt := '%(w)w'.
+ ].
+ ].
+ ].
+ ].
+ ] ifFalse:[days > 0 ifTrue:[
fmt := '%dd %(Hd)h %Mm'.
secs = 0 ifTrue:[
fmt := '%dd %(Hd)h %Mm'.
@@ -1031,7 +1064,7 @@
fmt := ''
].
].
- ].
+ ]].
((secs ~= 0) or:[millis ~= 0])ifTrue:[
fmt size ~~ 0 ifTrue:[
fmt := fmt , ' '
--- a/Timestamp.st Mon Jun 06 10:37:21 2016 +0100
+++ b/Timestamp.st Mon Jun 06 10:56:12 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -15,7 +17,7 @@
AbstractTime subclass:#Timestamp
instanceVariableNames:'osTime'
- classVariableNames:'Epoch MinOSTime MaxOSTime TimeZoneInfo'
+ classVariableNames:'Epoch MaxOSTime MinOSTime TimeZoneInfo'
poolDictionaries:''
category:'Magnitude-Time'
!
@@ -465,7 +467,6 @@
"
! !
-
!Timestamp class methodsFor:'private'!
basicReadFrom:aStream
@@ -815,6 +816,7 @@
%m minutes, 00..59 0-padded to length 2
%s seconds, 00..59 0-padded to length 2
%i milliseconds, 000..999 0-padded to length 3
+ %f fractional seconds any length, but only milliseconds kept
%a am/pm
%d - day
@@ -845,7 +847,7 @@
|day month year dayOfYear monthAndDay
hour minute second millisecond
utcOffset inStream formatStream error fChar format itemHandler
- len now s|
+ len now s fractionString fraction|
error := [:msg |
exceptionalValue isBlock ifTrue:[
@@ -928,6 +930,11 @@
] ifFalse:[ ( format = 'i' or:[ format = 'I' ]) ifTrue:[
millisecond := Integer readFrom:input onError:[ error value:'invalid month' ].
+ ] ifFalse:[ ( format = 'f' or:[ format = 'F' ]) ifTrue:[
+ fractionString := input upToMatching:[:ch | ch isDigit not].
+ fraction := FixedPoint readFrom:'0.',fractionString.
+ millisecond := (fraction * 1000) truncated.
+
] ifFalse:[ ( format = 'tz' ) ifTrue:[
utcOffset := self utcOffsetFrom:input.
utcOffset isNil ifTrue:[ error value:'invalid timezone' ]
@@ -946,7 +953,7 @@
] ifFalse:[
error value:'unhandled format:',format
- ]]]]]]]]]]]]]]]]]
+ ]]]]]]]]]]]]]]]]]]
].
hour := 0.
@@ -1018,6 +1025,15 @@
Timestamp readFrom:'March 7 2009 7:30pm EST' format:'%monthName %day %year %u:%m%a %tz' language:#en onError:[self halt]
Timestamp readFrom:'March 7 2009 7:30pm UTC' format:'%monthName %day %year %u:%m%a %tz' language:#en onError:[self halt]
Timestamp readFrom:'2015103' format:'%4y%3dayOfYear' onError:[self halt]
+
+ Timestamp readFrom:'20-2-1995 13:11:06.999' format:'%day-%month-%year %h:%m:%s.%i' language:nil onError:[self halt]
+ Timestamp readFrom:'20-2-1995 13:11:06.100' format:'%day-%month-%year %h:%m:%s.%i' language:nil onError:[self halt]
+ Timestamp readFrom:'20-2-1995 13:11:06.010' format:'%day-%month-%year %h:%m:%s.%i' language:nil onError:[self halt]
+
+ Timestamp readFrom:'20-2-1995 13:11:06.1' format:'%day-%month-%year %h:%m:%s.%f' language:nil onError:[self halt]
+ Timestamp readFrom:'20-2-1995 13:11:06.01' format:'%day-%month-%year %h:%m:%s.%f' language:nil onError:[self halt]
+ Timestamp readFrom:'20-2-1995 13:11:06.001' format:'%day-%month-%year %h:%m:%s.%f' language:nil onError:[self halt]
+ Timestamp readFrom:'20-2-1995 13:11:06.12345' format:'%day-%month-%year %h:%m:%s.%f' language:nil onError:[self halt]
"
!
@@ -1560,7 +1576,7 @@
'IDLW' -720 false "/ international date line west
'IDLE' 720 false "/ international date line east
- 'MEZ' 60 false "/ mittel europäische Zeit / central european (german)
+ 'MEZ' 60 false "/ mittel europäische Zeit / central european (german)
'MESZ' 120 true "/ central european summer (german)
'WESZ' 60 true "/ west european summer (german)
@@ -1709,7 +1725,6 @@
"
! !
-
!Timestamp methodsFor:'accessing'!
day
@@ -3077,8 +3092,6 @@
"
! !
-
-
!Timestamp methodsFor:'testing'!
isLocalTimestamp
--- a/Unicode16String.st Mon Jun 06 10:37:21 2016 +0100
+++ b/Unicode16String.st Mon Jun 06 10:56:12 2016 +0100
@@ -209,6 +209,11 @@
!
isUnicodeString
+ "true if this is a 2- or 4-byte unicode string
+ (i.e. not a single byte string).
+ Notice, that the name is misleading:
+ all strings are use unicode encoding"
+
^ true
! !
--- a/UserConfirmation.st Mon Jun 06 10:37:21 2016 +0100
+++ b/UserConfirmation.st Mon Jun 06 10:56:12 2016 +0100
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Notification subclass:#UserConfirmation
instanceVariableNames:'canCancel defaultAnswerInDialog defaultAnswer'
classVariableNames:''
@@ -150,12 +152,30 @@
"
! !
+!UserConfirmation methodsFor:'queries'!
+
+askingContext
+ "return the context which did the confirm-request"
+
+ |con|
+
+ con := self suspendedContext.
+ [
+ (con selector startsWith:'confirm')
+ and:[ con method mclass == Object ]
+ ] whileTrue:[
+ con := con sender.
+ ].
+ ^con
+! !
+
!UserConfirmation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserConfirmation.st,v 1.8 2014-06-10 10:21:16 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UserConfirmation.st,v 1.8 2014-06-10 10:21:16 cg Exp $'
+ ^ '$Header$'
! !
+