Stream.m
上传用户:shenzhenrh
上传日期:2013-05-12
资源大小:2904k
文件大小:11k
- #import <collections/Stream.h>
- #import <collections/List.h>
- #import <collections/predicates.h>
- #import <defobj/defalloc.h>
- #import "../defobj/internal.h" // fcall_type_size
- #include <objc/objc-api.h>
- @implementation ArchiverKeyword_c
- PHASE(Creating)
- - setKeywordName: (const char *)name
- {
- keywordName = STRDUP (name);
- return self;
- }
- PHASE(Using)
- - (const char *)getKeywordName
- {
- return keywordName;
- }
- - (void)lispOutShallow: (id <OutputStream>)stream
- {
- [self lispOutDeep: stream];
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- [stream catC: "#:"];
- [stream catC: keywordName];
- }
- - (void)drop
- {
- FREEBLOCK (keywordName);
- [super drop];
- }
- @end
-
- @implementation ArchiverArray_c
- PHASE(Creating)
- - setArray: array
- {
- id <List> l;
- id proto;
-
- for (l = array, rank = 0; archiver_list_p (l); rank++)
- l = [l getFirst];
- proto = l;
- if (!valuep (proto))
- raiseEvent (InvalidArgument, "Array element not numeric");
-
- dims = [getZone (self) alloc: rank * sizeof (unsigned)];
-
- {
- unsigned dimnum;
-
- elementCount = 1;
- for (l = array, dimnum = 0; archiver_list_p (l); l = [l getFirst], dimnum++)
- {
- dims[dimnum] = [l getCount];
- elementCount *= dims[dimnum];
- }
- }
- type = [proto getValueType];
- elementSize = fcall_type_size (type);
- {
- size_t size = elementCount * elementSize;
- data = [getZone (self) alloc: size];
- memset (data, 0, size);
- }
-
- {
- unsigned coord[rank];
-
- void expand (id val, unsigned dimnum)
- {
- if (archiver_list_p (val))
- {
- id <Index> li = [val begin: scratchZone];
- id item;
- unsigned pos = 0;
-
- while ((item = [li next]) != nil)
- {
- coord[dimnum] = pos;
- expand (item, dimnum + 1);
- pos++;
- }
- [li drop];
- }
- else
- {
- unsigned i;
- unsigned mult = 1;
- unsigned offset = 0;
-
- offset = coord[rank - 1];
- if (!valuep (val))
- raiseEvent (InvalidArgument, "Array element not a number");
- for (i = rank - 1; i > 0; i--)
- {
- mult *= dims[i];
- offset += coord[i - 1] * mult;
- }
- switch (type)
- {
- case fcall_type_object:
- ((id *) data)[offset] = [val getObject];
- break;
- case fcall_type_class:
- ((Class *) data)[offset] = [val getClass];
- break;
- case fcall_type_boolean:
- ((BOOL *) data)[offset] = [val getBoolean];
- break;
- case fcall_type_slonglong:
- ((long long *) data)[offset] = [val getLongLong];
- break;
- case fcall_type_float:
- ((float *) data)[offset] = [val getFloat];
- break;
- case fcall_type_double:
- ((double *) data)[offset] = [val getDouble];
- break;
- case fcall_type_long_double:
- ((long double *) data)[offset] = [val getLongDouble];
- break;
- case fcall_type_schar:
- ((unsigned char *) data)[offset] = [val getChar];
- break;
- default:
- raiseEvent (InvalidArgument, "Unknown element type");
- }
- }
- }
- expand (array, 0);
- }
- return self;
- }
- PHASE(Using)
- - (unsigned)getRank
- {
- return rank;
- }
- - (void *)getData
- {
- return data;
- }
- - convertToType: (fcall_type_t)destType dest: (void *)ptr
- {
- unsigned coord[rank];
- void permute (unsigned dim)
- {
- unsigned i;
- if (dim < rank)
- {
- for (i = 0; i < dims[dim]; i++)
- {
- coord[dim] = i;
- permute (dim + 1);
- }
- }
- else
- {
- unsigned offset = 0;
- unsigned mult = 1;
- long long val;
-
- offset = coord[rank - 1];
- for (i = rank - 1; i > 0; i--)
- {
- mult *= dims[i];
- offset += coord[i - 1] * mult;
- }
- val = ((long long *) data)[offset];
- switch (destType)
- {
- case fcall_type_sint:
- ((int *) ptr)[offset] = (int) val;
- break;
- case fcall_type_uint:
- ((unsigned *) ptr)[offset] = (unsigned) val;
- break;
- case fcall_type_slong:
- ((long *) ptr)[offset] = (long) val;
- break;
- case fcall_type_ulong:
- ((unsigned long *) ptr)[offset] = (unsigned long) val;
- break;
- case fcall_type_slonglong:
- ((long long *) ptr)[offset] = (long long) val;
- break;
- case fcall_type_ulonglong:
- ((unsigned long long *) ptr)[offset] = (unsigned long long) val;
- break;
- case fcall_type_sshort:
- ((short *) ptr)[offset] = (short) val;
- break;
- case fcall_type_ushort:
- ((unsigned short *) ptr)[offset] = (unsigned short) val;
- break;
- default:
- abort ();
- }
- }
- }
- if (type == fcall_type_slonglong)
- permute (0);
- else
- memcpy (ptr, data, fcall_type_size (type) * elementCount);
- return self;
- }
- - (unsigned *)getDims
- {
- return dims;
- }
- - (unsigned)getElementCount
- {
- return elementCount;
- }
- - (size_t)getElementSize
- {
- return elementSize;
- }
- - (fcall_type_t)getArrayType
- {
- return type;
- }
- - (void)lispOutShallow: (id <OutputStream>)stream
- {
- [self lispOutDeep: stream];
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- lisp_process_array (rank, dims, type, data, data, stream, YES);
- }
- - (void)drop
- {
- [getZone (self) free: dims];
- [getZone (self) free: data];
- [getZone (self) free: (void *) type];
- [super drop];
- }
- @end
- @implementation ArchiverValue_c
- PHASE(Creating)
- - setDouble: (double)val
- {
- type = fcall_type_double;
- value.d = val;
- return self;
- }
- - setLongDouble: (long double)val
- {
- type = fcall_type_long_double;
- value.ld = val;
- return self;
- }
- - setBoolean: (BOOL)val
- {
- type = fcall_type_boolean;
- value.bool = val;
- return self;
- }
- - setFloat: (float)val
- {
- type = fcall_type_float;
- value.f = val;
- return self;
- }
- - setLongLong: (long long)val
- {
- type = fcall_type_slonglong;
- value.ll = val;
- return self;
- }
- - setChar: (char)val
- {
- type = fcall_type_schar;
- value.ch = val;
- return self;
- }
- - setNil
- {
- type = fcall_type_object;
- value.obj = nil;
- return self;
- }
- - setClass: (Class)aClass
- {
- type = fcall_type_class;
- value.class = aClass;
- return self;
- }
- PHASE(Using)
- - (fcall_type_t)getValueType
- {
- return type;
- }
- - (long double)getLongDouble
- {
- return value.ld;
- }
- - (double)getDouble
- {
- return value.d;
- }
- - (float)getFloat
- {
- return value.f;
- }
- - (long long)getLongLong
- {
- return value.ll;
- }
- - (int)getInteger
- {
- if (type != fcall_type_slonglong)
- raiseEvent (InvalidArgument, "expecting an integer");
- return (int) value.ll;
- }
- - (unsigned)getUnsigned
- {
- if (type != fcall_type_slonglong)
- raiseEvent (InvalidArgument, "expecting an integer");
- return (unsigned) value.ll;
- }
- - (char)getChar
- {
- return value.ch;
- }
- - (BOOL)getBoolean
- {
- return value.ch;
- }
- - getObject
- {
- return value.obj;
- }
- - (Class)getClass
- {
- return value.class;
- }
- - (void)lispOutShallow: (id <OutputStream>)stream
- {
- [self lispOutDeep: stream];
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- switch (type)
- {
- case fcall_type_boolean:
- [stream catBoolean: value.bool];
- break;
- case fcall_type_schar: case fcall_type_uchar:
- [stream catChar: value.ch];
- break;
- case fcall_type_double:
- [stream catDouble: value.d];
- break;
- case fcall_type_long_double:
- [stream catLongDouble: value.ld];
- break;
- case fcall_type_float:
- [stream catFloat: value.f];
- break;
- case fcall_type_slonglong:
- [stream catLongLong: value.ll];
- break;
- case fcall_type_object:
- if (value.obj != nil)
- abort ();
- else
- [stream catNil];
- break;
- default:
- [stream catC: "serialization for this type not implemented yet"];
- break;
- }
- }
- @end
- @implementation ArchiverPair_c
- PHASE(Creating)
- - setCar: val;
- {
- car = val;
- return self;
- }
- - setCdr: val
- {
- cdr = val;
- return self;
- }
- - setConsFormatFlag: (BOOL)theConsFormatFlag
- {
- consFormatFlag = theConsFormatFlag;
- return self;
- }
- PHASE(Using)
- - getCar
- {
- return car;
- }
- - getCdr
- {
- return cdr;
- }
- - (BOOL)getConsFormatFlag
- {
- return consFormatFlag;
- }
- - (void)lispOutShallow: (id <OutputStream>)stream
- {
- [self lispOutDeep: stream];
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- [stream catC: (consFormatFlag ? "(cons " : "(")];
- [car lispOutDeep: stream];
- [stream catC: (consFormatFlag ? " ": " . ")];
- [cdr lispOutDeep: stream];
- [stream catC: ")"];
- }
- @end
- @implementation ArchiverList_c
- PHASE(Creating)
- PHASE(Setting)
- PHASE(Using)
- - (void)lispOutShallow: (id <OutputStream>)stream
- {
- [self lispOutDeep: stream];
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- id index = [self begin: getZone (self)];
- id member;
- [stream catC: "("];
- // get the first member of the list
- member = [index next];
- if (list_literal_p (member))
- [stream catC: [member getC]];
- else if (cons_literal_p (member))
- [stream catC: [member getC]];
- else if (stringp (member))
- {
- const char *funcName = [member getC];
- if (strcmp (funcName, MAKE_INSTANCE_FUNCTION_NAME) == 0
- || strcmp (funcName, MAKE_CLASS_FUNCTION_NAME) == 0)
- {
- [stream catC: [member getC]];
- member = [index next];
- [stream catC: " "];
- [member lispOutDeep: stream];
- }
- else if (strcmp (funcName, PARSE_FUNCTION_NAME) == 0)
- [stream catC: [member getC]];
- else
- raiseEvent (InvalidArgument, "function not one of ",
- MAKE_INSTANCE_FUNCTION_NAME
- " or "
- MAKE_CLASS_FUNCTION_NAME
- " or "
- PARSE_FUNCTION_NAME);
- }
- else
- [member lispOutDeep: stream];
-
- for (member = [index next]; [index getLoc] == Member; member = [index next])
- {
- [stream catC: " "];
- if (ARCHIVEREOLP (member))
- break;
- else if (keywordp (member)
- || valuep (member)
- || arrayp (member)
- || pairp (member)
- || quotedp (member)
- || stringp (member)
- || archiver_list_p (member))
- [member lispOutDeep: stream];
- else
- raiseEvent (InvalidArgument, "expression type not supported");
- }
- [stream catC: ")"];
- [index drop];
- }
- @end
- @implementation ArchiverQuoted_c
- PHASE(Creating)
- - setQuotedObject: aValue
- {
- value = aValue;
- return self;
- }
- PHASE(Using)
- - getQuotedObject
- {
- return value;
- }
- - (void)lispOutDeep: (id <OutputStream>)stream
- {
- [stream catC: "'"];
- if (stringp (value))
- [stream catC: [value getC]];
- else
- [value lispOutDeep: stream];
- }
- @end