ByteArray.st
author Claus Gittinger <cg@exept.de>
Fri, 08 May 1998 12:29:18 +0200
changeset 3425 f7faef75f0d8
parent 3422 09c13ab58bb2
child 3676 140bdb21d859
permissions -rw-r--r--
tuned word & doubleWord access for i386
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
3208
2d71538b9fd5 now subclass of UIBytes - which contains common protocol
Claus Gittinger <cg@exept.de>
parents: 3205
diff changeset
    13
UninterpretedBytes variableByteSubclass:#ByteArray
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    14
	instanceVariableNames:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    15
	classVariableNames:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    16
	poolDictionaries:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    17
	category:'Collections-Arrayed'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
    20
!ByteArray class methodsFor:'documentation'!
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    21
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    22
copyright
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    23
"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    24
 COPYRIGHT (c) 1989 by Claus Gittinger
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    25
	      All Rights Reserved
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    26
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    27
 This software is furnished under a license and may be used
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    28
 only in accordance with the terms of that license and with the
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    30
 be provided or otherwise made available to, or used by, any
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    31
 other person.  No title to or ownership of the software is
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    32
 hereby transferred.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    33
"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    34
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    35
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
documentation
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
    ByteArrays store integers in the range 0..255.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    39
    In contrast to normal arrays (which store pointers to their elements),
362
claus
parents: 359
diff changeset
    40
    byteArrays store the values in a dense & compact way. ByteArrays can
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    41
    be used to hold the data for bitmaps, images and other bulk data.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    42
    ByteArrays are also used to store the bytecode-instructions of an
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    43
    interpreted method and are used as superclass for Strings.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    44
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    45
    ByteArrays can be used as literals i.e. you can enter ByteArray-constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    46
    as #[ element1 element2 .... elementN] and also use byteArray constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    47
    as elements in a constant array.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    48
    As in: #( #[1 1 1] #[2 2 2] #[3 3 3])
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    49
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    50
    If you have to communicate structure-data (in the C-sense) with external
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    51
    programs/data-bases, see a companion class (Structure) in the goodies directory.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    52
    It allows the definition of subclasses of ByteArray, which transparently fetch
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    53
    and store C-structure fields.
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
    54
2145
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    55
    [warning:]
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
    56
	read the warning about 'growing fixed size collection'
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
    57
	in ArrayedCollection's documentation
2145
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    58
1290
15ba3221b89b documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
    59
    [author:]
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
    60
	Claus Gittinger
1290
15ba3221b89b documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
    61
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
    62
    [See also:]
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
    63
	Array CharacterArray String
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    64
"
2
claus
parents: 1
diff changeset
    65
! !
claus
parents: 1
diff changeset
    66
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
    67
