root/trunk/orca/ovalue.h

#ifndef OVALUE_H
#define OVALUE_H
/*============================================================================
    ORCA Interpreter
    Copyright (C) 2005-2006  Karl Robillard

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
===========================================================================*/


#include <stdint.h>


/*
   The following namespaces are used:

   OT_*  Value type defines
   OR_*  Constants
   O*    Structures and types
   or*   Functions, variables, macros
*/


#define OR_VERSION_STR  "0.0.24"
#define OR_VERSION      0x000024


// Simple datatypes

#define OT_UNSET        0
#define OT_NONE         1
#define OT_WORD         2
#define OT_LITWORD      3
#define OT_SETWORD      4
#define OT_GETWORD      5
#define OT_REFINEMENT   6
#define OT_OP           7
#define OT_NATIVE       8
#define OT_NUMBER       9
#define OT_INTEGER      10
#define OT_DECIMAL      11
#define OT_PAIR         12
#define OT_TUPLE        13
#define OT_CHAR         14
#define OT_LOGIC        15
#define OT_DATATYPE     16
#define OT_TIME         17
#define OT_DATE         18
#define OT_ACTION       19

// Complex datatypes

#define OT_COMPLEX      20
#define OT_BLOCK        20
#define OT_PAREN        21
#define OT_PATH         22
#define OT_LITPATH      23
#define OT_SETPATH      24
#define OT_STRING       25
#define OT_UNICODE      26
#define OT_ISSUE        27
#define OT_TAG          28
#define OT_FILE         29
#define OT_BINARY       30
#define OT_LIST         31
#define OT_HASH         32
#define OT_DEC_ARRAY    33
#define OT_INT_ARRAY    34
#define OT_SERIES       35

#define OT_OBJECT       36
#define OT_FUNCTION     37
#define OT_BITSET       38
#define OT_ERROR        39
#define OT_PORT         40
#define OT_STRUCT       41

#define OT_CORE         42

// Graphics datatypes

#define OT_IMAGE        42
#define OT_SOUND        43
#define OT_WIDGET       44
#define OT_VEC2         45
#define OT_VEC3         46
#define OT_MATRIX       47
#define OT_RESOURCE     48

#define OT_COUNT        49


#define OR_TMP_SIZE     512

#define OR_FALSE        0
#define OR_TRUE         1

#define OR_TUPLE_MAX    10

// orLookupPath() terminator.
#define OR_LPATH_END    -1

#define OR_INVALID_HOLD -1
#define OR_MAX_QHOLDS   256


// OValue flags

#define OR_FLAG_EOL         0x01
#define OR_FLAG_BEOL        0x02    // block! only
#define OR_FLAG_HEADER      0x04    // block! only
#define OR_FLAG_HEX         0x02    // integer! only
#define OR_FLAG_RECURSION   0x02    // object! only
//#define OR_FLAG_CLOSURE     0x04    // object! only
#define OR_FLAG_CATCH       0x08
#define OR_FLAG_THROW       0x10

// OWord flags

#define OR_WORD_PROT    0x01


typedef int32_t     OIndex;
typedef int16_t     OAtom;


typedef struct
{
    OIndex      wblkN;
    OIndex      vblkN;
}
OContext;


typedef struct
{
    OIndex      wordBlk;
    OIndex      context;
    uint16_t    index;
    uint16_t    atom;
}
OWordRef;


// NOTE: Must keep order of first 5 OR_ERROR_ in sync with errorText[].

#define OR_ERROR_SYNTAX     0
#define OR_ERROR_SCRIPT     1
#define OR_ERROR_MATH       2
#define OR_ERROR_ACCESS     3
#define OR_ERROR_INTERNAL   4
#define OR_ERROR_RETURN     5
#define OR_ERROR_BREAK      6
#define OR_ERROR_QUIT       7
#define OR_ERROR_HALT       8
#define OR_ERROR_THROW      9


typedef void (*ONativeFunc)(void*);


#ifdef __GNUC__
#define OVALUE_PACK  __attribute__ ((__packed__))
#endif
#ifdef _MSC_VER
#pragma pack(push)
#pragma pack(4)
#define OVALUE_PACK
#endif

