"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

CharacterArray subclass:#String

       instanceVariableNames:''

       classVariableNames:''

       poolDictionaries:''

       category:'Collections-Text'

!

String comment:'

COPYRIGHT (c) 1988 by Claus Gittinger

	     All Rights Reserved

'!

!String class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    Strings are ByteArrays storing Characters.

    Strings are kind of kludgy: to allow for easy handling by c-functions,

    there is always one 0-byte added at the end, which is not counted

    in size. also, the at:put: method does not allow for storing 0-bytes.

    (to do this, the basicAt:put: and basicNew: methods are redefined)

    You cannot add any instvars to String, since the the run time system & compiler

    creates literal strings and knows that strings have no named instvars.

    If you really need strings with instVars, you have to create a subclass 

    of String (the access functions defined here can handle this).

    A little warning though: not all smalltalk systems allow subclassing String,

    so your program may become unportable if you do so.

"

! !

!String primitiveDefinitions!

%{

#include <stdio.h>

#include <ctype.h>

/*

 * old st/x creates strings with spaces in it;

 * new st/x will fill it with zeros (for st-80 compatibility)

 * the define below sets old behavior.

 */

#define INITIALIZE_WITH_SPACE

%}

! !

!String class methodsFor:'queries'!

isBuiltInClass

    "this class is known by the run-time-system"

    ^ self == String

! !

!String class methodsFor:'instance creation'!

basicNew:anInteger

    "return a new empty string with anInteger characters"

%{  /* NOCONTEXT */

    OBJ newString;

    REGISTER int len;

    REGISTER unsigned char *cp;

    REGISTER OBJ *op;

    int nInstVars, instsize;

    extern OBJ new();

    if (__isSmallInteger(anInteger)) {

	len = _intVal(anInteger);

	if (len >= 0) {

	    if (self == String) {

		instsize = OHDR_SIZE + len + 1;

		if (_CanDoQuickNew(instsize)) {

		    /*

		     * the most common case

		     */

		    _qCheckedNew(newString, instsize);

		    _InstPtr(newString)->o_class = self;

		    cp = _stringVal(newString);

#ifdef FAST_MEMSET

		    memset(cp, ' ', len);

		    *(cp + len) = '\0';

#else

		    while (len >= 8) {

			cp[0] = cp[1] = cp[2] = cp[3] = ' ';

			cp[4] = cp[5] = cp[6] = cp[7] = ' ';

			cp += 8; 

			len -= 8;

		    }

		    while (len--)

			*cp++ = ' ';

		    *cp = '\0';

#endif

		    RETURN (newString);

		}

		nInstVars = 0;

	    } else {

		nInstVars = _intVal(_ClassInstPtr(self)->c_ninstvars);

		instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + len + 1;

	    }

	    PROTECT_CONTEXT

	    _qNew(newString, instsize, SENDER);

	    UNPROTECT_CONTEXT

	    if (newString == nil) goto fail;

	    _InstPtr(newString)->o_class = self;

	    if (nInstVars) {

#if defined(memset4)

		memset4(_InstPtr(newString)->i_instvars, nil, nInstVars);

#else

# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)

		/*

		 * knowing that nil is 0

		 */

		memset(_InstPtr(newString)->i_instvars, 0, __OBJS2BYTES__(nInstVars));

# else

		op = _InstPtr(newString)->i_instvars;

		do {

		    *op++ = nil;

		} while (--nInstVars);

# endif

#endif

		cp = _stringVal(newString) + __OBJS2BYTES__(nInstVars);

	    } else {

		cp = _stringVal(newString);

	    }

#ifdef FAST_MEMSET

	    memset(cp, ' ', len);

	    *(cp + len) = '\0';

#else

	    while (len >= 8) {

		cp[0] = cp[1] = cp[2] = cp[3] = ' ';

		cp[4] = cp[5] = cp[6] = cp[7] = ' ';

		cp += 8;

		len -= 8;

	    }

	    while (len--)

		*cp++ = ' ';

	    *cp = '\0';

#endif

	    RETURN (newString);

	}

    }

fail: ;;

%}

.

    "

     invalid argument, or out-of-memory:

     use error handling in superclass

    "

    ^ (super basicNew:anInteger) atAllPut:(Character space)

!

unititializedNew:anInteger

    "redefine it back - strings must have a 0-byte at the end"

    ^ self basicNew:anInteger

! !

!String methodsFor:'accessing'!

basicSize

    "return the number of characters in myself.

     Redefined here to exclude the 0-byte at the end."

%{  /* NOCONTEXT */

    OBJ cls;

    cls = _qClass(self);

    if ((cls == String) || (cls == Symbol)) {

	RETURN ( _MKSMALLINT(_stringSize(self)) );

    }

%}

.

    ^ super basicSize - 1

!

basicAt:index

    "return the character at position index, an Integer

     - reimplemented here since we return characters"

%{  /* NOCONTEXT */

    REGISTER int indx;

    int len;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index);

	cls = _qClass(self);

	if (cls != String)

	    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	len = _stringSize(self);

	if ((indx > 0) && (indx <= len)) {

	    RETURN ( _MKCHARACTER(_stringVal(self)[indx-1] & 0xFF) );

	}

    }

%}.

    ^ self subscriptBoundsError:index

!

basicAt:index put:aCharacter

    "store the argument, aCharacter at position index, an Integer

     - reimplemented here since we store characters"

