--- a/AbstractOperatingSystem.st Wed Mar 23 07:50:28 2016 +0000
+++ b/AbstractOperatingSystem.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -6001,13 +5999,13 @@
epochEndOSTime
"private interface for timestamp to ask the OS what the maximum time
(in milliseconds since the Unix epoch, 1.1.1970) is.
- Unix systems will return 0x7FFFFFFF here; other OS's may return a higher number to indicate,
+ 32bit Unix systems will return 0x7FFFFFFF here; other OS's may return a higher number to indicate,
that they can deal with timestamps after 2038 (especially: win32 will do so).
Notice that timestamp is prepared to compensate for any OS limitation by computing the timeInfo
components itself.
- So it is usually (except for a little performane) no problem to return a reange too small here."
-
- ^ 16r7FFFFFFF * 1000
+ So it is usually (except for a little performance) no problem to return a reange too small here."
+
+ ^ (SmallInteger maxVal * 2 + 1) * 1000
!
epochStartOSTime
--- a/ByteArray.st Wed Mar 23 07:50:28 2016 +0000
+++ b/ByteArray.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -489,20 +491,21 @@
REGISTER OBJ cls;
if (__bothSmallInteger(index, value)) {
- val = __intVal(value);
- if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
- indx = __intVal(index) - 1;
- slf = self;
- if ((cls = __qClass(slf)) != ByteArray) {
- if (indx < 0) goto badIndex;
- indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- }
- nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
- __ByteArrayInstPtr(slf)->ba_element[indx] = val;
- RETURN ( value );
- }
- }
+ val = __intVal(value);
+ if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
+ indx = __intVal(index) - 1;
+ slf = self;
+ if ((cls = __qClass(slf)) != ByteArray) {
+ if (indx < 0) goto badIndex;
+ if (cls == ImmutableByteArray) goto badIndex;
+ indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ }
+ nIndex = __byteArraySize(slf);
+ if ((unsigned)indx < (unsigned)nIndex) {
+ __ByteArrayInstPtr(slf)->ba_element[indx] = val;
+ RETURN ( value );
+ }
+ }
}
badIndex: ;
%}.
@@ -522,7 +525,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
union {
unsigned char u_char[4];
@@ -541,8 +544,10 @@
indx = __intVal(index);
if (indx > 0) {
- if ((cls = __qClass(self)) != @global(ByteArray))
+ if ((cls = __qClass(self)) != @global(ByteArray)) {
+ if (cls == ImmutableByteArray) goto error;
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ }
nIndex = __qSize(self) - OHDR_SIZE;
if ((indx+3) <= nIndex) {
byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
@@ -584,7 +589,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
int val;
OBJ cls;
@@ -599,8 +604,10 @@
}
indx = __intVal(index);
if (indx > 0) {
- if ((cls = __qClass(self)) != @global(ByteArray))
+ if ((cls = __qClass(self)) != @global(ByteArray)) {
+ if (cls == ImmutableByteArray) goto error;
indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ }
nIndex = __qSize(self) - OHDR_SIZE;
if ((indx+3) <= nIndex) {
byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
@@ -674,7 +681,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
union {
unsigned char u_char[2];
@@ -714,8 +721,7 @@
Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
%{ /* NOCONTEXT */
-
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
int val;
unsigned char *byteP;
@@ -792,7 +798,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
int v;
union {
@@ -804,8 +810,11 @@
if (__bothSmallInteger(index, value)) {
indx = __intVal(index);
if (indx > 0) {
- if (!__isByteArrayLike(self))
- indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
+ if (!__isByteArray(self)) {
+ OBJ cls = __qClass(self);
+ if (cls == ImmutableByteArray) goto immutable;
+ indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ }
nIndex = __byteArraySize(self);
if ((indx+1) <= nIndex) {
val.u_ushort = v = __intVal(value);
@@ -832,8 +841,9 @@
}
}
}
+immutable: ;
%}.
- ^ super unsignedInt16At:index put:value
+ ^ self unsignedInt16At:index put:value MSB:IsBigEndian
"
|b|
@@ -856,7 +866,7 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
int nIndex;
int val;
OBJ cls;
@@ -865,8 +875,11 @@
if (__bothSmallInteger(index, value)) {
indx = __intVal(index);
if (indx > 0) {
- if (!__isByteArrayLike(self))
- indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
+ if (!__isByteArray(self)) {
+ OBJ cls = __qClass(self);
+ if (cls == ImmutableByteArray) goto immutable;
+ indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ }
nIndex = __byteArraySize(self);
if ((indx+1) <= nIndex) {
val = __intVal(value);
@@ -920,6 +933,7 @@
}
}
}
+immutable: ;
%}.
^ super unsignedInt16At:index put:value MSB:msb
@@ -1204,13 +1218,12 @@
!
beUnsigned
- "thats what I am (but I don't know if this is true for subclasses."
+ "that's what I am (but I don't know if this is true for subclasses."
self class == ByteArray ifTrue:[
^ self.
- ] ifFalse:[
- self shouldNotImplement.
].
+ self shouldNotImplement.
"
#[ 1 2 3 128 255] copy beUnsigned
@@ -2471,7 +2484,7 @@
!
swapBytes
- "swap bytes inplace -
+ "swap bytes (of int16s) inplace -
Expects that the receiver has an even number of bytes;
if not, only the pairs excluding the last byte are swapped.
written as a primitive for speed on image grabbing (if display order is different)."
@@ -2483,32 +2496,32 @@
REGISTER unsigned t;
if (__qClass(self) == @global(ByteArray)) {
- cnt = __byteArraySize(self);
- cnt = cnt & ~1; /* make it even */
- p = __ByteArrayInstPtr(self)->ba_element;
-
- while (cnt >= sizeof(INT)) {
- unsigned INT i = ((unsigned INT *)p)[0];
+ cnt = __byteArraySize(self);
+ cnt = cnt & ~1; /* make it even */
+ p = __ByteArrayInstPtr(self)->ba_element;
+
+ while (cnt >= sizeof(INT)) {
+ unsigned INT i = ((unsigned INT *)p)[0];
#if __POINTER_SIZE__ == 8
- i = ((i>>8) & 0x00FF00FF00FF00FF) | ((i & 0x00FF00FF00FF00FF) << 8);
+ i = ((i>>8) & 0x00FF00FF00FF00FF) | ((i & 0x00FF00FF00FF00FF) << 8);
#else
- i = ((i>>8) & 0x00FF00FF) | ((i & 0x00FF00FF) << 8);
+ i = ((i>>8) & 0x00FF00FF) | ((i & 0x00FF00FF) << 8);
#endif /* __POINTER_SIZE__ */
- ((unsigned INT *)p)[0] = i;
- p += sizeof(INT);
- cnt -= sizeof(INT);
- }
- while (cnt > 0) {
- unsigned short s;
-
- s = ((unsigned short *)p)[0];
- s = (s >> 8) | (s << 8);
- ((unsigned short *)p)[0] = s;
- p += 2;
- cnt -= 2;
- }
- RETURN ( self );
+ ((unsigned INT *)p)[0] = i;
+ p += sizeof(INT);
+ cnt -= sizeof(INT);
+ }
+ while (cnt > 0) {
+ unsigned short s;
+
+ s = ((unsigned short *)p)[0];
+ s = (s >> 8) | (s << 8);
+ ((unsigned short *)p)[0] = s;
+ p += 2;
+ cnt -= 2;
+ }
+ RETURN ( self );
}
%}.
^ super swapBytes "/ rubbish - there is no one currenly
@@ -2566,7 +2579,7 @@
!
swapLongsFrom:startIndex to:endIndex
- "swap longs inplace
+ "swap longs (int32s) inplace
- any partial longs at the end are not swapped.
Swapping is from startIndex to (exclusiv) endIndex;
indexing starts at 1."
@@ -2580,48 +2593,48 @@
if ((__qClass(self) == @global(ByteArray))
&& __isSmallInteger(startIndex)
&& __isSmallInteger(endIndex)) {
- int __idx = __intVal(startIndex);
- int __endIdx = __intVal(endIndex);
-
- limit = __byteArraySize(self);
- if (__endIdx < limit) {
- limit = __endIdx;
- }
- p = __ByteArrayInstPtr(self)->ba_element;
- p = p + __idx - 1;
-
- limit = limit - 4 + 1;
+ int __idx = __intVal(startIndex);
+ int __endIdx = __intVal(endIndex);
+
+ limit = __byteArraySize(self);
+ if (__endIdx < limit) {
+ limit = __endIdx;
+ }
+ p = __ByteArrayInstPtr(self)->ba_element;
+ p = p + __idx - 1;
+
+ limit = limit - 4 + 1;
#if defined(__BSWAP)
- /*
- * can we use the bswap instruction ?
- * notice - not all CPUs have it (the HAS_BSWAP checks this).
- */
- if (__HAS_BSWAP()
- && (((unsigned int)p & 3) == 0)) {
- unsigned int *ip;
- ip = (unsigned int *)p;
-
- while (__idx <= limit) {
- *ip = __BSWAP(*ip);
- ip++;
- __idx += 4;
- }
- RETURN (self);
- }
+ /*
+ * can we use the bswap instruction ?
+ * notice - not all CPUs have it (the HAS_BSWAP checks this).
+ */
+ if (__HAS_BSWAP()
+ && (((unsigned int)p & 3) == 0)) {
+ unsigned int *ip;
+ ip = (unsigned int *)p;
+
+ while (__idx <= limit) {
+ *ip = __BSWAP(*ip);
+ ip++;
+ __idx += 4;
+ }
+ RETURN (self);
+ }
#endif /* __BSWAP */
- while (__idx <= limit) {
- t = p[0];
- p[0] = p[3];
- p[3] = t;
- t = p[1];
- p[1] = p[2];
- p[2] = t;
- p += 4;
- __idx += 4;
- }
- RETURN ( self );
+ while (__idx <= limit) {
+ t = p[0];
+ p[0] = p[3];
+ p[3] = t;
+ t = p[1];
+ p[1] = p[2];
+ p[2] = t;
+ p += 4;
+ __idx += 4;
+ }
+ RETURN ( self );
}
%}.
^ super swapLongsFrom:startIndex to:endIndex "/ rubbish - there is no one currenly
@@ -2827,28 +2840,31 @@
int len;
if (__isByteArrayLike(self)) {
- max = 0;
- index = 0;
- len = __qSize(self) - OHDR_SIZE;
- cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
-
- while (++index <= len) {
- unsigned int byte;
-
- byte = *cp;
- cp++;
- if (byte > max) {
- max = byte;
- if (byte == 255) break;
- }
- }
- RETURN ( __mkSmallInteger(max) );
+ max = 0;
+ index = 0;
+ len = __qSize(self) - OHDR_SIZE;
+ cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
+
+ if (len > 0) {
+ while (++index <= len) {
+ unsigned int byte;
+
+ byte = *cp;
+ cp++;
+ if (byte > max) {
+ max = byte;
+ if (byte == 255) break;
+ }
+ }
+ RETURN ( __mkSmallInteger(max) );
+ }
}
%}.
^ super max
"
#[1 2 3 1 2 3 1 2 19] max
+ #[] max
"
!
@@ -2979,7 +2995,6 @@
"
! !
-
!ByteArray methodsFor:'searching'!
indexOf:aByte startingAt:start
--- a/CharacterArray.st Wed Mar 23 07:50:28 2016 +0000
+++ b/CharacterArray.st Thu Mar 24 07:05:30 2016 +0100
@@ -320,7 +320,6 @@
"Created: 3.8.1997 / 18:16:40 / cg"
! !
-
!CharacterArray class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -364,7 +363,6 @@
"
! !
-
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -770,7 +768,6 @@
^ Unicode32String
! !
-
!CharacterArray methodsFor:'Compatibility-ANSI'!
addLineDelimiters
@@ -2783,10 +2780,10 @@
code := char codePoint.
bytesPerCharacter == 2 ifTrue:[
- bytes unsignedShortAt:idx put:code
+ bytes unsignedInt16At:idx put:code
] ifFalse:[
bytesPerCharacter == 4 ifTrue:[
- bytes unsignedLongAt:idx put:code
+ bytes unsignedInt32At:idx put:code
] ifFalse:[
bytes at:idx put:code
].
@@ -4453,8 +4450,6 @@
! !
-
-
!CharacterArray methodsFor:'matching - glob expressions'!
compoundMatch:aString
@@ -5840,7 +5835,6 @@
"Modified: 17.4.1997 / 12:50:23 / cg"
! !
-
!CharacterArray methodsFor:'special string converting'!
asUnixFilenameString
@@ -6883,7 +6877,6 @@
"
! !
-
!CharacterArray methodsFor:'substring searching'!
findRangeOfString:subString
@@ -7635,7 +7628,6 @@
^ aVisitor visitString:self with:aParameter
! !
-
!CharacterArray class methodsFor:'documentation'!
version
--- a/ExternalBytes.st Wed Mar 23 07:50:28 2016 +0000
+++ b/ExternalBytes.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -9,8 +11,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-'From Smalltalk/X, Version:6.2.5.0 on 18-03-2016 at 10:24:59' !
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -450,10 +450,33 @@
!
newNullTerminatedFromString:aString
- ^ ((self new:aString size+1)
- replaceBytesFrom:1 to:aString size with:aString startingAt:1)
- at:aString size+1 put:0;
- yourself
+ "allocate a null terminated string containing the chars of aString"
+
+ |nChars extBytes|
+
+ nChars := aString size.
+ self assert:(aString bitsPerCharacter == 8).
+
+ extBytes := self new:nChars+1.
+ extBytes replaceBytesFrom:1 to:nChars with:aString startingAt:1.
+ extBytes at:nChars+1 put:0.
+ ^ extBytes
+!
+
+newNullTerminatedFromWideString:aString
+ "allocate a null terminated wide string containing the chars of aString"
+
+ |nChars extBytes|
+
+ nChars := aString size.
+ self assert:(aString bitsPerCharacter <= 16).
+
+ extBytes := self new:((nChars+1)*2).
+ 1 to:nChars do:[:i |
+ extBytes unsignedInt16At:(i*2) put:(aString at:i) codePoint.
+ ].
+ extBytes unsignedInt16At:((nChars+1)*2) put:0.
+ ^ extBytes
!
unprotectedNew:numberOfBytes
@@ -854,9 +877,9 @@
idx := 1.
s := WriteStream on:Unicode16String new.
- [(word := self unsignedShortAt:idx) ~~ 0] whileTrue:[
- s nextPut:(Character value:word).
- idx := idx + 2.
+ [(word := self unsignedInt16At:idx) ~~ 0] whileTrue:[
+ s nextPut:(Character value:word).
+ idx := idx + 2.
].
^ s contents
!
@@ -877,6 +900,7 @@
RETURN(__MKEXTERNALADDRESS(__INST(address_)));
%}.
+ self primitiveFailed
!
asExternalBytes
--- a/ExternalStructure.st Wed Mar 23 07:50:28 2016 +0000
+++ b/ExternalStructure.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
@@ -149,17 +151,19 @@
!ExternalStructure methodsFor:'private'!
-fromExternalAddress:anExternalAddress
- self setAddress:(anExternalAddress address) size:(anExternalAddress size).
+fromExternalAddress:anExternalAddressOrExternalStructure
+ self
+ setAddress:(anExternalAddressOrExternalStructure address)
+ size:(anExternalAddressOrExternalStructure size).
! !
!ExternalStructure class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStructure.st,v 1.6 2015-02-09 11:52:18 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStructure.st,v 1.6 2015-02-09 11:52:18 cg Exp $'
+ ^ '$Header$'
! !
--- a/ImmutableByteArray.st Wed Mar 23 07:50:28 2016 +0000
+++ b/ImmutableByteArray.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2009 by eXept Software AG
All Rights Reserved
@@ -96,7 +98,7 @@
at:index put:value
"Trigger an error if an immutable bytearray is stored into.
The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+ in the debugger (or proceed in an exception handler)."
self noModificationError.
^ super at:index put:value
@@ -105,10 +107,73 @@
basicAt:index put:value
"Trigger an error if an immutable bytearray is stored into.
The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+ in the debugger (or proceed in an exception handler)."
self noModificationError.
^ super basicAt:index put:value
+!
+
+byteAt:index put:value
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super byteAt:index put:value
+!
+
+unsignedInt16At:index put:anInteger
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt16At:index put:anInteger
+!
+
+unsignedInt16At:index put:anInteger MSB:msb
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt16At:index put:anInteger MSB:msb
+!
+
+unsignedInt32At:index put:anInteger
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt32At:index put:anInteger
+!
+
+unsignedInt32At:index put:anInteger MSB:msb
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt32At:index put:anInteger MSB:msb
+!
+
+unsignedInt64At:index put:anInteger
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt64At:index put:anInteger
+!
+
+unsignedInt64At:index put:anInteger MSB:msb
+ "Trigger an error if an immutable bytearray is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger (or proceed in an exception handler)."
+
+ self noModificationError.
+ ^ super unsignedInt64At:index put:anInteger MSB:msb
! !
!ImmutableByteArray methodsFor:'converting'!
@@ -116,7 +181,7 @@
asByteArray
"return the receiver as a (mutable) byteArray"
- ^ self copy changeClassTo:ByteArray
+ ^ self shallowCopy
"
#[1 2 3 4] asImmutableByteArray asByteArray
@@ -124,13 +189,15 @@
!
asImmutableByteArray
+ "that's what I am-"
+
^ self
!
asMutableCollection
"return a writable copy of myself"
- ^ self copy changeClassTo:ByteArray
+ ^ self shallowCopy
!
beImmutable
--- a/Object.st Wed Mar 23 07:50:28 2016 +0000
+++ b/Object.st Thu Mar 24 07:05:30 2016 +0100
@@ -7752,17 +7752,18 @@
"helper for error messages - evaluate aBlock,
passing it a stream on which to put error messages."
- |stream stderr|
-
- stderr := Processor activeProcess stderr.
+ |stream stderr activeProcess|
+
+ activeProcess := Processor activeProcess.
+ stderr := activeProcess stderr.
"CG: care for standalone non-GUI progs, which have no userPreferences class"
(Smalltalk isInitialized
and:[ UserPreferences notNil
and:[ UserPreferences current sendMessagesAlsoToTranscript]]) ifTrue:[
- stream := Processor activeProcess isSystemProcess
+ stream := activeProcess isSystemProcess
ifTrue:[stderr]
- ifFalse:[Processor activeProcess transcript].
+ ifFalse:[activeProcess transcript].
].
stream notNil ifTrue:[
StreamError catch:[
@@ -7979,7 +7980,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?:selector
--- a/SignedByteArray.st Wed Mar 23 07:50:28 2016 +0000
+++ b/SignedByteArray.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2016 by eXept Sofware AG
All Rights Reserved
@@ -160,7 +162,7 @@
!
beUnsigned
- "make mayself unsigned.
+ "make myself unsigned.
elements < 0 are converted to positive numbers."
self class == SignedByteArray ifTrue:[
@@ -330,16 +332,17 @@
max = -128;
index = 0;
len = __qSize(self) - OHDR_SIZE;
-
- for (cp = __ByteArrayInstPtr(self)->ba_element; ++index <= len; cp++) {
- int byte = *cp;
+ if (len > 0) {
+ for (cp = __ByteArrayInstPtr(self)->ba_element; ++index <= len; cp++) {
+ int byte = *cp;
- if (byte > max) {
- max = byte;
- if (byte == 127) break;
+ if (byte > max) {
+ max = byte;
+ if (byte == 127) break;
+ }
}
+ RETURN ( __mkSmallInteger(max) );
}
- RETURN ( __mkSmallInteger(max) );
}
%}.
^ super max
@@ -348,6 +351,8 @@
#[1 2 3 -11 2 3 1 2 19] max
#(-1 -2 -3 -4) asSignedByteArray max
#() asSignedByteArray max
+ #[] max
+ #() max
"
! !
@@ -411,6 +416,8 @@
"
#(-1 2 3 -4 5 6 7 8 9 0 1 2 3 4 5) asSignedByteArray indexOf:0 startingAt:1
#(-1 2 3 -4 5 6 7 8 9 0 1 2 3 4 5) asSignedByteArray indexOf:-4 startingAt:1
+ #() asSignedByteArray indexOf:-4 startingAt:1
+ #() indexOf:-4 startingAt:1
"
! !
--- a/Smalltalk.st Wed Mar 23 07:50:28 2016 +0000
+++ b/Smalltalk.st Thu Mar 24 07:05:30 2016 +0100
@@ -20,9 +20,9 @@
StartupArguments CommandLine CommandName CommandLineArguments
CachedAbbreviations VerboseStartup VerboseLoading Verbose
SilentLoading Initializing StandAlone HeadlessOperation IsPlugin
- IsSharedLibraryComponent IsSTScript DebuggingStandAlone LogDoits
- LoadBinaries RealSystemPath ResourcePath SourcePath BinaryPath
- FileInPath PackagePath BinaryDirName ResourceDirName
+ IsSharedLibraryComponent IsSTScript DebuggingStandAlone Debugging
+ LogDoits LoadBinaries RealSystemPath ResourcePath SourcePath
+ BinaryPath FileInPath PackagePath BinaryDirName ResourceDirName
SourceDirName BitmapDirName PackageDirName FileInDirName
ChangeFileName ImageStartTime ImageRestartTime DemoMode
SaveEmergencyImage SpecialObjectArray CallbackSignal
@@ -546,19 +546,19 @@
"sent from VM via #initializeModules"
Error handle:[:ex |
- ObjectMemory printStackBacktrace.
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
- ].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- ex suspendedContext fullPrintAll.
- '------------------------------------------------' errorPrintCR.
- ((DebuggingStandAlone == true) or:[ Smalltalk commandLineArguments includes:'--debug']) ifTrue:[
- ex reject
- ].
+ ObjectMemory printStackBacktrace.
+ ClassesFailedToInitialize isNil ifTrue:[
+ ClassesFailedToInitialize := IdentitySet new.
+ ].
+ ClassesFailedToInitialize add:aClass.
+ ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
+ ex suspendedContext fullPrintAll.
+ '------------------------------------------------' errorPrintCR.
+ (Debugging == true) ifTrue:[
+ ex reject
+ ].
] do:[
- aClass initialize
+ aClass initialize
].
"Modified: / 11-09-2011 / 17:01:32 / cg"
@@ -635,17 +635,16 @@
Verbose := false.
self initializeVerboseFlags.
- DebuggingStandAlone := false.
-
+ DebuggingStandAlone := Debugging := false.
+ idx := CommandLineArguments indexOf:'--debug'.
+ Debugging := (idx ~~ 0).
+
StandAlone ifTrue:[
InfoPrinting := false.
ObjectMemory infoPrinting:false.
IgnoreAssertions := true.
- idx := CommandLineArguments indexOf:'--debug'.
- idx ~~ 0 ifTrue:[
- DebuggingStandAlone := true.
- ].
+ DebuggingStandAlone := Debugging.
DebuggingStandAlone ifTrue:[
Inspector := MiniInspector.
Debugger := MiniDebugger.
@@ -682,6 +681,10 @@
initializeVerboseFlags
|idx|
+ (idx := CommandLineArguments indexOf:'--ignoreHalt') ~~ 0 ifTrue:[
+ IgnoreHalt := true.
+ CommandLineArguments removeIndex:idx
+ ].
(idx := CommandLineArguments indexOf:'--silentStartup') ~~ 0 ifTrue:[
SilentLoading := true.
CommandLineArguments removeIndex:idx
@@ -4287,6 +4290,12 @@
('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
].
UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enter.
+ ex proceed.
+ ].
self exit:128+(OperatingSystem sigINT).
] do:[
arg = '-' ifTrue:[
@@ -4389,6 +4398,12 @@
('Smalltalk [info]: executing expression: "', arg, '".') infoPrintCR.
].
UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enter.
+ ex proceed.
+ ].
self exit:128+(OperatingSystem sigINT).
] do:[
isFilter ifTrue:[
--- a/UninterpretedBytes.st Wed Mar 23 07:50:28 2016 +0000
+++ b/UninterpretedBytes.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -743,7 +745,7 @@
longLongAt:index
"return the 8-bytes starting at index as a signed Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machineÄs natural byte order.
+ The value is retrieved in the machineÄs natural byte order.
This may be worth a primitive."
^ self signedInt64At:index MSB:IsBigEndian
@@ -997,10 +999,9 @@
signedLongAt:index
"return the 4-bytes starting at index as a signed Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machines natural byte order.
- This may be worth a primitive."
-
- ^ self longAt:index
+ The value is retrieved in the machine's natural byte order."
+
+ ^ self signedInt32At:index
"
|b|
@@ -1013,11 +1014,11 @@
!
signedLongAt:index put:newValue
- "store a 4-bytes value starting at index.
+ "store a 4-bytes signed value starting at index.
The index is a smalltalk index (i.e. 1-based).
- The value is in the machines natural byte order."
-
- ^ self longAt:index put:newValue
+ The value is in the machine's natural byte order."
+
+ ^ self signedInt32At:index put:newValue
"
|b|
@@ -1095,7 +1096,7 @@
The value is stored MSB-first, if the msb-arg is true;
LSB-first otherwise."
- ^ self int16At:byteIndex put:anInteger MSB:msb
+ ^ self signedInt16At:byteIndex put:anInteger MSB:msb
"
|b|
@@ -1439,11 +1440,11 @@
uint32At:zeroBasedIndex
"return the 4-bytes starting at index as (unsigned) Integer.
- The index is a C index (i.e. 0-based).
+ WARNING: The index is a C index (i.e. 0-based).
The value is retrieved in the machine's natural byte order.
- Similar to unsignedLongAt:, except for the index base"
-
- ^ self unsignedLongAt:zeroBasedIndex+1
+ Similar to unsignedInt32At:, except for the index base"
+
+ ^ self unsignedInt32At:zeroBasedIndex+1
"
|b|
@@ -1457,11 +1458,11 @@
uint32At:zeroBasedIndex put:anInteger
"set the 4-bytes starting at index to the value given by (unsigned) Integer.
- The index is a C index (i.e. 0-based).
- The value is stored in the machines natural byte order.
- Similar to unsignedLongAt:put:, except for the index base"
-
- ^ self unsignedLongAt:zeroBasedIndex+1 put:anInteger
+ WARNING: The index is a C index (i.e. 0-based).
+ The value is stored in the machine's natural byte order.
+ Similar to unsignedInt32At:put:, except for the index base"
+
+ ^ self unsignedInt32At:zeroBasedIndex+1 put:anInteger
"
|b|
@@ -1912,7 +1913,7 @@
"return the 8-bytes starting at index as a Float.
The index is a smalltalk index (i.e. 1-based).
Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
- Notice also, that the bytes are expected to be in this machines
+ Notice also, that the bytes are expected to be in this machine's
float representation - if the bytearray originated from another
machine, some conversion is usually needed."
@@ -1928,9 +1929,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(double)-1)) < sz) {
+ INT idx = __intVal(index) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(double)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -1991,7 +1992,7 @@
starting at index.
The index is a smalltalk index (i.e. 1-based).
Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
- Notice also, that the bytes are expected to be in this machines
+ Notice also, that the bytes are expected to be in this machine's
float representation - if the bytearray originated from another
machine, some conversion is usually needed."
@@ -2007,9 +2008,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(double)-1)) < sz) {
+ INT idx = __intVal(index) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(double)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2045,7 +2046,7 @@
starting at index.
The index is a smalltalk index (i.e. 1-based).
Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
- Notice also, that the bytes are expected to be in this machines
+ Notice also, that the bytes are expected to be in this machine's
float representation - if the bytearray originated from another
machine, some conversion is usually needed."
@@ -2071,7 +2072,7 @@
Notice, that (currently) ST/X Floats are what Doubles are in ST-80;
therefore this method reads a 4-byte float from the byteArray and returns
a float object which keeps an 8-byte double internally.
- Notice also, that the bytes are expected to be in this machines
+ Notice also, that the bytes are expected to be in this machine's
float representation and order - if the bytearray originated from another
machine, some conversion is usually needed."
@@ -2087,9 +2088,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(float)-1)) < sz) {
+ INT idx = __intVal(index) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(float)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2119,7 +2120,7 @@
Notice, that (currently) ST/X Floats are what Doubles are in ST-80;
therefore this method reads a 4-byte float from the byteArray and returns
a float object which keeps an 8-byte double internally.
- Notice also, that the bytes are expected to be in this machines
+ Notice also, that the bytes are expected to be in this machine's
float representation and order - if the bytearray originated from another
machine, some conversion is usually needed."
@@ -2160,9 +2161,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(float)-1)) < sz) {
+ INT idx = __intVal(index) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(float)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2224,7 +2225,7 @@
number format."
"
- currently, we assume that the machines native number format is already
+ currently, we assume that the machine's native number format is already
IEEE format - we need some more code here whenever ST/X is ported
to an IBM 370 or old VAX etc.
To date, all supported systems use IEEE float numbers, so there should be
@@ -2244,7 +2245,7 @@
(i.e. 8 bytes are stored)."
"
- currently, we assume that the machines native number format is already
+ currently, we assume that the machine's native number format is already
IEEE format - we need some more code here whenever ST/X is ported
to an IBM 370 or old VAX etc.
To date, all supported systems use IEEE float numbers, so there should be
@@ -2264,7 +2265,7 @@
number format."
"
- currently, we assume that the machines native number format is already
+ currently, we assume that the machine's native number format is already
IEEE format - we need some more code here whenever ST/X is ported
to an IBM 370 or old VAX etc.
To date, all supported systems use IEEE float numbers, so there should be
@@ -2285,7 +2286,7 @@
order 4 bytes of the precision is lost."
"
- currently, we assume that the machines native number format is already
+ currently, we assume that the machine's native number format is already
IEEE format - we need some more code here whenever ST/X is ported
to an IBM 370 or old VAX etc.
To date, all supported systems use IEEE float numbers, so there should be
@@ -2499,10 +2500,10 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;
+ INT idx = __smallIntegerVal(index) - 1;
char *pointer;
- if ((idx+(sizeof(pointer)-1)) < sz) {
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2549,7 +2550,7 @@
"set the pointer starting at index from the integer or externalAddress value.
The index is a smalltalk index (i.e. 1-based).
Only aligned accesses are allowed.
- The value is either an ExternalAddress or ExternalBytes"
+ The value is either an ExternalAddress, ExternalBytes or an Integer"
%{
OBJ *pointer;
@@ -2576,9 +2577,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;
-
- if ((idx+(sizeof(pointer)-1)) < sz) {
+ INT idx = __smallIntegerVal(index) - 1;
+
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2607,7 +2608,7 @@
!
pointerValueAt:index
- "get a pointer starting at index as Integer.
+ "get a pointer value starting at index as unsigned integer.
The index is a smalltalk index (i.e. 1-based).
Only aligned accesses are allowed."
@@ -2618,10 +2619,10 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;
+ INT idx = __smallIntegerVal(index) - 1;
char *pointer;
- if ((idx+(sizeof(pointer)-1)) < sz) {
+ if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
cp += idx;
/*
* aligned
@@ -2671,9 +2672,9 @@
The value is retrieved in the machine's natural byte order,
therefore, this should only be used for byte-data which is
only used inside this machine.
- To setup data packets which are to be sent to other machines,
- or stored into a file, always use longAt:MSB: and specify
- a definite byteOrder."
+ To setup binary data packets which are to be sent to other machines,
+ or stored into a file, always use the corresponding xxx:MSB: method
+ and specify a definite byteOrder."
|w|
@@ -2687,43 +2688,76 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+(sizeof(int)-1)) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+(4-1)) < sz)) {
+ int iVal;
+
cp += idx;
#if defined(__i386__)
/*
- * aligned or not, we dont care (i386 can do both)
+ * aligned or not, we don't care (i386 can do both)
*/
{
- int iVal = ((int *)cp)[0];
-
+ iVal = ((int *)cp)[0];
RETURN (__MKINT(iVal));
}
#else
+# if defined(__x86_64__)
/*
- * aligned
+ * aligned or not, we don't care (i386 can do both)
+ */
+ {
+ iVal = ((int *)cp)[0];
+ RETURN (__mkSmallInteger(iVal));
+ }
+# else
+ /*
+ * aligned ?
*/
if (((INT)cp & (sizeof(int)-1)) == 0) {
- int iVal = ((int *)cp)[0];
-
-# if __POINTER_SIZE__ == 8
+ iVal = ((int *)cp)[0];
+ } else {
+# ifdef __LSBFIRST__
+ iVal = cp[0] & 0xFF;
+ iVal += (cp[1] & 0xFF)<<8;
+ iVal += (cp[2] & 0xFF)<<16;
+ iVal += (cp[3] & 0xFF)<<24;
+# else
+# ifdef __MSBFIRST__
+ iVal = cp[0] & 0xFF;
+ iVal = (iVal<<8)+(cp[1] & 0xFF);
+ iVal = (iVal<<8)+(cp[2] & 0xFF);
+ iVal = (iVal<<8)+(cp[3] & 0xFF);
+# else
+ {
+ union {
+ int i;
+ char c[4];
+ } u;
+ u.c[0] = cp[0];
+ u.c[1] = cp[1];
+ u.c[2] = cp[2];
+ u.c[3] = cp[3];
+ iVal = u.i;
+ }
+# endif
+# endif
+
+# if __POINTER_SIZE__ == 8
RETURN (__mkSmallInteger(iVal));
-# else
+# else
RETURN (__MKINT(iVal));
+# endif
+ }
# endif
- }
#endif
}
}
}
%}.
- w := self unsignedLongAt:byteIndex.
- (w > (16r7FFFFFFF)) ifTrue:[
- ^ w - (16r100000000)
- ].
- ^ w
+ ^ self signedInt32At:byteIndex MSB:IsBigEndian.
"
|b|
@@ -2760,12 +2794,11 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
+ INT idx = __intVal(byteIndex) - 1;
int iVal;
cp += idx;
-
- if ((idx+(sizeof(int)-1)) < sz) {
+ if ((idx >= 0) && ((idx+(sizeof(int)-1)) < sz)) {
if (msb == true) {
#if defined(__MSBFIRST__)
@@ -2816,25 +2849,7 @@
}
%}.
- "/ fallBack code - non ByteArray-like receiver
- "/ or funny byteIndex
-
- i := byteIndex.
- msb ifFalse:[
- bLL := self byteAt:i.
- bLH := self byteAt:(i+1).
- bHL := self byteAt:(i+2).
- bHH := self byteAt:(i+3).
- ] ifTrue:[
- bHH := self byteAt:i.
- bHL := self byteAt:(i+1).
- bLH := self byteAt:(i+2).
- bLL := self byteAt:(i+3).
- ].
- ival := (bHH bitShift:8) + bHL.
- ival := (ival bitShift:8) + bLH.
- val := (ival bitShift:8) + bLL.
-
+ val := self unsignedInt32At:byteIndex MSB:msb.
(val > (16r7FFFFFFF)) ifTrue:[
^ val - (16r100000000)
].
@@ -2870,8 +2885,6 @@
signedInt32At:byteIndex put:anInteger MSB:msb
"set the 4-bytes starting at byteIndex from the signed Integer value.
The byteIndex is a smalltalk index (i.e. 1-based).
- The value is stored in the machines natural byte order.
- This may be worth a primitive.
This is the ST80 version of #signedDoubleWordAt:put:"
@@ -2887,9 +2900,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+3) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+3) < sz)) {
cp += idx;
if (__isSmallInteger(anInteger)) {
@@ -2960,7 +2973,7 @@
unsignedInt32At:byteIndex
"return the 4-bytes starting at index as an (unsigned) Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machines natural byte order."
+ The value is retrieved in the machine's natural byte order."
^ self unsignedInt32At:byteIndex MSB:IsBigEndian
@@ -2998,10 +3011,10 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
+ INT idx = __intVal(byteIndex) - 1;
unsigned int iVal;
- if ((idx+(sizeof(int)-1)) < sz) {
+ if ((idx >= 0) && ((idx+(sizeof(int)-1)) < sz)) {
cp += idx;
if (msb == true) {
@@ -3103,16 +3116,73 @@
!
unsignedInt32At:byteIndex put:anInteger MSB:msb
- "set the 4-bytes starting at index from the (unsigned) integer value.
- The index is a smalltalk index (i.e. 1-based).
- The value must be in the range 0 to 16rFFFFFFFF.
- The value is stored MSB-first if msb is true; LSB-first otherwise."
-
- |i "{ Class: SmallInteger }"
- b1 "{ Class: SmallInteger }"
- b2 "{ Class: SmallInteger }"
- b3 "{ Class: SmallInteger }"
- b4 "{ Class: SmallInteger }"|
+ "set the 4-bytes starting at byteIndex from the unsigned Integer value.
+ The byteIndex is a smalltalk index (i.e. 1-based).
+
+ This is the ST80 version of #doubleWordAt:put:"
+
+ |v i b1 b2 b3 b4|
+
+%{
+ /*
+ * handle the most common case fast ...
+ */
+ if (__isSmallInteger(byteIndex)) {
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+3) < sz)) {
+ cp += idx;
+
+ if (__isSmallInteger(anInteger)) {
+ INT __v = __intVal(anInteger);
+
+# if __POINTER_SIZE__ == 8
+ if ((__v < 0) || (__v > 0xFFFFFFFF)) {
+ goto badArg;
+ }
+# endif
+ if (((INT)cp & 3) == 0) {
+ /*
+ * aligned
+ */
+ if (
+# ifdef __LSBFIRST__
+ (msb == false)
+# else
+# ifdef __MSBFIRST__
+ (msb == true)
+# else
+ (0)
+# endif
+# endif
+ ) {
+ ((int *)cp)[0] = (int)__v;
+ RETURN (anInteger);
+ }
+ }
+ if (msb == false) {
+ cp[0] = __v & 0xFF;
+ cp[1] = (__v>>8) & 0xFF;
+ cp[2] = (__v>>16) & 0xFF;
+ cp[3] = (__v>>24) & 0xFF;
+ } else {
+ cp[0] = (__v>>24) & 0xFF;
+ cp[1] = (__v>>16) & 0xFF;
+ cp[2] = (__v>>8) & 0xFF;
+ cp[3] = __v & 0xFF;
+ }
+ RETURN (anInteger);
+ }
+ }
+ }
+ }
+ badArg: ;
+%}.
((anInteger < 0) or:[anInteger > 16rFFFFFFFF]) ifTrue:[
^ self elementBoundsError:anInteger
@@ -3138,14 +3208,16 @@
"
|b|
- b := ByteArray new:8.
- b doubleWordAt:1 put:16r04030201 MSB:true.
- b doubleWordAt:5 put:16r04030201 MSB:false.
- b inspect
- "
-
- "Modified: / 21.1.1998 / 17:43:34 / cg"
- "Modified: / 5.3.1998 / 11:42:17 / stefan"
+ b := ByteArray new:4.
+ b signedInt32At:1 put:-1.
+ (b unsignedInt32At:1) printStringRadix:16
+ "
+ "
+ |b|
+ b := ByteArray new:4.
+ b unsignedInt32At:1 put:16rFFFFFFFF.
+ (b signedInt32At:1)
+ "
! !
!UninterpretedBytes methodsFor:'accessing-shorts (16bit)'!
@@ -3153,8 +3225,7 @@
signedInt16At:byteIndex
"return the 2-bytes starting at index as a signed Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machines natural byte order.
- This may be worth a primitive."
+ The value is retrieved in the machine's natural byte order."
^ (self unsignedInt16At:byteIndex) signExtendedShortValue
@@ -3190,9 +3261,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+(2-1)) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+(2-1)) < sz)) {
short sVal;
cp += idx;
@@ -3258,9 +3329,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+1) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+1) < sz)) {
cp += idx;
if (__isSmallInteger(anInteger)) {
@@ -3308,8 +3379,7 @@
unsignedInt16At:index
"return the 2-bytes starting at index as an (unsigned) Integer.
The index is a smalltalk index (i.e. 1-based).
- The value is retrieved in the machine's natural byte order
- Subclasses may redefine this for better performance."
+ The value is retrieved in the machine's natural byte order"
^ self unsignedInt16At:index MSB:IsBigEndian
!
@@ -3336,11 +3406,11 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+(2-1)) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+(2-1)) < sz)) {
int iVal;
-
+printf("1\n");
cp += idx;
if (msb == false) {
#if defined(__i386__) || (defined(__LSBFIRST__) && defined(UNALIGNED_FETCH_OK))
@@ -3366,13 +3436,21 @@
^ (b1 bitShift:8) + b2
].
^ (b2 bitShift:8) + b1
+
+ "
+ #[ 16rFF 16r00 ] unsignedInt16At:1 MSB:true
+ #[ 16rFF 16r00 ] unsignedInt16At:1 MSB:false
+
+ #[ 16rFF 16r00 ] unsignedInt16At:2 MSB:true
+ #[ 16rFF 16r00 ] unsignedInt16At:2 MSB:false
+ "
!
unsignedInt16At:index put:anInteger
"set the 2-bytes starting at index from the (unsigned) Integer value.
The index is a smalltalk index (i.e. 1-based).
The stored value must be in the range 0 .. 16rFFFF.
- The value is stored in the machines natural byteorder."
+ The value is stored in the machine's natural byteorder."
^ self unsignedInt16At:index put:anInteger MSB:IsBigEndian
@@ -3409,9 +3487,9 @@
__fetchBytePointerAndSize__(self, &cp, &sz);
// printf("cp=%"_lx_"\n", (INT)cp);
if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(byteIndex)) - 1;
-
- if ((idx+1) < sz) {
+ INT idx = __intVal(byteIndex) - 1;
+
+ if ((idx >= 0) && ((idx+1) < sz)) {
cp += idx;
if (__isSmallInteger(anInteger)) {
@@ -3604,14 +3682,22 @@
maximum number of characters (bytes).
The index is a smalltalk index (i.e. 1-based)."
- |bytes idx|
-
- bytes := self copyFrom:index to:(index + count - 1).
- idx := bytes indexOf:0.
- idx ~~ 0 ifTrue:[ bytes := bytes copyTo:idx-1 ].
+ |bytes endIndex idx|
+
+ endIndex := self indexOf:0 startingAt:index.
+ endIndex == 0 ifTrue:[
+ endIndex := self size + 1
+ ].
+ endIndex := (endIndex min: (index + count)) - 1.
+ bytes := self copyFrom:index to:endIndex.
^ bytes asString
- "Created: 9.9.1996 / 15:28:34 / cg"
+ "
+ #[ 1 2 3 4 5 6 7 8 ] zeroByteStringAt:2 maximumSize:10
+ #[ 1 2 3 4 5 0 6 7 8 ] zeroByteStringAt:2 maximumSize:10
+ #[ 1 2 3 4 5 0 6 7 8 ] zeroByteStringAt:2 maximumSize:3
+ #[ 1 2 3 4 5 0 6 7 8 ] zeroByteStringAt:2 maximumSize:4
+ "
! !
!UninterpretedBytes methodsFor:'converting'!
@@ -4169,6 +4255,26 @@
#[1 2 3 4 5] copyReverse
#[1 2 3 4] copyReverse
"
+!
+
+swapBytes
+ "swap bytes (of int16s) inplace -
+ Expects that the receiver has an even number of bytes;
+ if not, only the pairs excluding the last byte are swapped"
+
+ |b1 lastIndex "{ Class: SmallInteger }"|
+
+ lastIndex := self size-1.
+ 1 to:lastIndex by:2 do:[:idx |
+ b1 := self byteAt:idx.
+ self byteAt:idx put:(self byteAt:idx+1).
+ self byteAt:idx+1 put:b1.
+ ].
+
+ "
+ #[1 2 3 4 5] swapBytes
+ #[1 2 3 4] swapBytes
+ "
! !
--- a/UnixOperatingSystem.st Wed Mar 23 07:50:28 2016 +0000
+++ b/UnixOperatingSystem.st Thu Mar 24 07:05:30 2016 +0100
@@ -9837,7 +9837,7 @@
that they can deal with timestamps before 1970 (especially: win32 will do so).
Notice that timestamp is prepared to compensate for any OS limitation by computing the timeInfo
components itself.
- So it is usually (except for a little performane) no problem to return a range too small here."
+ So it is usually (except for a little performance) no problem to return a range too small here."
^ -16r80000000 * 1000
!
--- a/Win32Constants.st Wed Mar 23 07:50:28 2016 +0000
+++ b/Win32Constants.st Thu Mar 24 07:05:30 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2009 by eXept Software AG
All Rights Reserved
@@ -11,11 +13,23 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
SharedPool subclass:#Win32Constants
instanceVariableNames:''
classVariableNames:'FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL
FILE_ATTRIBUTE_TEMPORARY FILE_ATTRIBUTE_DIRECTORY
- FILE_ATTRIBUTE_READONLY LOGPIXELSX LOGPIXELSY'
+ FILE_ATTRIBUTE_READONLY LOGPIXELSX LOGPIXELSY OFN_READONLY
+ OFN_OVERWRITEPROMPT OFN_HIDEREADONLY OFN_NOCHANGEDIR OFN_SHOWHELP
+ OFN_ENABLEHOOK OFN_ENABLETEMPLATE OFN_ENABLETEMPLATEHANDLE
+ OFN_NOVALIDATE OFN_ALLOWMULTISELECT OFN_EXTENSIONDIFFERENT
+ OFN_PATHMUSTEXIST OFN_FILEMUSTEXIST OFN_CREATEPROMPT
+ OFN_SHAREAWARE OFN_NOREADONLYRETURN OFN_NOTESTFILECREATE
+ OFN_NONETWORKBUTTON OFN_NOLONGNAMES OFN_EXPLORER
+ OFN_NODEREFERENCELINKS OFN_LONGNAMES OFN_ENABLEINCLUDENOTIFY
+ OFN_ENABLESIZING OFN_DONTADDTORECENT OFN_FORCESHOWHIDDEN
+ OFN_EX_NOPLACESBAR OFN_SHAREFALLTHROUGH OFN_SHARENOWARN
+ OFN_SHAREWARN'
poolDictionaries:''
category:'OS-Windows'
!
@@ -56,13 +70,46 @@
LOGPIXELSX := 88.
LOGPIXELSY := 90.
+ OFN_READONLY := 16r01.
+ OFN_OVERWRITEPROMPT := 16r2.
+ OFN_HIDEREADONLY := 16r4.
+ OFN_NOCHANGEDIR := 16r8.
+ OFN_SHOWHELP := 16r10.
+ OFN_ENABLEHOOK := 16r20.
+ OFN_ENABLETEMPLATE := 16r40.
+ OFN_ENABLETEMPLATEHANDLE := 16r80.
+ OFN_NOVALIDATE := 16r100.
+ OFN_ALLOWMULTISELECT := 16r200.
+ OFN_EXTENSIONDIFFERENT := 16r400.
+ OFN_PATHMUSTEXIST := 16r800.
+ OFN_FILEMUSTEXIST := 16r1000.
+ OFN_CREATEPROMPT := 16r2000.
+ OFN_SHAREAWARE := 16r4000.
+ OFN_NOREADONLYRETURN := 16r8000.
+ OFN_NOTESTFILECREATE := 16r10000.
+ OFN_NONETWORKBUTTON := 16r20000.
+ OFN_NOLONGNAMES := 16r40000.
+ OFN_EXPLORER := 16r80000.
+ OFN_NODEREFERENCELINKS := 16r100000.
+ OFN_LONGNAMES := 16r200000.
+ OFN_ENABLEINCLUDENOTIFY := 16r400000.
+ OFN_ENABLESIZING := 16r800000.
+ OFN_DONTADDTORECENT := 16r2000000.
+ OFN_FORCESHOWHIDDEN := 16r10000000.
+ OFN_EX_NOPLACESBAR := 16r1.
+
+ OFN_SHAREFALLTHROUGH := 16r2.
+ OFN_SHARENOWARN := 16r1.
+ OFN_SHAREWARN := 16r0.
+
"Modified: / 24-12-2010 / 11:17:57 / cg"
! !
!Win32Constants class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Win32Constants.st,v 1.4 2010-12-24 10:22:26 cg Exp $'
+ ^ '$Header$'
! !
+
Win32Constants initialize!
--- a/Win32OperatingSystem.st Wed Mar 23 07:50:28 2016 +0000
+++ b/Win32OperatingSystem.st Thu Mar 24 07:05:30 2016 +0100
@@ -895,7 +895,6 @@
"Modified: 7.1.1997 / 19:36:11 / stefan"
! !
-
!Win32OperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -5040,9 +5039,8 @@
!
getOpenFilename: openFilenameStructureExternalAddress
-
- "Opens a windows native file dialog without blocking stx for an OpenFilenameStructure stored in an externalAddress.
- openFilenameStructureExternalAddress is an integer representing it's address"
+ "Opens a windows native file dialog without blocking stx
+ for an OpenFilenameStructure stored in an externalStructure"
| rslt |
@@ -5053,14 +5051,14 @@
if (__isExternalAddressLike(openFilenameStructureExternalAddress)
|| __isExternalBytesLike(openFilenameStructureExternalAddress)){
- __address = __externalAddressVal(openFilenameStructureExternalAddress);
- __rslt = __STX_API_CALL1( "GetOpenFileName", (void *)GetOpenFileName, __address);
-
- if (__rslt == TRUE) {
- rslt = true;
- } else {
- rslt = false;
- }
+ __address = __externalAddressVal(openFilenameStructureExternalAddress);
+ __rslt = __STX_API_CALL1( "GetOpenFileNameA", (void *)GetOpenFileNameA, __address);
+
+ if (__rslt == TRUE) {
+ rslt = true;
+ } else {
+ rslt = false;
+ }
}
%}.
rslt isNil ifTrue:[ self primitiveFailed ].
@@ -5071,8 +5069,8 @@
getSaveFilename: openFilenameStructureExternalAddress
- "Opens a windows native file dialog without blocking stx for an OpenFilenameStructure stored in an externalAddress.
- openFilenameStructureExternalAddress is an integer representing it's address"
+ "Opens a windows native file dialog without blocking stx
+ for an OpenFilenameStructure stored in an externalStructure."
| rslt |
@@ -5083,14 +5081,14 @@
if (__isExternalAddressLike(openFilenameStructureExternalAddress)
|| __isExternalBytesLike(openFilenameStructureExternalAddress)){
- __address = __externalAddressVal(openFilenameStructureExternalAddress);
- __rslt = __STX_API_CALL1( "GetSaveFileName", (void *)GetSaveFileName, __address);
-
- if (__rslt == TRUE) {
- rslt = true;
- } else {
- rslt = false;
- }
+ __address = __externalAddressVal(openFilenameStructureExternalAddress);
+ __rslt = __STX_API_CALL1( "GetSaveFileName", (void *)GetSaveFileName, __address);
+
+ if (__rslt == TRUE) {
+ rslt = true;
+ } else {
+ rslt = false;
+ }
}
%}.
rslt isNil ifTrue:[ self primitiveFailed ].