#include #include #include #include #include #include #include #include /* In SOM 'any' is struct */ #define any Perlish_any #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "common_init.h" /* We use xsubpp from 5.005_64, and it puts some unexpected macros */ #ifdef CUSTOM_XSUBPP # define aTHX_ #endif #undef any typedef Contained ContainedContainer; typedef any SOM____any; #define tRepositoryNew() ((SOMObject*)RepositoryNew()) #define contained_describe(obj,ev) \ ((AttributeDescription*)((Contained_describe((obj),(ev))).value._value)) SV * contained_within_(Contained *obj, Environment *ev) { sequence(Container) seq = Contained_within(obj,ev); SV *sv = newSVpvn((char*)seq._buffer, seq._length * sizeof(Container*)); if (seq._length) SOMFree(seq._buffer); return sv; } SV * container_contents_(Container *obj, Environment *ev, char *lim, bool noinh) { sequence(Contained) seq = Container_contents(obj,ev,lim,noinh); SV *sv; /*printf("seq._buffer=%#lx, seq._length=%ld\n", (long)seq._buffer, (long)seq._length);*/ sv = newSVpvn((char*)seq._buffer, seq._length * sizeof(Contained*)); if (seq._length) SOMFree(seq._buffer); return sv; } SV * container_lookup_name_( Container *obj, Environment *env, char *name, int levels, char *type, bool noinherited) { sequence(Contained) seq = Container_lookup_name(obj,env,name,levels,type,noinherited); SV *sv = newSVpvn((char*)seq._buffer, seq._length * sizeof(Contained*)); if (seq._length) SOMFree(seq._buffer); return sv; } #define ad_name(ad) ((ad)->name) #define ad_id(ad) ((ad)->id) #define ad_defined_in(ad) ((ad)->defined_in) #define ad_type(ad) ((ad)->type) #define ad_readonly(ad) (((ad)->mode) == AttributeDef_READONLY) #define ad_DESTROY(ad) SOMFree(ad) char * pd_mode(ParameterDef *pd, Environment *env) { int x = ParameterDef__get_mode(pd,env); return ((x == ParameterDef_INOUT) ? "INOUT" : ( (x == ParameterDef_IN) ? "IN" : ( (x == ParameterDef_OUT) ? "OUT" : "?" ) ) ); } #define any__type(a,env) (a)._type unsigned long TypeCode_parameter_type_kind(TypeCode tc, Environment *env, long n) { unsigned long inikind = TypeCode_kind(tc, env); any a = TypeCode_parameter(tc, env, n); /* TypeCode type = a._type; */ /* unsigned long kind = TypeCode_kind(type, env); */ unsigned long inikind1 = TypeCode_kind(tc, env); if (inikind != tk_string) warn("Got unexpected typecode kind %lu", inikind); if (inikind != inikind1) { unsigned long inikind2; warn("Typecode kind mismatch %lu != %lu", inikind, inikind1); inikind2 = TypeCode_kind(TC_string, env); if (inikind2 != tk_string) warn("TC_string kind mismatch %lu != %lu", inikind2, tk_string); } return ((unsigned long) &a); } MODULE = SOMIr PACKAGE = SOM PREFIX = t PROTOTYPES: ENABLE Repository * tRepositoryNew() MODULE = SOMIr PACKAGE = ContainedPtr PREFIX = Contained__get_ char * Contained__get_name(obj,env) Contained *obj Environment *env char * Contained__get_id(obj,env) Contained *obj Environment *env char * Contained__get_defined_in(obj,env) Contained *obj Environment *env # somModifiers attribute of type sequence(somModifier) unsupported MODULE = SOMIr PACKAGE = ContainedPtr PREFIX = contained_ SV * contained_within_(obj,env) Contained *obj Environment *env AttributeDescription * contained_describe(obj, env) Contained *obj; Environment *env MODULE = SOMIr PACKAGE = ContainerPtr PREFIX = container_ SV * container_lookup_name_(obj,env,name,levels,type,noinherited) Container *obj; Environment *env; char *name; int levels; char *type; bool noinherited; # describe_contents(obj, env, type, noinherited) not supported SV * container_contents_(obj, env, type, noinherited) Container *obj; Environment *env; char *type; bool noinherited; MODULE = SOMIr PACKAGE = ParameterDefPtr PREFIX = pd_ char * pd_mode(pd,env) ParameterDef *pd; Environment *env MODULE = SOMIr PACKAGE = ParameterDefPtr PREFIX = ParameterDef__get_ TypeCode ParameterDef__get_type(pd,env) ParameterDef *pd; Environment *env MODULE = SOMIr PACKAGE = OperationDefPtr PREFIX = OperationDef__get_ TypeCode OperationDef__get_result(od,env) OperationDef *od; Environment *env MODULE = SOMIr PACKAGE = AttributeDescriptionPtr PREFIX = ad_ char * ad_name(ad) AttributeDescription *ad; char * ad_id(ad) AttributeDescription *ad; char * ad_defined_in(ad) AttributeDescription *ad; TypeCode ad_type(ad) AttributeDescription *ad; bool ad_readonly(ad) AttributeDescription *ad; void ad_DESTROY(ad) AttributeDescription *ad; MODULE = SOMIr PACKAGE = TypeCode PREFIX = TypeCode_ unsigned long TypeCode_kind(tc,env) TypeCode tc; Environment *env int TypeCode_param_count(tc,env) TypeCode tc; Environment *env SOM__::any TypeCode_parameter(tc,env,n) TypeCode tc; Environment *env; long n; unsigned long TypeCode_parameter_type_kind(tc, env, n) TypeCode tc; Environment *env; long n; MODULE = SOMIr PACKAGE = SOM__::any PREFIX = any__ TypeCode any__type(a,env=0) SOM__::any a; Environment *env; SV * any__value(a,env) SOM__::any a; Environment *env; CODE: { TypeCode tc = a._type; unsigned long kind = TypeCode_kind(tc, env); RETVAL = sv_newmortal(); switch (kind) { case tk_pointer: case tk_void: case tk_TypeCode: default: croak("panic: do not know how to extract value from any with TypeCode=kind=%lu", kind); break; case tk_short: sv_setiv(RETVAL, *(short*)a._value); break; case tk_ushort: sv_setuv(RETVAL, *(unsigned short*)a._value); break; case tk_long: sv_setiv(RETVAL, *(long*)a._value); break; case tk_enum: case tk_ulong: sv_setuv(RETVAL, *(unsigned long*)a._value); break; case tk_float: sv_setnv(RETVAL, *(float*)a._value); break; case tk_double: sv_setnv(RETVAL, *(double*)a._value); break; case tk_char: sv_setiv(RETVAL, *(char*)a._value); break; case tk_boolean: case tk_octet: sv_setuv(RETVAL, *(unsigned char*)a._value); break; case tk_string: sv_setpv(RETVAL, *(char**)a._value); break; } }