%{  /* NOCONTEXT */

    REGISTER int value, indx;

    int len;

    OBJ cls;

    if (__isCharacter(aCharacter)) {

	value = _intVal(_characterVal(aCharacter));

	if ((value > 0) 

	 && (value <= 255)

	 && __isSmallInteger(index)) {

	    indx = _intVal(index);

	    cls = _qClass(self);

	    if (cls != String)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    len = _stringSize(self);

	    if ((indx > 0) && (indx <= len)) {

		_stringVal(self)[indx-1] = value;

		RETURN ( aCharacter );

	    }

	}

    }

%}.

    (aCharacter isMemberOf:Character) ifFalse:[

	^ self elementNotCharacter

    ] ifTrue:[

	(aCharacter asciiValue between:1 and:255) ifFalse:[

	    ^ self elementBoundsError

	] ifTrue:[

	    ^ self subscriptBoundsError:index

	]

    ]

! !

!String methodsFor:'converting'!

asSymbol

    "return a unique symbol with name taken from myself.

     The argument must be a String, subclass instances are not allowed."

%{

    if (_qClass(self) == String) {

	RETURN ( _MKSYMBOL(_stringVal(self), (OBJ *)0, __context) );

    }

    self primitiveFailed

! !

!String class methodsFor:'binary storage'!

binaryDefinitionFrom: stream manager: manager

    ^ (stream next: (stream nextNumber: 4)) asString

! !

!String methodsFor:'printing & storing'!

isLiteral

    "return true, if the receiver can be used as a literal

     (i.e. can be used in constant arrays)"

    ^ true

!

print

    "print the receiver on standard output.

     This method does NOT use the stream classes and will therefore work

     even in case of emergency."

%{  /* NOCONTEXT */

    if (_qClass(self) == String) {

	printf("%s", _stringVal(self));

	RETURN (self);

    }

%}

.

    ^ super print

!

printfPrintString:formatString

    "non-portable but sometimes useful.

     Return a printed representation of the receiver as specified by formatString, 

     which is defined by printf.

     No checking on buffer overrun is done.

     This method is NONSTANDARD and may be removed without notice."

%{  /* STACK: 1000 */

    char buffer[800];

    char *cp;

    if (__isString(formatString)) {

	/*

	 * actually only needed on sparc: since thisContext is

	 * in a global register, which gets destroyed by printf,

	 * manually save it here - very stupid ...

	 */

	OBJ sav = __thisContext;

	cp = (char *)_stringVal(self);

	if (_qClass(self) != String)

	    cp += __OBJS2BYTES__(_intVal(_ClassInstPtr(_qClass(self))->c_ninstvars));

	sprintf(buffer, (char *)_stringVal(formatString), cp);

	__thisContext = sav;

	RETURN ( _MKSTRING(buffer COMMA_SND) );

    }

%}

.

    self primitiveFailed

    "'hello' printfPrintString:'%%s -> %s'"

    "'hello' printfPrintString:'%%10s -> %10s'"

    "'hello' printfPrintString:'%%-10s -> %-10s'"

!

storeString

    "return a String for storing myself"

    |s n index|

    n := self occurrencesOf:$'.

    n == 0 ifFalse:[

	s := String new:(n + 2 + self size).

	s at:1 put:$'.

	index := 2.

	self do:[:thisChar |

	    (thisChar == $') ifTrue:[

		s at:index put:thisChar.

		index := index + 1.

	    ].

	    s at:index put:thisChar.

	    index := index + 1.

	].

	s at:index put:$'.

	^ s

    ].

    ^ '''' , self , ''''

!

storeOn:aStream

    "put the storeString of myself on aStream"

    aStream nextPut: $'.

    (self includes:$') ifTrue:[

	self do:[:thisChar |

	    (thisChar == $') ifTrue:[aStream nextPut:thisChar].

	    aStream nextPut:thisChar

	]

    ] ifFalse:[

	aStream nextPutAll:self

    ].

    aStream nextPut:$'

! !

!String methodsFor:'comparing'!

> aString

    "Compare the receiver with the argument and return true if the

     receiver is greater than the argument. Otherwise return false.

     No national variants are honred; use after: for this.

     In contrast to ST-80, case differences are NOT ignored, thus

     'foo' > 'Foo' will return true. 

     This may change."

%{  /* NOCONTEXT */

    int len1, len2, cmp;

    REGISTER OBJ s = aString;

    char *cp1, *cp2;

    OBJ cls;

    if (_isNonNilObject(s)

     && (((cls = _qClass(s)) == String) || (cls == Symbol) || (cls == _qClass(self)))) {

	cp1 = (char *) _stringVal(self);

	len1 = _stringSize(self);

	/*

	 * care for instances of subclasses ...

	 */

	if (_qClass(self) != String) {

	    int n = __OBJS2BYTES__(_intVal(_ClassInstPtr(_qClass(self))->c_ninstvars));

	    cp1 += n;

	    len1 -= n;

	}

	cp2 = (char *) _stringVal(s);

	len2 = _stringSize(s);

	/*

	 * care for instances of subclasses ...

	 */

	if (cls != String) {

	    int n = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    cp2 += n;

	    len2 -= n;

	}

	if (len1 <= len2)

	    cmp = strncmp(cp1, cp2, len1);

	else

	    cmp = strncmp(cp1, cp2, len2);

	if (cmp > 0) {

	    RETURN ( true );

	}

	if ((cmp == 0) && (len1 > len2)) {

	    RETURN ( true );

	}

	RETURN ( false );

    }

%}

.

    ^ super > aString

!

= aString

    "Compare the receiver with the argument and return true if the

     receiver is equal to the argument. Otherwise return false.

     This compare is case-sensitive (i.e. 'Foo' is NOT = 'foo')"

%{  /* NOCONTEXT */

    int l1, l2;

    REGISTER OBJ s = aString;

    char *cp1, *cp2;

    OBJ cls;

    if (s == self) {

	RETURN ( true );

    }

    if (! _isNonNilObject(s)) {

	RETURN ( false );

    }