typedef struct
{
    uint8_t     type;
    uint8_t     flags;
    uint8_t     argc;               /* Sub-type for error! */
    uint8_t     refc;

    union
    {
        OIndex      index;
        int32_t     integer;
        uint8_t     tuple[OR_TUPLE_MAX];
        int32_t     pair[2];
        OWordRef    word;
        OContext    ctx;
        struct {
            OIndex      n;
            OIndex      it;
        } series;
        struct {
            int32_t pad;
            double  decimal;
        } OVALUE_PACK num;
        struct {
            OIndex      specBlk;
            OIndex      bodyBlk;
            OIndex      context;
        } func;
        struct {
            OIndex      specBlk;
            ONativeFunc addr;       /* On 8 byte boundary (64-bit systems) */
        } OVALUE_PACK native;
        struct {
            OIndex      msg;        /* Name atom for OR_ERROR_THROW, a string
                                       index for most other types */
            OIndex      block;
            uint16_t    nearVal;    /* LIMIT: block length; should be OIndex */
            uint16_t    funcName;
        } error;
        struct {
            float x;
            float y;
            float z;
        } vec3;
    } OVALUE_PACK;
}
OValue;

#ifdef _MSC_VER
#pragma pack(pop)
#endif


typedef struct
{
    uint16_t    flags;
    OAtom       atom;
    OIndex      str;
}
OWord;


typedef struct
{
    uint16_t    refCount;
    uint16_t    dataType;
    OIndex      which;
}
OHold;


typedef struct
{
    int32_t     avail;
    int32_t     used;
    union
    {
        void*       buf;
        OValue*     values;
        OWord*      words;
        OIndex*     indices;
        char*       charArray;
        uint8_t*    byteArray;
        uint16_t*   unicodeArray;
        int32_t*    integers;
        double*     decimals;
        float*      floats;
    };
}
OArray;


typedef OArray      OBlock;     // Array of OValue
typedef OArray      OBinary;    // Array of uint8_t
typedef OArray      OString;    // Array of char
typedef OArray      OProto;     // Array of OWord


typedef struct
{
    uint32_t    count;
    OIndex      sweepStart;
    OIndex      freeList;
}
OArrayGC;


typedef struct
{
    int (*open)( OValue* spec, OContext* ctx );
    void (*close)( OContext* );
    void (*read)( OContext*, OValue* a1 );
    void (*write)( OContext*, OValue* a1 );
}
OPortDevice;


typedef struct
{
    OArray      blocks;
    OArray      strings;
    OArray      holds;

    OArray      atoms;
    OBlock      dataStack;
    OArray      callStack;

    OValue*     error;

    OIndex      sweepStartAtom;

    uint16_t    gcEnabled;
    uint16_t    secure;

    OArrayGC    freeBlocks;
    OArrayGC    freeStrings;
    OArrayGC    freeHolds;

    OHold*      quickHolds;
    int         quickHoldsUsed;

#ifdef OR_CONFIG_NUMBER_ARRAYS
    OArray      decArr;
    OArray      intArr;
    OArrayGC    freeDecArr;
    OArrayGC    freeIntArr;
#endif

    OArray      loaders;
    OArray      devices;
}
OEnv;