!ByteArray class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    69
from:aByteArray
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    70
    "return new instance which is a copy of aByteArray"
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    71
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    72
    |len bytes|
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    73
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    74
    len := aByteArray size.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    75
    bytes := self new:len.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    76
    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:1.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
    77
    ^ bytes
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    78
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    79
    "Created: / 5.3.1998 / 15:57:52 / stefan"
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    80
!
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
    81
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    82
fromPackedString:aString
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    83
    "ST-80 compatibility: decode a byteArray from a packed string in which
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    84
     6bits are encoded per character. The argument, aString must be a multiple 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    85
     of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    86
     the radix-encoding used in good old PDP11 times ;-)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    87
     ST-80 uses this encoding for Images ...
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    88
     PS: It took a while to figure that one out ... I dont like it ;-)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    89
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    90
    |index    "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    91
     dstIndex "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    92
     stop     "{ Class: SmallInteger }"
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    93
     sixBits  "{ Class: SmallInteger }"
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    94
     n        "{ Class: SmallInteger }"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    95
     sz       "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    96
     lastCharacter bytes|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    97
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    98
    sz := aString size.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    99
    sz == 0 ifTrue:[^ self new].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   100
    stop := sz // 4 * 3.
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   101
    "the size modulo 3 is encoded in the last character, if its in the
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   102
     range 97 .. otherwise, its exact."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   103
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   104
    lastCharacter := aString last.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   105
    lastCharacter asciiValue > 96 ifTrue:[
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   106
        stop := stop - 3 + lastCharacter asciiValue - 96
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   107
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   108
    bytes := self new:stop.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   109
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   110
    index := 1. dstIndex := 1.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   111
    [dstIndex <= stop] whileTrue:[
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   112
        "take 4 characters ..."
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   113
        sixBits := (aString at:index) asciiValue.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   114
        sixBits := sixBits bitAnd:16r3F.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   115
        n := sixBits.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   116
        
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   117
        sixBits := (aString at:index+1) asciiValue.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   118
        sixBits := sixBits bitAnd:16r3F.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   119
        n := (n bitShift:6) + sixBits.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   120
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   121
        sixBits := (aString at:index+2) asciiValue.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   122
        sixBits := sixBits bitAnd:16r3F.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   123
        n := (n bitShift:6) + sixBits.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   124
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   125
        sixBits := (aString at:index+3) asciiValue.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   126
        sixBits := sixBits bitAnd:16r3F.
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   127
        n := (n bitShift:6) + sixBits.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   128
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   129
        index := index + 4.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   130
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   131
        "/ now have 24 bits in n
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   132
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   133
        bytes at:dstIndex put:(n bitShift:-16).
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   134
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   135
        dstIndex < stop ifTrue:[
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   136
            bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   137
            dstIndex+2 <= stop ifTrue:[
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   138
                bytes at:dstIndex+2 put:(n bitAnd:16rFF).
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   139
            ]
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   140
        ].
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   141
        dstIndex := dstIndex + 3.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   142
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   143
    ^ bytes
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   144
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   145
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   146
     ByteArray fromPackedString:(#[1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   147
     ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   148
     ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   149
     ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   150
     ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   151
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   152
    "
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   153
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   154
    "Modified: / 6.3.1997 / 15:28:52 / cg"
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3071
diff changeset
   155
    "Modified: / 18.12.1997 / 17:17:11 / stefan"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   156
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   157
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
uninitializedNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    "return a new instance of the receiver with uninitialized
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
     (i.e. undefined) contents. The indexed elements have any random
75
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   161
     value. However, any named instance variables are still nilled. 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   162
     For use, when contents will be set anyway shortly after - this
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   163
     is a bit faster than the regular basicNew:, which clears the bytes.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   164
     Of course, it only makes a difference for very big ByteArrays, such
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   165
     as used for images/bitmaps.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   166
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   167
     Notice: if you want to port code using uninitializedNew: to another
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   168
     smalltalk, you have to add an 'uninitializedNew: -> basicNew:'-calling 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   169
     method to the ByteArray class of the other smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
    OBJ newobj;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
    INT instsize, nInstVars, nindexedinstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
249
claus
parents: 221
diff changeset
   176
    if (__isSmallInteger(anInteger)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   177
	nindexedinstvars = __intVal(anInteger);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   178
	if (nindexedinstvars >= 0) {
249
claus
parents: 221
diff changeset
   179
	    if (self == ByteArray) {
claus
parents: 221
diff changeset
   180
		/*
claus
parents: 221
diff changeset
   181
		 * the most common case
claus
parents: 221
diff changeset
   182
		 */
claus
parents: 221
diff changeset
   183
		instsize = OHDR_SIZE + nindexedinstvars;
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
   184
		if (__CanDoQuickNew(instsize)) {        /* OBJECT ALLOCATION */
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
   185
		    __qCheckedNew(newobj, instsize);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   186
		    __InstPtr(newobj)->o_class = self;
249
claus
parents: 221
diff changeset
   187
		    RETURN (newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   188
		}
249
claus
parents: 221
diff changeset
   189
	    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   190
	    nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
249
claus
parents: 221
diff changeset
   191
	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   192
	    __PROTECT_CONTEXT__
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
   193
	    __qNew(newobj, instsize);   /* OBJECT ALLOCATION */
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   194
	    __UNPROTECT_CONTEXT__
281
d63a7d2c31a6 *** empty log message ***
claus
parents: 249
diff changeset
   195
	    if (newobj != nil) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   196
		__InstPtr(newobj)->o_class = self;
367
a2114577b799 *** empty log message ***
claus
parents: 362
diff changeset
   197
		__qSTORE(newobj, self);
249
claus
parents: 221
diff changeset
   198
		if (nInstVars) {
claus
parents: 221
diff changeset
   199
		    /*
claus
parents: 221
diff changeset
   200
		     * still have to nil out named instvars ...
claus
parents: 221
diff changeset
   201
		     */
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   202
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   203
		    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   204
#else
249
claus
parents: 221
diff changeset
   205
# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)
claus
parents: 221
diff changeset
   206
		    /*
claus
parents: 221
diff changeset
   207
		     * knowing that nil is 0
claus
parents: 221
diff changeset
   208
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   209
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
249
claus
parents: 221
diff changeset
   210
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   211
		    op = __InstPtr(newobj)->i_instvars;
249
claus
parents: 221
diff changeset
   212
		    while (nInstVars--)
claus
parents: 221
diff changeset
   213
			*op++ = nil;
claus
parents: 221
diff changeset
   214
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   216
		}
249
claus
parents: 221
diff changeset
   217
		RETURN ( newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   218
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   219
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   220
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   223
    (anInteger isMemberOf:SmallInteger) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   224
	(anInteger < 0) ifTrue:[
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   225
	    ^ self error:'bad (negative) argument to new'
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   226
	].
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   227
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   228
	 memory allocation failed.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   229
	 When we arrive here, there was no memory, even after
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   230
	 a garbage collect. This means, that the VM wanted to
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   231
	 get some more memory from the Operatingsystem, which
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   232
	 was not kind enough to give some.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   233
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   234
	^ ObjectMemory allocationFailureSignal raise.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   235
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
    ^ self basicNew:anInteger
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   237
!
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   238
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   239
with:aByteArray from:start to:stop
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   240
    "return new instance with a copy of aByteArray
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   241
     beginning at index start up to and including index stop"
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   242
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   243
    |len bytes|
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   244
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   245
    len := stop-start+1.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   246
    bytes := self new:len.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   247
    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:start.
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   248
    ^ bytes
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   249
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
   250
    "Modified: / 5.3.1998 / 16:00:18 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   252
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   253
!ByteArray class methodsFor:'binary storage'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   255
binaryDefinitionFrom: stream manager: manager
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   256
    "get a ByteArray from the binary stream.
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   257
     ByteArrays are stored as 4-byte size, followed by the bytes.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   258
     This is only invoked for long bytearrays. 
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   259
     Short ones are stored with 1byte length."
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   260
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   261
    |b len|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   263
    "take care of subclasses ..."
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   264
    self == ByteArray ifTrue:[
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   265
        len  := stream nextNumber:4.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   266
        b := ByteArray uninitializedNew:len.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   267
        stream nextBytes:len into:b startingAt:1.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   268
        ^ b
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   269
    ].
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   270
    ^ super binaryDefinitionFrom:stream manager:manager
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   271
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   272
    "Modified: / 2.11.1997 / 16:19:49 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   273
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   274
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   275
!ByteArray class methodsFor:'queries'!
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   276
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   277
isBuiltInClass
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   278
    "return true if this class is known by the run-time-system.
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   279
     Here, true is returned for myself, false for subclasses."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   280
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   281
    ^ self == ByteArray
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   282
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   283
    "Modified: 23.4.1996 / 15:56:25 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   284
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   285
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   286
!ByteArray methodsFor:'accessing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   287
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   288
basicAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   289
    "return the indexed instance variable with index, anInteger
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   290
     - redefined here to be slighly faster than the default in Object.
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   291
     Q: is it worth the extra code ?"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   292
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   293
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   294
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   295
    REGISTER int indx;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   296
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   297
    REGISTER OBJ cls;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   298
    REGISTER int nIndex;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   299
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   300
    if (__isSmallInteger(index)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   301
	indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   302
	slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   303
	if ((cls = __qClass(slf)) != @global(ByteArray)) {
1384
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   304
	    if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   305
		!= __MASKSMALLINT(BYTEARRAY)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   306
		goto fail;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   307
	    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   308
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   309
	}
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   310
	nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   311
	if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   312
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   313
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   314
    }
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   315
  fail: ;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   316
%}.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   317
    ^ super basicAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   318
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   319
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   320
basicAt:index put:value
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   321
    "set the indexed instance variable with index, anInteger to value.
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   322
     Returns value (sigh).
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   323
     - redefined here to be slighly faster than the default in Object.
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   324
     Q: is it worth the extra code ?"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   325
a27a279701f8 Initial revision
claus
parents:
diff changeset
   326
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   327
a27a279701f8 Initial revision
claus
parents:
diff changeset
   328
    REGISTER int indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   329
    int nIndex;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   330
    int val;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   331
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   332
    REGISTER OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   333
249
claus
parents: 221
diff changeset
   334
    if (__bothSmallInteger(index, value)) {
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   335
	val = __intVal(value);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   336
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   337
	    indx = __intVal(index) - 1;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   338
	    slf = self;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   339
	    if ((cls = __qClass(slf)) != @global(ByteArray)) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   340
		if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   341
		    != __MASKSMALLINT(BYTEARRAY)) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   342
		    goto fail;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   343
		}
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   344
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   345
	    }
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   346
	    nIndex = __byteArraySize(slf);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   347
	    if ((unsigned)indx < (unsigned)nIndex) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   348
		__ByteArrayInstPtr(slf)->ba_element[indx] = val;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   349
		RETURN ( value );
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   350
	    }
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
   351
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   352
    }
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   353
  fail: ;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   354
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   355
    ^ super basicAt:index put:value
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   356
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   357
    "Modified: 19.4.1996 / 11:14:40 / cg"
2
claus
parents: 1
diff changeset
   358
!
claus
parents: 1
diff changeset
   359
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   360
byteAt:index
249
claus
parents: 221
diff changeset
   361
    "return the byte at index. 
claus
parents: 221
diff changeset
   362
     For ByteArray, this is the same as basicAt:; 
claus
parents: 221
diff changeset
   363
     however, for strings or symbols, this returns a numeric byteValue
claus
parents: 221
diff changeset
   364
     instead of a character."
claus
parents: 221
diff changeset
   365
claus
parents: 221
diff changeset
   366
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   367
claus
parents: 221
diff changeset
   368
    REGISTER int indx;
claus
parents: 221
diff changeset
   369
    int nIndex;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   370
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   371
    REGISTER OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   372
249
claus
parents: 221
diff changeset
   373
    if (__isSmallInteger(index)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   374
	indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   375
	slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   376
	if ((cls = __qClass(slf)) != @global(ByteArray))
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   377
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   378
	nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   379
	if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   380
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
249
claus
parents: 221
diff changeset
   381
	}
claus
parents: 221
diff changeset
   382
    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   383
%}.
249
claus
parents: 221
diff changeset
   384
    ^ (super basicAt:index) asInteger
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   385
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   386
249
claus
parents: 221
diff changeset
   387
byteAt:index put:value
claus
parents: 221
diff changeset
   388
    "set the byte at index. For ByteArray, this is the same as basicAt:put:.
claus
parents: 221
diff changeset
   389
     However, for Strings, this expects a byteValue to be stored."
claus
parents: 221
diff changeset
   390
claus
parents: 221
diff changeset
   391
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   392
claus
parents: 221
diff changeset
   393
    REGISTER int indx;
claus
parents: 221
diff changeset
   394
    int nIndex;
claus
parents: 221
diff changeset
   395
    int val;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   396
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   397
    REGISTER OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   398
249
claus
parents: 221
diff changeset
   399
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   400
	val = __intVal(value);
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   401
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   402
	    indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   403
	    slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   404
	    if ((cls = __qClass(slf)) != ByteArray)
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   405
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   406
	    nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   407
	    if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   408
		__ByteArrayInstPtr(slf)->ba_element[indx] = val;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   409
		RETURN ( value );
249
claus
parents: 221
diff changeset
   410
	    }
claus
parents: 221
diff changeset
   411
	}
claus
parents: 221
diff changeset
   412
    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   413
%}.
249
claus
parents: 221
diff changeset
   414
    ^ super basicAt:index put:value
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   415
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   416
2
claus
parents: 1
diff changeset
   417
doubleWordAt:index
claus
parents: 1
diff changeset
   418
    "return the 4-bytes starting at index as an (unsigned) Integer.
359
claus
parents: 343
diff changeset
   419
     The value is retrieved in the machines natural byte order.
claus
parents: 343
diff changeset
   420
     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"
claus
parents: 343
diff changeset
   421
claus
parents: 343
diff changeset
   422
%{  /* NOCONTEXT */
claus
parents: 343
diff changeset
   423
claus
parents: 343
diff changeset
   424
    REGISTER int indx;
claus
parents: 343
diff changeset
   425
    int nIndex;
claus
parents: 343
diff changeset
   426
    union {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   427
	unsigned char u_char[4];
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   428
	unsigned int u_uint;
359
claus
parents: 343
diff changeset
   429
    } val;
claus
parents: 343
diff changeset
   430
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   431
    unsigned char *byteP;
359
claus
parents: 343
diff changeset
   432
claus
parents: 343
diff changeset
   433
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   434
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   435
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   436
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   437
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   438
	    nIndex = __byteArraySize(self);
claus
parents: 343
diff changeset
   439
	    if ((indx+3) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   440
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   441
#if defined(i386) || defined(UNALIGNED_FETCH_OK)
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   442
		val.u_uint = ((unsigned int *)(byteP))[0];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   443
#else
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   444
		if (((unsigned INT)byteP & 3) == 0) {
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   445
		    /* aligned fetch */
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   446
		    val.u_uint = ((unsigned int *)(byteP))[0];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   447
		} else {
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   448
		    /* unaligned fetch */
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   449
		    val.u_char[0] = byteP[0];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   450
		    val.u_char[1] = byteP[1];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   451
		    val.u_char[2] = byteP[2];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   452
		    val.u_char[3] = byteP[3];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   453
		}
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   454
#endif
359
claus
parents: 343
diff changeset
   455
		if ((val.u_uint >= 0) && (val.u_uint <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   456
		    RETURN ( __MKSMALLINT(val.u_uint) );
359
claus
parents: 343
diff changeset
   457
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   458
		RETURN ( __MKULARGEINT(val.u_uint) );
359
claus
parents: 343
diff changeset
   459
	    }
claus
parents: 343
diff changeset
   460
	}
claus
parents: 343
diff changeset
   461
    }
claus
parents: 343
diff changeset
   462
%}.
claus
parents: 343
diff changeset
   463
    ^ SubscriptOutOfBoundsSignal raise.
claus
parents: 343
diff changeset
   464
claus
parents: 343
diff changeset
   465
    "
claus
parents: 343
diff changeset
   466
     |b|
claus
parents: 343
diff changeset
   467
claus
parents: 343
diff changeset
   468
     b := ByteArray withAll:#(1 2 3 4).
claus
parents: 343
diff changeset
   469
     (b doubleWordAt:1) printStringRadix:16   
claus
parents: 343
diff changeset
   470
    "
claus
parents: 343
diff changeset
   471
!
claus
parents: 343
diff changeset
   472
claus
parents: 343
diff changeset
   473
doubleWordAt:index MSB:msb
claus
parents: 343
diff changeset
   474
    "return the 4-bytes starting at index as an (unsigned) Integer.
claus
parents: 343
diff changeset
   475
     The value is retrieved MSB-first, if the msb-arg is true;
claus
parents: 343
diff changeset
   476
     LSB-first otherwise.
claus
parents: 343
diff changeset
   477
     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"
2
claus
parents: 1
diff changeset
   478
claus
parents: 1
diff changeset
   479
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   480
claus
parents: 1
diff changeset
   481
    REGISTER int indx;
claus
parents: 1
diff changeset
   482
    int nIndex;
claus
parents: 1
diff changeset
   483
    int val;
249
claus
parents: 221
diff changeset
   484
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   485
    unsigned char *byteP;
2
claus
parents: 1
diff changeset
   486
249
claus
parents: 221
diff changeset
   487
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   488
	indx = __intVal(index);
249
claus
parents: 221
diff changeset
   489
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   490
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   491
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
249
claus
parents: 221
diff changeset
   492
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   493
	    if ((indx+3) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   494
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
359
claus
parents: 343
diff changeset
   495
		if (msb == true) {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   496
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   497
		     * most significant byte first (i.e sparc order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   498
		     */
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   499
		    val = byteP[0];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   500
		    val = (val << 8) + byteP[1];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   501
		    val = (val << 8) + byteP[2];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   502
		    val = (val << 8) + byteP[3];
359
claus
parents: 343
diff changeset
   503
		} else {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   504
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   505
		     * least significant byte first (i.e i386/alpha order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   506
		     */
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   507
#if  defined(i386) /* actually: LSBFIRST && UNALIGNED_FETCH_OK*/
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   508
		    val = ((int *)byteP)[0];
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   509
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   510
		    val = byteP[3];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   511
		    val = (val << 8) + byteP[2];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   512
		    val = (val << 8) + byteP[1];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   513
		    val = (val << 8) + byteP[0];
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   514
#endif
359
claus
parents: 343
diff changeset
   515
		}
249
claus
parents: 221
diff changeset
   516
		if ((val >= 0) && (val <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   517
		    RETURN ( __MKSMALLINT(val) );
249
claus
parents: 221
diff changeset
   518
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   519
		RETURN ( __MKULARGEINT(val) );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   520
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   521
	}
2
claus
parents: 1
diff changeset
   522
    }
359
claus
parents: 343
diff changeset
   523
%}.
claus
parents: 343
diff changeset
   524
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   525
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   526
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   527
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   528
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   529
     b := ByteArray withAll:#(1 2 3 4).
359
claus
parents: 343
diff changeset
   530
     (b doubleWordAt:1 MSB:true) printStringRadix:16.   
claus
parents: 343
diff changeset
   531
     (b doubleWordAt:1 MSB:false) printStringRadix:16   
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   532
    "
2
claus
parents: 1
diff changeset
   533
!
claus
parents: 1
diff changeset
   534
claus
parents: 1
diff changeset
   535
doubleWordAt:index put:value
claus
parents: 1
diff changeset
   536
    "set the 4-bytes starting at index from the (unsigned) Integer value.
359
claus
parents: 343
diff changeset
   537
     The value should be in the range 0 to 16rFFFFFFFF
claus
parents: 343
diff changeset
   538
     (for negative values, the stored value is not defined).
claus
parents: 343
diff changeset
   539
     The value is stored in the machines natural byte order.
claus
parents: 343
diff changeset
   540
     Q: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
claus
parents: 343
diff changeset
   541
claus
parents: 343
diff changeset
   542
    |t|
claus
parents: 343
diff changeset
   543
claus
parents: 343
diff changeset
   544
%{  /* NOCONTEXT */
claus
parents: 343
diff changeset
   545
claus
parents: 343
diff changeset
   546
    REGISTER int indx;
claus
parents: 343
diff changeset
   547
    int nIndex;
claus
parents: 343
diff changeset
   548
    union {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   549
	unsigned char u_char[4];
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   550
	unsigned int u_uint;
359
claus
parents: 343
diff changeset
   551
    } val;
claus
parents: 343
diff changeset
   552
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   553
    unsigned char *byteP;
359
claus
parents: 343
diff changeset
   554
claus
parents: 343
diff changeset
   555
    if (__isSmallInteger(index)) {
claus
parents: 343
diff changeset
   556
	if (__isSmallInteger(value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   557
	    val.u_uint = __intVal(value);
359
claus
parents: 343
diff changeset
   558
	} else {
claus
parents: 343
diff changeset
   559
	    val.u_uint = __longIntVal(value);
claus
parents: 343
diff changeset
   560
	    if (val.u_uint == 0) goto error;
claus
parents: 343
diff changeset
   561
	}
claus
parents: 343
diff changeset
   562
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   563
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   564
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   565
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   566
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   567
	    nIndex = __qSize(self) - OHDR_SIZE;
claus
parents: 343
diff changeset
   568
	    if ((indx+3) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   569
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   570
#if defined(i386) || defined(UNALIGNED_FETCH_OK)
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   571
		((unsigned int *)byteP)[0] = val.u_uint; 
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   572
#else
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   573
		if (((unsigned INT)byteP & 3) == 0) {
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   574
		    ((unsigned int *)byteP)[0] = val.u_uint; 
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   575
		} else {
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   576
		    byteP[0] = val.u_char[0];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   577
		    byteP[1] = val.u_char[1];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   578
		    byteP[2] = val.u_char[2];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   579
		    byteP[3] = val.u_char[3];
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   580
		}
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   581
#endif
359
claus
parents: 343
diff changeset
   582
		RETURN ( value );
claus
parents: 343
diff changeset
   583
	    }
claus
parents: 343
diff changeset
   584
	}
claus
parents: 343
diff changeset
   585
    }
claus
parents: 343
diff changeset
   586
  error: ;
claus
parents: 343
diff changeset
   587
%}.
claus
parents: 343
diff changeset
   588
    ^ SubscriptOutOfBoundsSignal raise.
claus
parents: 343
diff changeset
   589
claus
parents: 343
diff changeset
   590
    "
claus
parents: 343
diff changeset
   591
     |b|
claus
parents: 343
diff changeset
   592
     b := ByteArray new:4.
claus
parents: 343
diff changeset
   593
     b doubleWordAt:1 put:16r04030201.
claus
parents: 343
diff changeset
   594
     b inspect
claus
parents: 343
diff changeset
   595
    "
claus
parents: 343
diff changeset
   596
!
claus
parents: 343
diff changeset
   597
claus
parents: 343
diff changeset
   598
doubleWordAt:index put:value MSB:msb
claus
parents: 343
diff changeset
   599
    "set the 4-bytes starting at index from the (unsigned) Integer value.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   600
     The value must be in the range 0 to 16rFFFFFFFF.
359
claus
parents: 343
diff changeset
   601
     The value is stored MSB-first if msb is true; LSB-first otherwise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   602
     question: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
2
claus
parents: 1
diff changeset
   603
claus
parents: 1
diff changeset
   604
    |t|
claus
parents: 1
diff changeset
   605
claus
parents: 1
diff changeset
   606
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   607
claus
parents: 1
diff changeset
   608
    REGISTER int indx;
claus
parents: 1
diff changeset
   609
    int nIndex;
claus
parents: 1
diff changeset
   610
    int val;
249
claus
parents: 221
diff changeset
   611
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   612
    unsigned char *byteP;
2
claus
parents: 1
diff changeset
   613
359
claus
parents: 343
diff changeset
   614
    if (__isSmallInteger(index)) {
claus
parents: 343
diff changeset
   615
	if (__isSmallInteger(value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   616
	    val = __intVal(value);
359
claus
parents: 343
diff changeset
   617
	} else {
claus
parents: 343
diff changeset
   618
	    val = __longIntVal(value);
claus
parents: 343
diff changeset
   619
	    if (val == 0) goto error;
claus
parents: 343
diff changeset
   620
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   621
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   622
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   623
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   624
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   625
	    nIndex = __qSize(self) - OHDR_SIZE;
claus
parents: 343
diff changeset
   626
	    if ((indx+3) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   627
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
359
claus
parents: 343
diff changeset
   628
		if (msb == true) {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   629
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   630
		     * most significant byte first (i.e sparc order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   631
		     */
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   632
		    byteP[3] = val & 0xFF;
359
claus
parents: 343
diff changeset
   633
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   634
		    byteP[2] = val & 0xFF;
249
claus
parents: 221
diff changeset
   635
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   636
		    byteP[1] = val & 0xFF;
249
claus
parents: 221
diff changeset
   637
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   638
		    byteP[0] = val & 0xFF;
359
claus
parents: 343
diff changeset
   639
		} else {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   640
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   641
		     * least significant byte first (i.e i386/alpha order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   642
		     */
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   643
#if  defined(i386) /* actually: LSBFIRST && UNALIGNED_FETCH_OK*/
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   644
		    ((int *)byteP)[0] = val;
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   645
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   646
		    byteP[0] = val & 0xFF;
359
claus
parents: 343
diff changeset
   647
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   648
		    byteP[1] = val & 0xFF;
359
claus
parents: 343
diff changeset
   649
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   650
		    byteP[2] = val & 0xFF;
249
claus
parents: 221
diff changeset
   651
		    val >>= 8;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   652
		    byteP[3] = val & 0xFF;
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   653
#endif
249
claus
parents: 221
diff changeset
   654
		}
359
claus
parents: 343
diff changeset
   655
		RETURN ( value );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   656
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   657
	}
2
claus
parents: 1
diff changeset
   658
    }
359
claus
parents: 343
diff changeset
   659
  error: ;
claus
parents: 343
diff changeset
   660
%}.
claus
parents: 343
diff changeset
   661
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   662
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   663
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   664
     |b|
359
claus
parents: 343
diff changeset
   665
     b := ByteArray new:8.
claus
parents: 343
diff changeset
   666
     b doubleWordAt:1 put:16r04030201 MSB:true.
claus
parents: 343
diff changeset
   667
     b doubleWordAt:5 put:16r04030201 MSB:false.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   668
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   669
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   670
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   671
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   672
wordAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   673
    "return the 2-bytes starting at index as an (unsigned) Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   674
     The value is retrieved in the machines natural byte order
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   675
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   676
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   677
%{  /* NOCONTEXT */
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   678
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   679
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   680
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   681
    union {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   682
	unsigned char u_char[2];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   683
	unsigned short u_ushort;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   684
    } val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   685
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   686
    unsigned char *byteP;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   687
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   688
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   689
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   690
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   691
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   692
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   693
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   694
	    if ((indx+1) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   695
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   696
#if defined(i386) || defined(UNALIGNED_FETCH_OK)
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   697
		val.u_ushort = ((unsigned short *)byteP)[0]; 
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   698
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   699
		val.u_char[0] = byteP[0];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   700
		val.u_char[1] = byteP[1];
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   701
#endif
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   702
		RETURN ( __MKSMALLINT(val.u_ushort) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   703
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   704
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   705
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   706
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   707
    ^ SubscriptOutOfBoundsSignal raise.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   708
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   709
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   710
wordAt:index MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   711
    "return the 2-bytes starting at index as an (unsigned) Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   712
     The value is retrieved MSB (high 8 bits at lower index) if msb is true;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   713
     LSB-first (i.e. low 8-bits at lower byte index) if its false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   714
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   715
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   716
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   717
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   718
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   719
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   720
    int val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   721
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   722
    unsigned char *byteP;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   723
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   724
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   725
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   726
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   727
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   728
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   729
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   730
	    if ((indx+1) <= nIndex) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   731
		byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   732
		if (msb == true) {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   733
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   734
		     * most significant byte first (i.e sparc order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   735
		     */
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   736
		    val = byteP[0];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   737
		    val = (val << 8) + byteP[1];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   738
		} else {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   739
		    /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   740
		     * least significant byte first (i.e i386/alpha order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   741
		     */
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   742
#if  defined(i386) /* actually: LSBFIRST && UNALIGNED_FETCH_OK*/
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   743
		    val = ((unsigned short *)byteP)[0];
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   744
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   745
		    val = byteP[1];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   746
		    val = (val << 8) + byteP[0];
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   747
#endif
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   748
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   749
		RETURN ( __MKSMALLINT(val) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   750
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   751
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   752
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   753
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   754
    ^ SubscriptOutOfBoundsSignal raise.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   755
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   756
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   757
wordAt:index put:value
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   758
    "set the 2-bytes starting at index from the (unsigned) Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   759
     The stored value must be in the range 0 .. 16rFFFF. 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   760
     The value is stored in the machines natural byteorder.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   761
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   762
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   763
%{  /* NOCONTEXT */
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   764
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   765
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   766
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   767
    int v;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   768
    union {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   769
	unsigned char u_char[2];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   770
	unsigned short u_ushort;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   771
    } val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   772
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   773
    unsigned char *byteP;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   774
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   775
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   776
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   777
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   778
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   779
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   780
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   781
	    if ((indx+1) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   782
		val.u_ushort = v = __intVal(value);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   783
		if ((v & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   784
		    byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   785
#if defined(i386) || defined(UNALIGNED_FETCH_OK)
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   786
		    ((unsigned short *)byteP)[0] = val.u_ushort;
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   787
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   788
		    byteP[0] = val.u_char[0];
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   789
		    byteP[1] = val.u_char[1];
3422
09c13ab58bb2 i386 can do unaligned accesses
Claus Gittinger <cg@exept.de>
parents: 3345
diff changeset
   790
#endif
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   791
		    RETURN ( value );
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   792
		}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   793
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   794
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   795
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   796
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   797
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   798
	^ self elementBoundsError
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   799
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   800
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   801
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   802
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   803
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   804
     b := ByteArray new:4.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   805
     b wordAt:1 put:16r0102.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   806
     b wordAt:3 put:16r0304.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   807
     b inspect  
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   808
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   809
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   810
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   811
wordAt:index put:value MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   812
    "set the 2-bytes starting at index from the (unsigned) Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   813
     The stored value must be in the range 0 .. 16rFFFF. 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   814
     The value is stored LSB-first (i.e. the low 8bits are stored at the
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   815
     lower index) if msb is false, MSB-first otherwise.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   816
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   817
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   818
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   819
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   820
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   821
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   822
    int val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   823
    OBJ cls;
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   824
    unsigned char *byteP;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   825
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   826
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   827
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   828
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   829
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   830
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   831
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   832
	    if ((indx+1) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   833
		val = __intVal(value);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   834
		if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   835
		    byteP = (unsigned char *)(__ByteArrayInstPtr(self)->ba_element) + indx - 1;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   836
		    if (msb == true) {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   837
		        /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   838
		         * most significant byte first (i.e sparc order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   839
		         */
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   840
			byteP[1] = val & 0xFF;
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   841
			byteP[0] = (val>>8) & 0xFF;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   842
		    } else {
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   843
		        /*
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   844
		         * least significant byte first (i.e i386/alpha order)
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   845
		         */
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   846
#if  defined(i386) /* actually: LSBFIRST && UNALIGNED_FETCH_OK*/
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   847
		        ((unsigned short *)byteP)[0] = val;
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   848
#else
2950
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   849
			byteP[0] = val & 0xFF;
d5fae0fb75d7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2915
diff changeset
   850
			byteP[1] = (val>>8) & 0xFF;
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
   851
#endif
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   852
		    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   853
		    RETURN ( value );
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   854
		}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   855
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   856
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   857
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   858
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   859
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   860
	^ self elementBoundsError
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   861
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   862
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   863
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   864
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   865
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   866
     b := ByteArray new:8.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   867
     b wordAt:1 put:16r0102 MSB:false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   868
     b wordAt:3 put:16r0304 MSB:false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   869
     b wordAt:5 put:16r0102 MSB:true.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   870
     b wordAt:7 put:16r0304 MSB:true.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   871
     b inspect  
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   872
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   873
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   874
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   875
!ByteArray methodsFor:'binary storage'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   876
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   877
storeBinaryDefinitionOn:stream manager:manager
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   878
    "append a binary representation of the receiver onto stream.
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   879
     Redefined since short ByteArrays can be stored with a special type code
1261
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
   880
     in a more compact way.
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   881
     This is an internal interface for the binary storage mechanism."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   882
2464
e44ab57ff8ae dont convert bytes
Claus Gittinger <cg@exept.de>
parents: 2447
diff changeset
   883
    |myClass myBasicSize|
e44ab57ff8ae dont convert bytes
Claus Gittinger <cg@exept.de>
parents: 2447
diff changeset
   884
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   885
    "not, if I have named instance variables"
2464
e44ab57ff8ae dont convert bytes
Claus Gittinger <cg@exept.de>
parents: 2447
diff changeset
   886
    (myClass := self class) instSize ~~ 0 ifTrue:[
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   887
        ^ super storeBinaryDefinitionOn:stream manager:manager
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   888
    ].
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   889
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   890
    myBasicSize := self basicSize.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   891
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   892
    "/ can use a more compact representation;
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   893
    "/ but not for subclasses ...
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   894
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   895
    ((myClass == ByteArray) 
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   896
    and:[myBasicSize <= 255]) ifTrue:[
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   897
        "/ special encoding: <codeForByteArray> <len> <bytes> ...
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   898
        stream nextPut:(manager codeForByteArray); nextPut:myBasicSize.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   899
    ] ifFalse:[
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   900
        manager putIdOfClass:myClass on:stream.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   901
        stream nextNumber:4 put:myBasicSize.
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   902
    ].
2464
e44ab57ff8ae dont convert bytes
Claus Gittinger <cg@exept.de>
parents: 2447
diff changeset
   903
    stream nextPutBytes:myBasicSize from:self startingAt:1.
1261
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
   904
3071
ddf7118d466c binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 2950
diff changeset
   905
    "Modified: / 2.11.1997 / 15:28:45 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   906
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   907
3345
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   908
!ByteArray methodsFor:'comparing'!
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   909
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   910
= aByteArray
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   911
    "Compare the receiver with the argument and return true if the
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   912
     receiver is equal to the argument (i.e. has the same size and elements).
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   913
     Otherwise return false."
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   914
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   915
%{  /* NOCONTEXT */
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   916
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   917
    int l1, l2;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   918
    REGISTER OBJ s = aByteArray;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   919
    unsigned char *cp1, *cp2;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   920
    OBJ cls;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   921
    OBJ myCls;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   922
    INT addrDelta;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   923
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   924
    if (s == self) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   925
        RETURN ( true );
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   926
    }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   927
    if (! __isNonNilObject(s)) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   928
        RETURN ( false );
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   929
    }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   930
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   931
    cls = __qClass(s);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   932
    myCls = __qClass(self);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   933
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   934
    if (cls == myCls) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   935
        cp2 = __stringVal(s);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   936
        l2 = __byteArraySize(s);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   937
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   938
        cp1 = __stringVal(self);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   939
        l1 = __byteArraySize(self);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   940
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   941
        if (l1 != l2) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   942
            RETURN ( false );
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   943
        }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   944
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   945
        /*
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   946
         * care for instances of subclasses ...
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   947
         */
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   948
        if (cls != ByteArray) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   949
            int n = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   950
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   951
            cp2 += n;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   952
            cp1 += n;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   953
            l1 -= n;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   954
        }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   955
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   956
        addrDelta = cp2 - cp1;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   957
        while (l1 >= sizeof(unsigned INT)) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   958
            if (*((unsigned INT *)cp1) != *((unsigned INT *)(cp1+addrDelta))) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   959
                RETURN (false);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   960
            }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   961
            l1 -= sizeof(unsigned INT);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   962
            cp1 += sizeof(unsigned INT);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   963
        }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   964
        if (l1 >= sizeof(unsigned short)) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   965
            if (*((unsigned short *)cp1) != *((unsigned short *)(cp1+addrDelta))) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   966
                RETURN (false);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   967
            }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   968
            l1 -= sizeof(unsigned short);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   969
            cp1 += sizeof(unsigned short);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   970
        }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   971
        while (l1) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   972
            if (*cp1 != *(cp1+addrDelta)) {
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   973
                RETURN (false);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   974
            }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   975
            l1--;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   976
            cp1++;
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   977
        }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   978
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   979
        RETURN (true);
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   980
    }
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   981
%}.
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   982
    ^ super = aByteArray
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   983
! !
6cbaa948a813 added tuned version of #=
Claus Gittinger <cg@exept.de>
parents: 3325
diff changeset
   984
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   985
!ByteArray methodsFor:'converting'!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   986
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   987
asByteArray
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   988
    "return the receiver as a byteArray"
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   989
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   990
    "could be an instance of a subclass..."
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   991
    self class == ByteArray ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   992
	^ self
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   993
    ].
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   994
    ^ super asByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   995
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   996
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   997
     'hello world' asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   998
     #(1 2 3 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   999
     #(1 2 256 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1000
    "
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1001
! !
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1002
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1003
!ByteArray methodsFor:'copying'!
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1004
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1005
copyFrom:start to:stop
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1006
    "return the subcollection starting at index start, anInteger and ending
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1007
     at stop, anInteger.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1008
     - reimplemented here for speed"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1009
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1010
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1011
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1012
    REGISTER unsigned char *srcp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1013
    REGISTER unsigned char *dstp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1014
    REGISTER int count;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1015
    int len, index1, index2, sz;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1016
    OBJ newByteArray;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1017
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1018
    if (__isByteArray(self)
249
claus
parents: 221
diff changeset
  1019
     && __bothSmallInteger(start, stop)) {
claus
parents: 221
diff changeset
  1020
	len = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1021
	index1 = __intVal(start);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1022
	index2 = __intVal(stop);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1023
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1024
	if ((index1 <= index2) && (index1 > 0)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1025
	    if (index2 <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1026
		count = index2 - index1 + 1;
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1027
		__PROTECT_CONTEXT__
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1028
		sz = OHDR_SIZE + count;
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1029
		__qNew(newByteArray, sz);       /* OBJECT ALLOCATION */
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1030
		__UNPROTECT_CONTEXT__
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1031
		if (newByteArray != nil) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1032
		    __InstPtr(newByteArray)->o_class = ByteArray;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1033
		    dstp = __ByteArrayInstPtr(newByteArray)->ba_element;
2648
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1034
		    srcp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1035
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1036
#ifdef bcopy4
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1037
		    if ((((unsigned INT)srcp & 3) == 0)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1038
		     && (((unsigned INT)dstp & 3) == 0)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1039
			/* copy aligned part */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1040
			int nW = count >> 2;
2648
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1041
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1042
			if (count & 3) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1043
			    nW++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1044
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1045
			bcopy4(srcp, dstp, nW);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1046
			RETURN ( newByteArray );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1047
		    }
2648
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1048
#endif /* bcopy4 */
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1049
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1050
#ifdef FAST_MEMCPY
2648
a544a64491a7 better use of bcopy4
Claus Gittinger <cg@exept.de>
parents: 2585
diff changeset
  1051
		    bcopy(srcp, dstp, count);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1052
#else
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1053
		    while (count--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1054
			*dstp++ = *srcp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1055
		    }
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1056
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1057
		    RETURN ( newByteArray );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1058
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1059
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1060
	}
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1061
    }
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1062
%}.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1063
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1064
     fall back in case of non-integer index or out-of-bound index;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1065
     will eventually lead to an out-of-bound signal raise
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1066
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1067
    ^ super copyFrom:start to:stop
3325
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1068
!
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1069
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1070
symbolFrom:start to:stop
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1071
    "make a symbol from the characters of the subcollection starting 
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1072
     at index start, anInteger and ending at stop, anInteger.
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1073
     This saves us garbage and character copying."
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1074
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1075
    |sym|
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1076
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1077
%{  /* STACK:1024 */
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1078
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1079
    REGISTER unsigned char *srcp;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1080
    REGISTER unsigned char *endp;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1081
    REGISTER int count;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1082
    int len, index1, index2;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1083
    unsigned char s[1024], savec;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1084
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1085
    if (__isByteArray(self) && __bothSmallInteger(start, stop)) {
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1086
        len = __byteArraySize(self);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1087
        index1 = __intVal(start);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1088
        index2 = __intVal(stop);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1089
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1090
        if ((index1 <= index2) && (index1 > 0) && (index2 <= len)) {
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1091
            count = index2 - index1 + 1;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1092
            srcp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1093
            if (index2 < len) {
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1094
                /* temporarily stuff in a '\0' */
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1095
                endp = srcp + count + 1;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1096
                savec = *endp;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1097
                *endp = '\0';
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1098
                sym = __MKSYMBOL(srcp, 0);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1099
                endp = __ByteArrayInstPtr(self)->ba_element + index1 + count;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1100
                *endp = savec;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1101
            } else if (count < sizeof(s)) {
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1102
                /* not enough space for '\0', copy the bytes */
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1103
                bcopy(srcp, s, count);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1104
                s[count] = '\0';
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1105
                sym = __MKSYMBOL(s, 0);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1106
            }
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1107
        }
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1108
        if (sym != nil)
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1109
            RETURN(sym);
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1110
    }
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1111
%}.
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1112
    "
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1113
     fall back in case of non-integer index or out-of-bound index
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1114
     or no memory available;
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1115
     will eventually lead to an out-of-bound signal raise
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1116
    "
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1117
    ^ (super copyFrom:start to:stop) asString asSymbol
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1118
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1119
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1120
    "
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1121
     'abcdefghijklmnop' symbolFrom:1 to:3
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1122
     'abcdefghijklmnop' symbolFrom:3 to:16
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1123
     'abcdefghijklmnop' symbolFrom:3 to:17
e958a341f41d Add #from: and #with:form:to class methods.
Stefan Vogel <sv@exept.de>
parents: 3234
diff changeset
  1124
    "
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1125
! !
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1126
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1127
!ByteArray methodsFor:'filling and replacing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1128
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1129
from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1130
    "fill part of the receiver with aNumber.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1131
     - reimplemented here for speed"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1132
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1133
%{  /* NOCONTEXT */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1134
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1135
    REGISTER unsigned char *dstp;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1136
    REGISTER int count, value;
249
claus
parents: 221
diff changeset
  1137
    int len, index1, index2;
claus
parents: 221
diff changeset
  1138
    OBJ cls;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1139
249
claus
parents: 221
diff changeset
  1140
    if (__isSmallInteger(aNumber)
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1141
     && __bothSmallInteger(start, stop)
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1142
     && __isBytes(self)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1143
	len = __byteArraySize(self);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1144
	index1 = __intVal(start);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1145
	index2 = __intVal(stop);
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1146
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1147
	dstp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1148
	if ((cls = __qClass(self)) != @global(ByteArray)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1149
	    int nInst;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1150
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1151
	    nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1152
	    dstp += nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1153
	    len -= nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1154
	}
249
claus
parents: 221
diff changeset
  1155
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1156
	value = __intVal(aNumber);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1157
	if (((unsigned)value <= 0xFF) /* i.e. (value >= 0) && (value <= 255) */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1158
	 && (index1 <= index2) 
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1159
	 && (index1 > 0)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1160
	    if (index2 <= len) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1161
		count = index2 - index1 + 1;
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1162
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1163
#ifdef memset4
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1164
		if (count > 20) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1165
		    while (((unsigned INT)dstp & 3) != 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1166
			*dstp++ = value;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1167
			count--;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1168
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1169
		    {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1170
			int n4 = count & ~3;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1171
			int v4, nW;
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1172
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1173
			v4 = (value << 8) | value;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1174
			v4 = (v4 << 16) | v4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1175
			nW = n4>>2;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1176
			memset4(dstp, v4, nW);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1177
			count -= n4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1178
			dstp += n4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1179
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1180
		    while (count--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1181
			*dstp++ = value;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1182
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1183
		    RETURN (self);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1184
		}
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1185
#endif /* memset4 */
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1186
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1187
#ifdef FAST_MEMSET
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1188
		memset(dstp, value, count);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1189
#else
422
claus
parents: 395
diff changeset
  1190
# ifdef UNROLL_LOOPS
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1191
		while (count >= 8) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1192
		    dstp[0] = dstp[1] = dstp[2] = dstp[3] =
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1193
		    dstp[4] = dstp[5] = dstp[6] = dstp[7] = value;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1194
		    dstp += 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1195
		    count -= 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1196
		}
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1197
# endif /* UNROLL_LOOPS */
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1198
		while (count--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1199
		    *dstp++ = value;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1200
		}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1201
#endif
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1202
		RETURN (self);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1203
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1204
	}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1205
    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1206
%}.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1207
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1208
     fall back in case of non-integer index or out-of-bound index/value;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1209
     will eventually lead to an out-of-bound signal raise
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1210
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1211
    ^ super from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1212
!
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1213
249
claus
parents: 221
diff changeset
  1214
replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
claus
parents: 221
diff changeset
  1215
    "replace elements from another collection, which must be a ByteArray
claus
parents: 221
diff changeset
  1216
     or String."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1217
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1218
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1219
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1220
    int nIndex, repNIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1221
    int startIndex, stopIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1222
    REGISTER unsigned char *src;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1223
    REGISTER int repStartIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1224
    int repStopIndex, count;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1225
    REGISTER unsigned char *dst;
249
claus
parents: 221
diff changeset
  1226
    OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1227
2894
344aec8ba014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2890
diff changeset
  1228
#ifndef NO_PRIM_BYTEARR
249
claus
parents: 221
diff changeset
  1229
    if (__isBytes(aCollection)
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1230
     && __isBytes(self)
249
claus
parents: 221
diff changeset
  1231
     && __bothSmallInteger(start, stop)
claus
parents: 221
diff changeset
  1232
     && __isSmallInteger(repStart)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1233
	startIndex = __intVal(start) - 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1234
	if (startIndex >= 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1235
	    dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1236
	    nIndex = __byteArraySize(self);
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1237
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1238
	    if ((cls = __qClass(self)) != @global(ByteArray)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1239
		int nInst;
249
claus
parents: 221
diff changeset
  1240
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1241
		nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1242
		dst += nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1243
		nIndex -= nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1244
	    }
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1245
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1246
	    stopIndex = __intVal(stop) - 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1247
	    count = stopIndex - startIndex + 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1248
	    if (count == 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1249
		RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1250
	    }
249
claus
parents: 221
diff changeset
  1251
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1252
	    if ((count > 0) && (stopIndex < nIndex)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1253
		repStartIndex = __intVal(repStart) - 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1254
		if (repStartIndex >= 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1255
		    repNIndex = __qSize(aCollection) - OHDR_SIZE;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1256
		    src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1257
		    if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1258
			int nInst;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1259
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1260
			nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1261
			src += nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1262
			repNIndex -= nInst;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1263
		    }
249
claus
parents: 221
diff changeset
  1264
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1265
		    repStopIndex = repStartIndex + (stopIndex - startIndex);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1266
		    if (repStopIndex < repNIndex) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1267
			if (aCollection == self) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1268
			    /* take care of overlapping copy */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1269
			    if (src < dst) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1270
				/* must do a reverse copy */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1271
				src += count;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1272
				dst += count;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1273
				while (count-- > 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1274
				    *--dst = *--src;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1275
				}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1276
				RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1277
			    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1278
			}
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1279
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1280
#ifdef bcopy4
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1281
			if ((((unsigned INT)src & 3) == 0)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1282
			 && (((unsigned INT)dst & 3) == 0)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1283
			    /* copy aligned part */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1284
			    int nW = count >> 2;
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1285
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1286
			    bcopy4(src, dst, nW);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1287
			    if ((count = count & 3) != 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1288
				/* copy any remaining part */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1289
				src += (nW<<2);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1290
				dst += (nW<<2);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1291
				while (count--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1292
				    *dst++ = *src++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1293
				}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1294
			    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1295
			    RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1296
			}
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1297
#endif /* bcopy4 */
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1298
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1299
#ifdef FAST_MEMCPY
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1300
			bcopy(src, dst, count);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1301
#else
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1302
# ifdef UNROLL_LOOPS
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1303
			while (count >= 8) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1304
			    dst[0] = src[0]; dst[1] = src[1];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1305
			    dst[2] = src[2]; dst[3] = src[3];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1306
			    dst[4] = src[4]; dst[5] = src[5];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1307
			    dst[6] = src[6]; dst[7] = src[7];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1308
			    dst += 8; src += 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1309
			    count -= 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1310
			}
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1311
# endif /* UNROLL_LOOPS */
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1312
			while (count-- > 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1313
			    *dst++ = *src++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1314
			}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1315
#endif
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1316
			RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1317
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1318
		}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1319
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1320
	}
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1321
    }
2894
344aec8ba014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2890
diff changeset
  1322
#endif
437
claus
parents: 422
diff changeset
  1323
%}.
claus
parents: 422
diff changeset
  1324
    "
claus
parents: 422
diff changeset
  1325
     fall back in case of non-ByteArray argument,
claus
parents: 422
diff changeset
  1326
     or for the error report if any index is invalid
claus
parents: 422
diff changeset
  1327
    "
claus
parents: 422
diff changeset
  1328
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1329
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1330
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1331
replaceFrom:start to:stop with:aCollection startingAt:repStart
1169
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1332
    "replace elements in the receiver between index start and stop,
3234
4cc58bc6a8ed comment
Claus Gittinger <cg@exept.de>
parents: 3210
diff changeset
  1333
     with elements  taken from replacementCollection starting at repStart.
4cc58bc6a8ed comment
Claus Gittinger <cg@exept.de>
parents: 3210
diff changeset
  1334
     Return the receiver."
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1335
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1336
    (aCollection class == self class) ifTrue:[
3234
4cc58bc6a8ed comment
Claus Gittinger <cg@exept.de>
parents: 3210
diff changeset
  1337
        ^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1338
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1339
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
1169
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1340
3234
4cc58bc6a8ed comment
Claus Gittinger <cg@exept.de>
parents: 3210
diff changeset
  1341
    "Modified: / 28.1.1998 / 16:48:46 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1342
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1343
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1344
!ByteArray methodsFor:'image manipulation support'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1345
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1346
compressPixels:nBitsPerPixel width:width height:height into:aByteArray mapping:aMapByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1347
    "given the receiver with 8-bit pixels, compress them into aByteArray
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1348
     with nBitsPerPixel-depth pixels. The width/height-arguments are needed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1349
     to allow for any padding. On the fly, the source bytes are translated
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1350
     using aMapByteArray (if non-nil).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1351
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1352
     value of n is found in map at:(n + 1).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1353
     Output bits are filled left-to right, i.e. the first byte in the input
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1354
     corresponds to the high bit(s) if the first byte in the input.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1355
     This method can be used to convert 8-bit image data to mono, 2-bit and 4-bit 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1356
     bitmaps.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1357
     It can also be used to compress byte-arrays into bitArrays."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1358
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1359
%{  /* NOCONTEXT */
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1360
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1361
    REGISTER unsigned char *src, *dst;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1362
    REGISTER int wrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1363
    unsigned char *dstNext;
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1364
    unsigned char *dstEnd;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1365
    int bytesPerRow, mask, shift0, shift;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1366
    int w, h, hrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1367
    int srcBytes, dstBytes;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1368
    int bitsPerPixel;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1369
    int bits;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1370
    int ncells;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1371
    unsigned char *map;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1372
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1373
    if ((__qClass(self) == @global(ByteArray)) 
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1374
     && (__qClass(aByteArray) == @global(ByteArray))
249
claus
parents: 221
diff changeset
  1375
     && __isSmallInteger(nBitsPerPixel)
claus
parents: 221
diff changeset
  1376
     && __bothSmallInteger(height, width)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1377
	if ((aMapByteArray != nil)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1378
	 && (__Class(aMapByteArray) == @global(ByteArray))) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1379
	    map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1380
	} else {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1381
	    map = (unsigned char *)0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1382
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1383
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1384
	bitsPerPixel = __intVal(nBitsPerPixel);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1385
	w = __intVal(width);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1386
	h = __intVal(height);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1387
	src = __ByteArrayInstPtr(self)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1388
	dst = __ByteArrayInstPtr(aByteArray)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1389
	dstEnd = dst + __byteArraySize(aByteArray);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1390
	switch (bitsPerPixel) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1391
	    case 1:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1392
		mask = 0x01;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1393
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1394
	    case 2:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1395
		mask = 0x03;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1396
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1397
	    case 4:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1398
		mask = 0x0F;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1399
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1400
	    case 8:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1401
		mask = 0xFF;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1402
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1403
	    default:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1404
		printf("invalid depth in compressPixels\n");
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1405
		goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1406
	}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1407
	if (map) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1408
	    /*
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1409
	     * if a map is present, it must have entries for
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1410
	     * all possible byte-values (i.e. its size must be >= 256)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1411
	     */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1412
	    if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1413
		printf("invalid map in compressPixels\n");
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1414
		goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1415
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1416
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1417
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1418
	bytesPerRow = (w * bitsPerPixel + 7) / 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1419
	dstBytes = bytesPerRow * h;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1420
	srcBytes = w * h;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1421
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1422
	if ((__byteArraySize(self) >= srcBytes)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1423
	 && (__byteArraySize(aByteArray) >= dstBytes)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1424
	    for (hrun=h; hrun; hrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1425
		dstNext = dst + bytesPerRow;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1426
		bits = 0; shift = 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1427
		if (map) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1428
		    for (wrun=w; wrun; wrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1429
			bits = (bits << bitsPerPixel) | (map[*src++] & mask);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1430
			shift -= bitsPerPixel;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1431
			if (shift == 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1432
			    if (dst == dstEnd) goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1433
			    *dst++ = bits;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1434
			    bits = 0; shift = 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1435
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1436
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1437
		} else {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1438
		    for (wrun=w; wrun; wrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1439
			bits = (bits << bitsPerPixel) | (*src++ & mask);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1440
			shift -= bitsPerPixel;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1441
			if (shift == 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1442
			    if (dst == dstEnd) goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1443
			    *dst++ = bits;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1444
			    bits = 0; shift = 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1445
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1446
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1447
		}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1448
		if (shift != 8) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1449
		    if (dst == dstEnd) goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1450
		    *dst = bits;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1451
		}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1452
		dst = dstNext;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1453
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1454
	    RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1455
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1456
    }
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1457
fail: ;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1458
%}.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1459
    self primitiveFailed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1460
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1461
    "Example1:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1462
     compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1463
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1464
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1465
     |inBits outBits|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1466
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1467
     inBits := #[0 0 0 0 1 1 1 1
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1468
		 0 0 1 1 0 0 1 1
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1469
		 0 1 0 1 0 1 0 1
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1470
		 1 1 1 1 0 0 0 0].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1471
     outBits := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1472
     inBits compressPixels:1 width:8 height:4
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1473
		    into:outBits mapping:nil.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1474
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1475
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1476
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1477
    "Example2:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1478
     compress byte-array into a bitArray, translating 99 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1479
     and 176 to 1-bits. (just a stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1480
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1481
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1482
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1483
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1484
     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1485
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1486
     map at:176+1 put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1487
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1488
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1489
     inBits compressPixels:1 width:16 height:1 
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1490
		    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1491
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1492
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1493
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1494
    "Example3:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1495
     compress byte-array into a bitArray, translating everything below 128 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1496
     and 128 to 255 to 1-bits.99 to 0-bits (another stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1497
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1498
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1499
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1500
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1501
     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1502
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1503
     map atAll:(128+1 to:255+1) put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1504
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1505
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1506
     inBits compressPixels:1 width:16 height:1 
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1507
		    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1508
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1509
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1510
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1511
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1512
expandPixels:nBitsPerPixel width:width height:height into:aByteArray mapping:aMapByteArray
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1513
    "given the receiver with nBitsPerPixel-depth pixels, expand them into
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1514
     aByteArray with 8-bit pixels. The width/height-arguments are needed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1515
     to skip any padded src-bits. On the fly, the destination pixels
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1516
     are translated using aMapByteArray (if non-nil).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1517
     Input bits are read left-to right, i.e. the first byte in the output
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1518
     corresponds to the high bit(s) in the inputs first byte.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1519
     This is used to display mono, 2-bit and 4-bit bitmaps on grey-scale/color
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1520
     machines. With nBitsPerPixel==8, this is a translate operation.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1521
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1522
     value of n is found in map at:(n + 1).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1523
     It can also be used to expand bit-arrays into byteArrays.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1524
     This method is specialized for ByteArray arguments - it will not handle
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1525
     anything else."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1526
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1527
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1528
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1529
    REGISTER unsigned char *src, *dst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1530
    REGISTER int wrun;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1531
    unsigned char *srcNext;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1532
    int bytesPerRow, mask, shift0, shift;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1533
    int w, h, hrun;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1534
    int srcBytes, dstBytes;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1535
    int bitsPerPixel;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1536
    int bits;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1537
    int ncells;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1538
    unsigned char *map;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1539
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1540
    if ((__qClass(self) == @global(ByteArray)) 
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1541
     && (__qClass(aByteArray) == @global(ByteArray))
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1542
     && __isSmallInteger(nBitsPerPixel)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1543
     && __bothSmallInteger(height, width)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1544
	if ((aMapByteArray != nil)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1545
	 && (__Class(aMapByteArray) == @global(ByteArray))) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1546
	    map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1547
	} else {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1548
	    map = (unsigned char *)0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1549
	}
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1550
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1551
	bitsPerPixel = __intVal(nBitsPerPixel);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1552
	w = __intVal(width);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1553
	h = __intVal(height);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1554
	src = __ByteArrayInstPtr(self)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1555
	dst = __ByteArrayInstPtr(aByteArray)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1556
	switch (bitsPerPixel) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1557
	    case 1:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1558
		mask = 0x01;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1559
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1560
	    case 2:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1561
		mask = 0x03;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1562
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1563
	    case 4:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1564
		mask = 0x0F;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1565
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1566
	    case 8:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1567
		mask = 0xFF;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1568
		break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1569
	    default:
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1570
		printf("invalid depth in expandPixels\n");
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1571
		goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1572
	}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1573
	ncells = mask + 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1574
	if (map) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1575
	    /*
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1576
	     * if a map is present, it must have the correct size
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1577
	     * (i.e. 2 raisedTo:nBitsPerPixel)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1578
	     */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1579
	    if ((__qSize(aMapByteArray) - OHDR_SIZE) < ncells) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1580
		printf("invalid map in expandPixels\n");
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1581
		goto fail;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1582
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1583
	}
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1584
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1585
	bytesPerRow = (w * bitsPerPixel + 7) / 8;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1586
	shift0 = 8 - bitsPerPixel;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1587
	srcBytes = bytesPerRow * h;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1588
	dstBytes = w * h;
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1589
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1590
	if ((__byteArraySize(self) >= srcBytes)
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1591
	 && (__byteArraySize(aByteArray) >= dstBytes)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1592
	    for (hrun=h; hrun; hrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1593
		srcNext = src + bytesPerRow;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1594
		shift = shift0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1595
		if (map) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1596
		    if (shift0 == 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1597
			/* translate only */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1598
			for (wrun=w; wrun; wrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1599
			    bits = *src++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1600
			    *dst++ = map[bits];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1601
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1602
		    } else {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1603
			for (wrun=w; wrun; wrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1604
			    if (shift == shift0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1605
				bits = *src++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1606
			    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1607
			    *dst++ = map[(bits >> shift) & mask];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1608
			    shift -= bitsPerPixel;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1609
			    if (shift < 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1610
				shift = shift0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1611
			    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1612
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1613
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1614
		} else {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1615
		    for (wrun=w; wrun; wrun--) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1616
			if (shift == shift0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1617
			    bits = *src++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1618
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1619
			*dst++ = (bits >> shift) & mask;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1620
			shift -= bitsPerPixel;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1621
			if (shift < 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1622
			    shift = shift0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1623
			}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1624
		    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1625
		}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1626
		src = srcNext;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1627
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1628
	    RETURN ( self );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1629
	}
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1630
    }
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1631
    printf("invalid args\n");
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1632
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1633
fail: ;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1634
%}.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1635
    self primitiveFailed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1636
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1637
    "Example1:
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1638
     expand 1-bit-per-pixel bitmap into a 1byte-per-pixel byteArray
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1639
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1640
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1641
     |inBits outBits|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1642
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1643
     inBits := #[2r11110000 
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1644
		 2r11001100 
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1645
		 2r01010101 
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1646
		 2r00001111].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1647
     outBits := ByteArray new:(8*4).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1648
     inBits expandPixels:1 width:8 height:4
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1649
		    into:outBits mapping:nil.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1650
     outBits inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1651
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1652
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1653
    "Example2:
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1654
     expand bit-array into a byteArray, translating 0-bits to 99,
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1655
     1-bits to 176. (just a stupid example)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1656
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1657
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1658
     |inBits outBits|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1659
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1660
     inBits := #[2r11110000 2r11001100].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1661
     outBits := ByteArray new:16.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1662
     inBits expandPixels:1 width:16 height:1 
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1663
		    into:outBits mapping:#[99 176].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1664
     outBits inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1665
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1666
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1667
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1668
invert
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1669
    "invert all bytes - used with image manipulations
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1670
     written as a primitive for speed.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1671
     Q: is this really needed ?"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1672
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1673
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1674
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1675
    REGISTER unsigned char *dst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1676
    REGISTER unsigned long *ldst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1677
    REGISTER int cnt;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1678
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1679
    if (__qClass(self) == @global(ByteArray)) {
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1680
	cnt = __byteArraySize(self);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1681
	dst = __ByteArrayInstPtr(self)->ba_element;
2768
8827d8c188df alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2648
diff changeset
  1682
	if (! ((INT)dst & (sizeof(long)-1))) {
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1683
	    ldst = (unsigned long *)dst;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1684
	    while (cnt > 16) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1685
		ldst[0] = ~(ldst[0]);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1686
		ldst[1] = ~(ldst[1]);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1687
		ldst[2] = ~(ldst[2]);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1688
		ldst[3] = ~(ldst[3]);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1689
		ldst += 4;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1690
		cnt -= 16;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1691
	    }
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1692
	    while (cnt >= sizeof(long)) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1693
		*ldst = ~(*ldst);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1694
		ldst++;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1695
		cnt -= sizeof(long);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1696
	    }
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1697
	    dst = (unsigned char *)ldst;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1698
	}
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1699
	while (cnt--) {
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1700
	    *dst = ~(*dst);
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1701
	    dst++;
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1702
	}
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1703
	RETURN ( self );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1704
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1705
%}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1706
.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1707
    self primitiveFailed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1708
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1709
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1710
reverse
2585
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1711
    "reverse the order of my elements inplace - 
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1712
     written as a primitive for speed on image manipulations (mirror)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1713
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1714
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1715
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1716
    REGISTER unsigned char *p1, *p2;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1717
    REGISTER int cnt;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1718
    REGISTER unsigned t;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1719
    OBJ cls;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1720
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1721
    if (__qClass(self) == @global(ByteArray)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1722
	cnt = __byteArraySize(self);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1723
	p1 = __ByteArrayInstPtr(self)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1724
	p2 = p1 + cnt - 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1725
	while (p1 < p2) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1726
	    t = *p1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1727
	    *p1++ = *p2;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1728
	    *p2-- = t;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1729
	}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1730
	RETURN ( self );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1731
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1732
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1733
    ^ super reverse
2585
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1734
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1735
    "
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1736
     #[1 2 3 4 5] reverse
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1737
     #[1 2 3 4] reverse
6c25622320aa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2579
diff changeset
  1738
    "
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1739
!
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1740
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1741
swapBytes
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1742
    "swap bytes inplace - 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1743
     written as a primitive for speed on image grabbing (if display order is different)"
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1744
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1745
%{  /* NOCONTEXT */
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1746
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1747
    REGISTER unsigned char *p;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1748
    REGISTER int cnt;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1749
    REGISTER unsigned t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1750
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1751
    if (__qClass(self) == @global(ByteArray)) {
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1752
	cnt = __byteArraySize(self);
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1753
	cnt = cnt & ~1; /* make it even */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1754
	p = __ByteArrayInstPtr(self)->ba_element;
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1755
	while (cnt > 0) {
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1756
	    t = p[0];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1757
	    p[0] = p[1];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1758
	    p[1] = t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1759
	    p += 2;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1760
	    cnt -= 2;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1761
	}
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1762
	RETURN ( self );
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1763
    }
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1764
%}.
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1765
    ^ super swapBytes "/ rubbish - there is no one currenly
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1766
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1767
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1768
     #[1 2 3 4 5 6 7 8 9 10] copy swapBytes 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1769
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapBytes  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1770
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1771
!
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1772
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1773
swapLongs
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1774
    "swap long bytes inplace - any partial longs at the end
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1775
     are not swapped.
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1776
     written as a primitive for speed on image grabbing 
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  1777
     (if display order is different)"
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1778
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1779
%{  /* NOCONTEXT */
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1780
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1781
    REGISTER unsigned char *p;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1782
    REGISTER int cnt;
931
Claus Gittinger <cg@exept.de>
parents: 930
diff changeset
  1783
    REGISTER unsigned t;
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1784
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1785
    if (__qClass(self) == @global(ByteArray)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1786
	cnt = __byteArraySize(self);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1787
	cnt = cnt & ~3; /* make it even */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1788
	p = __ByteArrayInstPtr(self)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1789
	while (cnt > 0) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1790
	    t = p[0];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1791
	    p[0] = p[3];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1792
	    p[3] = t;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1793
	    t = p[1];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1794
	    p[1] = p[2];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1795
	    p[2] = t;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1796
	    p += 4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1797
	    cnt -= 4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1798
	}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1799
	RETURN ( self );
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1800
    }
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1801
%}.
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1802
    ^ super swapLongs "/ rubbish - there is no one currenly
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1803
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1804
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1805
     #[1 2 3 4 5 6 7 8 9] copy swapLongs 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1806
     #[1 2 3 4 5 6 7 8 9 10] copy swapLongs 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1807
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapLongs  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1808
     #[1 2 3 4 5 6 7 8 9 10 11 12] copy swapLongs  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1809
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1810
! !
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1811
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1812
!ByteArray methodsFor:'printing & storing'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1813
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1814
asPackedString
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1815
    "ST-80 compatibility: encode the receiver into an ascii String
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1816
     with 6bits encoded per character. Each group of 6 bits is encoded
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1817
     as a corresponding character (32+value) and the resulting string
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1818
     is returned. The resulting string is always a multiple of 4 (since
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1819
     24 is the lcm of 6 and 8) and the number of remaining characters is
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1820
     encoded in the last character.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1821
     ST-80 uses this encoding for Images ...
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1822
     PS: I dont like it ;-)"
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1823
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1824
    |outStream 
1974
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1825
     index     "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1826
     nextIndex "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1827
     stop      "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1828
     n         "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1829
     mod       "{ Class:SmallInteger}"|
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1830
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1831
    outStream := WriteStream on:String new.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1832
    index := 1. 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1833
    stop := self size.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1834
    [index <= stop] whileTrue:[
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1835
	"take 3 source bytes"
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1836
	n := (self at:index) bitShift:16.
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1837
	(index < stop) ifTrue:[
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1838
	    nextIndex := index + 1.
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1839
	    n := n bitOr:((self at:nextIndex) bitShift:8).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1840
	    (nextIndex < stop) ifTrue:[
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1841
		n := n bitOr:(self at:(index + 2)).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1842
	    ].
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1843
	].
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1844
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1845
	"took me a while to find that one out ..."
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1846
	n := n bitXor:16r820820.
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1847
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1848
	outStream nextPut:(Character value:(n bitShift:-18) + 32).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1849
	outStream nextPut:(Character value:((n bitShift:-12) bitAnd:16r3F) + 32).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1850
	outStream nextPut:(Character value:((n bitShift:-6) bitAnd:16r3F) + 32).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1851
	outStream nextPut:(Character value:(n bitAnd:16r3F) + 32).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1852
	index := index + 3.
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1853
    ].
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1854
    (mod := stop \\ 3) ~~ 0 ifTrue:[
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1855
	outStream position:(outStream position - 1).
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1856
	outStream nextPut:(Character value:(mod + 96)).
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1857
    ].
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1858
    ^ outStream contents
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1859
1974
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1860
    "Modified: 12.11.1996 / 15:45:02 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1861
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1862
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1863
displayString
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1864
    "return a printed representation of the receiver for displaying"
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1865
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1866
    ^ self storeString
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1867
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1868
    "Created: 25.10.1995 / 13:33:26 / cg"
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1869
    "Modified: 22.4.1996 / 12:54:06 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1870
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1871
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1872
storeOn:aStream
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1873
    "append a printed representation from which the receiver can be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1874
     reconstructed to aStream. (reimplemented to make it look better)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1875
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1876
    self class == ByteArray ifTrue:[    "/ care for subclasses
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1877
	aStream nextPutAll:'#['.
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1878
	self 
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1879
	    do:[:byte | byte storeOn:aStream]
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1880
	    separatedBy:[aStream space].
2579
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1881
	aStream nextPutAll:']'.
7e0783458c2f much faster #from:to:put: and #replaceBytes on i386 platforms
Claus Gittinger <cg@exept.de>
parents: 2464
diff changeset
  1882
	^ self
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1883
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1884
    ^ super storeOn:aStream
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1885
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1886
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1887
     #[1 2 3 4 5] storeOn:Transcript   
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1888
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1889
     #[1 2 3 4 5] storeString            
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1890
     #[1 2 3 4 5] displayString        
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1891
     #[1 2 3 4 5] printString         
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1892
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1893
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  1894
    "Modified: 12.9.1997 / 22:11:33 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1895
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1896
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1897
!ByteArray methodsFor:'queries'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1898
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1899
indexOf:aByte startingAt:start
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1900
    "return the index of the first occurrence of the argument, aByte
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1901
     in the receiver starting at start, anInteger; return 0 if not found.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1902
     - reimplemented here for speed"
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1903
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1904
%{  /* NOCONTEXT */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1905
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1906
    REGISTER unsigned char *cp;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1907
    REGISTER int index, byteValue;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1908
    REGISTER int len;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1909
    OBJ cls;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1910
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1911
    if (__isSmallInteger(aByte) &&__isBytes(self)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1912
	byteValue = __intVal(aByte);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1913
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1914
	if (byteValue & ~0xFF /* i.e. (byteValue < 0) || (byteValue > 255) */) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1915
	    /*
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1916
	     * searching for something which cannot be found
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1917
	     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1918
	    RETURN ( __MKSMALLINT(0) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1919
	}
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1920
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1921
	if (__isSmallInteger(start)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1922
	    index = __intVal(start);
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1923
	    len = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1924
	    cp = __ByteArrayInstPtr(self)->ba_element;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1925
	    if ((cls = __qClass(self)) != @global(ByteArray)) {
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1926
		int nInst;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1927
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1928
		nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1929
		cp += nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1930
		len -= nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1931
	    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1932
	    cp += index - 1;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1933
	    while (index <= len) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1934
		if (*cp == byteValue) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1935
		    RETURN ( __MKSMALLINT(index) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1936
		}
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1937
		index++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1938
		cp++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1939
	    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1940
	    RETURN ( __MKSMALLINT(0) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1941
	}
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1942
    }
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1943
%}.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1944
    ^ super indexOf:aByte startingAt:start
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1945
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1946
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1947
     #[1 2 3 4 5 6 7 8 9 0 1 2 3 4 5] indexOf:0 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1948
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1949
!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1950
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1951
isLiteral
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1952
    "return true, if the receiver can be used as a literal
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1953
     (i.e. can be used in constant arrays)"
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1954
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1955
    "/ no, simply returning true here is a mistake:
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1956
    "/ it could be a subclass of ByteArray 
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1957
    "/ (of which the compiler does not know at all ...)
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1958
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1959
    ^ self class == ByteArray
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1960
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  1961
    "Modified: 22.4.1996 / 12:55:30 / cg"
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1962
!
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1963
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1964
max
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1965
    "return the maximum value in the receiver -
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1966
     redefined to speedup image processing and sound-player 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1967
     (which need a fast method for this on byteArrays)"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1968
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1969
%{  /* NOCONTEXT */
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1970
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1971
    REGISTER unsigned char *cp;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1972
    REGISTER int index, max;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1973
    int len;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1974
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1975
    if (__qClass(self) == @global(ByteArray)) {
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1976
	max = 0;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1977
	index = 0;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1978
	len = __qSize(self) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1979
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1980
	while (++index <= len) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1981
	    if (*cp > max) max = *cp;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1982
	    cp++;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1983
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1984
	RETURN ( __MKSMALLINT(max) );
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1985
    }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1986
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1987
    ^ super max
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1988
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1989
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1990
     #[1 2 3 1 2 3 1 2 19] max 
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1991
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1992
! !
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1993
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1994
!ByteArray methodsFor:'special queries'!
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1995
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1996
usageCounts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1997
    "return an array filled with value-counts -
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1998
     This is needed in the bitmap/image classes to get info on color usage.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1999
     (i.e. to build up a histogram of color usage within an image)."
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2000
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2001
    |counts|
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2002
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2003
    counts := Array basicNew:256.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2004
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2005
%{  /* STACK: 2000 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2006
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2007
    REGISTER unsigned char *cp;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2008
    REGISTER int nByte;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2009
    REGISTER int index;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2010
    int icounts[256];
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2011
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2012
    if ((__qClass(self) == @global(ByteArray)) && __isArray(counts)) {
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2013
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2014
	 * zero counts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2015
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2016
	for (index=0; index<256; index++) {
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2017
	    icounts[index] = 0;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2018
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2019
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2020
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2021
	 * count
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2022
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2023
	nByte = __qSize(self) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2024
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2025
	while (nByte--) {
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2026
	    icounts[*cp++]++;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2027
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2028
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2029
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2030
	 * make it real counts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2031
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2032
	for (index=0; index<256; index++) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2033
	    __ArrayInstPtr(counts)->a_element[index] = __MKSMALLINT(icounts[index]);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2034
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2035
	RETURN ( counts );
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2036
    }
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2037
%}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2038
.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2039
    self primitiveFailed
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2040
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2041
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2042
     #[1 2 3 1 2 3 1 2 250 251 250 251 255] usageCounts 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2043
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2044
!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2045
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2046
usedValues
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2047
    "return a new ByteArray with all used values (actually a kind of Set);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2048
     This is needed specially in the bitmap/Imageclasses to find used colors 
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2049
     of an image."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2050
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2051
%{  /* STACK: 400 */
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2052
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2053
    REGISTER unsigned char *cp;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2054
    unsigned char *endp;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2055
    REGISTER int len;
2890
fa0418a0f896 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2866
diff changeset
  2056
    OBJ result;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2057
    union {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2058
	unsigned char flags[256];
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2059
	int toForceAlignmentOfFlags;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2060
    } f;
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2061
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2062
#ifdef TO_BE_MEASURED
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2063
    int coverage = 0;
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2064
#endif
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2065
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2066
    if (__qClass(self) == @global(ByteArray)) {
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2067
	memset(f.flags, 0, sizeof(f.flags));
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2068
	len = __qSize(self) - OHDR_SIZE;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2069
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2070
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2071
	/* for each used byte, set flag */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2072
	while (len > 0) {
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2073
#ifdef TO_BE_MEASURED
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2074
	    unsigned  byte;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2075
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2076
	    byte = *cp;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2077
	    if (! f.flags[byte]) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2078
		f.flags[byte] = 1;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2079
		coverage++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2080
		if (coverage == 256) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2081
		    /* no need to scan rest */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2082
		    break;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2083
		}
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2084
	    }
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2085
#else
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2086
	    f.flags[*cp] = 1;
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2087
#endif
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2088
	    cp++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2089
	    len--;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2090
	}
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2091
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2092
	/* count 1's */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2093
	len = 0;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2094
	for (cp=f.flags, endp=f.flags+256; cp < endp;) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2095
	    if ( *((unsigned int *)cp)) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2096
		if (cp[0]) len++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2097
		if (cp[1]) len++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2098
		if (cp[2]) len++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2099
		if (cp[3]) len++;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2100
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2101
	    cp += 4;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2102
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2103
2915
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2104
	/* create ByteArray of used values */
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2105
	result = __BYTEARRAY_UNINITIALIZED_NEW_INT(len);
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2106
	if (result) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2107
	    cp = __ByteArrayInstPtr(result)->ba_element;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2108
	    for (len=0; len < 256; len++) {
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2109
		if (f.flags[len]) 
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2110
		    *cp++ = len;
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2111
	    }
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2112
	    RETURN ( result );
fdfc6c64bf60 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2898
diff changeset
  2113
	}
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2114
    }
2866
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2115
%}.
0d1b10026aa8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2782
diff changeset
  2116
    ^ self asIdentitySet asByteArray
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2117
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2118
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2119
     #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues 
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2120
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2121
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2122
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2123
!ByteArray class methodsFor:'documentation'!
628
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2124
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2125
version
3425
f7faef75f0d8 tuned word & doubleWord access for i386
Claus Gittinger <cg@exept.de>
parents: 3422
diff changeset
  2126
    ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.99 1998-05-08 10:29:18 cg Exp $'
628
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2127
! !