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