*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Tue, 04 Feb 2014 18:05:02 +0100
changeset 3159 1ea80d1ded0c
parent 3158 32762c55c099
child 3160 d5bef8d7e676
*** empty log message ***
HalfFloatArray.st
Make.proto
Make.spec
abbrev.stc
libInit.cc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/HalfFloatArray.st	Tue Feb 04 18:05:02 2014 +0100
@@ -0,0 +1,246 @@
+"
+ COPYRIGHT (c) 2014 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic2' }"
+
+AbstractNumberVector variableWordSubclass:#HalfFloatArray
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Collections-Arrayed'
+!
+
+!HalfFloatArray primitiveFunctions!
+
+%{
+typedef unsigned short halffloat;
+typedef unsigned short uint16;
+typedef unsigned int   uint32;
+
+//
+// convert a halffloat (16-bit float) to a float
+//
+float
+__STX_halffloat_to_float(halffloat h) {
+	int e;
+	uint16 hs, he, hm;
+	uint32 xs, xe, xm;
+	int32 xes;
+	union {
+	    uint32 u32;
+	    float f32;
+	} u;
+
+	if( (h & 0x7FFFu) == 0 ) {  // Signed zero
+	    u.u32 = ((uint32) h) << 16;  // Return the signed zero
+	} else { // Not zero
+	    hs = h & 0x8000u;  // Pick off sign bit
+	    he = h & 0x7C00u;  // Pick off exponent bits
+	    hm = h & 0x03FFu;  // Pick off mantissa bits
+	    if( he == 0 ) {  // Denormal will convert to normalized
+		e = -1; // The following loop figures out how much extra to adjust the exponent
+		do {
+		    e++;
+		    hm <<= 1;
+		} while( (hm & 0x0400u) == 0 ); // Shift until leading bit overflows into exponent bit
+		xs = ((uint32) hs) << 16; // Sign bit
+		xes = ((uint32) (he >> 10)) - 15 + 127 - e; // Exponent unbias the halfp, then bias the single
+		xe = (uint32) (xes << 23); // Exponent
+		xm = ((uint32) (hm & 0x03FFu)) << 13; // Mantissa
+		u.u32 = (xs | xe | xm); // Combine sign bit, exponent bits, and mantissa bits
+	    } else if( he == 0x7C00u ) {  // Inf or NaN (all the exponent bits are set)
+		if( hm == 0 ) { // If mantissa is zero ...
+		    u.u32 = (((uint32) hs) << 16) | ((uint32) 0x7F800000u); // Signed Inf
+		} else {
+		    u.u32 = (uint32) 0xFFC00000u; // NaN, only 1st mantissa bit set
+		}
+	    } else { // Normalized number
+		xs = ((uint32) hs) << 16; // Sign bit
+		xes = ((uint32) (he >> 10)) - 15 + 127; // Exponent unbias the halfp, then bias the single
+		xe = (uint32) (xes << 23); // Exponent
+		xm = ((uint32) hm) << 13; // Mantissa
+		u.u32 = (xs | xe | xm); // Combine sign bit, exponent bits, and mantissa bits
+	    }
+	}
+	return u.f32;
+}
+
+//
+// convert a float to a halffloat (16-bit float)
+//
+halffloat
+__STX_float_to_halffloat(float f32) {
+	uint16    hs, he, hm;
+	uint32 x, xs, xe, xm;
+	int hes;
+	union {
+	    uint32 u32;
+	    float f32;
+	} u;
+	halffloat h;
+
+	u.f32 = f32;
+	x = u.u32;
+	if( (x & 0x7FFFFFFFu) == 0 ) {  // Signed zero
+	    h = (uint16) (x >> 16);  // Return the signed zero
+	} else { // Not zero
+	    xs = x & 0x80000000u;  // Pick off sign bit
+	    xe = x & 0x7F800000u;  // Pick off exponent bits
+	    xm = x & 0x007FFFFFu;  // Pick off mantissa bits
+	    if( xe == 0 ) {  // Denormal will underflow, return a signed zero
+		h = (uint16) (xs >> 16);
+	    } else if( xe == 0x7F800000u ) {  // Inf or NaN (all the exponent bits are set)
+		if( xm == 0 ) { // If mantissa is zero ...
+		    h = (uint16) ((xs >> 16) | 0x7C00u); // Signed Inf
+		} else {
+		    h = (uint16) 0xFE00u; // NaN, only 1st mantissa bit set
+		}
+	    } else { // Normalized number
+		hs = (uint16) (xs >> 16); // Sign bit
+		hes = ((int)(xe >> 23)) - 127 + 15; // Exponent unbias the single, then bias the halfp
+		if( hes >= 0x1F ) {  // Overflow
+		    h = (uint16) ((xs >> 16) | 0x7C00u); // Signed Inf
+		} else if( hes <= 0 ) {  // Underflow
+		    if( (14 - hes) > 24 ) {  // Mantissa shifted all the way off & no rounding possibility
+			hm = (uint16) 0u;  // Set mantissa to zero
+		    } else {
+			xm |= 0x00800000u;  // Add the hidden leading bit
+			hm = (uint16) (xm >> (14 - hes)); // Mantissa
+			if( (xm >> (13 - hes)) & 0x00000001u ) // Check for rounding
+			    hm += (uint16) 1u; // Round, might overflow into exp bit, but this is OK
+		    }
+		    h = (hs | hm); // Combine sign bit and mantissa bits, biased exponent is zero
+		} else {
+		    he = (uint16) (hes << 10); // Exponent
+		    hm = (uint16) (xm >> 13); // Mantissa
+		    if( xm & 0x00001000u ) // Check for rounding
+			h = (hs | he | hm) + (uint16) 1u; // Round, might overflow to inf, this is OK
+		    else
+			h = (hs | he | hm);  // No rounding
+		}
+	    }
+	}
+	return h;
+}
+
+%}
+!
+
+!HalfFloatArray class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    HalfFloatArrays store half precision (16bit) floats (and nothing else).
+    HalfFloats were trditionally seldom used, but seem to become more popular
+    these days, as some 3D graphics accelerators and game engines use them
+    for very dens and compact storage.
+    Notice, that when accessing a HalfFloats elements via getters/setters,
+    shortFloat (i.e. single precision 32bit floats are exchanged).
+    HalfFloats are not supported as first class objects by the st/x system (yet?).
+
+    [memory requirements:]
+	OBJ-HEADER + (size * 2)
+
+    [See also:]
+	FloatArray DoubleArray Array
+
+    [author:]
+	Claus Gittinger
+"
+! !
+
+!HalfFloatArray class methodsFor:'queries'!
+
+elementByteSize
+    ^ 2
+! !
+
+
+!HalfFloatArray methodsFor:'accessing'!
+
+at:index
+%{  /* NOCONTEXT */
+    if (__isSmallInteger(index)) {
+	int i = __intVal(index);
+
+	if ((unsigned int)i <= __wordArraySize(self)) {
+	    unsigned short h;
+	    OBJ newFloat;
+	    float f;
+
+	    h = __WordArrayInstPtr(self)->s_element[i];
+
+	    f = __STX_halffloat_to_float(h);
+	    __qMKSFLOAT(newFloat, f);
+	    RETURN ( newFloat );
+	}
+    }
+%}.
+    self primitiveFailed
+!
+
+at:index put:aFloat
+%{
+    if (__isSmallInteger(index)) {
+	int i = __intVal(index);
+
+	if ((unsigned)i <= __wordArraySize(self)) {
+	    unsigned short h;
+	    float f;
+
+	    if (__isFloat(aFloat)) {
+		f = (float)(__floatVal(aFloat));
+	    } else if (__isShortFloat(aFloat)) {
+		f = __shortFloatVal(aFloat);
+	    } else if (__isSmallInteger(aFloat)) {
+		f = (float)(__intVal(aFloat));
+	    } else
+		goto error;
+
+	    h = __STX_float_to_halffloat(f);
+	    __WordArrayInstPtr(self)->s_element[i] = h;
+	    RETURN (aFloat);
+	}
+    }
+  error: ;
+%}.
+    self primitiveFailed
+! !
+
+!HalfFloatArray methodsFor:'queries'!
+
+defaultElement
+    ^ ShortFloat zero
+!
+
+numFloats
+    ^ self size
+! !
+
+!HalfFloatArray class methodsFor:'documentation'!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libbasic2/HalfFloatArray.st,v 1.1 2014-02-04 17:05:02 cg Exp $'
+! !
--- a/Make.proto	Sat Feb 01 23:29:26 2014 +0100
+++ b/Make.proto	Tue Feb 04 18:05:02 2014 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic2/Make.proto,v 1.200 2013-12-24 10:47:24 cg Exp $
+# $Header: /cvs/stx/stx/libbasic2/Make.proto,v 1.201 2014-02-04 17:05:02 cg Exp $
 #
 # DO NOT EDIT
 # automagically generated from the projectDefinition: stx_libbasic2.