#ifdef __cplusplus
extern "C" {
#endif

extern OEnv* orEnv;

extern uint8_t charset_white[32];
extern char    orTmp[OR_TMP_SIZE];

void    orInitEnv( OEnv*, int dataStackSize, int callStackSize );
void    orFreeEnv( OEnv* );
void    orResetEnv( OEnv* );
void    orAtomStr( OAtom, OString* );
OAtom   orInternAtom( const char* str, int len );
OIndex  orInternA( OBlock* wordBlk, OAtom );
OValue* orIntern( OContext*, const char* str, int len, OValue* wordV );
int     orLookup( const OContext*, int atom );
OValue* orLookupPath( int first_tag, ... );
const char* orDatatypeName( int type );
void    orNative( void* func, const char* name );
void    orMakeOp( void* func, const char* name );
void    orDumpBlock( OBlock*, int depth );
void    orBind( OBlock*, OContext* ctx );
void    orEvalBlock( OBlock*, int seriesIndex );
void    orEvalCStr( const char* txt, int len );
void    orDoNative( OValue* );
void    orLockGarbageCollector();
void    orCollectGarbage();
void    orFreeBlock( OIndex );
void    orRegisterPortDevice( OPortDevice* );
void    orRegisterFileLoader( int (*func)( const char*, uint8_t*, int ) );
int     orEqual( const OValue*, const OValue* );
void    orForm( OString* out, const OValue* val );
void    orMold( OString* out, const OValue* val );
void    orProbe( OValue* );
void    orPrintNative( OValue* );
void    orError( const char* fmt, ... );
void    orErrorT( int type, const char* fmt, ... );
void    orSetError( OValue*, int type );
void    orSetErrorLoc( int blkN, int vi );

int       orMakeChar( const char* txt, int len );
OIndex    orMakeCString( const char* txt, int len );
OIndex    orMakeCStringS( const char* txt, int len );
OIndex    orMakeBinaryStr( const char* txt, int len );
OBlock*   orMakeBlock( int size );
OString*  orMakeString( int size );
void      orMakeContext( OContext*, int size );
int       orMakeObject( OBlock*, int index, OContext* );
OBinary*  orMakeCharset( const OString*, int index );

#ifdef OR_CONFIG_NUMBER_ARRAYS
OArray*  orMakeDecArray( int size );
OArray*  orMakeIntArray( int size );
void     orDecArrayAppend( OArray*, double );
void     orIntArrayAppend( OArray*, int32_t );
#endif

OBlock*  orCopyBlock( OIndex, int skip, int deep );
OString* orCopyString( OIndex, int skip );
void     orCopy( OValue*, int part, int deep );
void     orCloneObject( const OContext* orig, OContext* clone );
int      orPick( const OValue* ser, int n, OValue* result );

int     orStringToInt( const char* start, const char* end, const char** it );
double  orStringToDec( const char* start, const char* end, const char** it );

OValue* orAppendValue( OBlock*, int type, int ind );
OValue* orAppendNone( OBlock* );
OValue* orAppendWord( OBlock* blk, int type, const char* name, int len );
OValue* orAppendPath( OBlock*, int type, OIndex blkN );
OValue* orAppendDecimal( OBlock*, double );
OValue* orAppendTuple( OBlock*, const uint8_t* bytes, int len );

void orArrayInit( OArray*, int elemSize, int elemCount );
void orArrayFree( OArray* );
void orArrayReserve( OArray*, int elemSize, int elemCount );
void orArrayErase( OArray*, int elemSize, int index, int count );

#ifdef OR_CONFIG_BYTECODE
void orCompileByteCodes( OBinary*, const OValue* );
OIndex orByteCodeBlock( const uint8_t** codep, OIndex* lenp );
const uint8_t* orRevaluateByteCodes( const uint8_t*, int valueCount, OBlock* );
#endif

OIndex orHold( int type, OIndex which );
OIndex orHoldIndex( OIndex );
void   orRelease( OIndex );

#ifdef __cplusplus
}
#endif


#define orSTRINGS       ((OString*) orEnv->strings.buf)
#define orBLOCKS        ((OBlock*) orEnv->blocks.buf)
#define orTOS           (orEnv->dataStack.values + orEnv->dataStack.used)

#define orSTRING(val)   (orSTRINGS + (val)->index)
#define orBLOCK(val)    (orBLOCKS + (val)->index)

#ifdef OR_CONFIG_NUMBER_ARRAYS
#define orDEC_ARRAYS        ((OArray*) orEnv->decArr.buf)
#define orINT_ARRAYS        ((OArray*) orEnv->intArr.buf)

#define orDEC_ARRAY(val)    (orDEC_ARRAYS + (val)->index)
#define orINT_ARRAY(val)    (orINT_ARRAYS + (val)->index)
#endif

#define orBlockN(ptr)   (ptr - orBLOCKS)
#define orStringN(ptr)  (ptr - orSTRINGS)
#define orBinaryN(ptr)  (ptr - orSTRINGS)

#define orBlockPtr(n)   (orBLOCKS + n)
#define orStringPtr(n)  (orSTRINGS + n)

#define orIs(val,t)     ((val)->type == t)

#define orType(val)     (val)->type
#define orAtom(val)     (val)->word.atom
#define orDatatype(val) (val)->index
#define orInt(val)      (val)->integer
#define orLogic(val)    (val)->integer
#define orDecimal(val)  (val)->num.decimal
#define orSeconds(val)  (val)->num.decimal
#define orTupleLen(val) (val)->argc

#define orIsWord(t)     ((t >= OT_WORD) && (t < OT_REFINEMENT))
#define orIsSeries(t)   ((t >= OT_COMPLEX) && (t < OT_SERIES))
#define orIsString(t)   ((t >= OT_STRING) && (t < OT_BINARY))
#define orIsBlock(t)    ((t >= OT_BLOCK) && (t < OT_SETPATH))
#define orIsNumber(t)   ((t == OT_INTEGER) || (t == OT_DECIMAL))

#define orIfTrue(val) \
    ((orType(val) != OT_NONE) && \
     ((orType(val) != OT_LOGIC) || (orLogic(val) != 0)))

#define orIfFalse(val) \
    (orIs(val, OT_NONE) || (orIs(val, OT_LOGIC) && (orLogic(val) == 0)))

