"

 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 primitiveDefinitions!

%{

#include <stdio.h>

#define _STDIO_H_INCLUDED_

#include <ctype.h>

#ifdef LINUX

# define __STRINGDEFS__

# include <linuxIntern.h>

#else

  extern char *strchr();

#endif

/*

 * 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:'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.

"

!

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 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;

    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;

		    __qSTORE(newString, self);

		    cp = __stringVal(newString);

#if defined(memset4) && !defined(NON_ASCII)

		    instsize = len >> 2;

		    if (len & 3) instsize++;

		    memset4(cp, 0x20202020, instsize);

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

#else

# ifdef FAST_MEMSET

		    memset(cp, ' ', len);

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

# else

		    while (len >= 8) {

#  ifndef NON_ASCII       /* i.e. EBCDIC ;-) */

			((int *)cp)[0] = 0x20202020;

			((int *)cp)[1] = 0x20202020;

#  else

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

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

#  endif

			cp += 8; 

			len -= 8;

		    }

		    while (len--)

			*cp++ = ' ';

		    *cp = '\0';

# endif

#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;

	    __qSTORE(newString, 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) {

# ifndef NON_ASCII       /* i.e. EBCDIC ;-) */

		((int *)cp)[0] = 0x20202020;

		((int *)cp)[1] = 0x20202020;

# else

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

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

# endif

		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)

!

new:n

    ^ self basicNew:n

!

readFrom:aStream onError:exceptionBlock

    "read & return the next String from the (character-)stream aStream;

     skipping all whitespace first; return the value of exceptionBlock,

     if no string can be read. The sequence of characters as read from the 

     stream must be one as stored via storeOn: or storeString."

    |collected char|

    "

     this method is not to be inherited

     (i.e. not ok for subclasses; Symbol, for example)

    "

    self ~~ String ifTrue:[

	^ super readFrom:aStream onError:exceptionBlock

    ].

    "skip whiteSpace"

    aStream skipSeparators.

    (aStream next == $') ifTrue:[

	collected := WriteStream on:(String new).

	[true] whileTrue:[

	    aStream atEnd ifTrue:[

		"/ mhmh - reached the end without a closing quote

		"/ looks like an error to me ...

		^ exceptionBlock value

	    ].

	    char := aStream next.

	    char == $' ifTrue:[

		"/ look for another quote

		aStream peek == $' ifFalse:[

		    ^ collected contents

		].

		aStream next.

	    ].

	    collected nextPut:char

	]

    ].

    ^ exceptionBlock value

    "

     String readFrom:('''hello world''' readStream) 

     String readFrom:('''hello '''' world''' readStream) 

     String readFrom:('1 ''hello'' ' readStream)

     String readFrom:('1 ''hello'' ' readStream) onError:['foobar']  

    "  

!

unititializedNew:anInteger

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

    ^ self basicNew:anInteger

! !

!String class methodsFor:'binary storage'!

binaryDefinitionFrom:stream manager:manager

    "read a binary representation from stream."

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

! !

!String class methodsFor:'queries'!

isBuiltInClass

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

    ^ self == String

! !

!String methodsFor:'accessing'!

at:index

    "return the character at position index, an Integer.

     Reimplemented here to avoid the additional at:->basicAt: send

     (which we can do here, since at: is obviously not redefined in a subclass).

     This method is the same as at:."

%{  /* NOCONTEXT */

    REGISTER int indx;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index);

	if (indx > 0) {

	    cls = __qClass(self);

	    if (cls != String)

		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));

	    if (indx <= (__stringSize(self))) {

		RETURN ( __MKCHARACTER(__stringVal(self)[indx-1] & 0xFF) );

	    }

	}

    }

%}.

    ^ self subscriptBoundsError:index

!

at:index put:aCharacter

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

     Reimplemented here to avoid the additional at:put:->basicAt:put: send

     (but only for Strings, since subclasses may redefine basicAt:put:).

     This method is the same as basicAt:put:."