@@ -63,7 +63,7 @@
 
 all:: preMake classLibRule postMake
 
-pre_objs:: bz2lib zlib 
+pre_objs:: bz2lib zlib
 
 
 zlib:
@@ -220,6 +220,7 @@
 $(OUTDIR)UDSocketAddress.$(O) UDSocketAddress.$(H): UDSocketAddress.st $(INCLUDE_TOP)/stx/libbasic2/SocketAddress.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)Unicode32String.$(O) Unicode32String.$(H): Unicode32String.st $(INCLUDE_TOP)/stx/libbasic2/FourByteString.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)WordArray.$(O) WordArray.$(H): WordArray.st $(INCLUDE_TOP)/stx/libbasic2/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)HalfFloatArray.$(O) HalfFloatArray.$(H): HalfFloatArray.st $(INCLUDE_TOP)/stx/libbasic2/WordArray.$(H) $(INCLUDE_TOP)/stx/libbasic2/UnboxedIntegerArray.$(H) $(INCLUDE_TOP)/stx/libbasic/AbstractNumberVector.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)ZipArchive.$(O) ZipArchive.$(H): ZipArchive.st $(INCLUDE_TOP)/stx/libbasic2/ZipArchiveConstants.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR)
 $(OUTDIR)ZipStream.$(O) ZipStream.$(H): ZipStream.st $(INCLUDE_TOP)/stx/libbasic2/CompressionStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)FileURI.$(O) FileURI.$(H): FileURI.st $(INCLUDE_TOP)/stx/libbasic2/HierarchicalURI.$(H) $(INCLUDE_TOP)/stx/libbasic2/URI.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -230,4 +231,3 @@
 $(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Float.$(H) $(INCLUDE_TOP)/stx/libbasic/LimitedPrecisionReal.$(H) $(INCLUDE_TOP)/stx/libbasic/Number.$(H) $(INCLUDE_TOP)/stx/libbasic/ArithmeticValue.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR)
 
 # ENDMAKEDEPEND --- do not remove this line