#define orRefAvail(n) \
    (((OR_MAX_QHOLDS - 1) - orEnv->quickHoldsUsed) > n)

#define orRefAvailErr(n) \
    if( ! orRefAvail(n) ) { \
        orErrorT(OR_ERROR_INTERNAL, "Hold stack overflow"); \
        return; }

#define orRefPush(type,index) \
    orEnv->quickHolds[ orEnv->quickHoldsUsed ].dataType = type; \
    orEnv->quickHolds[ orEnv->quickHoldsUsed ].which = index; \
    ++orEnv->quickHoldsUsed

#define orRefPop(count)         orEnv->quickHoldsUsed -= count

#define orWordVal(wv,blk,val) \
    blk = orBLOCKS + wv->word.context; \
    val = blk->values + wv->word.index

#define orMakePath(n)           orMakeBlock(n)
#define orMakeBinary(n)         ((OBinary*) orMakeString(n))

#define orAppendInteger(b,v)    orAppendValue(b,OT_INTEGER,v)
#define orAppendLogic(b,v)      orAppendValue(b,OT_LOGIC,v)
#define orAppendChar(b,v)       orAppendValue(b,OT_CHAR,v)
#define orAppendString(b,v)     orAppendValue(b,OT_STRING,v)
#define orAppendFile(b,v)       orAppendValue(b,OT_FILE,v)
#define orAppendTag(b,v)        orAppendValue(b,OT_TAG,v)
#define orAppendBlock(b,v)      orAppendValue(b,OT_BLOCK,v)

#define orBitIsSet(array,n) (array[(n)>>3] & 1<<((n)&7))
#define orSetBit(array,n)   (array[(n)>>3] |= 1<<((n)&7))
#define orClrBit(array,n)   (array[(n)>>3] &= ~(1<<((n)&7)))

#ifdef __BIG_ENDIAN__
#define orSetTF(val,t)      *((uint32_t*) &(val)->type) = t << 24
#else
#define orSetTF(val,t)      *((uint32_t*) &(val)->type) = t
#endif

#define orSetSeries(val,w,idx) \
    val->series.n  = w; \
    val->series.it = idx

#define orSetWord(val,wb,vb,wrd,atm) \
    val->word.wordBlk = wb; \
    val->word.context = vb; \
    val->word.index   = wrd; \
    val->word.atom    = atm

#define orStrChars(str,val)     (str->charArray + val->series.it)
#define orSeriesLen(ser,val)    (ser->used - val->series.it)

#define orRefineSet(val)    ((val)->type == OT_LOGIC)

#define orCopyV(val,t)      *(val) = t

#define orNumberToInt(v) \
    ((v->type == OT_DECIMAL) ? (int) v->num.decimal : v->integer)

#define orResult(t,v) \
    orSetTF(a1, t); \
    a1->index = v;

#define orResultCopy(v)     orCopyV(a1,v)

#define orResultSeries(t,w,idx) \
    orSetTF(a1, t); \
    orSetSeries(a1,w,idx)

#define orResultSTRING(i)   orResultSeries(OT_STRING,i,0)
#define orResultFILE(i)     orResultSeries(OT_FILE,i,0)
#define orResultBLOCK(i)    orResultSeries(OT_BLOCK,i,0)
#define orResultBINARY(i)   orResultSeries(OT_BINARY,i,0)
#define orResultNONE        orResult(OT_NONE,0)
#define orResultUNSET       orResult(OT_UNSET,0)
#define orResultTRUE        orResult(OT_LOGIC,OR_TRUE)
#define orResultFALSE       orResult(OT_LOGIC,OR_FALSE)

#define orResultDECIMAL(v) \
    orSetTF(a1, OT_DECIMAL); \
    a1->num.decimal = v

#define OR_NATIVE(func)     static void func( OValue* a1 )
#define OR_NATIVE_PUB(func) void func( OValue* a1 )

#define OR_CTERM_LEN        1

#define orTermCStr(s) \
    if(s->used == s->avail) \
        orArrayReserve(s,sizeof(char),s->used+1); \
    s->charArray[s->used] = '\0'

#define orErrorThrown       orEnv->error
#define orErrorClear        orEnv->error = 0
#define orErrorType(ev)     (ev)->argc
#define orErrorIsType(t)    (orEnv->error->argc == t)

#define orHoldIsValid(h)    ((h) > OR_INVALID_HOLD)

#define orToByteRange(v)    ((v) < 0 ? 0 : (v) > 255 ? 255 : (v))

#endif  /* OVALUE_H */