%{  /* NOCONTEXT */

    REGISTER int value, indx;

    if (__isString(self)) {

	if (__isCharacter(aCharacter)) {

	    value = __intVal(_characterVal(aCharacter));

#ifdef OLD

	    if ((value > 0) 

	     && (value <= 255)

#else

	    if (((value & ~0xFF) == 0)

#endif

	     && __isSmallInteger(index)) {

		indx = __intVal(index);

		if (indx > 0) {

		    if (indx <= (__stringSize(self))) {

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

			RETURN ( aCharacter );

		    }

		}

	    }

	}

    }

%}.

    (self isMemberOf:String) ifFalse:[

	^ super at:index put:aCharacter

    ].

    (aCharacter isMemberOf:Character) ifFalse:[

	"

	 tried to store something which is not a character

	"

	^ self elementNotCharacter

    ].

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

	"

	 tried to store a multibyte character

	"

	^ self elementBoundsError

    ].

    "

     invalid index

    "

    ^ self subscriptBoundsError:index

!

basicAt:index

    "return the character at position index, an Integer

     - reimplemented here since we return characters"

%{  /* NOCONTEXT */

    REGISTER int indx;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index);

	if (indx > 0) {

	    cls = __qClass(self);

	    if (cls != String)

		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));

	    if (indx <= (__stringSize(self))) {

		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

     (but only for Strings, since subclasses may redefine basicAt:put:)."

%{  /* NOCONTEXT */

    REGISTER int value, indx;

    if (__isString(self)) {

	if (__isCharacter(aCharacter)) {

	    value = __intVal(_characterVal(aCharacter));

	    if ((value > 0) 

	     && (value <= 255)

	     && __isSmallInteger(index)) {

		indx = __intVal(index);

		if (indx > 0) {

		    if (indx <= (__stringSize(self))) {

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

			RETURN ( aCharacter );

		    }

		}

	    }

	}

    }

%}.

    (self isMemberOf:String) ifFalse:[

	^ super basicAt:index put:aCharacter

    ].

    (aCharacter isMemberOf:Character) ifFalse:[

	"

	 tried to store something which is not a character

	"

	^ self elementNotCharacter

    ].

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

	"

	 tried to store a multibyte character

	"

	^ self elementBoundsError

    ].

    "

     invalid index

    "

    ^ self subscriptBoundsError:index

!

basicSize

    "return the number of characters in myself.

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

%{  /* NOCONTEXT */

    REGISTER OBJ cls;

    cls = __qClass(self);

    if (cls == String) {

	RETURN ( __MKSMALLINT(__stringSize(self)) );

    }

    RETURN ( __MKSMALLINT(__stringSize(self)

			 - __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));

%}

!

size

    "return the number of characters in myself.

     Reimplemented here to avoid the additional size->basicSize send

     (which we can do here, since size is obviously not redefined in a subclass).

     This method is the same as basicSize."

%{  /* NOCONTEXT */

    REGISTER OBJ cls;

    cls = __qClass(self);

    if (cls == String) {

	RETURN ( __MKSMALLINT(__stringSize(self)) );

    }

    RETURN ( __MKSMALLINT(__stringSize(self)

			 - __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));

%}

! !

!String ignoredMethodsFor:'binary storage'!

storeBinaryOn:stream manager:manager

    "append a binary representation of the receiver onto stream.

     Redefined to store short Strings in a more compact way with a

     special type code."

    |sz "{ Class: SmallInteger }"|

    sz := self size.

    "not, if I am a thingy of a subclass"

    ((self class ~~ String) or:[sz > 255]) ifTrue:[

	^ super storeBinaryOn:stream manager:manager

    ].

    stream nextPut:manager codeForString.

    stream nextPut:sz.

    1 to:sz do:[:index |

	stream nextPut:(self basicAt:index) asciiValue

    ]

! !

!String methodsFor:'character searching'!

includes:aCharacter

    "return true if the argument, aCharacter is included in the receiver

     - reimplemented here for speed"

%{  /* NOCONTEXT */

    REGISTER unsigned char *cp;

    REGISTER int byteValue;

    OBJ cls;