"

 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.

"

"{ Package: 'stx:libbasic' }"

CharacterArray variableByteSubclass:#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>

#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

#ifdef FAST_MEMCHR

 char *memchr();

#endif

%}

! !

!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 the strings size, and is not accessable from the smalltalk level.

    This guarantees, that a smalltalk string can always be passed to a

    C- or a system api function without danger (of course, this does not

    prevent a nonsense contents ...)

    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.

    [author:]

        Claus Gittinger

    [see also:]

        Text StringCollection TwoByteString JISEncodedString

        Symbol

"

! !

!String class methodsFor:'instance creation'!

basicNew:anInteger

    "return a new empty string with anInteger characters.

     In contrast to other smalltalks, this returns a string filled

     with spaces (instead of a string filled with 0-bytes).

     This makes much more sense, in that a freshly created string

     can be directly used as separator or for formatting."

%{  /* 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) {

            instsize = OHDR_SIZE + len + 1;

            if (self == String) {

                if (__CanDoQuickNew(instsize)) {        /* OBJECT ALLOCATION */

                    /*

                     * the most common case

                     */

                    __qCheckedNew(newString, instsize);

                    __InstPtr(newString)->o_class = self; /* no need for PROTECT - there was no GC */

                    __qSTORE(newString, self);

                    cp = __stringVal(newString);

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

                    {

                        /* 

                         * no sizeof(int) here please -

                         * - memset4 (if defined) fills 4-bytes on ALL machines 

                         */

                        int l4 = len >> 2;

                        if (len & 3) l4++;

                        memset4(cp, 0x20202020, l4);

                        cp[len] = '\0';

                    }

#else

# ifdef FAST_MEMSET

                    memset(cp, ' ', len);

                    cp[len] = '\0';

# else

                    while (len >= 8) {

#  ifndef NON_ASCII       /* i.e. EBCDIC  */

#   ifdef INT64

                        ((INT64 *)cp)[0] = 0x2020202020202020L;

#   else

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

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

#   endif

#  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 /* not FAST_MEMSET */

#endif /* not memset4 */

                    RETURN (newString);

                }

                nInstVars = 0;

            } else {

                nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);

                instsize += __OBJS2BYTES__(nInstVars);

            }

            __PROTECT_CONTEXT__;

            __qNew(newString, instsize);        /* OBJECT ALLOCATION */

            __UNPROTECT_CONTEXT__;

            if (newString == nil) goto fail;

            __InstPtr(newString)->o_class = self;

            __qSTORE(newString, self);

            if (nInstVars) {

                /*

                 * nil-out instvars

                 */

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

            }

            /*

             * fill with spaces

             */

#ifdef FAST_MEMSET

            memset(cp, ' ', len);

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

#else

            while (len >= 8) {

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

#  ifdef INT64

                ((INT64 *)cp)[0] = 0x2020202020202020L;

#  else

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

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

#  endif

# 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+1) atAllPut:(Character space)

!

new:n

    "return a new empty string with anInteger characters.

     In contrast to other smalltalks, this returns a string filled

     with spaces (instead of a string filled with 0-bytes).

     This makes much more sense, in that a freshly created string

     can be directly used as separator or for formatting."

    ^ 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 peekOrNil == $' 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']  

    "

    "Modified: / 14.4.1998 / 18:46:26 / cg"

!

unititializedNew:anInteger

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

    ^ self basicNew:anInteger

! !

!String class methodsFor:'Compatibility - Squeak'!

cr

    "return a string consisting of the cr-Character"

    ^ Character cr asString

    "Modified: / 13.11.1999 / 13:53:36 / cg"

! !

!String class methodsFor:'binary storage'!

binaryDefinitionFrom:stream manager:manager

    "read a binary representation from stream. This is only invoked

     for long strings. Short strings are stored with 1byte length."

    |s len|

    "take care of subclasses ..."

    ((self == String) or:[self == Symbol]) ifTrue:[

	len := stream nextNumber:4.

	s := String basicNew:len.

	stream nextBytes:len into:s startingAt:1.

	^ s

    ].

    ^ super binaryDefinitionFrom:stream manager:manager

    "Modified: / 2.11.1997 / 16:18:37 / cg"

! !

!String class methodsFor:'queries'!

defaultPlatformClass

    "dummy for ST-80 compatibility"

    ^ self

    "Created: 6.6.1997 / 18:25:56 / cg"

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == String

    "Modified: 23.4.1996 / 16:00:38 / cg"

! !

!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 slf, cls;

    if (__isSmallInteger(index)) {

        slf = self;

        cls = __qClass(slf);

        indx = __intVal(index) - 1;

        if (cls != String) {

            if (indx < 0) goto badIndex;

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

        }

        if ((unsigned)indx < (unsigned)(__stringSize(slf))) {

            RETURN ( __MKCHARACTER(__stringVal(slf)[indx] & 0xFF) );

        }

    }

badIndex: ;

%}.

    ^ self basicAt:index

!

at:index put:aCharacter

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

     Return aCharacter (sigh).

     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;

    REGISTER OBJ slf;

    slf = self;

    if (__isString(slf)) {

        if (__isCharacter(aCharacter)) {

            value = __intVal(_characterVal(aCharacter));

            if (((unsigned)value <= 0xFF)

             && __isSmallInteger(index)) {

                indx = __intVal(index) - 1;

                if ((unsigned)indx < (unsigned)(__stringSize(slf))) {

                    __stringVal(slf)[indx] = value;

                    RETURN ( aCharacter );

                }

            }

        }

    }

%}.

    ^ self basicAt:index put:aCharacter

!

basicAt:index

    "return the character at position index, an Integer

     - reimplemented here since we return characters"

%{  /* NOCONTEXT */

    REGISTER int indx;

    REGISTER OBJ slf, cls;

    if (__isSmallInteger(index)) {

        slf = self;

        cls = __qClass(slf);

        indx = __intVal(index) - 1;

        if (cls != String) {

            if (indx < 0) goto badIndex;

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

        }

        if ((unsigned)indx < (unsigned)(__stringSize(slf))) {

            RETURN ( __MKCHARACTER(__stringVal(slf)[indx] & 0xFF) );

        }

    }

badIndex: ;

%}.

    index isInteger ifFalse:[

        ^ self indexNotInteger:index

    ].

    index == super basicSize ifTrue:[

        ^ self subscriptBoundsError:index

    ].

    ^ Character value:(super basicAt:index)

!

basicAt:index put:aCharacter

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

     Returns aCharacter (sigh).

     - reimplemented here since we store characters"

%{  /* NOCONTEXT */

    REGISTER int value, indx;

    REGISTER OBJ slf;

    REGISTER OBJ cls;

    slf = self;

    if (__isCharacter(aCharacter)) {

        value = __intVal(_characterVal(aCharacter));

        if (((unsigned)value <= 0xFF)

         && __isSmallInteger(index)) {

            cls = __qClass(slf);

            indx = __intVal(index) - 1;

            if (cls != String) {

                if (indx < 0) goto badIndex;

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

            }

            if ((unsigned)indx < (unsigned)(__stringSize(slf))) {

                __stringVal(slf)[indx] = value;

                RETURN ( aCharacter );

            }

        }

    }

badIndex: ;

%}.

    (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

        "