-
--- a/Make.spec	Sat Feb 01 23:29:26 2014 +0100
+++ b/Make.spec	Tue Feb 04 18:05:02 2014 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic2/Make.spec,v 1.99 2013-12-24 10:47:20 cg Exp $
+# $Header: /cvs/stx/stx/libbasic2/Make.spec,v 1.100 2014-02-04 17:05:02 cg Exp $
 #
 # DO NOT EDIT
 # automagically generated from the projectDefinition: stx_libbasic2.
@@ -159,6 +159,7 @@
 	UDSocketAddress \
 	Unicode32String \
 	WordArray \
+	HalfFloatArray \
 	ZipArchive \
 	ZipStream \
 	FileURI \
@@ -280,6 +281,7 @@
     $(OUTDIR_SLASH)UDSocketAddress.$(O) \
     $(OUTDIR_SLASH)Unicode32String.$(O) \
     $(OUTDIR_SLASH)WordArray.$(O) \
+    $(OUTDIR_SLASH)HalfFloatArray.$(O) \
     $(OUTDIR_SLASH)ZipArchive.$(O) \
     $(OUTDIR_SLASH)ZipStream.$(O) \
     $(OUTDIR_SLASH)FileURI.$(O) \
@@ -288,6 +290,3 @@
     $(OUTDIR_SLASH)IPv6SocketAddress.$(O) \
     $(OUTDIR_SLASH)SftpURI.$(O) \
     $(OUTDIR_SLASH)extensions.$(O) \
-
-
-
--- a/abbrev.stc	Sat Feb 01 23:29:26 2014 +0100
+++ b/abbrev.stc	Tue Feb 04 18:05:02 2014 +0100
@@ -128,6 +128,7 @@
 UDSocketAddress UDSocketAddress stx:libbasic2 'OS-Sockets' 0
 Unicode32String Unicode32String stx:libbasic2 'Collections-Text' 0
 WordArray WordArray stx:libbasic2 'Collections-Arrayed' 0
+HalfFloatArray HalfFloatArray stx:libbasic2 'Collections-Arrayed' 0
 ZipArchive ZipArchive stx:libbasic2 'System-Support-FileFormats' 0
 ZipStream ZipStream stx:libbasic2 'System-Compress' 0
 FileURI FileURI stx:libbasic2 'Net-Resources' 0
--- a/libInit.cc	Sat Feb 01 23:29:26 2014 +0100
+++ b/libInit.cc	Tue Feb 04 18:05:02 2014 +0100
@@ -1,5 +1,5 @@
 /*
- * $Header: /cvs/stx/stx/libbasic2/libInit.cc,v 1.124 2013-12-24 10:47:39 cg Exp $
+ * $Header: /cvs/stx/stx/libbasic2/libInit.cc,v 1.125 2014-02-04 17:05:02 cg Exp $
  *
  * DO NOT EDIT
  * automagically generated from the projectDefinition: stx_libbasic2.
@@ -136,6 +136,7 @@
 _UDSocketAddress_Init(pass,__pRT__,snd);
 _Unicode32String_Init(pass,__pRT__,snd);
 _WordArray_Init(pass,__pRT__,snd);
+_HalfFloatArray_Init(pass,__pRT__,snd);
 _ZipArchive_Init(pass,__pRT__,snd);
 _ZipStream_Init(pass,__pRT__,snd);
 _FileURI_Init(pass,__pRT__,snd);