diff options
Diffstat (limited to 'lib/ic')
192 files changed, 48628 insertions, 0 deletions
diff --git a/lib/ic/AUTHORS b/lib/ic/AUTHORS new file mode 100644 index 0000000000..f3791aabaa --- /dev/null +++ b/lib/ic/AUTHORS @@ -0,0 +1,8 @@ +Original Authors: + +Peter Lundel +Lars Thorsen +Babbis Xagorarakis + + +Contributors: diff --git a/lib/ic/Makefile b/lib/ic/Makefile new file mode 100644 index 0000000000..07db8b7d35 --- /dev/null +++ b/lib/ic/Makefile @@ -0,0 +1,41 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include vsn.mk +VSN=$(ORBER_VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +SUB_DIRECTORIES = src c_src java_src doc/src examples/pre_post_condition + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_subdir.mk + diff --git a/lib/ic/c_src/Makefile b/lib/ic/c_src/Makefile new file mode 100644 index 0000000000..8256edda64 --- /dev/null +++ b/lib/ic/c_src/Makefile @@ -0,0 +1,24 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in new file mode 100644 index 0000000000..6eef7827b9 --- /dev/null +++ b/lib/ic/c_src/Makefile.in @@ -0,0 +1,160 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +CC = @CC@ +LIBS = @LIBS@ + +LIBDIR = ../priv/lib/$(TARGET) +OBJDIR = ../priv/obj/$(TARGET) +INCDIR = ../include +ERL_INTERFACE_FLAGS = \ + -I$(ERL_TOP)/lib/erl_interface/include \ + -I$(ERL_TOP)/lib/erl_interface/src + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(IC_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) + +# ---------------------------------------------------- +# File Specs +# ---------------------------------------------------- + +IDL_FILES = \ + $(INCDIR)/erlang.idl + +ifeq ($(findstring win32,$(TARGET)),win32) +USING_MINGW=@MIXED_CYGWIN_MINGW@ +ifeq ($(USING_MINGW),yes) +AR_OUT = rcv +CC_FLAGS = +LIBRARY = $(LIBDIR)/libic.a +SKIP_BUILDING_BINARIES := false +else +LIBRARY = $(LIBDIR)/ic.lib +AR_OUT = -out: +CC_FLAGS = -MT +endif +ifeq ($(HOST_OS),) +HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess) +endif +ifeq ($(findstring solaris,$(HOST_OS)),solaris) +SKIP_BUILDING_BINARIES := true +endif +else +AR_OUT = rcv +CC_FLAGS = @DED_CFLAGS@ +LIBRARY = $(LIBDIR)/libic.a +SKIP_BUILDING_BINARIES := false +endif + +C_FILES = \ + ic.c \ + ic_tmo.c \ + oe_ei_encode_version.c \ + oe_ei_encode_long.c \ + oe_ei_encode_ulong.c \ + oe_ei_encode_double.c \ + oe_ei_encode_char.c \ + oe_ei_encode_string.c \ + oe_ei_encode_atom.c \ + oe_ei_encode_pid.c \ + oe_ei_encode_port.c \ + oe_ei_encode_ref.c \ + oe_ei_encode_term.c \ + oe_ei_encode_tuple_header.c \ + oe_ei_encode_list_header.c \ + oe_ei_encode_longlong.c \ + oe_ei_encode_ulonglong.c \ + oe_ei_encode_wchar.c \ + oe_ei_encode_wstring.c \ + oe_ei_decode_longlong.c \ + oe_ei_decode_ulonglong.c \ + oe_ei_decode_wchar.c \ + oe_ei_decode_wstring.c \ + oe_ei_code_erlang_binary.c + +H_FILES = $(INCDIR)/ic.h + +OBJ_FILES= $(C_FILES:%.c=$(OBJDIR)/%.o) + +ALL_CFLAGS = @CFLAGS@ @DEFS@ -I$(INCDIR) $(ERL_INTERFACE_FLAGS) $(CFLAGS) + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +ifeq ($(SKIP_BUILDING_BINARIES), true) +debug opt: +else +debug opt: $(LIBRARY) +endif + +clean: + rm -f $(LIBRARY) $(OBJ_FILES) + rm -f core *~ + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(OBJDIR): + -mkdir -p $(OBJDIR) + +$(LIBDIR): + -mkdir -p $(LIBDIR) + +$(LIBRARY): $(OBJDIR) $(LIBDIR) $(OBJ_FILES) + -$(AR) $(AR_OUT) $@ $(OBJ_FILES) + -$(RANLIB) $@ + +$(OBJDIR)/%.o: %.c + $(CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $< + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/c_src + $(INSTALL_DIR) $(RELSYSDIR)/include + $(INSTALL_DIR) $(RELSYSDIR)/priv/lib + $(INSTALL_DATA) ic.c ic_tmo.c $(RELSYSDIR)/c_src + $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) $(RELSYSDIR)/include + $(INSTALL_DATA) $(LIBRARY) $(RELSYSDIR)/priv/lib + +release_docs_spec: + + + + + + diff --git a/lib/ic/c_src/Makefile.win32 b/lib/ic/c_src/Makefile.win32 new file mode 100644 index 0000000000..d782555788 --- /dev/null +++ b/lib/ic/c_src/Makefile.win32 @@ -0,0 +1,108 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# + +CC = cl.exe +LIBRARIAN = lib.exe /nologo + +IC_INCLUDE = ..\include +EI_INCLUDE = \erts\lib\erl_interface\src + +CFLAGS = /MT /nologo /Ox /I$(IC_INCLUDE) /I$(EI_INCLUDE) +TARGET = win32 +OBJDIR = ..\priv\obj\$(TARGET) +LIBDIR = ..\priv\lib\$(TARGET) + + +C_FILES = \ + ic.c \ + oe_ei_encode_version.c \ + oe_ei_encode_long.c \ + oe_ei_encode_ulong.c \ + oe_ei_encode_double.c \ + oe_ei_encode_char.c \ + oe_ei_encode_string.c \ + oe_ei_encode_atom.c \ + oe_ei_encode_pid.c \ + oe_ei_encode_port.c \ + oe_ei_encode_ref.c \ + oe_ei_encode_term.c \ + oe_ei_encode_tuple_header.c \ + oe_ei_encode_list_header.c \ + oe_ei_encode_longlong.c \ + oe_ei_encode_ulonglong.c \ + oe_ei_encode_wchar.c \ + oe_ei_encode_wstring.c \ + oe_ei_decode_longlong.c \ + oe_ei_decode_ulonglong.c \ + oe_ei_decode_wchar.c \ + oe_ei_decode_wstring.c + +OBJ_FILES = \ + $(OBJDIR)\ic.obj \ + $(OBJDIR)\oe_ei_encode_version.obj \ + $(OBJDIR)\oe_ei_encode_long.obj \ + $(OBJDIR)\oe_ei_encode_ulong.obj \ + $(OBJDIR)\oe_ei_encode_double.obj \ + $(OBJDIR)\oe_ei_encode_char.obj \ + $(OBJDIR)\oe_ei_encode_string.obj \ + $(OBJDIR)\oe_ei_encode_atom.obj \ + $(OBJDIR)\oe_ei_encode_pid.obj \ + $(OBJDIR)\oe_ei_encode_port.obj \ + $(OBJDIR)\oe_ei_encode_ref.obj \ + $(OBJDIR)\oe_ei_encode_term.obj \ + $(OBJDIR)\oe_ei_encode_tuple_header.obj \ + $(OBJDIR)\oe_ei_encode_list_header.obj \ + $(OBJDIR)\oe_ei_encode_longlong.obj \ + $(OBJDIR)\oe_ei_encode_ulonglong.obj \ + $(OBJDIR)\oe_ei_encode_wchar.obj \ + $(OBJDIR)\oe_ei_encode_wstring.obj \ + $(OBJDIR)\oe_ei_decode_longlong.obj \ + $(OBJDIR)\oe_ei_decode_ulonglong.obj \ + $(OBJDIR)\oe_ei_decode_wchar.obj \ + $(OBJDIR)\oe_ei_decode_wstring.obj + + +LIBRARY = $(LIBDIR)\ic.lib + + +all: $(OBJDIR) $(LIBDIR) $(LIBRARY) + +release: + echo "Nothing to do" + +clean: + -del $(OBJ_FILES) $(LIBRARY) + +$(LIBRARY): $(OBJ_FILES) + $(LIBRARIAN) /OUT:$@ $** + +{}.c{$(OBJDIR)}.obj: + $(CC) $(CFLAGS) /c /Fo$@ $< + +$(OBJDIR): + -mkdir $(OBJDIR) + +$(LIBDIR): + -mkdir $(LIBDIR) + +$(LIBRARY): + + +{}.c: $(EI_INCLUDE)\ei.h $(IC_INCLUDE)\ic. diff --git a/lib/ic/c_src/ic.c b/lib/ic/c_src/ic.c new file mode 100644 index 0000000000..1ace9ea1af --- /dev/null +++ b/lib/ic/c_src/ic.c @@ -0,0 +1,612 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + +static int oe_send(CORBA_Environment *env); + +void CORBA_free(void *p) +{ + if (p != NULL) + free(p); +} + + +CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len) +{ + return (CORBA_char *) malloc(len+1); +} + + +CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long len) +{ + return (CORBA_wchar *) malloc(len*(__OE_WCHAR_SIZE_OF__+1)); +} + + +CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz) +{ + CORBA_Environment *env; + + env = malloc(sizeof(CORBA_Environment)); + + if (env != NULL) { + + /* CORBA */ + env->_major = CORBA_NO_EXCEPTION; + + /* Set by user */ + env->_fd= -1; + env->_inbufsz = inbufsz; + env->_inbuf = malloc(inbufsz); + env->_outbufsz = outbufsz; + env->_outbuf = malloc(outbufsz); + env->_memchunk = __OE_MEMCHUNK__; + env->_regname[0] = '\0'; + env->_to_pid = NULL; + env->_from_pid = NULL; + + /* Set by client or server */ + env->_iin = 0; + env->_iout = 0; + env->_operation[0] = '\0'; + env->_received = 0; + /* env->_caller */ + /* env->_unique */ + env->_exc_id = NULL; + env->_exc_value = NULL; + env->_ref_counter_1 = 0; + env->_ref_counter_2 = 0; + env->_ref_counter_3 = 0; + } + + return env; +} + +#if 0 +/* NOT EXPORTED SO FAR */ +void CORBA_Environment_free(CORBA_Environment *env) +{ + + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_exception_free(env); + CORBA_free(env); +} +#endif + + +CORBA_char *CORBA_exception_id(CORBA_Environment *env) +{ + + return env->_exc_id; +} + +void *CORBA_exception_value(CORBA_Environment *env) +{ + + return env->_exc_value; +} + +void CORBA_exception_free(CORBA_Environment *env) +{ + + /* Setting major value */ + env->_major=CORBA_NO_EXCEPTION; + + /* Freeing storage */ + CORBA_free(env->_exc_id); + CORBA_free(env->_exc_value); + env->_exc_id = env->_exc_value = NULL; +} + +void CORBA_exc_set(CORBA_Environment *env, + CORBA_exception_type Major, + CORBA_char *Id, + CORBA_char *Value) +{ + int ilen,vlen; + + /* Create exception only if exception not already set */ + if (env->_major == CORBA_NO_EXCEPTION) { + + /* Counting lengths */ + ilen = strlen(Id)+1; + vlen = strlen(Value)+1; + + /* Allocating storage */ + env->_exc_id = (CORBA_char *) malloc(ilen); + env->_exc_value = (CORBA_char *) malloc(vlen); + + /* Initiating */ + env->_major = Major; + strcpy(env->_exc_id,Id); + strcpy(env->_exc_value,Value); + } +} + +#define ERLANG_REF_NUM_SIZE 18 +#define ERLANG_REF_MASK (~(~((unsigned int)0) << ERLANG_REF_NUM_SIZE)) + +/* Initiating message reference */ +void ic_init_ref(CORBA_Environment *env, erlang_ref *ref) +{ + + strcpy(ref->node, erl_thisnodename()); + + ref->len = 3; + + ++env->_ref_counter_1; + env->_ref_counter_1 &= ERLANG_REF_MASK; + if (env->_ref_counter_1 == 0) + if (++env->_ref_counter_2 == 0) + ++env->_ref_counter_3; + ref->n[0] = env->_ref_counter_1; + ref->n[1] = env->_ref_counter_2; + ref->n[2] = env->_ref_counter_3; + + ref->creation = erl_thiscreation(); +} + +/* Comparing message references */ +int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2) +{ + int i; + + if(strcmp(ref1->node, ref2->node) != 0) + return -1; + + if (ref1->len != ref2->len) + return -1; + + for (i = 0; i < ref1->len; i++) + if (ref1->n[i] != ref2->n[i]) + return -1; + + return 0; +} + +/* Length counter for wide strings */ +int ic_wstrlen(CORBA_wchar * p) +{ + int len = 0; + + while(1) { + if (p[len] == 0) + return len; + + len+=1; + } +} + + +/* Wide string compare function */ +int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2) +{ + int index = 0; + + while(1) { + if (ws1[index] == ws2[index]) { + + if (ws1[index] == 0) + return 0; + + index += 1; + + } else + return -1; + } +} + +/* For backward compatibility -- replaced by prepare_request_decoding() */ +int ___call_info___(CORBA_Object obj, CORBA_Environment *env) +{ + return oe_prepare_request_decoding(env); +} + +/* #define DEBUG_MAP */ + +#if defined(DEBUG_MAP) + +#define PRINT_MAPS(P, M, S) print_maps(P, M, S) +#define PRINT_MAP(T, M) print_map(T, "", M) + +static void print_map(char *title, char *prefix, oe_map_t *map) +{ + if (map == NULL) { + fprintf(stdout, "%s => NULL\n", title); + return; + } + + fprintf(stdout, "%s%s\n", prefix, title); + + { + int j, len = map->length; + + fprintf(stdout, "%s length: %d\n", prefix, len); + fprintf(stdout, "%s operations: 0x%X%d\n", prefix, map->operations); + + for (j = 0 ; j < len ; j++) { + fprintf(stdout, "%s operation[%d]:\n", prefix, j); + + if (map->operations[j].interface != NULL) { + fprintf(stdout, "%s intf: %s\n", prefix, + map->operations[j].interface); + } else { + fprintf(stdout, "%s intf: NULL\n", prefix); + } + fprintf(stdout, "%s name: %s\n", prefix, + map->operations[j].name); + fprintf(stdout, "%s func: 0x%X\n", prefix, + map->operations[j].function); + } + } + fflush(stdout); +} + +static void print_maps(char* title, oe_map_t * maps, int size) +{ + int i; + char p[64]; + + fprintf(stdout, "%s\n", title); + + for (i = 0 ; i < size ; i++) { + sprintf(p, "map[%d]:", i); + print_map(p, " ", &maps[i]); + } + fprintf(stdout, "\n"); + fflush(stdout); +} + +#else + +#define PRINT_MAPS(P, M, S) +#define PRINT_MAP(T, M) + +#endif /* if defined(DEBUG_MAP) */ + + +/* Generic server switch */ +int oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map) +{ + /* Setting local variables */ + int res = 0; + int index = 0; + + /* XXX map may be NULL !! */ + int length = map->length; + char* op = env->_operation; + + PRINT_MAP("switching on map", map); + + /* Initiating exception indicator */ + env->_major = CORBA_NO_EXCEPTION; + + if ((res = oe_prepare_request_decoding(env) < 0)) + return res; +#if defined(DEBUG_MAP) + fprintf(stdout, "looking for operation: %s\n", op); fflush(stdout); +#endif + for (index = 0; index < length; index++) { +#if defined(DEBUG_MAP) + fprintf(stdout, "map->operations[%d].name: %s\n", + index, map->operations[index].name); + fflush(stdout); +#endif + if(strcmp(map->operations[index].name, op) == 0) { +#if defined(DEBUG_MAP) + fprintf(stdout, "calling map->operations[%d].function: 0x%X\n", + index, map->operations[index].function); + fflush(stdout); +#endif + return map->operations[index].function(obj, env); + } + } + /* Bad call */ + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, + "Invalid operation"); + return -1; +} + +/* For backward compatibility */ +int ___switch___(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map) +{ + return oe_exec_switch(obj, env, map); +} + + +oe_map_t* oe_merge_maps(oe_map_t *maps, int size) +{ + int i, j, length, len, maplen, malloc_size; + void *memp; + oe_map_t *merged; + + if ((maps == NULL) || (size <= 0)) + return NULL; + + PRINT_MAPS("merging maps", maps, size); + + length = 0; + for (i = 0; i < size; i++) + length += (maps[i].length); + + maplen = OE_ALIGN(sizeof(oe_map_t)); + malloc_size = maplen + OE_ALIGN(length*sizeof(oe_operation_t)); + if ((memp = malloc(malloc_size)) == NULL) + return NULL; + + merged = memp; + merged->length = length; + merged->operations = (oe_operation_t *)((char*)memp + maplen); + + for (i = 0, len = 0; i < size; i++) { + for(j = 0 ; j < maps[i].length; j++) + merged->operations[len+j] = maps[i].operations[j]; + len += maps[i].length; + } + PRINT_MAP("merged map", merged); + return merged; +} + +/* For backward compatibility */ +oe_map_t* ___merge___(oe_map_t *maps, int size) +{ + return oe_merge_maps(maps, size); +} + +/* Client send message (Erlang distribution protocol) */ +static int oe_send(CORBA_Environment *env) +{ + if (strlen(env->_regname) == 0) { + if (ei_send_encoded(env->_fd, env->_to_pid, env->_outbuf, + env->_iout) < 0) { + /* XXX Cannot send to peer? */ + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, + "Cannot connect to server"); + return -1; + } + } else { + if (ei_send_reg_encoded(env->_fd, env->_from_pid, + env->_regname, env->_outbuf, + env->_iout) < 0) { + /* XXX Cannot send to peer? */ + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, + "Cannot connect to server"); + return -1; + } + } + return 0; +} + +/* Send notification (gen_server client) */ +int oe_send_notification(CORBA_Environment *env) +{ + return oe_send(env); +} + +/* Send request and receive reply (gen_server client) */ +int oe_send_request_and_receive_reply(CORBA_Environment *env) +{ + int msgType = 0; + erlang_msg msg; + + if (oe_send(env) < 0) + return -1; + + do { + if ((msgType = ei_receive_encoded(env->_fd, + &env->_inbuf, + &env->_inbufsz, + &msg, &env->_iin)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, + "Cannot decode message"); + return -1; + } + } while (msgType != ERL_SEND && msgType != ERL_REG_SEND); + + /* Extracting return message header */ + if (oe_prepare_reply_decoding(env) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message"); + return -1; + } + return 0; +} + +/* Prepare notification encoding (gen_server client) */ +int oe_prepare_notification_encoding(CORBA_Environment *env) +{ + env->_iout = 0; + oe_ei_encode_version(env); + oe_ei_encode_tuple_header(env, 2); + oe_ei_encode_atom(env, "$gen_cast"); + return 0; +} + +/* Prepare request encoding (gen_server client) */ +int oe_prepare_request_encoding(CORBA_Environment *env) +{ + int error = 0; + + env->_iout = 0; + oe_ei_encode_version(env); + oe_ei_encode_tuple_header(env, 3); + oe_ei_encode_atom(env, "$gen_call"); + oe_ei_encode_tuple_header(env, 2); + if ((error = oe_ei_encode_pid(env, env->_from_pid)) < 0) + return error; + if ((error = oe_ei_encode_ref(env, &env->_unique)) < 0) + return error; + return 0; +} + +/* Prepare reply decoding (gen_server client) */ +int oe_prepare_reply_decoding(CORBA_Environment *env) +{ + int error = 0; + int version = 0; + erlang_ref unique; + + env->_iin = 0; + env->_received = 0; + + if ((error = ei_decode_version(env->_inbuf, + &env->_iin, + &version)) < 0) + return error; + if ((error = ei_decode_tuple_header(env->_inbuf, + &env->_iin, + &env->_received)) < 0) + return error; + if ((error = ei_decode_ref(env->_inbuf, + &env->_iin, + &unique)) < 0) + return error; + return ic_compare_refs(&env->_unique, &unique); +} + + +/* Prepare request decoding (gen_server server) */ +int oe_prepare_request_decoding(CORBA_Environment *env) +{ + char gencall_atom[10]; + int error = 0; + int version = 0; + + env->_iin = 0; + env->_received = 0; + memset(gencall_atom, 0, 10); + ei_decode_version(env->_inbuf, &env->_iin, &version); + ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); + ei_decode_atom(env->_inbuf, &env->_iin, gencall_atom); + + if (strcmp(gencall_atom, "$gen_cast") == 0) { + if ((error = ei_decode_atom(env->_inbuf, &env->_iin, + env->_operation)) < 0) { + ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); + if ((error = ei_decode_atom(env->_inbuf, &env->_iin, + env->_operation)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, + "Bad Message, cannot extract operation"); + return error; + } + env->_received -= 1; + } else + env->_received -= 2; + return 0; + } + if (strcmp(gencall_atom, "$gen_call") == 0) { + ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); + if ((error = ei_decode_pid(env->_inbuf, &env->_iin, + &env->_caller)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, + "Bad Message, bad caller identity"); + return error; + } + if ((error = ei_decode_ref(env->_inbuf, &env->_iin, + &env->_unique)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, + "Bad Message, bad message reference"); + return error; + } + if ((error = ei_decode_atom(env->_inbuf, &env->_iin, + env->_operation)) < 0) { + + ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); + + if ((error = ei_decode_atom(env->_inbuf, &env->_iin, + env->_operation)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, + "Bad Message, cannot extract operation"); + return error; + } + env->_received -= 1; + return 0; + } + else { + env->_received -= 2; + return 0; + } + } + + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, + "Bad message, neither cast nor call"); + return -1; +} + +/* Prepare reply encoding (gen_server server) */ +int oe_prepare_reply_encoding(CORBA_Environment *env) +{ + env->_iout = 0; + oe_ei_encode_version(env); + oe_ei_encode_tuple_header(env, 2); + oe_ei_encode_ref(env, &env->_unique); + return 0; +} + +/* ---- Function for making it more easy to implement a server */ +/* Server receive (possibly) send reply (gen_server server) */ + +int oe_server_receive(CORBA_Environment *env, oe_map_t *map) +{ + int res = 0, loop = 1; + erlang_msg msg; + + while (res >= 0 && loop > 0) { + res = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, + &msg, &env->_iin); + switch(res) { + case ERL_SEND: + case ERL_REG_SEND: + oe_exec_switch(NULL, env, map); + switch(env->_major) { + case CORBA_NO_EXCEPTION: + break; + case CORBA_SYSTEM_EXCEPTION: + /* XXX stderr */ + fprintf(stderr, "Request failure, reason : %s\n", + (char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + break; + default: /* Should not happen */ + CORBA_exception_free(env); + break; + } + /* send reply */ + /* XXX We are required to set env->_iout = 0 if oneway?? */ + if (env->_iout > 0) + ei_send_encoded(env->_fd, &env->_caller, env->_outbuf, + env->_iout); + loop = 0; + break; + case ERL_TICK: + break; + default: + /* XXX */ + if (res < 0) { + fprintf(stderr, "Result negative: %d\n", res); + loop = 0; + } + break; + } + } + + return 0; +} + diff --git a/lib/ic/c_src/ic_tmo.c b/lib/ic/c_src/ic_tmo.c new file mode 100644 index 0000000000..78698a6a89 --- /dev/null +++ b/lib/ic/c_src/ic_tmo.c @@ -0,0 +1,135 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + +static int oe_send_tmo(CORBA_Environment *env, unsigned int ms); + +/* Client send message (Erlang distribution protocol) */ +static int oe_send_tmo(CORBA_Environment *env, unsigned int ms) +{ + if (strlen(env->_regname) == 0) { + if (ei_send_encoded_tmo(env->_fd, env->_to_pid, env->_outbuf, + env->_iout, ms) < 0) { + /* XXX Cannot send to peer? */ + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, + "Cannot connect to server"); + return -1; + } + } else { + if (ei_send_reg_encoded_tmo(env->_fd, env->_from_pid, + env->_regname, env->_outbuf, + env->_iout, ms) < 0) { + /* XXX Cannot send to peer? */ + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, + "Cannot connect to server"); + return -1; + } + } + return 0; +} + +/* Send notification (gen_server client) */ +int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms) +{ + return oe_send_tmo(env, send_ms); +} + +/* Send request and receive reply (gen_server client) */ +int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, + unsigned int send_ms, + unsigned int recv_ms) +{ + int msgType = 0; + erlang_msg msg; + + if (oe_send_tmo(env, send_ms) < 0) + return -1; + + do { + if ((msgType = ei_receive_encoded_tmo(env->_fd, + &env->_inbuf, + &env->_inbufsz, + &msg, &env->_iin, + recv_ms)) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, + "Cannot decode message"); + return -1; + } + } while (msgType != ERL_SEND && msgType != ERL_REG_SEND); + + /* Extracting return message header */ + if (oe_prepare_reply_decoding(env) < 0) { + CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message"); + return -1; + } + return 0; +} + +/* Server receive (possibly) send reply (gen_server server) */ + +int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, + unsigned int send_ms, + unsigned int recv_ms) +{ + int res = 0, loop = 1; + erlang_msg msg; + + while (res >= 0 && loop > 0) { + res = ei_receive_encoded_tmo(env->_fd, &env->_inbuf, &env->_inbufsz, + &msg, &env->_iin, recv_ms); + switch(res) { + case ERL_SEND: + case ERL_REG_SEND: + oe_exec_switch(NULL, env, map); + switch(env->_major) { + case CORBA_NO_EXCEPTION: + break; + case CORBA_SYSTEM_EXCEPTION: + /* XXX stderr */ + fprintf(stderr, "Request failure, reason : %s\n", + (char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + break; + default: /* Should not happen */ + CORBA_exception_free(env); + break; + } + /* send reply */ + /* XXX We are required to set env->_iout = 0 if oneway?? */ + if (env->_iout > 0) + ei_send_encoded_tmo(env->_fd, &env->_caller, env->_outbuf, + env->_iout, send_ms); + loop = 0; + break; + case ERL_TICK: + break; + default: + /* XXX */ + if (res < 0) { + fprintf(stderr, "Result negative: %d\n", res); + loop = 0; + } + break; + } + } + + return 0; +} + diff --git a/lib/ic/c_src/oe_ei_code_erlang_binary.c b/lib/ic/c_src/oe_ei_code_erlang_binary.c new file mode 100644 index 0000000000..f790f8bd69 --- /dev/null +++ b/lib/ic/c_src/oe_ei_code_erlang_binary.c @@ -0,0 +1,105 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_encode_erlang_binary(CORBA_Environment *ev, erlang_binary *binary) { + + int size = ev->_iout; + + (int) ei_encode_binary(0, &size, binary->_buffer, binary->_length); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_binary(ev->_outbuf, &ev->_iout, binary->_buffer, binary->_length); +} + + + +int oe_sizecalc_erlang_binary(CORBA_Environment *ev, int* _index, int* _size) { + + long _malloc_size = 0; + int _error = 0; + + if(*_size == 0) + *_size = ((*_size + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1); + + if ((_error = ei_decode_binary(ev->_inbuf, _index, 0, &_malloc_size)) < 0) + return _error; + + *_size = ((*_size + (int)_malloc_size)+sizeof(double)-1)&~(sizeof(double)-1); + + return 0; +} + + +int oe_decode_erlang_binary(CORBA_Environment *ev, char *_first, int* _index, erlang_binary *binary) { + + long _length = 0; + int _error = 0; + + if((char*) binary == _first) + *_index = ((*_index + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1); + + binary->_buffer = (CORBA_octet *)(_first+*_index); + + if ((_error = ei_decode_binary(ev->_inbuf, &ev->_iin, binary->_buffer, &_length)) < 0) + return _error; + + binary->_length = (CORBA_unsigned_long)_length; + + *_index = ((*_index)+_length+sizeof(double)-1)&~(sizeof(double)-1); + + return 0; +} + + + +int print_erlang_binary(erlang_binary *binary) { + + int i=0; + + if (binary == NULL) + return -1; + + fprintf(stdout,"binary->_length : %ld\n",binary->_length); + fprintf(stdout,"binary->_buffer : "); + if(binary->_buffer != NULL) { + for (i=0; i<binary->_length; i++) + fprintf(stdout,"%c",binary->_buffer[i]); + fprintf(stdout,"\n"); + } else + fprintf(stdout,"NULL\n"); + return 0; +} diff --git a/lib/ic/c_src/oe_ei_decode_longlong.c b/lib/ic/c_src/oe_ei_decode_longlong.c new file mode 100644 index 0000000000..1fd5c8420a --- /dev/null +++ b/lib/ic/c_src/oe_ei_decode_longlong.c @@ -0,0 +1,25 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p) { + return ei_decode_long(buf, index, p); +} diff --git a/lib/ic/c_src/oe_ei_decode_ulonglong.c b/lib/ic/c_src/oe_ei_decode_ulonglong.c new file mode 100644 index 0000000000..26e4294783 --- /dev/null +++ b/lib/ic/c_src/oe_ei_decode_ulonglong.c @@ -0,0 +1,25 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_decode_ulonglong(const char *buf, int *index, CORBA_unsigned_long_long *p) { + return ei_decode_ulong(buf, index, p); +} diff --git a/lib/ic/c_src/oe_ei_decode_wchar.c b/lib/ic/c_src/oe_ei_decode_wchar.c new file mode 100644 index 0000000000..b68cdb829f --- /dev/null +++ b/lib/ic/c_src/oe_ei_decode_wchar.c @@ -0,0 +1,25 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p) { + return ei_decode_ulong(buf, index, p); +} diff --git a/lib/ic/c_src/oe_ei_decode_wstring.c b/lib/ic/c_src/oe_ei_decode_wstring.c new file mode 100644 index 0000000000..b89922f4b8 --- /dev/null +++ b/lib/ic/c_src/oe_ei_decode_wstring.c @@ -0,0 +1,107 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +/* Scratch function */ +int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p) { + + int length,error_code,type,tmp=0; + char * tmp_space = NULL; + + + if ((error_code = ei_get_type(buf, index, &type, &length)) < 0) + return error_code; + + switch(type) { + + case ERL_LIST_EXT: /* A list */ + case ERL_NIL_EXT: /* An empty list */ + + if (p) { /* Decoding part */ + + if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) + return error_code; + + if (length != 0) { + for(tmp = 0; tmp < length; tmp++) + if ((error_code = oe_ei_decode_wchar(buf, index, &(p[tmp]))) < 0) + return error_code; + + /* Read list tail also */ + if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) + return error_code; + } + + p[tmp] = 0; /* Wide NULL */ + + } else { /* Allocation counting part */ + + if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) + return error_code; + + if (length != 0) { + for(tmp = 0; tmp < length; tmp++) + if ((error_code = oe_ei_decode_wchar(buf, index, 0)) < 0) + return error_code; + + /* Read list tail also */ + if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) + return error_code; + } + } + + break; + + case ERL_STRING_EXT: /* A string */ + + if (p) { /* Decoding part */ + + /* Allocate temporary string */ + tmp_space = (char*) malloc(length*(__OE_WCHARSZ__+1)); + + if ((error_code = ei_decode_string(buf, index, tmp_space)) < 0) + return error_code; + + /* Assign characters to wide characters */ + for(tmp = 0; tmp < length; tmp++) + p[tmp] = tmp_space[tmp]; + + p[tmp] = 0; /* Wide NULL */ + + /* Free temporary string */ + CORBA_free(tmp_space); + + } else { /* Allocation counting part */ + + if ((error_code = ei_decode_string(buf, index, 0)) < 0) + return error_code; + + } + break; + + default: /* Bad header */ + return -1; + } + + return 0; +} + + diff --git a/lib/ic/c_src/oe_ei_encode_atom.c b/lib/ic/c_src/oe_ei_encode_atom.c new file mode 100644 index 0000000000..d16df25859 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_atom.c @@ -0,0 +1,46 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_atom(CORBA_Environment *ev, const char *p) { + int size = ev->_iout; + + (int) ei_encode_atom(0,&size,p); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_atom(ev->_outbuf,&ev->_iout,p); +} + diff --git a/lib/ic/c_src/oe_ei_encode_char.c b/lib/ic/c_src/oe_ei_encode_char.c new file mode 100644 index 0000000000..a180b908af --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_char.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_char(CORBA_Environment *ev, char p) { + int size = ev->_iout + __OE_CHARSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_char(ev->_outbuf, &ev->_iout, p); +} + + + diff --git a/lib/ic/c_src/oe_ei_encode_double.c b/lib/ic/c_src/oe_ei_encode_double.c new file mode 100644 index 0000000000..931b91ab90 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_double.c @@ -0,0 +1,43 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_double(CORBA_Environment *ev, double p) { + int size = ev->_iout + __OE_DOUBLESZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_double(ev->_outbuf, &ev->_iout, p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_list_header.c b/lib/ic/c_src/oe_ei_encode_list_header.c new file mode 100644 index 0000000000..b93ad9c22a --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_list_header.c @@ -0,0 +1,41 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_list_header(CORBA_Environment *ev, int arity) { + int size = ev->_iout + __OE_LISTHDRSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_list_header(ev->_outbuf, &ev->_iout, arity); +} diff --git a/lib/ic/c_src/oe_ei_encode_long.c b/lib/ic/c_src/oe_ei_encode_long.c new file mode 100644 index 0000000000..1f2e62a999 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_long.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_long(CORBA_Environment *ev, long p) { + int size = ev->_iout + __OE_LONGSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_long(ev->_outbuf, &ev->_iout, p); +} + + + diff --git a/lib/ic/c_src/oe_ei_encode_longlong.c b/lib/ic/c_src/oe_ei_encode_longlong.c new file mode 100644 index 0000000000..79b4eef6a8 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_longlong.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_longlong(CORBA_Environment *ev, CORBA_long_long p) { + int size = ev->_iout + __OE_LONGLONGSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + /* CORBA_long_long = long because of erl_interface limitation */ + return ei_encode_long(ev->_outbuf, &ev->_iout, p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c new file mode 100644 index 0000000000..b7083f84a0 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_pid.c @@ -0,0 +1,45 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) { + int size = ev->_iout; + + (int) ei_encode_pid(NULL, &size, p); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_pid(ev->_outbuf, &ev->_iout, p); +} diff --git a/lib/ic/c_src/oe_ei_encode_port.c b/lib/ic/c_src/oe_ei_encode_port.c new file mode 100644 index 0000000000..981f82c08d --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_port.c @@ -0,0 +1,46 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_port(CORBA_Environment *ev, const erlang_port *p) { + int size = ev->_iout; + + (int) ei_encode_port(NULL, &size, p); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_port(ev->_outbuf, &ev->_iout, p); +} + diff --git a/lib/ic/c_src/oe_ei_encode_ref.c b/lib/ic/c_src/oe_ei_encode_ref.c new file mode 100644 index 0000000000..d321469b45 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_ref.c @@ -0,0 +1,46 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_ref(CORBA_Environment *ev, const erlang_ref *p) { + int size = ev->_iout; + + (int) ei_encode_ref(NULL, &size, p); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_ref(ev->_outbuf, &ev->_iout, p); +} + diff --git a/lib/ic/c_src/oe_ei_encode_string.c b/lib/ic/c_src/oe_ei_encode_string.c new file mode 100644 index 0000000000..48de73b5a8 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_string.c @@ -0,0 +1,47 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_string(CORBA_Environment *ev, const char *p) { + int size = ev->_iout; + + (int) ei_encode_string(0,&size,p); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_string(ev->_outbuf,&ev->_iout,p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_term.c b/lib/ic/c_src/oe_ei_encode_term.c new file mode 100644 index 0000000000..48de152ac6 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_term.c @@ -0,0 +1,48 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_term(CORBA_Environment *ev, void *t) { + int size = ev->_iout; + + (int) ei_encode_term(NULL, &size, t); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + return ei_encode_term(ev->_outbuf, &ev->_iout, t); +} + + + diff --git a/lib/ic/c_src/oe_ei_encode_tuple_header.c b/lib/ic/c_src/oe_ei_encode_tuple_header.c new file mode 100644 index 0000000000..c2d92a79fb --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_tuple_header.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_tuple_header(CORBA_Environment *ev, int arity) { + int size = ev->_iout + __OE_TUPLEHDRSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_tuple_header(ev->_outbuf, &ev->_iout, arity); +} + + + diff --git a/lib/ic/c_src/oe_ei_encode_ulong.c b/lib/ic/c_src/oe_ei_encode_ulong.c new file mode 100644 index 0000000000..d1a9cf1aa1 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_ulong.c @@ -0,0 +1,43 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_ulong(CORBA_Environment *ev, unsigned long p) { + int size = ev->_iout + __OE_ULONGSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_ulong(ev->_outbuf, &ev->_iout, p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_ulonglong.c b/lib/ic/c_src/oe_ei_encode_ulonglong.c new file mode 100644 index 0000000000..1260053116 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_ulonglong.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_ulonglong(CORBA_Environment *ev, CORBA_unsigned_long_long p) { + int size = ev->_iout + __OE_ULONGLONGSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + /* CORBA_long_long = long because of erl_interface limitation */ + return ei_encode_ulong(ev->_outbuf, &ev->_iout, p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_version.c b/lib/ic/c_src/oe_ei_encode_version.c new file mode 100644 index 0000000000..2448b32916 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_version.c @@ -0,0 +1,42 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_version(CORBA_Environment *ev) { + int size = ev->_iout + __OE_VSNSZ__; + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + if ((buf = realloc(buf,bufsz)) != NULL) { + ev->_outbuf = buf; + ev->_outbufsz += ev->_memchunk; + } + else { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + } + + return ei_encode_version(ev->_outbuf, &ev->_iout); +} + diff --git a/lib/ic/c_src/oe_ei_encode_wchar.c b/lib/ic/c_src/oe_ei_encode_wchar.c new file mode 100644 index 0000000000..6b9505aab0 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_wchar.c @@ -0,0 +1,27 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_wchar(CORBA_Environment *ev, CORBA_wchar p) { + return oe_ei_encode_ulong(ev, p); +} + + diff --git a/lib/ic/c_src/oe_ei_encode_wstring.c b/lib/ic/c_src/oe_ei_encode_wstring.c new file mode 100644 index 0000000000..6f26c53623 --- /dev/null +++ b/lib/ic/c_src/oe_ei_encode_wstring.c @@ -0,0 +1,62 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <ic.h> + + +int oe_ei_encode_wstring(CORBA_Environment *ev, CORBA_wchar *p) { + + int len,wchar,size,tmp,error_code; + + len = ic_wstrlen(p); + size = ev->_iout + __OE_LISTHDRSZ__ +(len * __OE_WCHARSZ__); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } + + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } + + /* Encode the wide string */ + error_code = 0; + + if ((error_code = oe_ei_encode_list_header(ev, len)) < 0) + return error_code; + + for(tmp = 0; tmp < len; tmp++) + if ((error_code = oe_ei_encode_wchar(ev, p[tmp])) < 0) + return error_code; + + if ((error_code = oe_ei_encode_empty_list(ev)) < 0) + return error_code; + + return 0; +} + + diff --git a/lib/ic/doc/html/.gitignore b/lib/ic/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/doc/html/.gitignore diff --git a/lib/ic/doc/man1/.gitignore b/lib/ic/doc/man1/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/doc/man1/.gitignore diff --git a/lib/ic/doc/man3/.gitignore b/lib/ic/doc/man3/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/doc/man3/.gitignore diff --git a/lib/ic/doc/pdf/.gitignore b/lib/ic/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/doc/pdf/.gitignore diff --git a/lib/ic/doc/src/CORBA_Environment_alloc.xml b/lib/ic/doc/src/CORBA_Environment_alloc.xml new file mode 100644 index 0000000000..909379d6dc --- /dev/null +++ b/lib/ic/doc/src/CORBA_Environment_alloc.xml @@ -0,0 +1,142 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE cref SYSTEM "cref.dtd"> + +<cref> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>CORBA_Environment_alloc</title> + <prepared></prepared> + <docno></docno> + <checked></checked> + <date>1998-12-01</date> + <rev>A</rev> + </header> + <lib>CORBA_Environment_alloc</lib> + <libsummary>Allocation function for the CORBA_Environement struct</libsummary> + <description> + <p>The <em>CORBA_Environment_alloc()</em> function is the + function used to allocate and initiate the <em>CORBA_Environment</em> + structure.</p> + </description> + <funcs> + <func> + <name><ret>CORBA_Environment *</ret><nametext>CORBA_Environment_alloc(inbufsz, outbufsz)</nametext></name> + <fsummary>Initialize communication</fsummary> + <type> + <v>int inbufsz;</v> + <v>int outbufsz;</v> + </type> + <desc> + <p>This function is used to create and initiate the <c>CORBA_Environment</c> + structure. In particular, it is used to dynamically allocate a CORBA_Environment + structure and set the default values for the structure's fields. </p> + <p><em>inbufsize</em> is the wished size of input buffer.</p> + <p><em>outbufsize</em> is the wished size of output buffer.</p> + <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure used by the + generated stub.</p> + <p>This function will set all needed default values and allocate buffers equal + to the values passed, but will not allocate space for the _to_pid and _from_pid fields.</p> + <p>To free the space allocated by CORBA_Environment_alloc/2 :</p> + <list type="bulleted"> + <item> + <p>First call CORBA_free for the input and output buffers.</p> + </item> + <item> + <p>After freeing the buffer space, call CORBA_free for the CORBA_Environment space. </p> + </item> + </list> + </desc> + </func> + </funcs> + + <section> + <title>The CORBA_Environment structure</title> + <p>Here is the complete definition of the CORBA_Environment structure, + defined in file <em>ic.h</em> : </p> + <code type="none"> +/* Environment definition */ +typedef struct { + + /*----- CORBA compatibility part ------------------------*/ + /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ + CORBA_exception_type _major; + + /*----- External Implementation part - initiated by the user ---*/ + /* File descriptor */ + int _fd; + /* Size of input buffer */ + int _inbufsz; + /* Pointer to always dynamically allocated buffer for input */ + char *_inbuf; + /* Size of output buffer */ + int _outbufsz; + /* Pointer to always dynamically allocated buffer for output */ + char *_outbuf; + /* Size of memory chunks in bytes, used for increasing the output + buffer, set to >= 32, should be around >= 1024 for performance + reasons */ + int _memchunk; + /* Pointer for registered name */ + char _regname[256]; + /* Process identity for caller */ + erlang_pid *_to_pid; + /* Process identity for callee */ + erlang_pid *_from_pid; + + /*- Internal Implementation part - used by the server/client ---*/ + /* Index for input buffer */ + int _iin; + /* Index for output buffer */ + int _iout; + /* Pointer for operation name */ + char _operation[256]; + /* Used to count parameters */ + int _received; + /* Used to identify the caller */ + erlang_pid _caller; + /* Used to identify the call */ + erlang_ref _unique; + /* Exception id field */ + CORBA_char *_exc_id; + /* Exception value field */ + void *_exc_value; + + +} CORBA_Environment; + </code> + <note> + <p>Remember to set the field values <em>_fd </em>, <em>_regname </em>, <em>*_to_pid </em> and/or + <em>*_from_pid </em> to the appropriate application values. These are not automatically + set by the stubs.</p> + </note> + <warning> + <p>Never assign static buffers to the buffer pointers, never set the <em>_memchunk</em> field to + a value less than <em>32</em>.</p> + </warning> + </section> + + <section> + <title>SEE ALSO</title> + <p>ic(3)</p> + </section> + +</cref> + + diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile new file mode 100644 index 0000000000..fff930d745 --- /dev/null +++ b/lib/ic/doc/src/Makefile @@ -0,0 +1,320 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(IC_VSN) +APPLICATION=ic +# ---------------------------------------------------- +# Include dependency +# ---------------------------------------------------- + +ifndef DOCSUPPORT +include make.dep +endif + +# ---------------------------------------------------- +# Java specific +# ---------------------------------------------------- +JAVADOC=javadoc +JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/ +JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/ +JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/ + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml +XML_REF3_FILES = ic.xml \ + ic_clib.xml \ + ic_c_protocol.xml + +XML_PART_FILES = part.xml \ + part_notes.xml + +XML_CHAPTER_FILES = \ + ch_introduction.xml \ + ch_basic_idl.xml \ + ch_ic_protocol.xml \ + ch_erl_plain.xml \ + ch_erl_genserv.xml \ + ch_c_mapping.xml \ + ch_c_client.xml \ + ch_c_server.xml \ + ch_c_corba_env.xml \ + ch_java.xml \ + notes.xml + +BOOK_FILES = book.xml + +GIF_FILES = \ + book.gif \ + notes.gif \ + ref_man.gif \ + user_guide.gif + +# ---------------------------------------------------- + +HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) + +INFO_FILE = ../../info +EXTRA_FILES = summary.html.src \ + $(DEFAULT_GIF_FILES) \ + $(DEFAULT_HTML_FILES) \ + $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) + +MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) + +ifdef DOCSUPPORT + +HTML_REF_MAN_FILE = $(HTMLDIR)/index.html + +TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf + +else + +TEX_FILES_BOOK = \ + $(BOOK_FILES:%.xml=%.tex) +TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ + $(XML_APPLICATION_FILES:%.xml=%.tex) +TEX_FILES_USERS_GUIDE = \ + $(XML_CHAPTER_FILES:%.xml=%.tex) + +TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf +TOP_PS_FILE = $(APPLICATION)-$(VSN).ps + +$(TOP_PDF_FILE): book.dvi ../../vsn.mk + $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ + +$(TOP_PS_FILE): book.dvi ../../vsn.mk + $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ + +endif + +JAVA_SOURCE_FILES = \ + Holder.java \ + BooleanHolder.java \ + ByteHolder.java \ + CharHolder.java \ + DoubleHolder.java \ + FloatHolder.java \ + IntHolder.java \ + LongHolder.java \ + ShortHolder.java \ + StringHolder.java \ + Environment.java \ + Any.java \ + AnyHelper.java \ + AnyHolder.java \ + TypeCode.java \ + TCKind.java \ + Pid.java \ + PidHolder.java \ + PidHelper.java \ + Ref.java \ + RefHolder.java \ + RefHelper.java \ + Port.java \ + PortHolder.java \ + PortHelper.java \ + Term.java \ + TermHolder.java \ + TermHelper.java + + +JD_INDEX_HTML_FILES = \ + allclasses-frame.html \ + allclasses-noframe.html \ + deprecated-list.html \ + index-all.html \ + overview-tree.html \ + stylesheet.css \ + help-doc.html \ + index.html \ + package-list \ + serialized-form.html \ + constant-values.html + +JD_GIF_FILES = \ + ../html/java/resources/inherit.gif + + +PACK_DIR = com/ericsson/otp/ic +JAVA_SOURCE_DIR = ../../java_src/$(PACK_DIR) + +JD_PACK_HTML_FILES = \ + package-frame.html \ + package-summary.html \ + package-tree.html + +JAVADOC_PACK_HTML_FILES = \ + $(JAVA_SOURCE_FILES:%.java=../html/java/$(PACK_DIR)/%.html) \ + $(JD_PACK_HTML_FILES:%=../html/java/$(PACK_DIR)/%) + +JAVADOC_INDEX_HTML_FILES = $(JD_INDEX_HTML_FILES:%=../html/java/%) + +JAVADOC_GENERATED_FILES = $(JAVADOC_PACK_HTML_FILES) $(JAVADOC_INDEX_HTML_FILES) + + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT) + +XML_FLAGS += +DVIPS_FLAGS += +JAVADOCFLAGS = \ + -classpath $(CLASSPATH) \ + -d ../doc/html/java \ + -windowtitle "Package com.ericsson.otp.ic version $(IC_VSN)" \ + -public \ + -footer "<CENTER><FONT SIZE=-1>Copyright © 1991-2007 Ericsson AB<BR> </FONT> </CENTER>" + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +$(HTMLDIR)/%.gif: %.gif + $(INSTALL_DATA) $< $@ + +ifdef DOCSUPPORT + +docs: pdf html man $(JAVADOC_GENERATED_FILES) + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: gifs $(HTML_REF_MAN_FILE) + +clean clean_docs: + rm -rf $(HTMLDIR)/* + rm -f $(MAN3DIR)/* + rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f errs core *~ + +else + +ifeq ($(DOCTYPE),pdf) +docs: pdf +else +ifeq ($(DOCTYPE),ps) +docs: ps +else +docs: html $(JAVADOC_GENERATED_FILES) gifs man +endif +endif + +pdf: $(TOP_PDF_FILE) + +ps: $(TOP_PS_FILE) + +html: $(HTML_FILES) + +clean clean_docs clean_tex: + rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) + rm -f $(HTML_FILES) $(MAN3_FILES) + rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) + rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) + rm -rf ../html/java/* + +endif + +$(JAVADOC_GENERATED_FILES): + @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic) + +man: $(MAN3_FILES) + +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) + +$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +debug opt: + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +ifdef DOCSUPPORT + +release_docs_spec: docs + $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf + $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf + $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) + $(INSTALL_DIR) $(RELSYSDIR)/doc/html + (/bin/cp -rf $(HTMLDIR) $(RELSYSDIR)/doc) + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 + +else + +ifeq ($(DOCTYPE),pdf) +release_docs_spec: pdf + $(INSTALL_DIR) $(RELEASE_PATH)/pdf + $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf +else +ifeq ($(DOCTYPE),ps) +release_docs_spec: ps + $(INSTALL_DIR) $(RELEASE_PATH)/ps + $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps +else +release_docs_spec: docs + $(INSTALL_DIR) $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ + $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp + $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic + $(INSTALL_DATA) $(JAVADOC_INDEX_HTML_FILES) \ + $(RELSYSDIR)/doc/html/java + $(INSTALL_DATA) $(JD_GIF_FILES) \ + $(RELSYSDIR)/doc/html/java/resources + $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ + $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 + +endif +endif + +endif + + +release_spec: + + diff --git a/lib/ic/doc/src/book.gif b/lib/ic/doc/src/book.gif Binary files differnew file mode 100644 index 0000000000..94b3868792 --- /dev/null +++ b/lib/ic/doc/src/book.gif diff --git a/lib/ic/doc/src/book.xml b/lib/ic/doc/src/book.xml new file mode 100644 index 0000000000..f83bb1c632 --- /dev/null +++ b/lib/ic/doc/src/book.xml @@ -0,0 +1,49 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE book SYSTEM "book.dtd"> + +<book xmlns:xi="http://www.w3.org/2001/XInclude"> + <header titlestyle="normal"> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>ic</title> + <prepared></prepared> + <docno></docno> + <date>1998-09-29</date> + <rev>4.0.4</rev> + <file>book.sgml</file> + </header> + <insidecover> + </insidecover> + <pagetext>ic</pagetext> + <preamble> + <contents level="2"></contents> + </preamble> + <parts lift="no"> + <xi:include href="part.xml"/> + </parts> + <applications> + <xi:include href="ref_man.xml"/> + </applications> + <releasenotes> + <xi:include href="notes.xml"/> + </releasenotes> + <listofterms></listofterms> + <index></index> +</book> + diff --git a/lib/ic/doc/src/c-part.xml b/lib/ic/doc/src/c-part.xml new file mode 100644 index 0000000000..91c81c8ef3 --- /dev/null +++ b/lib/ic/doc/src/c-part.xml @@ -0,0 +1,40 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part> + <header> + <copyright> + <year>2002</year> + <year>2007</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>IDL to C language Mapping</title> + <prepared></prepared> + <docno></docno> + <date>2002-06-25</date> + <rev>A</rev> + </header> + <description> + <p>IDL to C</p> + </description> + <include file="ch_c_mapping"></include> + <include file="ch_c_client"></include> + <include file="ch_c_server"></include> + <include file="ch_c_corba_env"></include> +</part> + diff --git a/lib/ic/doc/src/ch_basic_idl.xml b/lib/ic/doc/src/ch_basic_idl.xml new file mode 100644 index 0000000000..d993fa3594 --- /dev/null +++ b/lib/ic/doc/src/ch_basic_idl.xml @@ -0,0 +1,163 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2002</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>OMG IDL</title> + <prepared></prepared> + <docno></docno> + <date>2002-07-15</date> + <rev></rev> + <file>ch_basic_idl.xml</file> + </header> + + <section> + <title>OMG IDL - Overview</title> + <p>The purpose of OMG IDL, <em>Interface Definition Language</em>, mapping + is to act as translator between platforms and languages. An IDL + specification is supposed to describe data types, object types etc.</p> + <p>Since the <c>C</c> and <c>Java</c> IC backends only supports a subset of the + IDL types supported by the other backends, the mapping is divided into + different parts. For more information about IDL to Erlang mapping, + i.e., <c>CORBA</c>, plain Erlang and generic Erlang Server, see the Orber + User's Guide. How to use the plain Erlang and generic Erlang Server is + found in this User's Guide.</p> + + <section> + <title>Reserved Compiler Names and Keywords</title> + <p>The use of some names is strongly discouraged due to + ambiguities. However, the use of some names is prohibited + when using the Erlang mapping , as they are strictly reserved for IC.</p> + <p>IC reserves all identifiers starting with <c>OE_</c> and <c>oe_</c> + for internal use.</p> + <p>Note also, that an identifier in IDL can contain alphabetic, + digits and underscore characters, but the first character + <em>must</em> be alphabetic. + </p> + <p>Using underscores in IDL names can lead to ambiguities + due to the name mapping described above. It is advisable to + avoid the use of underscores in identifiers.</p> + <p>The OMG defines a set of reserved words, shown below, for use as keywords. + These may <em>not</em> be used as, for example, identifiers.</p> + <table> + <row> + <cell align="left" valign="middle">abstract</cell> + <cell align="left" valign="middle">double</cell> + <cell align="left" valign="middle">local</cell> + <cell align="left" valign="middle">raises</cell> + <cell align="left" valign="middle">typedef</cell> + </row> + <row> + <cell align="left" valign="middle">any</cell> + <cell align="left" valign="middle">exception</cell> + <cell align="left" valign="middle">long</cell> + <cell align="left" valign="middle">readonly</cell> + <cell align="left" valign="middle">unsigned</cell> + </row> + <row> + <cell align="left" valign="middle">attribute</cell> + <cell align="left" valign="middle">enum</cell> + <cell align="left" valign="middle">module</cell> + <cell align="left" valign="middle">sequence</cell> + <cell align="left" valign="middle">union</cell> + </row> + <row> + <cell align="left" valign="middle">boolean</cell> + <cell align="left" valign="middle">factory</cell> + <cell align="left" valign="middle">native</cell> + <cell align="left" valign="middle">short</cell> + <cell align="left" valign="middle">ValueBase</cell> + </row> + <row> + <cell align="left" valign="middle">case</cell> + <cell align="left" valign="middle">FALSE</cell> + <cell align="left" valign="middle">Object</cell> + <cell align="left" valign="middle">string</cell> + <cell align="left" valign="middle">valuetype</cell> + </row> + <row> + <cell align="left" valign="middle">char</cell> + <cell align="left" valign="middle">fixed</cell> + <cell align="left" valign="middle">octet</cell> + <cell align="left" valign="middle">struct</cell> + <cell align="left" valign="middle">void</cell> + </row> + <row> + <cell align="left" valign="middle">const</cell> + <cell align="left" valign="middle">float</cell> + <cell align="left" valign="middle">oneway</cell> + <cell align="left" valign="middle">supports</cell> + <cell align="left" valign="middle">wchar</cell> + </row> + <row> + <cell align="left" valign="middle">context</cell> + <cell align="left" valign="middle">in</cell> + <cell align="left" valign="middle">out</cell> + <cell align="left" valign="middle">switch</cell> + <cell align="left" valign="middle">wstring</cell> + </row> + <row> + <cell align="left" valign="middle">custom</cell> + <cell align="left" valign="middle">inout</cell> + <cell align="left" valign="middle">private</cell> + <cell align="left" valign="middle">TRUE</cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle">default</cell> + <cell align="left" valign="middle">interface</cell> + <cell align="left" valign="middle">public</cell> + <cell align="left" valign="middle">truncatable</cell> + <cell align="left" valign="middle"></cell> + </row> + <tcaption>OMG IDL keywords</tcaption> + </table> + <p>The keywords listed above must be written exactly as shown. Any usage + of identifiers that collide with a keyword is illegal. For example, + <em>long</em> is a valid keyword; <em>Long</em> and <em>LONG</em> are + illegal as keywords and identifiers. But, since the OMG must be able + to expand the IDL grammar, it is possible to use <em>Escaped Identifiers</em>. For example, it is not unlikely that <c>native</c> + have been used in IDL-specifications as identifiers. One option is to + change all occurrences to <c>myNative</c>. Usually, it is necessary + to change programming language code that depends upon that IDL as well. + Since Escaped Identifiers just disable type checking (i.e. if it is a reserved + word or not) and leaves everything else unchanged, it is only necessary to + update the IDL-specification. To escape an identifier, simply prefix it + with <c>_</c>. The following IDL-code is illegal:</p> + <code type="none"> +typedef string native; +interface i { + void foo(in native Arg); + }; +}; + </code> + <p>With Escaped Identifiers the code will look like:</p> + <code type="none"> +typedef string _native; +interface i { + void foo(in _native Arg); + }; +}; + </code> + </section> + </section> +</chapter> + diff --git a/lib/ic/doc/src/ch_c_client.xml b/lib/ic/doc/src/ch_c_client.xml new file mode 100644 index 0000000000..7d4f8ec91a --- /dev/null +++ b/lib/ic/doc/src/ch_c_client.xml @@ -0,0 +1,149 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>The C Client Back-end</title> + <prepared></prepared> + <docno></docno> + <date>2004-01-14</date> + <rev>C</rev> + <file>ch_c_client.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>With the option <c>{be, c_client}</c> the IDL Compiler generates + C client stubs according to the IDL to C mapping, on top of the + Erlang distribution and gen_server protocols.</p> + <p>The developer has to write additional code, that together with + the generated C client stubs, form a hidden Erlang node. That + additional code uses <c>erl_interface</c> functions for defining + the hidden node, and for establishing connections to other + Erlang nodes.</p> + </section> + + <section> + <title>Generated Stub Files</title> + <p>The generated stub files are:</p> + <list type="bulleted"> + <item> + <p>For each IDL interface, a C source file, the name of which + is <c><![CDATA[<Scoped Interface Name>.c]]></c>. Each operation of the + IDL interface is mapped to a C function (with scoped name) + in that file;</p> + </item> + <item> + <p>C source files that contain functions for type conversion, + memory allocation, and data encoding/decoding;</p> + </item> + <item> + <p>C header files that contain function prototypes and type + definitions.</p> + </item> + </list> + <p>All C functions are exported (i.e. not declared static).</p> + </section> + + <section> + <title>C Interface Functions</title> + <p>For each IDL operation a C interface function is + generated, the prototype of which is:</p> + <p><c><![CDATA[<Return Value> <Scoped Function Name>(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env);]]></c></p> + <p>where</p> + <list type="bulleted"> + <item> + <p><c><![CDATA[<Return Value>]]></c> is the value to be returned as defined + by the IDL specification;</p> + </item> + <item> + <p><c><![CDATA[<Interface Object> oe_obj]]></c> is the client interface + object;</p> + </item> + <item> + <p><c><![CDATA[<Parameters>]]></c> is a list of parameters of the + operation, defined in the same order as defined by the IDL + specification;</p> + </item> + <item> + <p><c>CORBA_Environment *oe_env</c> is a pointer to the current + client environment. It contains the current file descriptor, + the current input and output buffers, etc. For details see + <seealso marker="ch_c_corba_env#corbaenv">CORBA_Environment C Structure</seealso>.</p> + </item> + </list> + </section> + + <section> + <title>Generating, Compiling and Linking</title> + <p>To generate the C client stubs type the following in an + appropriate shell:</p> + <p><c><![CDATA[erlc -I ICROOT/include "+{be, c_client}" File.idl]]></c>,</p> + <p>where <c>ICROOT</c> is the root of the IC application. The + <c>-I ICROOT/include</c> is only needed if <c>File.idl</c> + refers to <c>erlang.idl</c>.</p> + <p>When compiling a generated C stub file, the directories + <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be + specified as include directories, where <c>EIROOT</c> is the + root directory of the Erl_interface application.</p> + <p>When linking object files the <c>EIROOT/lib</c> and + <c>ICROOT/priv/lib</c> directories have to be specified. </p> + </section> + + <section> + <title>An Example</title> + <p>In this example the IDL specification file "random.idl" is used + for generating C client stubs (the file is contained in the IC + <c>/examples/c-client</c> directory):</p> + <code type="none"><![CDATA[ +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; ]]></code> + <p>Generate the C client stubs:</p> + + <code type="none"><![CDATA[ +erlc '+{be, c_client}' random.idl +Erlang IDL compiler version X.Y.Z ]]></code> + + <p>Six files are generated. </p> + <p>Compile the C client stubs:</p> + <p>Please read the <c>ReadMe</c> file att the + <c>examples/c-client</c> directory</p> + <p>In the same + directory you can find all the code for this example.</p> + <p>In particular you will find the <c>client.c</c> file that contains + all the additional code that must be written to obtain a complete + client. </p> + <p>In the <c>examples/c-client</c> directory you will also find + source code for an Erlang server, which can be used for testing + the C client.</p> + </section> +</chapter> + + diff --git a/lib/ic/doc/src/ch_c_corba_env.xml b/lib/ic/doc/src/ch_c_corba_env.xml new file mode 100644 index 0000000000..557eeffdd4 --- /dev/null +++ b/lib/ic/doc/src/ch_c_corba_env.xml @@ -0,0 +1,385 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>CORBA_Environment C Structure</title> + <prepared></prepared> + <docno></docno> + <date>2003-12-15</date> + <rev>PC1</rev> + <file>ch_c_corba_env.xml</file> + </header> + <marker id="corbaenv"></marker> + <p>This chapter describes the CORBA_Environment C structure.</p> + + <section> + <title>C Structure</title> + <p>Here is the complete definition of the CORBA_Environment + C structure, defined in file "ic.h" : </p> + <code type="none"> +/* Environment definition */ +typedef struct { + + /*----- CORBA compatibility part ------------------------*/ + /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ + CORBA_exception_type _major; + + /*----- External Implementation part - initiated by the user ---*/ + /* File descriptor */ + int _fd; + /* Size of input buffer */ + int _inbufsz; + /* Pointer to always dynamically allocated buffer for input */ + char *_inbuf; + /* Size of output buffer */ + int _outbufsz; + /* Pointer to always dynamically allocated buffer for output */ + char *_outbuf; + /* Size of memory chunks in bytes, used for increasing the output + buffer, set to >= 32, should be around >= 1024 for performance + reasons */ + int _memchunk; + /* Pointer for registered name */ + char _regname[256]; + /* Process identity for caller */ + erlang_pid *_to_pid; + /* Process identity for callee */ + erlang_pid *_from_pid; + + /*- Internal Implementation part - used by the server/client ---*/ + /* Index for input buffer */ + int _iin; + /* Index for output buffer */ + int _iout; + /* Pointer for operation name */ + char _operation[256]; + /* Used to count parameters */ + int _received; + /* Used to identify the caller */ + erlang_pid _caller; + /* Used to identify the call */ + erlang_ref _unique; + /* Exception id field */ + CORBA_char *_exc_id; + /* Exception value field */ + void *_exc_value; + + +} CORBA_Environment; + </code> + <p>The structure is divided into three parts:</p> + <list type="bulleted"> + <item> + <p>The CORBA Compatibility part, demanded by the standard OMG + IDL mapping v2.0.</p> + </item> + <item> + <p>The external implementation part used for generated + client/server code.</p> + </item> + <item> + <p>The internal part useful for those who wish to define their + own functions.</p> + </item> + </list> + </section> + + <section> + <title>The CORBA Compatibility Part</title> + <p>Contains only one field <c>_major</c> defined as a + CORBA_Exception_type. The CORBA_Exception type is an integer + which can be one of:</p> + <list type="bulleted"> + <item> + <p><em>CORBA_NO_EXCEPTION</em>, by default equal to 0, can be + set by the application programmer to another value.</p> + </item> + <item> + <p><em>CORBA_SYSTEM_EXCEPTION</em>, by default equal to -1, can + be set by the application programmer to another value.</p> + </item> + </list> + <p>The current definition of these values are:</p> + <code type="none"> + #define CORBA_NO_EXCEPTION 0 + #define CORBA_SYSTEM_EXCEPTION -1 + </code> + </section> + + <section> + <title>The External Part</title> + <p>This part contains the following fields:</p> + <list type="bulleted"> + <item> + <p>int <em>_fd</em> - a file descriptor returned from + erl_connect. Used for connection setting.</p> + </item> + <item> + <p>char* <em>_inbuf</em> - pointer to a buffer used for + input. Buffer size checks are done under runtime that + prevent buffer overflows. This is done by expanding the + buffer to fit the input message. In order to allow buffer + reallocation, the output buffer must always be dynamically + allocated. The pointer value can change under runtime in + case of buffer reallocation.</p> + </item> + <item> + <p>int <em>_inbufsz</em> - start size of input buffer. Used + for setting the input buffer size under initialization of + the Erl_Interface function ei_receive_encoded/5. The value + of this field can change under runtime in case of input + buffer expansion to fit larger messages</p> + </item> + <item> + <p>int <em>_outbufsz</em> - start size of output buffer. The + value of this field can change under runtime in case of + input buffer expansion to fit larger messages</p> + </item> + <item> + <p>char* <em>_outbuf</em> - pointer to a buffer used for + output. Buffer size checks prevent buffer overflows under + runtime, by expanding the buffer to fit the output message + in cases of lack of space in buffer. In order to allow + buffer reallocation, the output buffer must always be + dynamically allocated. The pointer value can change under + runtime in case of buffer reallocation.</p> + </item> + <item> + <p>int <em>_memchunk</em> - expansion unit size for the output + buffer. This is the size of memory chunks in bytes used for + increasing the output in case of buffer expansion. The value + of this field must be always set to >= 32, should be at + least 1024 for performance reasons.</p> + </item> + <item> + <p>char <em>regname[256]</em> - a registered name for a process. </p> + </item> + <item> + <p>erlang_pid* <em>_to_pid</em> - an Erlang process identifier, + is only used if the registered_name parameter is the empty + string.</p> + </item> + <item> + <p>erlang_pid* <em>_from_pid</em> - your own process id so the + answer can be returned.</p> + </item> + </list> + </section> + + <section> + <title>The Internal Part</title> + <p>This part contains the following fields:</p> + <list type="bulleted"> + <item> + <p>int <em>_iin</em> - Index for input buffer. Initially set + to zero. Updated to agree with the length of the received + encoded message.</p> + </item> + <item> + <p>int <em>_iout</em> - Index for output buffer Initially set + to zero. Updated to agree with the length of the message + encoded to the communication counterpart.</p> + </item> + <item> + <p>char <em>_operation[256]</em> - Pointer for operation name. + Set to the operation to be called.</p> + </item> + <item> + <p>int <em>_received</em> - Used to count parameters. + Initially set to zero.</p> + </item> + <item> + <p>erlang_pid <em>_caller</em> - Used to identify the caller. + Initiated to a value that identifies the caller.</p> + </item> + <item> + <p>erlang_ref <em>_unique</em> - Used to identify the call. + Set to a default value in the case of generated functions.</p> + </item> + <item> + <p>CORBA_char* <em>_exc_id</em> - Exception id field. + Initially set to NULL to agree with the initial value of + _major (CORBA_NO_EXCEPTION).</p> + </item> + <item> + <p>void* <em>_exc_value</em> - Exception value field Initially + set to <em>NULL</em> to agree with the initial value of + _major (CORBA_NO_EXCEPTION).</p> + </item> + </list> + <p>The advanced user who defines his own functions has to + update/support these values in a way similar to how they are + updated in the generated code.</p> + </section> + + <section> + <title>Creating and Initiating the CORBA_Environment Structure</title> + <p>There are two ways to set the CORBA_Environment structure:</p> + <list type="bulleted"> + <item> + <p>Manually</p> + <p>The following default values must be set to the + CORBA_Environment *<em>ev</em> fields, when buffers for + input/output should have the size <em>inbufsz</em>/ + <em>outbufsz</em>:</p> + <list type="bulleted"> + <item> + <p><em>ev->_inbufsz</em> = <em>inbufsz</em>;</p> + <p>The value for this field can be between 0 and maximum + size of a signed integer.</p> + </item> + <item> + <p><em>ev->_inbuf</em> = malloc(<em>inbufsz</em>);</p> + <p>The size of the allocated buffer must be equal to the + value of its corresponding index, _inbufsz.</p> + </item> + <item> + <p><em>ev->_outbufsz</em> = <em>outbufsz</em>;</p> + <p>The value for this field can be between 0 and maximum + size of a signed integer.</p> + </item> + <item> + <p><em>ev->_outbuf</em> = malloc(<em>outbufsz</em>);</p> + <p>The size of the allocated buffer must be equal to the + value of its corresponding index, _outbufsz.</p> + </item> + <item> + <p><em>ev->_memchunk</em> = <em>__OE_MEMCHUNK__</em>;</p> + <p>Please note that __OE_MEMCHUNK__ is equal to + <em>1024</em>, you can set this value to a value bigger + than 32 yourself.</p> + </item> + <item> + <p><em>ev->_to_pid</em> = <em>NULL</em>;</p> + </item> + <item> + <p><em>ev->_from_pid</em> = <em>NULL</em>;</p> + </item> + </list> + <p></p> + </item> + <item> + <p>By using the <em>CORBA_Environment_alloc</em>/2 function. </p> + <p>The CORBA_Environment_alloc function is defined as:</p> + <code type="none"> +\\011 CORBA_Environment *CORBA_Environment_alloc(int inbufsz, + int outbufsz); + </code> + <p>where:</p> + <list type="bulleted"> + <item> + <p><em>inbufsz</em> is the desired size of input buffer</p> + </item> + <item> + <p><em>outbufsz</em> is the desired size of output + buffer</p> + </item> + <item> + <p>return value is a <em>pointer</em> to an allocated and + initialized <em>CORBA_Environment</em> structure.</p> + <p></p> + </item> + </list> + <p>This function will set all needed default values and + allocate buffers equal to the values passed, but will not + allocate space for the _to_pid and _from_pid fields.</p> + <p>To free the space allocated by CORBA_Environment_alloc/2:</p> + <list type="bulleted"> + <item> + <p>First call CORBA_free for the input and output buffers.</p> + </item> + <item> + <p>After freeing the buffer space, call CORBA_free for + the CORBA_Environment space.</p> + </item> + </list> + </item> + </list> + <note> + <p>Remember to set the fields <em>_fd</em>, <em>_regname</em>, + <em>*_to_pid</em> and/or <em>*_from_pid</em> to the + appropriate application values. These are not automatically + set by the stubs.</p> + </note> + <warning> + <p>Never assign static buffers to the buffer pointers. Never set + the <em>_memchunk</em> field to a value less than + <em>32</em>.</p> + </warning> + </section> + + <section> + <title>Setting System Exceptions</title> + <p>If the user wishes to set own system exceptions at critical + positions on the code, it is strongly recommended to use one of + the current values:</p> + <list type="bulleted"> + <item> + <p>CORBA_NO_EXCEPTION upon success. The value of the _exc_id + field should be then set to NULL. The value of the + _exc_value field should be then set to NULL.</p> + </item> + <item> + <p>CORBA_SYSTEM_EXCEPTION upon system failure. The value of + the _exc_id field should be then set to one of the values + defined in "ic.h" :</p> + <code type="none"> + #define UNKNOWN "UNKNOWN" + #define BAD_PARAM "BAD_PARAM" + #define NO_MEMORY "NO_MEMORY" + #define IMPL_LIMIT "IMP_LIMIT" + #define COMM_FAILURE "COMM_FAILURE" + #define INV_OBJREF "INV_OBJREF" + #define NO_PERMISSION "NO_PERMISSION" + #define INTERNAL "INTERNAL" + #define MARSHAL "MARSHAL" + #define INITIALIZE "INITIALIZE" + #define NO_IMPLEMENT "NO_IMPLEMENT" + #define BAD_TYPECODE "BAD_TYPECODE" + #define BAD_OPERATION "BAD_OPERATION" + #define NO_RESOURCES "NO_RESOURCES" + #define NO_RESPONSE "NO_RESPONSE" + #define PERSIST_STORE "PERSIST_STORE" + #define BAD_INV_ORDER "BAD_INV_ORDER" + #define TRANSIENT "TRANSIENT" + #define FREE_MEM "FREE_MEM" + #define INV_IDENT "INV_IDENT" + #define INV_FLAG "INV_FLAG" + #define INTF_REPOS "INTF_REPOS" + #define BAD_CONTEXT "BAD_CONTEXT" + #define OBJ_ADAPTER "OBJ_ADAPTER" + #define DATA_CONVERSION "DATA_CONVERSION" + #define OBJ_NOT_EXIST "OBJECT_NOT_EXIST" + </code> + </item> + </list> + <p>The value of the _exc_value field should be then set to a string + that explains the problem in an informative way. The user + should use the functions CORBA_exc_set/4 and + CORBA_exception_free/1 to free the exception. + The user has to use CORBA_exception_id/1 and + CORBA_exception_value/1 to access exception information. + Prototypes for these functions are declared in "ic.h"</p> + </section> +</chapter> + + diff --git a/lib/ic/doc/src/ch_c_mapping.xml b/lib/ic/doc/src/ch_c_mapping.xml new file mode 100644 index 0000000000..58b026ee78 --- /dev/null +++ b/lib/ic/doc/src/ch_c_mapping.xml @@ -0,0 +1,892 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IDL to C mapping</title> + <prepared></prepared> + <docno></docno> + <date>2002-08-06</date> + <rev>PB1</rev> + <file>ch_c_mapping.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The IC C mapping (used by the C client and C server back-ends) follows + the <em>OMG C Language Mapping Specification</em>. </p> + <p>The C mapping supports the following:</p> + <list type="bulleted"> + <item> + <p>All OMG IDL basic types except <c>long double</c> and <c>any</c>.</p> + </item> + <item> + <p>All OMG IDL constructed types.</p> + </item> + <item> + <p>OMG IDL constants.</p> + </item> + <item> + <p>Operations with passing of parameters and receiving of + results. <c>inout</c> parameters are not supported.</p> + </item> + </list> + <p>The following is not supported: + </p> + <list type="bulleted"> + <item> + <p>Access to attributes.</p> + </item> + <item> + <p>User defined exceptions.</p> + <p></p> + </item> + <item> + <p>User defined objects.</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>C Mapping Characteristics</title> + + <section> + <title>Reserved Names</title> + <p>The IDL compiler reserves all identifiers starting with + <c>OE_</c> and <c>oe_</c> for internal use.</p> + </section> + + <section> + <title>Scoped Names</title> + <p>The C programmer must always use the global name for a type, + constant or operation. The C global name corresponding to an + OMG IDL global name is derived by converting occurrences of + "::" to underscore, and eliminating the leading "::". So, for + example, an operation <c>op1</c> defined in interface + <c>I1</c> which is defined in module <c>M1</c> would be + written as <c>M1::I1::op1</c> in IDL and as <c>M1_I1_op1</c> + in C.</p> + <warning> + <p>If underscores are used in IDL names it can lead to + ambiguities due to the name mapping described above, + therefore it is advisable to avoid underscores in + identifiers.</p> + </warning> + </section> + + <section> + <title>Generated Files</title> + <p>Two files will be generated for each scope. One set of files + will be generated for each module and each interface scope. + An extra set is generated for those definitions at top + level scope. One of the files is a header file(<c>.h</c>), and the + other file is a C source code file (<c>.c</c>). In addition to these + files a number of C source files will be generated for type encodings, + they are named according to the following template: + <c><![CDATA[oe_code_<type>.c]]></c>.</p> + <p>For example:</p> + <code type="none"><![CDATA[ +// IDL, in the file "spec.idl" +module m1 { + + typedef sequence<long> lseq; + + interface i1 { + ... + }; + ... +}; + ]]></code> + <p>XXX This is C client specific. + Will produce the files <c>oe_spec.h</c> and + <c>oe_spec.c</c> for the top scope level. Then the files + <c>m1.h</c> and <c>m1.c</c> for the module <c>m1</c> and + files <c>m1_i1.h</c> and <c>m1_i1.c</c> for the interface + <c>i1</c>. The typedef will produce <c>oe_code_m1_lseq.c</c>.</p> + <p>The header file contains type definitions for all + <c>struct</c> types and sequences and constants in the IDL file. The + c file contains all operation stubs if the the scope is an interface.</p> + <p>In addition to the scope-related files a C source file will + be generated for encoding operations of all <c>struct</c> and + sequence types.</p> + </section> + </section> + + <section> + <title>Basic OMG IDL Types</title> + <p>The mapping of basic types is as follows.</p> + <table> + <row> + <cell align="left" valign="middle"><em>OMG IDL type</em></cell> + <cell align="left" valign="middle"><em>C type</em></cell> + <cell align="left" valign="middle"><em>Mapped to C type</em></cell> + </row> + <row> + <cell align="left" valign="middle">float</cell> + <cell align="left" valign="middle">CORBA_float</cell> + <cell align="left" valign="middle">float</cell> + </row> + <row> + <cell align="left" valign="middle">double</cell> + <cell align="left" valign="middle">CORBA_double</cell> + <cell align="left" valign="middle">double</cell> + </row> + <row> + <cell align="left" valign="middle">short</cell> + <cell align="left" valign="middle">CORBA_short</cell> + <cell align="left" valign="middle">short</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned short</cell> + <cell align="left" valign="middle">CORBA_unsigned_short</cell> + <cell align="left" valign="middle">unsigned short</cell> + </row> + <row> + <cell align="left" valign="middle">long</cell> + <cell align="left" valign="middle">CORBA_long</cell> + <cell align="left" valign="middle">long</cell> + </row> + <row> + <cell align="left" valign="middle">long long</cell> + <cell align="left" valign="middle">CORBA_long_long</cell> + <cell align="left" valign="middle">long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long</cell> + <cell align="left" valign="middle">unsigned long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> + <cell align="left" valign="middle">unsigned long</cell> + </row> + <row> + <cell align="left" valign="middle">char</cell> + <cell align="left" valign="middle">CORBA_char</cell> + <cell align="left" valign="middle">char</cell> + </row> + <row> + <cell align="left" valign="middle">wchar</cell> + <cell align="left" valign="middle">CORBA_wchar</cell> + <cell align="left" valign="middle">unsigned long</cell> + </row> + <row> + <cell align="left" valign="middle">boolean</cell> + <cell align="left" valign="middle">CORBA_boolean</cell> + <cell align="left" valign="middle">unsigned char</cell> + </row> + <row> + <cell align="left" valign="middle">octet</cell> + <cell align="left" valign="middle">CORBA_octet</cell> + <cell align="left" valign="middle">char</cell> + </row> + <row> + <cell align="left" valign="middle">any</cell> + <cell align="left" valign="middle">Not supported</cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle">long double</cell> + <cell align="left" valign="middle">Not supported</cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle">Object</cell> + <cell align="left" valign="middle">Not supported</cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle">void</cell> + <cell align="left" valign="middle">void</cell> + <cell align="left" valign="middle">void</cell> + </row> + <tcaption>OMG IDL Basic Types</tcaption> + </table> + <p>XXX Note that several mappings are not according to OMG C Language + mapping.</p> + </section> + + <section> + <title>Constructed OMG IDL Types</title> + <p>Constructed types have mappings as shown in the following table.</p> + <table> + <row> + <cell align="left" valign="middle">OMG IDL type</cell> + <cell align="left" valign="middle">Mapped to C type</cell> + </row> + <row> + <cell align="left" valign="middle">string</cell> + <cell align="left" valign="middle">CORBA_char*</cell> + </row> + <row> + <cell align="left" valign="middle">wstring</cell> + <cell align="left" valign="middle">CORBA_wchar*</cell> + </row> + <row> + <cell align="left" valign="middle">struct</cell> + <cell align="left" valign="middle">struct</cell> + </row> + <row> + <cell align="left" valign="middle">union</cell> + <cell align="left" valign="middle">union</cell> + </row> + <row> + <cell align="left" valign="middle">enum</cell> + <cell align="left" valign="middle">enum</cell> + </row> + <row> + <cell align="left" valign="middle">sequence</cell> + <cell align="left" valign="middle">struct (see below)</cell> + </row> + <row> + <cell align="left" valign="middle">array</cell> + <cell align="left" valign="middle">array</cell> + </row> + <tcaption>OMG IDL Constructed Types</tcaption> + </table> + <p>An OMG IDL sequence (an array of variable length), </p> + <code type="none"><![CDATA[ +// IDL +typedef sequence <IDL_TYPE> NAME; + ]]></code> + <p>is mapped to a C struct as follows:</p> + <code type="none"> +/* C */ +typedef struct { + CORBA_unsigned_long _maximum; + CORBA_unsigned_long _length; + C_TYPE* _buffer; +} C_NAME; + </code> + <p>where <c>C_TYPE</c> is the mapping of <c>IDL_TYPE</c>, and where + <c>C_NAME</c> is the scoped name of <c>NAME</c>.</p> + </section> + + <section> + <title>OMG IDL Constants</title> + <p>An IDL constant is mapped to a C constant through a C + <c>#define</c> macro, where the name of the macro is scoped. + Example:</p> + <code type="none"> +// IDL +module M1 { + const long c1 = 99; +}; + </code> + <p>results in the following:</p> + <code type="none"> +/* C */ +#define M1_c1 99 + </code> + </section> + + <section> + <title>OMG IDL Operations</title> + <p>An OMG IDL operation is mapped to C function. Each C operation + function has two mandatory parameters: a first parameter of + <em>interface object</em> type, and a last parameter of + <em>environment</em> type.</p> + <p></p> + <p>In a C operation function the the <c>in</c> and <c>out</c> + parameters are located between the first and last parameters + described above, and they appear in the same order as in the IDL + operation declaration.</p> + <p>Notice that <c>inout</c> parameters are not supported. </p> + <p></p> + <p>The return value of an OMG IDL operation is mapped to a + corresponding return value of the C operation function.</p> + <p>Mandatory C operation function parameters:</p> + <list type="bulleted"> + <item><c>CORBA_Object oe_obj</c> - the first parameter of a C + operation function. This parameter is required by the <em>OMG C Language Mapping Specification</em>, but in the current + implementation there is no particular use for it.</item> + <item> + <p><c>CORBA_Environment* oe_env</c> - the last parameter of a C + operation function. The parameter is defined in the C header + file <c>ic.h</c> and has the following public fields:</p> + <list type="bulleted"> + <item> + <p><c>CORBA_Exception_type _major</c> - indicates if an + operation invocation was successful which will be one of + the following:</p> + <list type="bulleted"> + <item>CORBA_NO_EXCEPTION</item> + <item>CORBA_SYSTEM_EXCEPTION</item> + </list> + </item> + <item>int <em>_fd</em> - a file descriptor returned from + <em>erl_connect</em> function.</item> + <item>int <em>_inbufsz</em> - size of input buffer.</item> + <item>char* <em>_inbuf</em> - pointer to a buffer used for + input.</item> + <item>int <em>_outbufsz</em> - size of output buffer.</item> + <item>char* <em>_outbuf</em> - pointer to a buffer used for + output.</item> + <item> + <p>int <em>_memchunk</em> - expansion unit size for the + output buffer. This is the size of memory chunks in + bytes used for increasing the output in case of buffer + expansion. The value of this field must be always set + to >= 32, should be at least 1024 for performance + reasons.</p> + </item> + <item>char <em>regname[256]</em> - a registered name for a + process.</item> + <item>erlang_pid* <em>_to_pid</em> - an Erlang process + identifier, is only used if the registered_name parameter + is the empty string.</item> + <item>erlang_pid* <em>_from_pid</em> - your own process id so + the answer can be returned</item> + </list> + <p>Beside the public fields, other private fields + are internally used but are not mentioned here. </p> + </item> + </list> + <p>Example:</p> + <code type="none"> +// IDL +interface i1 { + long op1(in long a); + long op2(in string s, out long count); +}; + </code> + <p>Is mapped to the following C functions</p> + <code type="none"> +/* C */ +CORBA_long i1_op1(i1 oe_obj, CORBA_long a, CORBA_Environment* oe_env) +{ + ... +} +CORBA_long i1_op2(i1 oe_obj, CORBA_char* s, CORBA_long *count, +CORBA_Environment* oe_env) +{ + ... +} + </code> + <marker id="op_impl"></marker> + + <section> + <title>Operation Implementation</title> + <p>There is no standard CORBA mapping for the C-server side, + as it is implementation-dependent but built in a similar way. + The current server side mapping is different from the client + side mapping in several ways:</p> + <list type="bulleted"> + <item>Argument mappings</item> + <item>Result values</item> + <item>Structure</item> + <item>Usage</item> + <item>Exception handling</item> + </list> + </section> + </section> + + <section> + <title>Exceptions</title> + <p>Although exception mapping is not implemented, the stubs will + generate CORBA system exceptions in case of operation failure. + Thus, the only exceptions propagated by the system are built in + system exceptions.</p> + </section> + + <section> + <title>Access to Attributes</title> + <p>Not Supported</p> + </section> + + <section> + <title>Summary of Argument/Result Passing for the C-client</title> + <p>The user-defined parameters can only be <c>in</c> or <c>out</c> + parameters, as + <c>inout</c> parameters are not supported.</p> + <p>This table summarize the types a client passes as arguments to + a stub, and receives as a result.</p> + <table> + <row> + <cell align="left" valign="middle">OMG IDL type</cell> + <cell align="left" valign="middle">In</cell> + <cell align="left" valign="middle">Out</cell> + <cell align="left" valign="middle">Return</cell> + </row> + <row> + <cell align="left" valign="middle">short</cell> + <cell align="left" valign="middle">CORBA_short</cell> + <cell align="left" valign="middle">CORBA_short*</cell> + <cell align="left" valign="middle">CORBA_short</cell> + </row> + <row> + <cell align="left" valign="middle">long</cell> + <cell align="left" valign="middle">CORBA_long</cell> + <cell align="left" valign="middle">CORBA_long*</cell> + <cell align="left" valign="middle">CORBA_long</cell> + </row> + <row> + <cell align="left" valign="middle">long long</cell> + <cell align="left" valign="middle">CORBA_long_long</cell> + <cell align="left" valign="middle">CORBA_long_long*</cell> + <cell align="left" valign="middle">CORBA_long_long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned short</cell> + <cell align="left" valign="middle">CORBA_unsigned_short</cell> + <cell align="left" valign="middle">CORBA_unsigned_short*</cell> + <cell align="left" valign="middle">CORBA_unsigned_short</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long*</cell> + <cell align="left" valign="middle">CORBA_unsigned_long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> + <cell align="left" valign="middle">CORBA_unsigned_long_long*</cell> + <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> + </row> + <row> + <cell align="left" valign="middle">float</cell> + <cell align="left" valign="middle">CORBA_float</cell> + <cell align="left" valign="middle">CORBA_float*</cell> + <cell align="left" valign="middle">CORBA_float</cell> + </row> + <row> + <cell align="left" valign="middle">double</cell> + <cell align="left" valign="middle">CORBA_double</cell> + <cell align="left" valign="middle">CORBA_double*</cell> + <cell align="left" valign="middle">CORBA_double</cell> + </row> + <row> + <cell align="left" valign="middle">boolean</cell> + <cell align="left" valign="middle">CORBA_boolean</cell> + <cell align="left" valign="middle">CORBA_boolean*</cell> + <cell align="left" valign="middle">CORBA_boolean</cell> + </row> + <row> + <cell align="left" valign="middle">char</cell> + <cell align="left" valign="middle">CORBA_char</cell> + <cell align="left" valign="middle">CORBA_char*</cell> + <cell align="left" valign="middle">CORBA_char</cell> + </row> + <row> + <cell align="left" valign="middle">wchar</cell> + <cell align="left" valign="middle">CORBA_wchar</cell> + <cell align="left" valign="middle">CORBA_wchar*</cell> + <cell align="left" valign="middle">CORBA_wchar</cell> + </row> + <row> + <cell align="left" valign="middle">octet</cell> + <cell align="left" valign="middle">CORBA_octet</cell> + <cell align="left" valign="middle">CORBA_octet*</cell> + <cell align="left" valign="middle">CORBA_octet</cell> + </row> + <row> + <cell align="left" valign="middle">enum</cell> + <cell align="left" valign="middle">CORBA_enum</cell> + <cell align="left" valign="middle">CORBA_enum*</cell> + <cell align="left" valign="middle">CORBA_enum</cell> + </row> + <row> + <cell align="left" valign="middle">struct, fixed</cell> + <cell align="left" valign="middle">struct*</cell> + <cell align="left" valign="middle">struct*</cell> + <cell align="left" valign="middle">struct</cell> + </row> + <row> + <cell align="left" valign="middle">struct, variable</cell> + <cell align="left" valign="middle">struct*</cell> + <cell align="left" valign="middle">struct**</cell> + <cell align="left" valign="middle">struct*</cell> + </row> + <row> + <cell align="left" valign="middle">union, fixed</cell> + <cell align="left" valign="middle">union*</cell> + <cell align="left" valign="middle">union*</cell> + <cell align="left" valign="middle">union</cell> + </row> + <row> + <cell align="left" valign="middle">union, variable</cell> + <cell align="left" valign="middle">union*</cell> + <cell align="left" valign="middle">union**</cell> + <cell align="left" valign="middle">union*</cell> + </row> + <row> + <cell align="left" valign="middle">string</cell> + <cell align="left" valign="middle">CORBA_char*</cell> + <cell align="left" valign="middle">CORBA_char**</cell> + <cell align="left" valign="middle">CORBA_char*</cell> + </row> + <row> + <cell align="left" valign="middle">wstring</cell> + <cell align="left" valign="middle">CORBA_wchar*</cell> + <cell align="left" valign="middle">CORBA_wchar**</cell> + <cell align="left" valign="middle">CORBA_wchar*</cell> + </row> + <row> + <cell align="left" valign="middle">sequence</cell> + <cell align="left" valign="middle">sequence*</cell> + <cell align="left" valign="middle">sequence**</cell> + <cell align="left" valign="middle">sequence*</cell> + </row> + <row> + <cell align="left" valign="middle">array, fixed</cell> + <cell align="left" valign="middle">array</cell> + <cell align="left" valign="middle">array</cell> + <cell align="left" valign="middle">array_slice*</cell> + </row> + <row> + <cell align="left" valign="middle">array, variable</cell> + <cell align="left" valign="middle">array</cell> + <cell align="left" valign="middle">array_slice**</cell> + <cell align="left" valign="middle">array_slice*</cell> + </row> + <tcaption>Basic Argument and Result passing</tcaption> + </table> + <p>A client is responsible for providing storage of all arguments passed + as <em>in</em> arguments.</p> + <table> + <row> + <cell align="left" valign="middle">OMG IDL type</cell> + <cell align="left" valign="middle">Out</cell> + <cell align="left" valign="middle">Return</cell> + </row> + <row> + <cell align="left" valign="middle">short</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">long</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">long long</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned short</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long long</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">float</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">double</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">boolean</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">char</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">wchar</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">octet</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">enum</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">struct, fixed</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">1</cell> + </row> + <row> + <cell align="left" valign="middle">struct, variable</cell> + <cell align="left" valign="middle">2</cell> + <cell align="left" valign="middle">2</cell> + </row> + <row> + <cell align="left" valign="middle">string</cell> + <cell align="left" valign="middle">2</cell> + <cell align="left" valign="middle">2</cell> + </row> + <row> + <cell align="left" valign="middle">wstring</cell> + <cell align="left" valign="middle">2</cell> + <cell align="left" valign="middle">2</cell> + </row> + <row> + <cell align="left" valign="middle">sequence</cell> + <cell align="left" valign="middle">2</cell> + <cell align="left" valign="middle">2</cell> + </row> + <row> + <cell align="left" valign="middle">array, fixed</cell> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">3</cell> + </row> + <row> + <cell align="left" valign="middle">array, variable</cell> + <cell align="left" valign="middle">3</cell> + <cell align="left" valign="middle">3</cell> + </row> + <tcaption>Client argument storage responsibility</tcaption> + </table> + <table> + <row> + <cell align="left" valign="middle">Case</cell> + <cell align="left" valign="middle">Description</cell> + </row> + <row> + <cell align="left" valign="middle">1</cell> + <cell align="left" valign="middle">Caller allocates all necessary storage, except that which may be encapsulated and managed within the parameter itself.</cell> + </row> + <row> + <cell align="left" valign="middle">2</cell> + <cell align="left" valign="middle">The caller allocates a pointer and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the parameter's type. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell> + </row> + <row> + <cell align="left" valign="middle">3</cell> + <cell align="left" valign="middle">The caller allocates a pointer to an array slice which has all the same dimensions of the original array except the first, and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the array. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell> + </row> + <tcaption>Argument passing cases</tcaption> + </table> + <p>The returned storage in case 2 and 3 is allocated as one block of memory + so it is possible to deallocate it with one call of CORBA_free.</p> + </section> + + <section> + <title>Supported Memory Allocation Functions</title> + <list type="bulleted"> + <item> + <p><em>CORBA_Environment</em> can be allocated from the user by calling + <em>CORBA_Environment_alloc()</em>.</p> + <p>The interface for this function is </p> + <p><c>CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz);</c></p> + <p>where :</p> + <list type="bulleted"> + <item> + <p><em>inbufsz</em> is the desired size of input buffer</p> + </item> + <item> + <p><em>outbufsz</em> is the desired size of output buffer</p> + </item> + <item> + <p>return value is a <em>pointer</em> to an allocated and initialized + <em>CORBA_Environment</em> structure</p> + <p></p> + </item> + </list> + </item> + <item> + <p>Strings can be allocated from the user by calling <em>CORBA_string_alloc()</em>.</p> + <p>The interface for this function is </p> + <p><c>CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len);</c></p> + <p>where :</p> + <list type="bulleted"> + <item> + <p><em>len</em> is the length of the string to be allocated.</p> + </item> + </list> + </item> + </list> + <p>Thus far, no other type allocation function is supported.</p> + </section> + + <section> + <title>Special Memory Deallocation Functions</title> + <list type="bulleted"> + <item> + <p><c>void CORBA_free(void *storage)</c></p> + <p>This function will free storage allocated by the stub.</p> + </item> + <item> + <p><c>void CORBA_exception_free(CORBA_environment *ev)</c></p> + <p>This function will free storage allocated under exception propagation. </p> + </item> + </list> + </section> + + <section> + <title>Exception Access Functions</title> + <list type="bulleted"> + <item> + <p><c>CORBA_char *CORBA_exception_id(CORBA_Environment *ev)</c></p> + <p>This function will return raised exception identity.</p> + </item> + <item> + <p><c>void *CORBA_exception_value(CORBA_Environment *ev)</c></p> + <p>This function will return the value of a raised exception. </p> + </item> + </list> + </section> + + <section> + <title>Special Types</title> + <list type="bulleted"> + <item> + <p>The erlang binary type has some special features.</p> + <p></p> + <p>While the <c>erlang::binary</c> idl type has the same C-definition as + a generated sequence of octets :</p> + <code type="none"><![CDATA[ +\011 module erlang +\011 { + +\011 .... + +\011 // an erlang binary +\011 typedef sequence<octet> binary; +\011 +\011 }; + ]]></code> + <p>it provides a way on sending trasparent data between C and Erlang.</p> + <p>The C-definition (ic.h) for an erlang binary is :</p> + <code type="none"> +\011 typedef struct { +\011 CORBA_unsigned_long _maximum; +\011 CORBA_unsigned_long _length; +\011 CORBA_octet* _buffer; +\011 } erlang_binary; /* ERLANG BINARY */ + </code> + <p>The differences (between <c>erlang::binary</c> and <c><![CDATA[sequence< octet >]]></c>) are :</p> + <list type="bulleted"> + <item> + <p>on the erlang side the user is sending/receiving typical + built in erlang binaries, using <c>term_to_binary() / binary_to_term()</c> + to create / extract binary structures.</p> + </item> + <item> + <p>no encoding/decoding functions are generated</p> + </item> + <item> + <p>the underlying protocol is more efficient than usual sequences of + octets</p> + </item> + </list> + <p>The erlang binary IDL type is defined in <c>erlang.idl</c>, while it's + C definition is located in the <c>ic.h</c> header file, both in the + <c><![CDATA[IC-< vsn >/include]]></c> directory. + The user will have to include the file <c>erlang.idl</c> in order to use the + <c>erlang::binary</c> type.</p> + </item> + </list> + </section> + + <section> + <title>A Mapping Example</title> + <p> <marker id="stack_idl"></marker> + + This is a small example of a simple stack. There are two + operations on the stack, push and pop. The example shows all + generated files as well as conceptual usage of the stack.</p> + <code type="none"> +// The source IDL file: stack.idl + +struct s { + long l; + string s; +}; + +interface stack { + void push(in s val); + s pop(); +}; + </code> + <p>When this file is compiled it produces four files, two for the + top scope and two for the stack interface scope. The important parts + of the generated C code for the stack API is shown below. <marker id="stack_serv"></marker> +</p> + <p>stack.c</p> + <code type="none"> + +void push(stack oe_obj, s val, CORBA_Environment* oe_env) { + ... +} + + +s* pop(stack oe_obj, CORBA_Environment* oe_env) { + ... +} + </code> + <p>oe_stack.h</p> + <code type="none"> +#ifndef OE_STACK_H +#define OE_STACK_H + + +/*------------------------------------------------------------ + * Struct definition: s + */ +typedef struct { + long l; + char *s; +} s; + + + +#endif + </code> + <p>stack.h just contains an include statement of <c>oe_stack.h</c>.</p> + <p>oe_code_s.c</p> + <code type="none"> + +int oe_sizecalc_s(CORBA_Environment + *oe_env, int* oe_size_count_index, int* oe_size) { + ... +} + +int oe_encode_s(CORBA_Environment *oe_env, s* oe_rec) { + ... +} + +int oe_decode_s(CORBA_Environment *oe_env, char *oe_first, + int* oe_outindex, s *oe_out) { + ... +} + </code> + <p>The only files that are really important are the <c>.h</c> + files and the stack.c file.</p> + </section> +</chapter> + diff --git a/lib/ic/doc/src/ch_c_server.xml b/lib/ic/doc/src/ch_c_server.xml new file mode 100644 index 0000000000..c66ae85fa3 --- /dev/null +++ b/lib/ic/doc/src/ch_c_server.xml @@ -0,0 +1,148 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>The C Server Back-end</title> + <prepared></prepared> + <docno></docno> + <date>2004-01-14</date> + <rev>C</rev> + <file>ch_c_server.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>With the option <c>{be, c_server}</c> the IDL Compiler generates + C server skeletons according to the IDL to C mapping, on top of + the Erlang distribution and gen_server protocols.</p> + <p>The developer has to write additional code, that together with + the generated C server skeletons, form a hidden Erlang + node. That additional code contains implementations of call-back + functions that implement the true server functionality, and also + code uses <c>erl_interface</c> functions for defining the hidden + node and for establishing connections to other Erlang nodes.</p> + </section> + + <section> + <title>Generated Stub Files</title> + <p>The generated stub files are:</p> + <list type="bulleted"> + <item> + <p>For each IDL interface, a C source file, the name of which + is <c><![CDATA[<Scoped Interface Name>__s.c]]></c>. Each operation of the + IDL interface is mapped to a C function (with scoped name) + in that file;</p> + </item> + <item> + <p>C source files that contain functions for type conversion, + memory allocation, and data encoding/decoding;</p> + </item> + <item> + <p>C header files that contain function prototypes and type + definitions.</p> + </item> + </list> + <p>All C functions are exported (i.e. not declared static).</p> + </section> + + <section> + <title>C Skeleton Functions</title> + <p>For each IDL operation a C skeleton function is generated, the + prototype of which is <c><![CDATA[int <Scoped Function Name>__exec(<Interface Object> oe_obj, CORBA_Environment *oe_env)]]></c>, where <c><![CDATA[<Interface Object>]]></c>, and + <c>CORBA_Environment</c> are of the same type as for the + generated C client stubs code.</p> + <p>Each <c><![CDATA[<Scoped Function Name>__exec()]]></c> function calls the + call-back function</p> + <p><c><![CDATA[<Scoped Function Name>_rs* <Scoped Function Name>__cb(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env)]]></c></p> + <p>where the arguments are of the same type as those generated for + C client stubs. </p> + <p>The return value <c><![CDATA[<Scoped Function Name>_rs* ]]></c> is a pointer + to a function with the same signature as the call-back function + <c><![CDATA[<Scoped Function Name>_cb]]></c>, and is called after the call-back + function has been evaluated (provided that the pointer is not equal + to <c>NULL</c>). </p> + </section> + + <section> + <title>The Server Loop</title> + <p>The developer has to implement code for establishing connections + with other Erlang nodes, code for call-back functions and restore + functions. </p> + <p></p> + <p>In addition, the developer also has to implement code for a + server loop, that receives messages and calls the relevant + <c>__exec</c> function. For that purpose the IC library function + <c>oe_server_receive()</c> function can be used.</p> + </section> + + <section> + <title>Generating, Compiling and Linking</title> + <p>To generate the C server skeletons type the following in an + appropriate shell:</p> + <p><c>erlc -I ICROOT/include "+{be, c_server}" File.idl</c>,</p> + <p>where <c>ICROOT</c> is the root of the IC application. The + <c>-I ICROOT/include</c> is only needed if <c>File.idl</c> + refers to <c>erlang.idl</c>.</p> + <p>When compiling a generated C skeleton file, the directories + <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be + specified as include directories, where <c>EIROOT</c> is the + root directory of the Erl_interface application.</p> + <p>When linking object files the <c>EIROOT/lib</c> and + <c>ICROOT/priv/lib</c> directories have to be specified. </p> + </section> + + <section> + <title>An Example</title> + <p>In this example the IDL specification file "random.idl" is used + for generating C server skeletons (the file is contained in the IC + <c>/examples/c-server</c> directory):</p> + <code type="none"> +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; </code> + <p>Generate the C server skeletons:</p> + <code type="none"> +erlc '+{be, c_server}' random.idl +Erlang IDL compiler version X.Y.Z </code> + <p>Six files are generated. </p> + <p>Compile the C server skeletons:</p> + <p>Please read the <c>ReadMe</c> file in the + <c>examples/c-server</c> directory.</p> + <p>In the same directory you can find all the code for this + example. In particular you will find the <c>server.c</c> file + that contains all the additional code that must be written to + obtain a complete server.</p> + <p>In the <c>examples/c-server</c> directory you will also find + source code for an Erlang client, which can be used for testing + the C server.</p> + </section> +</chapter> + + diff --git a/lib/ic/doc/src/ch_erl_genserv.xml b/lib/ic/doc/src/ch_erl_genserv.xml new file mode 100644 index 0000000000..972eff7c17 --- /dev/null +++ b/lib/ic/doc/src/ch_erl_genserv.xml @@ -0,0 +1,205 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Using the Erlang Generic Server Back-end</title> + <prepared></prepared> + <docno></docno> + <date>98-08-06</date> + <rev>B</rev> + <file>ch_erl_genserver.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The mapping of OMG IDL to the Erlang programming language when Erlang + generic server is the back-end of choice is similar to the one used in + the chapter 'OMG IDL Mapping'. + The only difference is in the generated code, a client stub and + server skeleton to an Erlang <c>gen_server</c>. Orber's User's Guide + contain a more detailed description of IDL to Erlang mapping.</p> + </section> + + <section> + <title>Compiling the Code</title> + <p>The <c>ic:gen/2</c> function can be called from the command + line as follows:</p> + <p></p> + <code type="none"> +shell> erlc "+{be, erl_genserv}" MyFile.idl + </code> + </section> + + <section> + <title>Writing the Implementation File</title> + <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file :</p> + <list type="bulleted"> + <item>Create the corresponding Erlang file that will hold the + Erlang implementation of the IDL definitions. </item> + <item>Call the implementation file after the scope of the IDL interface, + followed by the suffix <c>_impl</c>.</item> + <item>Export the implementation functions.</item> + </list> + <p>For each function defined in the IDL interface :</p> + <list type="bulleted"> + <item>Implement an Erlang function that uses as arguments in the same + order, as the input arguments described in the IDL file, and returns + the value described in the interface.</item> + <item>When using the function, follow the mapping described in chapter 2.</item> + </list> + </section> + + <section> + <title>An Example</title> + <p>In this example, a file <c>random.idl</c> generates code for the Erlang + gen_server back-end:</p> + <code type="none"> +// Filename random.idl +module rmod { + + interface random { + // Generate a new random number + double produce(); + // Initialize random generator + oneway void init(in long seed1, in long seed2, in long seed3); + + }; +}; + </code> + <p>When the file "random.idl" is compiled (e.g., <c>shell> erlc "+{be, erl_genserv}" random.idl</c>) + five files are produced; two for the top scope, two for the interface scope, + and one for the module scope. The header files for top scope and interface + are empty and not shown here. In this case, the stub/skeleton file + <c>rmod_random.erl</c> is the most important. This module exports two kinds of + operations:</p> + <list type="bulleted"> + <item><em>Administrative</em> - used when, for example, creating and + terminating the server.</item> + <item><em>IDL dependent</em> - operations defined in the IDL + specification. In this case, <c>produce</c> and <c>init</c>.</item> + </list> + + <section> + <title>Administrative Operations</title> + <p>To create a new server instance, one of the following functions should + be used:</p> + <list type="bulleted"> + <item><em>oe_create/0/1/2</em> - create a new instance of the object. + Accepts <c>Env</c> and <c>RegName</c>, in that order, as parameters. + The former is passed uninterpreted to the initialization operation + of the call-back module, while the latter must be as the + <c>gen_server</c> parameter <c>ServerName</c>. If <c>Env</c> is + left out, an empty list will be passed.</item> + <item><em>oe_create_link/0/1/2</em> - similar to <c>oe_create/0/1/2</c>, + but create a linked server.</item> + <item><em>typeID/0</em> - returns the scooped id compliant with the + OMG standard. In this case the string + <c>"IDL:rmod/random:1.0"</c>.</item> + <item><em>stop/1</em> - asynchronously terminate the server. The required + argument is the return value from any of the start functions.</item> + </list> + </section> + + <section> + <title>IDL Dependent Operations</title> + <p>Operations can either be synchronous or asynchronous + (i.e., <c>oneway</c>). These are, respectively, mapped to + <c>gen_server:call/2/3</c> and <c>gen_server:cast/2</c>. + Consult the <c>gen_server</c> documentation for valid return values.</p> + <p>The IDL dependent operations in this example are listed below. + The first argument must be the whatever the create operation returned.</p> + <list type="bulleted"> + <item><em>init(ServerReference, Seed1, Seed2, Seed3)</em> - initialize + the random number generator.</item> + <item><em>produce(ServerReference)</em> - generate a new random number.</item> + </list> + </section> + <p>If the compile option <c>timeout</c> is used a timeout must be added + (e.g., <c>produce(ServerReference, 5000)</c>). For more information, see + the <c>gen_server</c> documentation.</p> + + <section> + <title>Implementation Module</title> + <p>The implementation module shall, unless the compile option + <c>impl</c> is used, be named <c>rmod_random_impl.erl</c>. + and could look like this:</p> + <code type="none"> +-module('rmod_random_impl'). +%% Mandatory gen_server operations +-export([init/1, terminate/2, code_change/3]). +%% Add if 'handle_info' compile option used +-export([handle_info/2]). +%% API defined in IDL specification +-export([produce/1,init/4]). + +%% Mandatory operations +init(Env) -> + {ok, []}. + +terminate(From, Reason) -> + ok. + +code_change(OldVsn, State, Extra) -> + {ok, State}. + +%% Optional +handle_info(Info, State) -> + {noreply, NewState}. + +%% IDL specification +produce(State) -> + case catch random:uniform() of +\\011{'EXIT',_} -> +\\011 {stop, normal, "random:uniform/0 - EXIT", State}; +\\011RUnif -> + {reply, RUnif, State} + end. + + +init(State, S1, S2, S3) -> + case catch random:seed(S1, S2, S3) of +\\011{'EXIT',_} -> +\\011 {stop, normal, State}; +\\011_ -> + {noreply, State} + end. + </code> + <p>Compile the code and run the example:</p> + <code type="none"><![CDATA[ +1> make:all(). +Recompile: rmod_random +Recompile: oe_random +Recompile: rmod_random_impl +up_to_date +2> {ok,R} = rmod_random:oe_create(). +{ok,<0.30.0>} +3> rmod_random:init(R, 1, 2, 3). +ok +4> rmod_random:produce(R). +1.97963e-4 +5> + ]]></code> + </section> + </section> +</chapter> + + diff --git a/lib/ic/doc/src/ch_erl_plain.xml b/lib/ic/doc/src/ch_erl_plain.xml new file mode 100644 index 0000000000..36de46f624 --- /dev/null +++ b/lib/ic/doc/src/ch_erl_plain.xml @@ -0,0 +1,175 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Using the Plain Erlang Back-end</title> + <prepared></prepared> + <docno></docno> + <date>98-05-06</date> + <rev>B</rev> + <file>ch_erl_plain.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The mapping of OMG IDL to the Erlang programming language when + Plain Erlang + is the back-end of choice is similar to the one used in pure Erlang IDL + mapping. The only difference is on the generated code and the extended + use of pragmas for code generation: IDL functions are translated + to Erlang + module function calls.</p> + </section> + + <section> + <title>Compiling the Code</title> + <p>In the Erlang shell type :</p> + <p>ic:gen(<c><![CDATA[<filename>, [{be, erl_plain}])]]></c>.</p> + </section> + + <section> + <title>Writing the Implementation File</title> + <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file:</p> + <list type="bulleted"> + <item>Create the corresponding Erlang file that will hold the + Erlang implementation of the IDL definitions. </item> + <item>Call the implementation file after the scope of the IDL interface, + followed by the suffix <c>_impl</c>.</item> + <item>Export the implementation functions.</item> + </list> + <p>For each function defined in the IDL interface :</p> + <list type="bulleted"> + <item>Implement an Erlang function that uses as arguments in the same + order, as the input arguments described in the IDL file, and returns + the value described in the interface.</item> + <item>When using the function, follow the mapping described in chapter 2.</item> + </list> + </section> + + <section> + <title>An Example</title> + <p> <marker id="plain_idl"></marker> + + In this example, a file "random.idl" is generates code for the plain Erlang + back-end :</p> + <list type="bulleted"> + <item> + <p>Main file : "plain.idl"</p> + <code type="none"> +\011 +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + </code> + </item> + </list> + <p>Compile the file :</p> + <code type="none"> + Erlang (BEAM) emulator version 4.9 + + Eshell V4.9 (abort with ^G) + 1> ic:gen(random,[{be, erl_plain}]). + Erlang IDL compiler version 2.5.1 + ok + 2> + </code> + <p></p> + <p>When the file "random.idl" is compiled it produces five files: two for + the top scope, two for the interface scope, and one for the module + scope. The header files for top scope and interface + are empty and not shown here. In this case only the file for the interface + <c>rmod_random.erl</c> is important :. + <marker id="generated files"></marker> +</p> + <list type="bulleted"> + <item> + <p>Erlang file for interface : "rmod_random.erl"</p> + <code type="none"> + +-module(rmod_random). + + + +%% Interface functions +-export([produce/0, init/3]). + +%%------------------------------------------------------------ +%% Operation: produce +%% +%% Returns: RetVal +%% +produce() -> + rmod_random_impl:produce(). + +%%------------------------------------------------------------ +%% Operation: init +%% +%% Returns: RetVal +%% +init(Seed1, Seed2, Seed3) -> + rmod_random_impl:init(Seed1, Seed2, Seed3). + </code> + </item> + </list> + <p>The implementation file should be called <c>rmod_random_impl.erl</c> + and could look like this:</p> + <code type="none"> + -module('rmod_random_impl'). + + -export([produce/0,init/3]). + + + produce() -> + random:uniform(). + + + init(S1,S2,S3) -> + random:seed(S1,S2,S3). + </code> + <p>Compiling the code : </p> + <code type="none"> +2> make:all(). +Recompile: rmod_random +Recompile: oe_random +Recompile: rmod_random_impl +up_to_date + </code> + <p></p> + <p>Running the example : </p> + <code type="none"> +3> rmod_random:init(1,2,3). +ok +4> rmod_random:produce(). +1.97963e-4 +5> + </code> + </section> +</chapter> + diff --git a/lib/ic/doc/src/ch_ic_protocol.xml b/lib/ic/doc/src/ch_ic_protocol.xml new file mode 100644 index 0000000000..678fdc766c --- /dev/null +++ b/lib/ic/doc/src/ch_ic_protocol.xml @@ -0,0 +1,233 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2003</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IC Protocol</title> + <prepared></prepared> + <docno></docno> + <date>2003-12-11</date> + <rev>PA1</rev> + <file>ch_ic_protocol.xml</file> + </header> + <p>The purpose of this chapter is to explain the bits and bytes of the + IC protocol, which is a composition of the Erlang distribution protocol + and the Erlang/OTP gen_server protocol. If you do not intend to replace + the Erlang distribution protocol, or replace the gen_server protocol, + skip over this chapter. + </p> + + <section> + <title>Introduction</title> + <p>The IDL Compiler (IC) transforms Interface Definition Language + (IDL) specifications files to interface code for Erlang, C, and + Java. The Erlang language mapping is described in the Orber + documentation, while the other mappings are described in the IC + documentation (they are of course in accordance with the CORBA C + and Java language mapping specifications, with some restrictions). + </p> + <p>The most important parts of an IDL specification are the operation + declarations. An operation defines what information a client + provides to a server, and what information (if any) the client + gets back from the server. We consider IDL operations and language + mappings in section 2. + </p> + <p>What we here call the IC protocol, is the description of messages + exchanged between IC end-points (client and servers). It is valid + for all IC back-ends, except the 'erl_plain' and 'erl_corba' + back-ends. + The IC protocol is in turn embedded into the Erlang gen_server + protocol, which is described below. + Finally, the gen_server protocol is embedded in the Erlang + distribution protocol. Pertinent parts of that protocol is + described further below. + </p> + </section> + + <section> + <title>Language mappings and IDL operations</title> + + <section> + <title>IDL Operations</title> + <p>An IDL operation is declared as follows:</p> + <code type="none"> +\011[oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN, +\011out OType1 O1, out OType2 O2, ..., out OTypeM OM) +\011N, M = 0, 1, 2, ...\011\011(2.1.1) + </code> + <p>`Op' is the operation name, RetType is the return type, and ITypei, + i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types + and `out' types, respectively. The values I1, I2, ..., IN are + provided by the caller, and the value of RetType, and the values + O1, O2, ..., OM, are provided as results to the caller. + </p> + <p>The types can be any basic types or derived types declared in the + IDL specification of which the operation declaration is a part. + </p> + <p>If the RetType has the special name `void' there is no return + value (but there might still be result values O1, 02, ..., OM). + </p> + <p>The `in' and `out' parameters can be declared in any order, but + for clarity we have listed all `in' parameters before the `out' + parameters in the declaration above. + </p> + <p>If the keyword `oneway' is present, the operation is a cast, i.e. + there is no confirmation of the operation, and consequently there + must be no result values: RetType must be equal to `void', and M = + 0 must hold. + </p> + <p>Otherwise the operation is a call, i.e. it is confirmed (or else + an exception is raised). + </p> + <p>Note carefully that an operation declared without `oneway' is + always a call, even if RetType is `void' and M = 0. + </p> + </section> + + <section> + <title>Language Mappings</title> + <p>There are several CORBA Language Mapping specifications. These are + about mapping interfaces to various programming languages. IC + supports the CORBA C and Java mapping specifications, and the + Erlang language mapping specified in the Orber documentation. + </p> + <p>Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide: + </p> + <list type="bulleted"> + <item> + <p>Functions with return type void will return the atom ok.</p> + </item> + </list> + <p>Excerpt from "6.13 Invocations of Operations" in the Orber User's + Guide: + </p> + <list type="bulleted"> + <item> + <p>A function call will invoke an operation. The first parameter + of the function should be the object reference and then all in + and inout parameters follow in the same order as specified in + the IDL specification. The result will be a return value + unless the function has inout or out parameters specified; in + which case, a tuple of the return value, followed by the + parameters will be returned.</p> + </item> + </list> + <p>Hence the function that is mapped from an IDL operation to Erlang + always have a return value (an Erlang function always has). That + fact has influenced the IC protocol, in that there is always a + return value (which is 'ok' if the return type was declared 'void'). </p> + </section> + </section> + + <section> + <title>IC Protocol</title> + <p>Given the operation declaration (2.1.1) the IC protocol maps to + messages as follows, defined in terms of Erlang terms. + </p> + + <section> + <title>Call (Request/Reply, i.e. not oneway)</title> + <code type="none"> + request:\011\011 Op\011\011\011atom()\011\011N = 0\011 +\011\011\011 {Op, I1, I2, ..., IN}\011tuple()\011\011N > 0 +\011\011\011\011\011\011\011\011(3.1.1) + + reply:\011\011 Ret\011\011\011\011\011M = 0 +\011\011\011 {Ret, O1, O2, ..., OM}\011\011\011M > 0 +\011\011\011\011\011\011\011\011(3.1.2) </code> + <p><em>Notice:</em> Even if the RetType of the operation Op is + declared to be 'void', a return value 'ok' is returned in + the reply message. That + return value is of no significance, and is therefore ignored (note + however that a C server back-end returns the atom 'void' instead + of 'ok'). + </p> + </section> + + <section> + <title>Cast (oneway)</title> + <code type="none"> + + notification:\011Op\011\011\011atom()\011\011N = 0 +\011\011\011{Op, I1, I2, ..., IN}\011tuple()\011\011N > 0 +\011\011\011\011\011\011\011\011(3.2.1) </code> + <p>(There is of course no return message). + </p> + </section> + </section> + + <section> + <title>Gen_server Protocol</title> + <p>Most of the IC generated code deals with encoding and decoding the + gen_server protocol. + </p> + + <section> + <title>Call</title> + <code type="none"> + + request:\011{'$gen_call', {self(), Ref}, Request}\011\011(4.1.1) + + reply:\011{Ref, Reply}\011\011\011\011\011(4.1.2) </code> + <p>where Request and Reply are the messages defined in the previous + chapter. + </p> + </section> + + <section> + <title>Cast</title> + <code type="none"> + notification: {'$gen_cast', Notification}\011\011(4.2.1) </code> + <p>where Notification is the message defined in the previous chapter. + </p> + </section> + </section> + + <section> + <title>Erlang Distribution Protocol</title> + <p>Messages (of interest here) between Erlang nodes are of the form: </p> + <code type="none"> + Len(4), Type(1), CtrlBin(N), MsgBin(M)\011\011\011(5.1) </code> + <p>Type is equal to 112 = PASS_THROUGH. + </p> + <p>CtrlBin and MsgBin are Erlang terms in binary form (as if created + by term_to_binary/1), whence for each of them the first byte is + equal to 131 = VERSION_MAGIC. + </p> + <p>CtrlBin (of interest here) contains the SEND and REG_SEND control + messages, which are binary forms of the Erlang terms</p> + <code type="none"> +\011{2, Cookie, ToPid} ,\011\011\011\011\011(5.2) </code> + <p>and</p> + <code type="none"> +\011{6, FromPid, Cookie, ToName} ,\011\011\011\011(5.3) </code> + <p>respectively. + </p> + <p>The CtrlBin(N) message is read and written by erl_interface code + (C), j_interface code (Java), or the Erlang distribution + implementation, which are invoked from IC generated code. + </p> + <p>The MsgBin(N) is the "real" message, i.e. of the form described + in the previous section. + </p> + </section> +</chapter> + diff --git a/lib/ic/doc/src/ch_introduction.xml b/lib/ic/doc/src/ch_introduction.xml new file mode 100644 index 0000000000..898d2a732a --- /dev/null +++ b/lib/ic/doc/src/ch_introduction.xml @@ -0,0 +1,148 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Using the IC Compiler</title> + <prepared></prepared> + <docno></docno> + <date>2002-08-02</date> + <rev>PB1</rev> + <file>ch_introduction.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The IC application is an IDL compiler implemented in Erlang. + The IDL compiler generates client stubs and server skeletons. + Several back-ends are supported, and they fall into three main + groups.</p> + <p>The first group consists of a CORBA back-end:</p> + <taglist> + <tag>IDL to Erlang CORBA</tag> + <item> + <p>This back-end is for CORBA communication and implementation, + and the generated code uses the CORBA specific protocol for + communication between clients and servers. See the + <em>Orber</em> application User's Guide and manuals for + further details.</p> + </item> + </taglist> + <p>The second group consists of a simple Erlang back-end:</p> + <taglist> + <tag>IDL to plain Erlang</tag> + <item> + <p>This back-end provides a very simple Erlang client + interface. It can only be used within an Erlang node, + and the communication between client and "server" is + therefore in terms of ordinary function calls. </p> + <p>This back-end can be considered a short-circuit version of + the IDL to Erlang gen_server back-end (see further below).</p> + </item> + </taglist> + <p>The third group consists of backends for Erlang, C, and + Java. The communication between clients and servers is by the + Erlang distribution protocol, facilitated by + <em>erl_interface</em> and <em>jinterface</em> for C and Java, + respectively.</p> + <p>All back-ends of the third group generate code compatible with + the Erlang gen_server behavior protocol. Thus generated client + code corresponds to <c>call()</c> or <c>cast()</c> of an Erlang + <c>gen_server</c>. Similarly, generated server code corresponds + to <c>handle_call()</c> or <c>handle_cast()</c> of an Erlang + <c>gen_server</c>.</p> + <p>The back-ends of the third group are: + </p> + <taglist> + <tag>IDL to Erlang gen_server</tag> + <item> + <p>Client stubs and server skeletons are generated. Data types + are mapped according to the IDL to Erlang mapping described + in the <em>Orber User's Guide</em>.</p> + <p></p> + </item> + <tag>IDL to C client</tag> + <item> + <p>Client stubs are generated. The mapping of data types is + described further on in the C client part of this guide.</p> + </item> + <tag>IDL to C server</tag> + <item> + <p>Server skeletons are generated. The mapping of data types is + described further on in the C server part of this guide.</p> + </item> + <tag>IDL to Java</tag> + <item> + <p>Client stubs and server skeletons are generated. The mapping + of data types is described further on in the Java part of + this guide.</p> + </item> + </taglist> + </section> + + <section> + <title>Compilation of IDL Files</title> + <p>The IC compiler is invoked by executing the generic <c>erlc</c> + compiler from a shell:</p> + <code type="none"> +%> erlc +'{be,BackEnd}' File.idl + </code> + <p>where <c>BackEnd</c> is according to the table below, and + <c>File.idl</c> is the IDL file to be compiled.</p> + <table> + <row> + <cell align="left" valign="middle"><em>Back-end</em></cell> + <cell align="left" valign="middle"><c>BackEnd</c>option</cell> + </row> + <row> + <cell align="left" valign="middle">IDL to CORBA</cell> + <cell align="left" valign="middle"><c>erl_corba</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to CORBA template</cell> + <cell align="left" valign="middle"><c>erl_template</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to plain Erlang</cell> + <cell align="left" valign="middle"><c>erl_plain</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to Erlang gen_server</cell> + <cell align="left" valign="middle"><c>erl_genserv</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to C client</cell> + <cell align="left" valign="middle"><c>c_client</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to C server</cell> + <cell align="left" valign="middle"><c>c_server</c></cell> + </row> + <row> + <cell align="left" valign="middle">IDL to Java</cell> + <cell align="left" valign="middle"><c>java</c></cell> + </row> + <tcaption>Compiler back-ends and options</tcaption> + </table> + <p>For more details on IC compiler options consult the ic(3) manual page.</p> + </section> +</chapter> + diff --git a/lib/ic/doc/src/ch_java.xml b/lib/ic/doc/src/ch_java.xml new file mode 100644 index 0000000000..831850f211 --- /dev/null +++ b/lib/ic/doc/src/ch_java.xml @@ -0,0 +1,737 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1999</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IDL to Java language Mapping</title> + <prepared></prepared> + <docno></docno> + <date>98-09-24</date> + <rev>A</rev> + <file>ch_java.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>This chapter describes the mapping of OMG IDL constructs to the Java + programming language for the generation of native Java - Erlang + communication. </p> + <p>This language mapping defines the following:</p> + <list type="bulleted"> + <item> + <p>All OMG IDL basic types</p> + </item> + <item> + <p>All OMG IDL constructed types</p> + </item> + <item> + <p>References to constants defined in OMG IDL</p> + </item> + <item> + <p>Invocations of operations, including passing of + parameters and receiving of result</p> + </item> + <item> + <p>Access to attributes</p> + </item> + </list> + </section> + + <section> + <title>Specialties in the Mapping</title> + + <section> + <title>Names Reserved by the Compiler</title> + <p>The IDL compiler reserves all identifiers starting with + <c>OE_</c> and <c>oe_</c> for internal use.</p> + </section> + </section> + + <section> + <title>Basic OMG IDL Types</title> + <p>The mapping of basic types are according to the standard. All basic types have + a special Holder class.</p> + <table> + <row> + <cell align="left" valign="middle">OMG IDL type</cell> + <cell align="left" valign="middle">Java type</cell> + </row> + <row> + <cell align="left" valign="middle">float</cell> + <cell align="left" valign="middle">float</cell> + </row> + <row> + <cell align="left" valign="middle">double</cell> + <cell align="left" valign="middle">double</cell> + </row> + <row> + <cell align="left" valign="middle">short</cell> + <cell align="left" valign="middle">short</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned short</cell> + <cell align="left" valign="middle">short</cell> + </row> + <row> + <cell align="left" valign="middle">long</cell> + <cell align="left" valign="middle">int</cell> + </row> + <row> + <cell align="left" valign="middle">long long</cell> + <cell align="left" valign="middle">long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long</cell> + <cell align="left" valign="middle">long</cell> + </row> + <row> + <cell align="left" valign="middle">unsigned long long</cell> + <cell align="left" valign="middle">long</cell> + </row> + <row> + <cell align="left" valign="middle">char</cell> + <cell align="left" valign="middle">char</cell> + </row> + <row> + <cell align="left" valign="middle">wchar</cell> + <cell align="left" valign="middle">char</cell> + </row> + <row> + <cell align="left" valign="middle">boolean</cell> + <cell align="left" valign="middle">boolean</cell> + </row> + <row> + <cell align="left" valign="middle">octet</cell> + <cell align="left" valign="middle">octet</cell> + </row> + <row> + <cell align="left" valign="middle">string</cell> + <cell align="left" valign="middle">java.lang.String</cell> + </row> + <row> + <cell align="left" valign="middle">wstring</cell> + <cell align="left" valign="middle">java.lang.String</cell> + </row> + <row> + <cell align="left" valign="middle">any</cell> + <cell align="left" valign="middle">Any</cell> + </row> + <row> + <cell align="left" valign="middle">long double</cell> + <cell align="left" valign="middle">Not supported</cell> + </row> + <row> + <cell align="left" valign="middle">Object</cell> + <cell align="left" valign="middle">Not supported</cell> + </row> + <row> + <cell align="left" valign="middle">void</cell> + <cell align="left" valign="middle">void</cell> + </row> + <tcaption>OMG IDL basic types</tcaption> + </table> + </section> + + <section> + <title>Constructed OMG IDL Types</title> + <p>All constructed types are according to the standard with three (3) major exceptions.</p> + <p></p> + <list type="bulleted"> + <item> + <p>The IDL Exceptions are not implemented in this Java mapping.</p> + <p></p> + </item> + <item> + <p>The functions used for read/write to streams, defined in <c>Helper</c> functions + are named unmarshal (instead for read) and marshal (instead for write). </p> + <p></p> + </item> + <item> + <p>The streams used in <c>Helper</c> functions are <c>OtpInputStream</c> for + input and <c>OtpOutputStream</c> for output.</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>Mapping for Constants</title> + <p>Constants are mapped according to the standard.</p> + </section> + + <section> + <title>Invocations of Operations</title> + <p>Operation invocation is implemented according to the standard. + The implementation is in the class <c><![CDATA[_<nterfacename>Stub.java]]></c> which implements + the interface in <c><![CDATA[<nterfacename>.java]]></c>.</p> + <code type="none"> +test._iStub client; + +client.op(10); + </code> + + <section> + <title>Operation Implementation</title> + <p>The server is implemented through extension of the class + <c><![CDATA[_<nterfacename>ImplBase.java]]></c> and implementation of all the methods in the + interface.</p> + <code type="none"> +public class server extends test._iImplBase { + + public void op(int i) throws java.lang.Exception { + System.out.println("Received call op()"); + o.value = i; + return i; + } + +} + </code> + </section> + </section> + + <section> + <title>Exceptions</title> + <p>While exception mapping is not implemented, the stubs will + generate some Java exceptions in case of operation failure. + No exceptions are propagated through the communication.</p> + </section> + + <section> + <title>Access to Attributes</title> + <p>Attributes are supported according to the standard.</p> + </section> + + <section> + <title>Summary of Argument/Result Passing for Java</title> + <p>All types (<c>in</c>, <c>out</c> or <c>inout</c>) of user defined parameters are supported + in the Java mapping. This is also the case in the Erlang mappings but <em>not</em> in the C + mapping. <c>inout</c> parameters are not supported in the C mapping so if you are going to + do calls to or from a C program <c>inout</c> cannot be used in the IDL specifications.</p> + <p><c>out</c> and <c>inout</c> parameters must be of Holder types. There is a jar file ( <c>ic.jar</c>) + with Holder classes for the basic types in the <c>ic</c> application. This library is in the directory + <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c>.</p> + </section> + + <section> + <title>Communication Toolbox</title> + <p>The generated client and server stubs use the classes + defined in the <c>jinterface</c> package to communicate + with other nodes. + The most important classes are :</p> + <list type="bulleted"> + <item> + <p><c>OtpInputStream</c> which is the stream class used for incoming message storage</p> + <p></p> + </item> + <item> + <p><c>OtpOutputStream</c> which is the stream class used for outgoing message storage</p> + <p></p> + </item> + <item> + <p><c>OtpErlangPid</c> which is the process identification class used to identify processes inside + a java node.</p> + <p>The recommended constructor function for the OtpErlangPid is + <c>OtpErlangPid(String node, int id, int serial, int creation)</c> where :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>String node</c>, is the name of the node where this process runs.</p> + <p></p> + </item> + <item> + <p><c>int id</c>, is the identification number for this identity.</p> + <p></p> + </item> + <item> + <p><c>int serial</c>, internal information, must be an 18-bit integer.</p> + <p></p> + </item> + <item> + <p><c>int creation</c>, internal information, must have value in range 0..3.</p> + <p></p> + </item> + </list> + </item> + <item> + <p><c>OtpConnection</c> which is used to define a connection between nodes.</p> + <p>While the connection object is stub side constructed in client stubs, it is + returned after calling the <c>accept</c> function from an OtpErlangServer object + in server stubs. + The following methods used for node connection :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>OtpInputStream receiveBuf()</c>, which returns the incoming streams that + contain the message arrived.</p> + <p></p> + </item> + <item> + <p><c>void sendBuf(OtpErlangPid client, OtpOutputStream reply)</c>, which sends + a reply message (in an OtpOutputStream form) to the client node.</p> + <p></p> + </item> + <item> + <p><c>void close()</c>, which closes a connection.</p> + <p></p> + </item> + </list> + </item> + <item> + <p><c>OtpServer</c> which is used to define a server node.</p> + <p>The recommended constructor function for the OtpServer is :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>OtpServer(String node, String cookie)</c>. where :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>node</c> is the requested name for the new java node, + represented as a String object.</p> + <p></p> + </item> + <item> + <p><c>cookie</c> is the requested cookie name for the new java node, + represented as a String object.</p> + <p></p> + </item> + </list> + </item> + </list> + <p>The following methods used for node registration and connection acceptance :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>boolean publishPort()</c>, which registers the server node to <c>epmd</c> daemon.</p> + <p></p> + </item> + <item> + <p><c>OtpConnection accept()</c>, which waits for a connection and returns the + OtpConnection object which is unique for each client node.</p> + <p></p> + </item> + </list> + </item> + </list> + </section> + + <section> + <title>The Package com.ericsson.otp.ic</title> + <p>The package <seealso marker="java/com/ericsson/otp/ic/package-summary">com.ericsson.otp.ic</seealso> + contains a number of java classes specially designed for the IC generated java-back-ends :</p> + <list type="bulleted"> + <item> + <p>Standard java classes defined through OMG-IDL java mapping :</p> + <list type="bulleted"> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/BooleanHolder">BooleanHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/ByteHolder">ByteHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/CharHolder">CharHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/ShortHolder">ShortHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/IntHolder">IntHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/LongHolder">LongHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/FloatHolder">FloatHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/DoubleHolder">DoubleHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/StringHolder">StringHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Any">Any</seealso>, + <seealso marker="java/com/ericsson/otp/ic/AnyHelper">AnyHelper</seealso>, + <seealso marker="java/com/ericsson/otp/ic/AnyHolder">AnyHolder</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/TypeCode">TypeCode</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/TCKind">TCKind</seealso></p> + <p></p> + </item> + </list> + </item> + <item> + <p>Implementation-dependant classes :</p> + <list type="bulleted"> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Environment">Environment</seealso></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Holder">Holder</seealso></p> + <p></p> + </item> + </list> + </item> + <item> + <p>Erlang compatibility classes :</p> + <list type="bulleted"> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Pid">Pid</seealso>, + <seealso marker="java/com/ericsson/otp/ic/PidHelper">PidHelper</seealso>, + <seealso marker="java/com/ericsson/otp/ic/PidHolder">PidHolder</seealso></p> + <p>The Pid class originates from <c>OtpErlangPid</c> and is used to + represent the Erlang built-in <c>pid</c> type, a process's identity. + PidHelper and PidHolder are helper respectively holder classes for Pid.</p> + <p></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Ref">Ref</seealso>, + <seealso marker="java/com/ericsson/otp/ic/RefHelper">RefHelper</seealso>, + <seealso marker="java/com/ericsson/otp/ic/RefHolder">RefHolder</seealso></p> + <p>The Ref class originates from <c>OtpErlangRef</c> and is used to + represent the Erlang built-in <c>ref</c> type, an Erlang reference. + RefHelper and RefHolder are helper respectively holder classes for Ref.</p> + <p></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Port">Port</seealso>, + <seealso marker="java/com/ericsson/otp/ic/PortHelper">PortHelper</seealso>, + <seealso marker="java/com/ericsson/otp/ic/PortHolder">PortHolder</seealso></p> + <p>The Port class originates from <c>OtpErlangPort</c> and is used to + represent the Erlang built-in <c>port</c> type, an Erlang port. + PortHelper and PortHolder are helper respectively holder classes for Port.</p> + <p></p> + </item> + <item> + <p><seealso marker="java/com/ericsson/otp/ic/Term">Term</seealso>, + <seealso marker="java/com/ericsson/otp/ic/TermHelper">TermHelper</seealso>, + <seealso marker="java/com/ericsson/otp/ic/TermHolder">TermHolder</seealso></p> + <p>The Term class originates from <c>Any</c> and is used to + represent the Erlang built-in <c>term</c> type, an Erlang term. + TermHelper and TermHolder are helper respectively holder classes for Term.</p> + <p></p> + </item> + </list> + <p>To use the Erlang build-in classes, you will have to include the file <c>erlang.idl</c> + located under <c>$OTPROOT/lib/ic/include</c>.</p> + </item> + </list> + </section> + + <section> + <title>The Term Class</title> + <p>The <c>Term</c> class is intended to represent the Erlang term generic type. + It extends the <c>Any</c> class and it is basically used in the same way as + in the Any type.</p> + <p>The big difference between Term and Any is the use of <c>guard</c> methods + instead of <c>TypeCode</c> to determine the data included in the Term. + This is especially true when the Term's value class cannot be + determined at compilation time. The guard methods found in Term :</p> + <list type="bulleted"> + <item> + <p><c>boolean isAtom()</c> returns <c>true</c> if the Term is an OtpErlangAtom, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isConstant()</c> returns <c>true</c> if the Term is neither an OtpErlangList nor an OtpErlangTuple, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isFloat()</c> returns <c>true</c> if the Term is an OtpErlangFloat, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isInteger()</c> returns <c>true</c> if the Term is an OtpErlangInt, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isList()</c> returns <c>true</c> if the Term is an OtpErlangList, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isString()</c> returns <c>true</c> if the Term is an OtpErlangString, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isNumber()</c> returns <c>true</c> if the Term is an OtpErlangInteger or an OtpErlangFloat, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isPid()</c> returns <c>true</c> if the Term is an OtpErlangPid or Pid, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isPort()</c> returns <c>true</c> if the Term is an OtpErlangPort or Port, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isReference()</c> returns <c>true</c> if the Term is an OtpErlangRef, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isTuple()</c> returns <c>true</c> if the Term is an OtpErlangTuple, <c>false</c> otherwise</p> + <p></p> + </item> + <item> + <p><c>boolean isBinary()</c> returns <c>true</c> if the Term is an OtpErlangBinary, <c>false</c> otherwise</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>Stub File Types</title> + <p>For each interface, three (3) stub/skeleton files are generated :</p> + <list type="bulleted"> + <item> + <p>A java interface file, named after the idl interface.</p> + <p></p> + </item> + <item> + <p>A client stub file, named after the convention <c><![CDATA[_< interface name >Stub]]></c> + which implements the java interface. Example : <c>_stackStub</c>.java</p> + <p></p> + </item> + <item> + <p>A server stub file, named after the convention <c><![CDATA[_< interface name >ImplBase]]></c> + which implements the java interface. Example : <c>_stackImplBase</c>.java</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>Client Stub Initialization, Methods Exported</title> + <p>The recommended constructor function for client stubs accepts four (4) parameters :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>String selfNode</c>, the node identification name to be used in the new + client node.</p> + <p></p> + </item> + <item> + <p><c>String peerNode</c>, the node identification name where the client process is running.</p> + <p></p> + </item> + <item> + <p><c>String cookie</c>, the cookie to be used.</p> + <p></p> + </item> + <item> + <p><c>Object server</c>, where the java Object can be one of:</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>OtpErlangPid</c>, the server's process identity under the node where the server + process is running.</p> + <p></p> + </item> + <item> + <p><c>String</c>, the server's registered name under the node where the server + process is running.</p> + <p></p> + </item> + </list> + </item> + </list> + <p>The methods exported from the generated client stub are :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>void __disconnect()</c>, which disconnects the server connection.</p> + <p></p> + </item> + <item> + <p><c>void __reconnect()</c>, which disconnects the server connection if open, + and then connects to the same peer.</p> + <p></p> + </item> + <item> + <p><c>void __stop()</c>, which sends the standard stop termination call. + When connected to an Erlang server, the server will be terminated. + When connected to a java server, this will set a stop flag that + denotes that the server must be terminated.</p> + <p></p> + </item> + <item> + <p><c>com.ericsson.otp.erlang.OtpErlangRef __getRef()</c>, will return the message reference + received from a server that denotes which call it is referring to. + This is useful when building asynchronous clients.</p> + <p></p> + </item> + <item> + <p><c>java.lang.Object __server()</c>, which returns the server for the current connection.</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>Server Skeleton Initialization, Server Stub Implementation, Methods Exported</title> + <p>The constructor function for server skeleton accepts no parameters.</p> + <p>The server skeleton file contains a server <c>switch</c> which + decodes messages from the input stream and calls implementation + (<c>callback</c>) functions. + As the server skeleton is declared <c>abstract</c>, the application + programmer will have to create a stub class that <c>extends</c> the + skeleton file. In this class, all operations defined in the interface + class, generated under compiling the idl file, are implemented.</p> + <p>The server skeleton file exports the following methods:</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>OtpOutputStrem invoke(OtpInputStream request)</c>, where the input + stream <c>request</c> is unmarshalled, the implementation function is called + and a reply stream is marshalled.</p> + <p></p> + </item> + <item> + <p><c>boolean __isStopped()</c>, which returns true if a stop message is received. + The implementation of the stub should always check if such a message is received + and terminate if so.</p> + <p></p> + </item> + <item> + <p><c>boolean __isStopped(com.ericsson.otp.ic.Environment)</c>, which returns true if + a stop message is received for a certain Environment and Connection. + The implementation of the stub should always check if such a message is received + and terminate if so.</p> + <p></p> + </item> + <item> + <p><c>OtpErlangPid __getCallerPid()</c>, which returns the caller identity for the latest call.</p> + <p></p> + </item> + <item> + <p><c>OtpErlangPid __getCallerPid(com.ericsson.otp.ic.Environment)</c>, which returns the caller + identity for the latest call on a certain Environment.</p> + <p></p> + </item> + <item> + <p><c>java.util.Dictionary __operations()</c>, which returns the operation dictionary which + holds all operations supported by the server skeleton.</p> + <p></p> + </item> + </list> + </section> + + <section> + <title>A Mapping Example</title> + <p> <marker id="stack_idl"></marker> + + This is a small example of a simple stack. There are two + operations on the stack, push and pop. The example shows some of the + generated files.</p> + <code type="none"> +// The source IDL file: stack.idl + +struct s { + long l; + string s; +}; + +interface stack { + void push(in s val); + s pop(); +}; + </code> + <p>When this file is compiled it produces eight files. Three important files + are shown below. <marker id="stack_serv"></marker> +</p> + <p>The public interface is in <em>stack.java</em>.</p> + <code type="none"> + +public interface stack { + +/**** + * Operation "stack::push" interface functions + * + */ + + void push(s val) throws java.lang.Exception; + +/**** + * Operation "stack::pop" interface functions + * + */ + + s pop() throws java.lang.Exception; + +} + </code> + <p>For the IDL struct s three files are generated, a public class in <em>s.java</em>.</p> + <code type="none"> + +final public class s { + // instance variables + public int l; + public java.lang.String s; + + // constructors + public s() {}; + public s(int _l, java.lang.String _s) { + l = _l; + s = _s; + }; + +}; + </code> + <p>A holder class in <em>sHolder.java</em> and a helper class in <em>sHelper.java</em>. + The helper class is used for marshalling.</p> + <code type="none"> + +public class sHelper { + + // constructors + private sHelper() {}; + + // methods + public static s unmarshal(OtpInputStream in) + throws java.lang.Exception { +\011: +\011: + }; + + public static void marshal(OtpOutputStream out, s value) + throws java.lang.Exception { +\011: +\011: + }; + +}; + </code> + </section> + + <section> + <title>Running the Compiled Code</title> + <p>When using the generated java code you must have added + <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c> and + <c><![CDATA[$OTPROOT/lib/jinterface_<version number>/priv]]></c> to your + <c>CLASSPATH</c> variable to get + basic Holder types and the communication classes.</p> + </section> +</chapter> + diff --git a/lib/ic/doc/src/erl-part.xml b/lib/ic/doc/src/erl-part.xml new file mode 100644 index 0000000000..b5041dce7f --- /dev/null +++ b/lib/ic/doc/src/erl-part.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part> + <header> + <copyright> + <year>2002</year> + <year>2007</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>IDL to Erlang language Mapping</title> + <prepared></prepared> + <docno></docno> + <date>2002-06-25</date> + <rev>A</rev> + </header> + <description> + <p>Tjosan Erlang</p> + </description> + <include file="ch_erl_plain"></include> + <include file="ch_erl_genserv"></include> +</part> + diff --git a/lib/ic/doc/src/fascicules.xml b/lib/ic/doc/src/fascicules.xml new file mode 100644 index 0000000000..0678195e07 --- /dev/null +++ b/lib/ic/doc/src/fascicules.xml @@ -0,0 +1,18 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> + +<fascicules> + <fascicule file="part" href="part_frame.html" entry="no"> + User's Guide + </fascicule> + <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> + Reference Manual + </fascicule> + <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> + Release Notes + </fascicule> + <fascicule file="" href="../../../../doc/print.html" entry="no"> + Off-Print + </fascicule> +</fascicules> + diff --git a/lib/ic/doc/src/ic.gif b/lib/ic/doc/src/ic.gif Binary files differnew file mode 100644 index 0000000000..d78cf7d8ed --- /dev/null +++ b/lib/ic/doc/src/ic.gif diff --git a/lib/ic/doc/src/ic.xml b/lib/ic/doc/src/ic.xml new file mode 100644 index 0000000000..9f48229425 --- /dev/null +++ b/lib/ic/doc/src/ic.xml @@ -0,0 +1,469 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>1997</year> + <year>2007</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>ic</title> + <prepared></prepared> + <docno></docno> + <checked></checked> + <date>2004-01-08</date> + <rev>B</rev> + </header> + <module>ic</module> + <modulesummary>The Erlang IDL Compiler</modulesummary> + <description> + <p>The ic module is an Erlang implementation of an OMG IDL + compiler. Depending on the choice of back-end the code will map + to Erlang, C, or Java. The compiler generates client stubs and + server skeletons.</p> + <p>Two kinds of files are generated for each scope: Ordinary code + files and header files. The latter are used for defining record + definitions, while the ordinary files contain the object + interface functions.</p> + </description> + <funcs> + <func> + <name>ic:gen(FileName) -> Result</name> + <name>ic:gen(FileName, [Option]) -> Result</name> + <fsummary>Generate stub and server code according to the OMG CORBA standard.</fsummary> + <type> + <v>Result = ok | error | {ok, [Warning]} | {error, [Warning], [Error]}</v> + <v></v> + <v>Option = [ GeneralOption | CodeOption | WarningOption | BackendOption]</v> + <v></v> + <v>GeneralOption = </v> + <v>{outdir, String()} | {cfgfile, String()} | {use_preproc, bool()} |</v> + <v>{preproc_cmd, String()} | {preproc_flags, String()}</v> + <v></v> + <v>CodeOption =</v> + <v>{gen_hrl, bool()} | {serv_last_call, exception | exit} | {{impl, String()}, String()} | {light_ifr, bool()}</v> + <v>this | {this, String()} | {{this, String()}, bool()} |</v> + <v>from | {from, String()} | {{from, String()}, bool()} |</v> + <v>handle_info | {handle_info, String()} | {{handle_info, String()}, bool()} |</v> + <v>timeout | {timeout, String()} | {{timeout, String()}, bool()} |</v> + <v>{scoped_op_calls, bool()} | {scl, bool()} |</v> + <v>{user_protocol, Prefix} |</v> + <v>{c_timeout, SendTimeout, RecvTimeout} |</v> + <v>{c_report, bool()} |</v> + <v>{precond, {atom(), atom()}} | {{precond, String()} {atom(), atom()}} |</v> + <v>{postcond, {atom(), atom()}} | {{postcond, String()} {atom(), atom()}}</v> + <v></v> + <v>WarningOption =</v> + <v>{'Wall', bool()} | {maxerrs, int() | infinity} |</v> + <v>{maxwarns, int() | infinity} | {nowarn, bool()} |</v> + <v>{warn_name_shadow, bool()} | {pedantic, bool()} |</v> + <v>{silent, bool()}</v> + <v></v> + <v>BackendOption = {be, Backend}</v> + <v></v> + <v>Backend = erl_corba | erl_template | erl_plain | erl_genserv | c_client | c_server | java</v> + <v></v> + <v>DirNAme = string() | atom()</v> + <v>FileName = string() | atom()</v> + </type> + <desc> + <p>The tuple <c>{Option, true}</c> can be replaced by + <c>Option</c> for boolean values.</p> + <p>The <c>ic:gen/2</c> function can be called from the command + line as follows:</p> + <p><c>erlc "+Option" ... File.idl</c></p> + <p>Example:</p> + <p><c>erlc "+{be,c_client}" '+{outdir, "../out"}' File.idl</c></p> + </desc> + </func> + </funcs> + + <section> + <title>General options</title> + <taglist> + <tag><em>outdir</em></tag> + <item> + <p>Places all output files in the directory given by the option. + The directory will be created if it does not already exist.</p> + <p>Example option: <c>{outdir, "output/generated"}</c>.</p> + </item> + <tag><em>cfgfile</em></tag> + <item> + <p>Uses <em>FileName</em> as configuration file. Options will + override compiler defaults but can be overridden by command line + options. Default value is <c>".ic_config"</c>.</p> + <p>Example option: <c>{cfgfile, "special.cfg"}</c>.</p> + </item> + <tag><em>use_preproc</em></tag> + <item> + <p>Uses a preprocessor. Default value is true.</p> + </item> + <tag><em>preproc_cmd</em></tag> + <item> + <p>Command string to invoke the preprocessor. The actual + command will be built as + <c>preproc_cmd++preproc_flags++FileName</c></p> + <p>Example option: <c>{preproc_cmd, "erl"})</c>.</p> + <p>Example option: <c>{preproc_cmd, "gcc -x c++ -E"}</c>.</p> + </item> + <tag><em>preproc_flags</em></tag> + <item> + <p>Flags given to the preprocessor.</p> + <p>Example option: <c>{preproc_flags, "-I../include"}</c>.</p> + </item> + </taglist> + </section> + + <section> + <title>Code options</title> + <taglist> + <tag><em>light_ifr</em></tag> + <item> + <p>Currently, the default setting is <c>false</c>. To be able to + use this option Orber must be configured to use Light IFR (see + Orber's User's Guide). When this options is used, the size of the + generated files used to register the API in the IFR DB are minimized.</p> + <p>Example option: <c>{light_ifr, true}</c>.</p> + </item> + <tag><em>gen_hrl</em></tag> + <item> + <p>Generate header files. Default is true.</p> + </item> + <tag><em>serv_last_call</em></tag> + <item> + <p>Makes the last <c>gen_server handle_call</c> either raise a + CORBA exception or just exit plainly. Default is the exception. + </p> + </item> + <tag><em>{{impl, IntfName}, ModName}</em></tag> + <item> + <p>Assumes that the interface with name <em>IntfName</em> is + implemented by the module with name <em>ModName</em> and + will generate calls to the <em>ModName</em> module in the + server behavior. Note that the <em>IntfName</em> must be a + fully scoped name as in <c>"M1::I1"</c>.</p> + <p></p> + </item> + <tag><em>this</em></tag> + <item> + <p>Adds the object reference as the first parameter to the + object implementation functions. This makes the + implementation aware of its own object reference. + <br></br> +The option + comes in three varieties: <c>this</c> which activates the + parameter for all interfaces in the source file, <c>{this, IntfName}</c> which activates the parameter for a specified + interface and <c>{{this, IntfName}, false}</c> which + deactivates the parameter for a specified + interface.</p> + <p>Example option: <c>this)</c> activates the parameter for + all interfaces.</p> + <p>Example option: <c>{this, "M1::I1"}</c> activates the + parameter for all functions of <c>M1::I1</c>.</p> + <p>Example options: <c>[this, {{this, "M1::I2"}, false}]</c> + activates the parameter for all interfaces except + <c>M1::I2</c>.</p> + </item> + <tag><em>from</em></tag> + <item> + <p>Adds the invokers reference as the first parameter to the + object implementation two-way functions. If both + <c>from</c> and <c>this</c> options are used the invokers + reference parameter will be passed as the second + parameter. This makes it possible for the implementation to + respond to a request and continue executing + afterwards. Consult the <c>gen_server</c> and <c>Orber</c> + documentation how this option may be used. <br></br> +The option + comes in three varieties: <c>from</c> which activates the + parameter for all interfaces in the source file, <c>{from, IntfName}</c> which activates the parameter for a specified + interface and <c>{{from, IntfName}, false}</c> which + deactivates the parameter for a specified interface.</p> + <p>Example option: <c>from)</c> activates the parameter for + all interfaces.</p> + <p>Example options: <c>[{from, "M1::I1"}]</c> activates the + parameter for all functions of <c>M1::I1</c>.</p> + <p>Example options: <c>[from, {{from, "M1::I2"}, false}]</c> + activates the parameter for all interfaces except + <c>M1::I2</c>.</p> + </item> + <tag><em>handle_info</em></tag> + <item> + <p>Makes the object server call a function <c>handle_info</c> + in the object implementation module on all unexpected + messages. Useful if the object implementation need to trap + exits.</p> + <p>Example option: <c>handle_info</c> will activates module + implementation <c>handle_info</c> for all interfaces in the + source file.</p> + <p>Example option: <c>{{handle_info, "M1::I1"}, true}</c> + will activates module implementation <c>handle_info</c> for + the specified interface.</p> + <p>Example options: <c>[handle_info, {{handle_info, "M1::I1"}, false}]</c> will generate the <c>handle_info</c> + call for all interfaces except <c>M1::I1</c>.</p> + </item> + <tag><em>timeout</em></tag> + <item> + <p>Used to allow a server response time limit to be set by the user. + This should be a string that represents the scope for the interface + which should have an extra variable for wait time initialization.</p> + <p>Example option: <c>{timeout,"M::I"})</c> produces server + stub which will has an extra timeout parameter in the initialization + function for that interface.</p> + <p>Example option: <c>timeout</c> produces server + stub which will has an extra timeout parameter in the initialization + function for all interfaces in the source file.</p> + <p>Example options: <c>[timeout, {{timeout,"M::I"}, false}]</c> + produces server stub which will has an extra timeout + parameter in the initialization function for all interfaces + except <c>M1::I1</c>.</p> + </item> + <tag><em>scoped_op_calls</em></tag> + <item> + <p>Used to produce more refined request calls to server. When + this option is set to true, the operation name which was + mentioned in the call is scoped. This is essential to avoid + name clashes when communicating with c-servers. This option + is available for the c-client, c-server and the Erlang + gen_server back ends. <c>All</c> of the parts generated by ic + have to agree in the use of this option. Default is + <c>false</c>. </p> + <p>Example options: + <c>[{be,c_genserv},{scoped_op_calls,true}])</c> produces + client stubs which sends "scoped" requests to a gen_server + or a c-server.</p> + </item> + <tag><em>user_protocol</em></tag> + <item> + <p>Used to define a own protocol different from the default + Erlang distribution + gen_server protocol. Currently only + valid for C back-ends. For further details see <seealso marker="ic_c_protocol">IC C protocol</seealso>.</p> + <p>Example options: + <c>[{be,c_client},{user_protocol, "my_special"}])</c> produces + client stubs which use C protocol functions with the prefix + "my_special".</p> + </item> + <tag><em>c_timeout</em></tag> + <item> + <p>Makes sends and receives to have timeouts (C back-ends only). These + timeouts are specified in milliseconds. </p> + <p>Example options: + <c>[{be,c_client},{c_timeout, 10000, 20000}])</c> produces + client stubs which use a 10 seconds send timeout, and a + 20 seconds receive timeout.</p> + </item> + <tag><em>c_report</em></tag> + <item> + <p>Generates code for writing encode/decode errors to <c>stderr</c> (C back-ends only). + timeouts are specified in milliseconds. </p> + <p>Example options: + <c>[{be,c_client}, c_report])</c>.</p> + </item> + <tag><em>scl</em></tag> + <item> + <p>Used for compatibility with previous compiler versions up + to <c>3.3</c>. Due to better semantic checks on enumerants, + the compiler discovers name clashes between user defined + types and enumerant values in the same name space. By + enabling this option the compiler turns off the extended + semantic check on enumerant values. Default is + <c>false</c>. </p> + <p>Example option: <c>{scl,true}</c></p> + </item> + <tag><em>precond</em></tag> + <item> + <p>Adds a precondition call before the call to the operation + implementation on the server side.</p> + <p>The option comes in three varieties: <c>{precond, {M, F}}</c> which activates the call for operations in all + interfaces in the source file, <c>{{precond, IntfName}, {M, F}}</c> which activates the call for all operations in a + specific interface and <c>{{precond, OpName}, {M, F}}</c> + which activates the call for a specific operation.</p> + <p>The precondition function has the following signature + <c>m:f(Module, Function, Args)</c>.</p> + <p>Example option: <c>{precond, {mod, fun}}</c> adds the call + of m:f for all operations in the idl file.</p> + <p>Example options: <c>[{{precond, "M1::I"}, {mod, fun}}]</c> + adds the call of <c>m:f</c> for all operations in the + interface <c>M1::I1</c>.</p> + <p>Example options: <c>[{{precond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation + <c>M1::I::Op</c>.</p> + </item> + <tag><em>postcond</em></tag> + <item> + <p>Adds a postcondition call after the call to the operation + implementation on the server side. </p> + <p>The option comes in three varieties: <c>{postcond, {M, F}}</c> which activates the call for operations in all + interfaces in the source file, <c>{{postcond, IntfName}, {M, F}}</c> which activates the call for all operations in a + specific interface and <c>{{postcond, OpName}, {M, F}}</c> + which activates the call for a specific operation.</p> + <p>The postcondition function has the following signature + <c>m:f(Module, Function, Args, Result)</c>.</p> + <p>Example option: <c>{postcond, {mod, fun}}</c> adds the call + of m:f for all operations in the idl file.</p> + <p>Example options: <c>[{{postcond, "M1::I"}, {mod, fun}}]</c> + adds the call of <c>m:f</c> for all operations in the + interface <c>M1::I1</c>.</p> + <p>Example options: <c>[{{postcond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation + <c>M1::I::Op</c>.</p> + </item> + </taglist> + </section> + + <section> + <title>Warning options</title> + <taglist> + <tag><em>'Wall'</em></tag> + <item> + <p>The option activates all reasonable warning messages in + analogy with the gcc -Wall option. Default value is true.</p> + </item> + <tag><em>maxerrs</em></tag> + <item> + <p>The maximum numbers of errors that can be detected before + the compiler gives up. The option can either have an integer + value or the atom <c>infinity</c>. Default number is 10.</p> + </item> + <tag><em>maxwarns</em></tag> + <item> + <p>The maximum numbers of warnings that can be detected before + the compiler gives up. The option can either have an integer + value or the atom <c>infinity</c>. Default value is + infinity.</p> + </item> + <tag><em>nowarn</em></tag> + <item> + <p>Suppresses all warnings. Default value is false.</p> + </item> + <tag><em>warn_name_shadow</em></tag> + <item> + <p>Warning appears whenever names are shadowed due to + inheritance; for example, if a type name is redefined from a + base interface. Note that it is illegal to overload + operation and attribute names as this causes an error to be + produced. Default value is true. </p> + </item> + <tag><em>pedantic</em></tag> + <item> + <p>Activates all warning options. Default value is false.</p> + </item> + <tag><em>silent</em></tag> + <item> + <p>Suppresses compiler printed output. Default value is false.</p> + </item> + </taglist> + </section> + + <section> + <title>Back-End options</title> + <p>Which back-end IC will generate code for is determined by the supplied + <c>{be,atom()}</c> option. If left out, <c>erl_corba</c> is used. + Currently, IC support the following back-ends:</p> + <taglist> + <tag><em>erl_corba</em></tag> + <item> + <p>This option switches to the IDL generation for CORBA.</p> + </item> + <tag><em>erl_template</em></tag> + <item> + <p>Generate CORBA call-back module templates for each interface in the target + IDL file. Note, will overwrite existing files.</p> + </item> + <tag><em>erl_plain</em></tag> + <item> + <p>Will produce plain Erlang modules which contain functions that + map to the corresponding interface functions on the input file.</p> + </item> + <tag><em>erl_genserv</em></tag> + <item> + <p>This is an IDL to Erlang generic server generation option.</p> + </item> + <tag><em>c_client</em></tag> + <item> + <p>Will produce a C client to the generic Erlang server.</p> + </item> + <tag><em>c_server</em></tag> + <item> + <p>Will produce a C server switch with functionality of a + generic Erlang server.</p> + </item> + <tag><em>java</em></tag> + <item> + <p>Will produce Java client stubs and server skeletons with + functionality of a generic Erlang server.</p> + </item> + <tag><em>c_genserv</em></tag> + <item> + <p>Deprecated. Use <c>c_client</c> instead.</p> + </item> + </taglist> + </section> + + <section> + <title>Preprocessor</title> + <p>The IDL compiler allows several preprocessors to be used, the + <c>Erlang IDL preprocessor</c> or other standard <c>C</c> preprocessors. + Options can be used to provide extra flags such as include + directories to the preprocessor. The build in the Erlang IDL + preprocessor is used by default, but any standard C preprocessor + such as <c>gcc</c> is adequate.</p> + <p>The preprocessor command is formed by appending the prepoc_cmd + to the preproc_flags option and then appending the input IDL + file name.</p> + </section> + + <section> + <title>Configuration</title> + <p>The compiler can be configured in two ways:</p> + <list type="ordered"> + <item> + <p>Configuration file</p> + </item> + <item> + <p>Command line options</p> + </item> + </list> + <p>The configuration file is optional and overrides the compiler + defaults and is in turn overridden by the command line options. + The configuration file shall contain options in the form of + Erlang terms. The configuration file is read using + <c>file:consult</c>.</p> + <p>An example of a configuration file, note the "." after each + line.</p> + <code type="none"> +{outdir, gen_dir}. +{{impl, "M1::M2::object"}, "obj"}. + </code> + </section> + + <section> + <title>Output files</title> + <p>The compiler will produce output in several files depending on + scope declarations found in the IDL file. At most + three file types will be generated for each scope (including the top scope), + depending on the compiler back-end and the compiled interface. + Generally, the output per interface will be a header file (<c>.hrl</c>/ + <c>.h</c>) and one or more Erlang/C files (<c>.erl</c>/<c>.c</c>). + Please look at the language mapping for each back-end for details.</p> + <p>There will be at least one set of files for an IDL file, for the + file level scope. Modules and interfaces also have their own set + of generated files.</p> + </section> + +</erlref> + diff --git a/lib/ic/doc/src/ic_c_protocol.xml b/lib/ic/doc/src/ic_c_protocol.xml new file mode 100644 index 0000000000..f895fe0723 --- /dev/null +++ b/lib/ic/doc/src/ic_c_protocol.xml @@ -0,0 +1,158 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE cref SYSTEM "cref.dtd"> + +<cref> + <header> + <copyright> + <year>2004</year> + <year>2007</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>IC C Protocol Functions</title> + <prepared></prepared> + <docno></docno> + <date>2004-04-06</date> + <rev>A</rev> + </header> + <lib>ic_c_protocol</lib> + <libsummary>IC C Protocol Functions</libsummary> + <description> + <p>This manual page lists some of the functions of the IC C runtime + library that are used internally for the IC protocol. + </p> + <p>The listed functions are used internally by generated C client + and server code. They are documented here for <em>the advanced user</em> that want to replace the default protocol (Erlang + distribution + gen_server) by his own protocol, For each set of + client or sever functions below with prefix <c>oe</c>, the user + has to implement his own set of functions, the names of which + are obtained by replacing the <c>oe</c> prefix by <c>Prefix</c>. + The <c>Prefix</c> has to be set with the option + <c>{user_protocol, Prefix}</c> at compile time.</p> + <p>The following terminology is used (reflected in names of + functions): a <em>notification</em> is a message send from + client to server, without any reply back (i.e. a + <em>oneway</em> operation); a <em>request</em> is a message sent + from client to server, and where a <em>reply</em> message is + sent back from the server to the client.</p> + <p>In order to understand how the functions work and what they do + the user <em>must</em> study their implementation in the IC C + library (source file is <c>ic.c</c>), and also consider how they + are used in the C code of ordinary generated client stubs or + server skeletons.</p> + <p></p> + </description> + + <section> + <title>Client Protocol Functions</title> + <p>The following functions are used internally by generated C + client code.</p> + </section> + <funcs> + <func> + <name><ret>int</ret><nametext>oe_prepare_notification_encoding(CORBA_Environment *env)</nametext></name> + <fsummary>Prepare client notification encoding.</fsummary> + <desc> + <p>The result of this function is the beginning of a binary of + in external format of the tuple <c>{'$gen_cast', X}</c> where + <c>X</c> is not yet filled in. </p> + <p>In generated client code this function is the first to be called + in the encoding function for each oneway operation.</p> + </desc> + </func> + <func> + <name><ret>int</ret><nametext>oe_send_notification(CORBA_Environment *env)</nametext></name> + <name><ret>int</ret><nametext>oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms)</nametext></name> + <fsummary>Send client notification.</fsummary> + <desc> + <p>Sends a client notification to a server according to the + Erlang distribution + gen_server protocol.</p> + <p>The <c>send_ms</c> parameter specified a timeout in milliseconds.</p> + </desc> + </func> + <func> + <name><ret>int</ret><nametext>oe_prepare_request_encoding(CORBA_Environment *env)</nametext></name> + <fsummary>Prepare client request encoding.</fsummary> + <desc> + <p>The result of this function is the beginning of a binary in + the external format of the tuple <c>{'$gen_call', {Pid, Ref}, X}</c> where <c>X</c> is not yet filled in.</p> + <p>In generated client code this function is the first to be called + in the encoding function for each twoway operation.</p> + </desc> + </func> + <func> + <name><ret>int</ret><nametext>oe_send_request_and_receive_reply(CORBA_Environment *env)</nametext></name> + <name><ret>int</ret><nametext>oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</nametext></name> + <fsummary>Send client request and receive reply.</fsummary> + <desc> + <p>Sends a client request and receives the reply according to + the Erlang distribution + gen_server protocol. This function + calls the <c>oe_prepare_reply_decoding</c> function in order + to obtain the gen_server reply. + </p> + <p><c>send_ms</c> and <c>recv_ms</c> specify timeouts for send + and receive, respectively, in milliseconds.</p> + </desc> + </func> + <func> + <name><ret>int</ret><nametext>oe_prepare_reply_decoding(CORBA_Environment *env)</nametext></name> + <fsummary>Prepare client decoding of reply.</fsummary> + <desc> + <p>Decodes the binary version of the tuple <c>{Ref, X}</c>, + where <c>X</c> is to be decoded later by the specific client + decoding function.</p> + </desc> + </func> + </funcs> + + <section> + <title>Server Protocol Functions</title> + <p>The following functions are used internally by generated C + server code.</p> + </section> + <funcs> + <func> + <name><ret>int</ret><nametext>oe_prepare_request_decoding(CORBA_Environment *env)</nametext></name> + <fsummary>Prepare server decoding of request.</fsummary> + <desc> + <p>Decodes the binary version of the tuple <c>{'$gen_cast', Op}</c> (<c>Op</c> an atom), or the tuple <c>{'$gen_cast', {Op, X}}</c>, where <c>Op</c> is the operation name, and + where <c>X</c> is to be decoded later by the specific + operation decoding function; or</p> + <p>decodes the binary version of the tuple <c>{'$gen_call', {Pid, Ref}, Op}</c> (<c>Op</c> an atom), or the tuple + <c>{'$gen_call', {Pid, Ref}, {Op, X}}</c>, where <c>Op></c> + is the operation name, and <c>X</c> is to be decode later by + the specific operation decoding function.</p> + </desc> + </func> + <func> + <name><ret>int</ret><nametext>oe_prepare_reply_encoding(CORBA_Environment *env)</nametext></name> + <fsummary>Prepare server encoding of reply.</fsummary> + <desc> + <p>Encodes the beginning of the binary version of the tuple + <c>{{Ref,X}</c>, where <c>X</c> is to be filled in by the + specific server encoding function.</p> + </desc> + </func> + </funcs> + + <section> + <title>SEE ALSO</title> + <p>ic(3), ic_clib(3), <seealso marker="ch_ic_protocol">IC Protocol</seealso></p> + </section> + +</cref> + diff --git a/lib/ic/doc/src/ic_clib.xml b/lib/ic/doc/src/ic_clib.xml new file mode 100644 index 0000000000..b557c4b5f6 --- /dev/null +++ b/lib/ic/doc/src/ic_clib.xml @@ -0,0 +1,246 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE cref SYSTEM "cref.dtd"> + +<cref> + <header> + <copyright> + <year>2003</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IC C Library Functions</title> + <prepared></prepared> + <docno></docno> + <date>2003-12-16</date> + <rev>PB1</rev> + </header> + <lib>ic_clib</lib> + <libsummary>IC C Library Functions</libsummary> + <description> + <p>This manual page lists some of the functions in the IC C runtime + library. </p> + </description> + + <section> + <title>Allocation and Deallocation Functions</title> + <p>The following functions are used for allocating and + deallocating a <em>CORBA_Environment</em> structure.</p> + </section> + <funcs> + <func> + <name><ret>CORBA_Environment*</ret><nametext>CORBA_Environment_alloc(int inbufsz, int outbufsz)</nametext></name> + <fsummary>Allocate environment data.</fsummary> + <desc> + <p>This function is used to allocate and initiate the + <c>CORBA_Environment</c> structure. In particular, it is used + to dynamically allocate a CORBA_Environment structure and set + the default values for the structure's fields.</p> + <p><em>inbufsize</em> is the initial size of the input + buffer.</p> + <p><em>outbufsize</em> is the initial size of the output + buffer.</p> + <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure + used by the generated stub.</p> + <p>This function will set all needed default values and + allocate buffers the lengths of which are equal to the + values passed, but will not allocate space for the _to_pid + and _from_pid fields.</p> + <p>To free the space allocated by CORBA_Environment_alloc() do + as follows.</p> + <list type="bulleted"> + <item> + <p>First call CORBA_free for the input and output buffers.</p> + </item> + <item> + <p>After freeing the buffer space, call CORBA_free for the + CORBA_Environment space.</p> + </item> + </list> + </desc> + </func> + <func> + <name><ret>void</ret><nametext>CORBA_free(void *p)</nametext></name> + <fsummary>Free any allocated data.</fsummary> + <desc> + <p>Frees allocated space pointed to by <c>p</c>.</p> + </desc> + </func> + <func> + <name><ret>CORBA_char*</ret><nametext>CORBA_string_alloc(CORBA_unsigned_long len)</nametext></name> + <fsummary>Allocate a string.</fsummary> + <desc> + <p>Allocates a (simple) CORBA character string of length <c>len + 1</c>.</p> + </desc> + </func> + <func> + <name><ret>CORBA_wchar*</ret><nametext>CORBA_wstring_alloc(CORBA_unsigned_long len)</nametext></name> + <fsummary>Allocate a wide string.</fsummary> + <desc> + <p>Allocates a CORBA wide string of length <c>len + 1</c>.</p> + </desc> + </func> + </funcs> + + <section> + <title>Exception Functions</title> + <p>Functions for retrieving exception ids and values, and for setting + exceptions. </p> + </section> + <funcs> + <func> + <name><ret>CORBA_char*</ret><nametext>CORBA_exception_id(CORBA_Environment *env)</nametext></name> + <fsummary>Get exception identity.</fsummary> + <desc> + <p>Returns the exception identity if an exception is set, otherwise + it returns <c>NULL</c>.</p> + </desc> + </func> + <func> + <name><ret>void*</ret><nametext>CORBA_exception_value(CORBA_Environment *env)</nametext></name> + <fsummary>Get exception value.</fsummary> + <desc> + <p>Returns the exception value, if an exception is set, otherwise + it returns <c>NULL</c>.</p> + </desc> + </func> + <func> + <name><ret>void</ret><nametext>CORBA_exc_set(CORBA_Environment *env, CORBA_exception_type Major, CORBA_char *Id, CORBA_char *Value)</nametext></name> + <fsummary>Set exception.</fsummary> + <desc> + <p>Sets the exception type, exception identity, and exception value + in the environment pointed to by <c>env</c>.</p> + </desc> + </func> + </funcs> + + <section> + <title>Server Reception</title> + <p>The following function is provided for convenience. </p> + </section> + <funcs> + <func> + <name><ret>int</ret><nametext>oe_server_receive(CORBA_Environment *env, oe_map_t *map)</nametext></name> + <name><ret>int</ret><nametext>oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</nametext></name> + <fsummary>Server receive of notification or request, and sending of reply (in case of request).</fsummary> + <desc> + <p>Provides a loop that receives one message, executes the + operation in question, and in case of a two-way operation + sends a reply.</p> + <p><c>send_ms</c> and <c>recv_ms</c> specify timeout values + in milliseconds for send and receive, respectively.</p> + </desc> + </func> + </funcs> + + <section> + <title>Generic Execution Switch and Map Merging</title> + <p>Function for searching for server operation function, and for + calling it if found. Function for merging maps (see the include + file <c>ic.h</c> for definitions). </p> + </section> + <funcs> + <func> + <name><ret>int</ret><nametext>oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map)</nametext></name> + <fsummary>Search for server operation and execute it.</fsummary> + <desc> + <p>Search for server operation and execute it.</p> + </desc> + </func> + <func> + <name><ret>oe_map_t*</ret><nametext>oe_merge_maps(oe_map_t *maps, int size)</nametext></name> + <fsummary>Merge an array of server maps to one single map.</fsummary> + <desc> + <p>Merge an array of server maps to one single map.</p> + </desc> + </func> + </funcs> + + <section> + <title>The CORBA_Environment structure</title> + <p>Here is the complete definition of the CORBA_Environment structure, + defined in file <em>ic.h</em>: </p> + <code type="none"> + /* Environment definition */ + typedef struct { + + /*----- CORBA compatibility part ------------------------*/ + /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ + CORBA_exception_type _major; + + /*----- External Implementation part - initiated by the user ---*/ + /* File descriptor */ + int _fd; + /* Size of input buffer */ + int _inbufsz; + /* Pointer to always dynamically allocated buffer for input */ + char *_inbuf; + /* Size of output buffer */ + int _outbufsz; + /* Pointer to always dynamically allocated buffer for output */ + char *_outbuf; + /* Size of memory chunks in bytes, used for increasing the output + buffer, set to >= 32, should be around >= 1024 for performance + reasons */ + int _memchunk; + /* Pointer for registered name */ + char _regname[256]; + /* Process identity for caller */ + erlang_pid *_to_pid; + /* Process identity for callee */ + erlang_pid *_from_pid; + + /*- Internal Implementation part - used by the server/client ---*/ + /* Index for input buffer */ + int _iin; + /* Index for output buffer */ + int _iout; + /* Pointer for operation name */ + char _operation[256]; + /* Used to count parameters */ + int _received; + /* Used to identify the caller */ + erlang_pid _caller; + /* Used to identify the call */ + erlang_ref _unique; + /* Exception id field */ + CORBA_char *_exc_id; + /* Exception value field */ + void *_exc_value; + + + } CORBA_Environment; + </code> + <note> + <p>Always set the field values <em>_fd</em>, <em>_regname</em>, + <em>_to_pid</em> and/or <em>*_from_pid</em> to appropriate + application values. These are not automatically set by the + stubs.</p> + </note> + <warning> + <p>Never assign static buffers to the buffer pointers, and never + set the <em>_memchunk</em> field to a value less than + <em>32</em>.</p> + </warning> + </section> + + <section> + <title>SEE ALSO</title> + <p>ic(3), ic_c_protocol(3) + </p> + </section> + +</cref> + diff --git a/lib/ic/doc/src/java-part.xml b/lib/ic/doc/src/java-part.xml new file mode 100644 index 0000000000..69cc0f026c --- /dev/null +++ b/lib/ic/doc/src/java-part.xml @@ -0,0 +1,37 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part> + <header> + <copyright> + <year>2002</year> + <year>2007</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>IDL to Java language Mapping</title> + <prepared></prepared> + <docno></docno> + <date>2002-06-25</date> + <rev>A</rev> + </header> + <description> + <p></p> + </description> + <include file="ch_java"></include> +</part> + diff --git a/lib/ic/doc/src/make.dep b/lib/ic/doc/src/make.dep new file mode 100644 index 0000000000..64694ee85a --- /dev/null +++ b/lib/ic/doc/src/make.dep @@ -0,0 +1,24 @@ +# ---------------------------------------------------- +# >>>> Do not edit this file <<<< +# This file was automaticly generated by +# /home/otp/bin/docdepend +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# TeX files that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: book.tex c-part.tex ch_basic_idl.tex ch_c_client.tex \ + ch_c_corba_env.tex ch_c_mapping.tex ch_c_server.tex \ + ch_erl_genserv.tex ch_erl_plain.tex ch_ic_protocol.tex \ + ch_introduction.tex ch_java.tex erl-part.tex \ + ic.tex ic_c_protocol.tex ic_clib.tex java-part.tex \ + ref_man.tex + +# ---------------------------------------------------- +# Source inlined when transforming from source to LaTeX +# ---------------------------------------------------- + +book.tex: ref_man.xml + diff --git a/lib/ic/doc/src/notes.gif b/lib/ic/doc/src/notes.gif Binary files differnew file mode 100644 index 0000000000..e000cca26a --- /dev/null +++ b/lib/ic/doc/src/notes.gif diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml new file mode 100644 index 0000000000..c4314d8cc1 --- /dev/null +++ b/lib/ic/doc/src/notes.xml @@ -0,0 +1,444 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IDL Compiler Release Notes</title> + <prepared></prepared> + <docno></docno> + <checked></checked> + <date>2004-04-06</date> + <rev>AC</rev> + <file>notes.xml</file> + </header> + + <section> + <title>IC 4.2.23</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + The documentation is now built with open source tools (xsltproc and fop) + that exists on most platforms. One visible change is that the frames are removed.</p> + <p> + Own Id: OTP-8201 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.22</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The 64-bit version of libic was not compiled with the -fPIC flag.</p> + <p>Own id: OTP-8088</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.21</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The function print_erlang_binary (oe_ei_code_erlang_binary.c) + updated to avoid compiler warning.</p> + <p>Own id: OTP-7982</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.20</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Updated file headers.</p> + <p>Own id: OTP-7837</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.19</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Documentation source included in open source releases.</p> + <p>Own id: OTP-7595</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.18</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Insufficient buffer allocated when passing wide strings + using the C backend on a 64-bit architecture.</p> + <p>Own Id: OTP-7313 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.17</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Updated file headers.</p> + <p>Own id: OTP-7011</p> + </item> + <item> + <p>IC no longer use the obsolete function file:rawopen/2.</p> + <p>Own id: OTP-7182</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.16</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Added links to classes inherited from Jinterface in the + User's Guide.</p> + <p>Own Id: OTP-6965 Aux Id: </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.15</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>If an inherited function name begun with a capital letter + the generated stub/skeleton oe_tc/1 function was incorrect.</p> + <p>Own Id: OTP-6855 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.14</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The documentation source has been converted from SGML to XML.</p> + <p>Own Id: OTP-6754 Aux Id: </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.13</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Minor Makefile changes.</p> + <p>Own Id: OTP-6701 Aux Id: </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.12</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Dead code was deleted from the following modules: + ic_cclient, ic_code, ic_cserver, ic_erlbe, ic_java_type, + ic_noc, ic_plainbe, ic_pp, ic_pragma, icscan, icstruct, + ictype, icunion.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.11</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Changed code generation to avoid warnings such as unused + variables.</p> + <p>Own Id: OTP-5930 Aux Id: </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.10</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The FD_SETSIZE limit has been increased to 2048 for + VxWorks/PPC603.</p> + <p>Own Id: OTP-5395 Aux Id: seq9751</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.9</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>In C back-ends, the compiler crashed when generating C code + for error reports when a scoped name was used as a type + in a union.</p> + <p>Own Id: OTP-5375 Aux Id: seq9740 </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.8</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>In C back-ends, when decoding a sequence of "small" + integers, which from Erlang is sent as a string (i.e. + each element between 0 and 255), each string element was + considered to be of signed character type. Each such + element is now correctly treated as an unsigned character + type.</p> + <p>Own Id: OTP-5205 Aux Id: seq9241 </p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.7</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>A new compiler option <c>c_report</c> has been introduced + for C back-ends (client and server). If that option is + set, encoding/decoding errors will be reported to + <c>stderr</c>.</p> + <p>Own Id: OTP-4977</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.6</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The size of modules, used then registering data in the + IFR DB (e.g., oe_MyModule:oe_register()), can be minimized + if the compile option light_ifr is used and Orber is + configured to use Light IFR. Requires that orber-3.5.1, or + later, is used.</p> + <p>Own Id: OTP-5036</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>The compile option <c>multiple_be</c> is no longer supported.</p> + <p>Own Id: OTP-5049</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.5</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Send and receive functions with timeouts have been added + to the C back-ends for the standard protocol (i.e. Erlang + distribution + gen_server protocol).</p> + <p>Accordingly a new compiler option <c>{c_timeout, {SendTimeout, RecvTimeout}}</c> has been added. Timeouts + are specified in milliseconds.</p> + <p>A user that want to implement its own protocols with + function timeouts has to implement the following functions.</p> + <p>For C clients the functions <c>int PFX_send_notification(CORBA_Environment *env, unsigned int send_ms)</c>, and <c>int PFX_send_request_and_receive_reply(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</c> + have to be additionally implemented, where PFX is the + user defined prefix.</p> + <p>For C servers no additional functions have to be + implemented, but a clone of the <c>int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</c> + might be handy.</p> + <p>Own Id: OTP-4972</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.4</title> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The C back-ends has been opened up, so that a user can + define his own protocol, differing from the Erlang + distribution + gen_server protocol. <br></br> + + For C clients it means to replace the library functions + <c>int oe_prepare_notification_encoding(CORBA_Environment *env)</c>, <c>int oe_send_notification(CORBA_Environment *env)</c>, <c>int oe_prepare_request_encoding(CORBA_Environment *env)</c>, + <c>int oe_send_request_and_receive_reply(CORBA_Environment *env)</c>, and <c>int oe_prepare_reply_decoding(CORBA_Environment *env)</c>, + with functions of the same signature, but with the prefix + "oe" replaced by a user defined prefix. + For C servers the functions <c>int oe_prepare_request_decoding(CORBA_Environment *env)</c>, + and <c>int oe_prepare_reply_encoding(CORBA_Environment *env)</c>, are similarly replaced. <br></br> + + The new compiler option <c>{user_protocol, Prefix}</c> has + been added.</p> + <p>Own Id: OTP-4834</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.3</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>In generated code for the C server back-end, the naming scope + was in error for prototypes in C header files for interfaces + inheriting base interfaces.</p> + <p>Own Id: OTP-4881</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.2</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>IDL long long and unsigned long long could not + be used in a struct for the Java backend.</p> + <p>All unsigned integer types for the Java backend + had broken marshalling for large values.</p> + <p>Own Id: OTP-4763</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2.1</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A scoping problem (IC could not find typedefs contained + inherited interfaces) in the C-backend solved.</p> + <p>Own Id: OTP-4758</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.2</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The CORBA stub/skeleton-files generated by IC have been improved, + i.e., depending on the IDL-files, reduced the size of the + erl- and beam-files and decreased dependencies off Orber's + Interface Repository. It is necessary to re-compile all IDL-files + and use COS-applications, including Orber, compiled with + IC-4.2.</p> + <p>Own Id: OTP-4576</p> + </item> + </list> + </section> + </section> +</chapter> + diff --git a/lib/ic/doc/src/old_notes.xml b/lib/ic/doc/src/old_notes.xml new file mode 100644 index 0000000000..9ba0262573 --- /dev/null +++ b/lib/ic/doc/src/old_notes.xml @@ -0,0 +1,1565 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2003</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IDL Compiler Release Notes</title> + <prepared></prepared> + <docno></docno> + <checked></checked> + <date>2003-11-19</date> + <rev>AB</rev> + </header> + + <section> + <title>IC 4.1.8</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>IDL-files containing <c>result</c> or <c>Result</c> as, + for example, parameter name, caused an exit with reason + <c>bad_match</c>.</p> + <p>Own Id: OTP-4532</p> + </item> + <item> + <p>Uninitialized variables were used in <c>ic_init_ref</c> for + C backends. </p> + <p>Own Id: OTP-4537 <br></br> + + Aux Id: seq7666, ETOtr17107</p> + </item> + <item> + <p><c>CORBA_Environment_alloc()</c> left some fields + uninitialized in the returned pointer to an + <c>CORBA_Environment</c> for C backends.</p> + <p>Own Id: OTP-4538</p> + </item> + <item> + <p>The function <c>ic_compare_refs()</c> for C backends + could find two unequal references to be equal.</p> + <p>Own Id: OTP-4539</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.7</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Operation names were always scoped in C server backend, + irrespective of the setting of the option + <c>scoped_op_calls</c>.</p> + <p>Own Id: OTP-4521 <br></br> + + Aux Id: seq7643, ETOtr16925</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.6</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>For C backends generated code checks that the + <c>_length</c> field of bounded sequences (i.e. specified + as <c><![CDATA[sequence <TYPE, MAX>]]></c>) does not exceed the + specified maximum length. If so, an exception is raised.</p> + <p>Own Id: OTP-4471</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The <c>_maximum</c> field was not set for sequence structs + generated by the C backends.</p> + <p>Own Id: OTP-4471 <br></br> + + Aux Id: seq7600, ETOtr16308</p> + </item> + <item> + <p>There was a memory leak in C backends in case there was a + decoding error in a sequence with elements of basic type.</p> + <p>Own Id: OTP-4475</p> + </item> + <item> + <p>For for C backends, IDL structs defined within an + interface were not mapped into C structs in appropriate + include files.</p> + <p>Own Id: OTP-4481 <br></br> + + Aux Id: seq7617</p> + </item> + <item> + <p>If the user, incorrectly, trap exit's but did not use the + 'handle_info' compile option it would cause the server to + terminate. The same problem occurred if someone, + illegally, sent a message to the server. It could also + happen for illegal oneway operations.</p> + <p>Own Id: OTP-4488</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.5</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Invalid C code was generated for type short. </p> + <p>Own Id: OTP-4450 <br></br> + + Aux Id: seq7582</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.4</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Operation functions inherited by an interface were not + placed in the map table in generated code for the C server + backend. As a result such functions were not found by the + switch function of the interface.</p> + <p>Own Id: OTP-4448 <br></br> + + Aux Id: seq7582</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.3.1</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A non-ANSI compliant construct in libic.a was changed.</p> + <p>Own Id: -</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.3</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>For Erlang and C back-ends an IC version stamp has been + added to generated source code. This stamp i preserved in + compiled target code.</p> + </item> + <item> + <p>For C backends an <c>assert()</c> expression has been + added to generated code. That expression asserts that the + result of a memory allocation size calculation is strictly + positive. An error will result in a printout and an + <c>abort()</c>. The assertion can be inhibited by defining + the macro <c>NDEBUG</c> (according to ANSI C).</p> + <p>If the assertion is inhibited, and a size calculation error + is detected, an INTERNAL CORBA exception is set. </p> + </item> + <item> + <p>An internal reorganization of C backend generator code has + been done (addition of module <c>ic_cclient</c>). Several + changes has been done in generated C code:</p> + <list type="bulleted"> + <item> + <p>The typedef <c>___generic___</c> has been replaced by + the typedef <c>___exec_function___</c>, which has been + made more strict; for backward compatibility the + <c>___generic___</c> typedef is now an alias for + <c>___exec_function___</c>.</p> + </item> + <item> + <p>Function parameters that are arrays, has been changed + to be pointers to array slices, which are equivalent + according to ANSI C. </p> + </item> + <item> + <p>The storage class specifier <c>extern</c> has been + removed from function prototypes in header files.</p> + </item> + <item> + <p>Redundant type casts have been removed from generated code. + Also some local "generic" variables have been renamed.</p> + </item> + </list> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Module info vsn replaced by app_vsn.</p> + <p>Own Id: OTP-4341</p> + </item> + <item> + <p>IC-4.1.2 disabled the definition of float constants + beginning with a zero (e.g. <c>0.14</c>).</p> + <p>Own Id: OTP-4367</p> + </item> + <item> + <p>IC did not handle constant definitions correctly for + char, string, wchar and wstring.</p> + <p>Own Id: OTP-4067, OTP-3222</p> + </item> + <item> + <p>IC did not recognize all reserved words defined in the + OMG specification (2.3.1). The new keywords are <c>fixed, abstract, custom, factory, local, native, private, public, supports, truncatable, 'ValueBase'</c> and + <c>valuetype</c>. But for now this is only active for the + <c>erl_corba</c> backend and only incorrect usage of + <c>fixed</c>, since this datatype is now supported, + triggers an error for this backend.</p> + <p>Own Id: OTP-4368</p> + </item> + <item> + <p>It was not possible to use wchar or wstring inside a + union body when using the Java backend.</p> + <p>Own Id: + OTP-4365</p> + </item> + <item> + <p>The compile options <c>this</c> and <c>handle_info</c> + did not behave as described in the documentation. The + <c>timeout</c> now behaves as, for example, + <c>handle_info</c>.</p> + <p>Own Id: OTP-4386, OTP-3231</p> + </item> + <item> + <p>If we typedef a sequence, which contains a struct or a union, + the access function <c>id/0</c> returned an incorrect IFR Id + if a prefix pragma was used.</p> + <p>Own Id: OTP-4387</p> + </item> + <item> + <p>If an IDL file contained a prefix pragma, incorrect + IFR-id's was generated in the IFR-registration operation + <c>oe_register</c> for aliases (typedef) and + attributes.</p> + <p>Own Id: OTP-4388, OTP-4392</p> + </item> + <item> + <p>For C back-ends, when encodings/decodings failed, memory + allocated for variable size parameter types was not freed.</p> + <p>Own Id: OTP-4391 + <br></br> +Aux Id: seq7438, ETOtr14009</p> + </item> + <item> + <p>If an IDL file contained a multiple typedef + (e.g. typedef string str1, str2;), the <c>oe_unregister</c> + operation failed to remove all data, in this case str2, + from the IFR.</p> + <p>Own Id: OTP-4393</p> + </item> + <item> + <p>IC did not recognize octet-constants + (e.g. const octet octetmax = 255;).</p> + <p>Own Id: OTP-4400</p> + </item> + <item> + <p>Negative 'long long' constants was not accepted + (e.g. const long long MyConstant = -1;).</p> + <p>Own Id: OTP-4401</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.2</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Merging of map's (<em>___map___</em>) using the + <em>___merge___</em> function does not work.</p> + <p>Own Id: OTP-4323</p> + </item> + <item> + <p>Error in generated C decode/encode functions for union's with + discriminator where the union has no value for all discriminator + values. E.g. a union with discriminator boolean where only the + discriminator value TRUE has a corresponding union value. + Here is how such a thing would look in IDL:</p> + <pre> +\011 union OptXList switch(boolean) { +\011 case TRUE: integer val; + }; + </pre> + <p>Own Id: OTP-4322</p> + </item> + <item> + <p>Scoped op calls ('{scoped_op_calls, true}') does not handle + module/function names beginning with capital letter (e.g. + Megaco should be 'Megaco') for oneway operations (handle_cast).</p> + <p>Own Id: OTP-4310</p> + </item> + <item> + <p>A bug is fixed on C-IDL erlang binaries that caused + pointer error when residing inside sequences.</p> + <p>Own Id: OTP-4303</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.1.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>A new option 'multiple_be' is added that allows multiple backend + generation for the same IDL file.</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed on IDL types that contain underscore '_'.</p> + <p>Own Id: OTP-3710</p> + </item> + <item> + <p>A bug is fixed on IDL structs that caused scope confusion + when types and fields of a struct had the same name.</p> + <p>Own Id: OTP-2893</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.7</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The Erlang binary special type is introduced, that + allows efficient transfer of binaries between Erlang and C. </p> + <p>Own Id:OTP-4107</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.6</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed on noc backend which caused generation of erroneous code.</p> + <p>Own Id: OTP-3812</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.5</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The pragma code option is extended to point + specific functions on NOC backend, not only + interfaces.</p> + <p></p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.4</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug in pragma prefix when including IDL files is fixed. + This caused problems for Erlang-corba IFR registrations.</p> + <p>Own Id: OTP-3620</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.3</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Limited support on multiple file module definitions.</p> + <p>The current version supports multiple file module definitions all + backends except the c oriented backends.</p> + <p>Own Id: OTP-3550</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.2</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed on Erlang backends.</p> + <p>The (recently) introduced generation of files + describing sequence and array files were even + true for included interfaces. In the case of + some Erlang backends this were unnecessary.</p> + <p>Own Id: OTP-3485</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>New functionality added on Java and Erl_genserv backends.</p> + <p></p> + <list type="bulleted"> + <item> + <p>On the Java client stub :</p> + <p></p> + <list type="bulleted"> + <item> + <p>The Java client have now one more constructor function, + that allows to continue with an already started connection.</p> + </item> + <item> + <p><c>void __stop()</c> which sends a stop cast call to the server. + While this causes the Erlang server to terminate, it + sets a stop flag to the Java server environment, requesting the + server to terminate.</p> + </item> + <item> + <p><c>void __reconnect()</c> which closes the current client connection + if open and then connects to the same server.</p> + </item> + </list> + <p>The Environment variable is now declared as <c>public</c>. </p> + </item> + <item> + <p>On the Java server skeleton :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>boolean __isStopped()</c> which returns true if a <c>stop</c> + message where received, false otherwise. The user must check if + this function returns true, and in this case exit the implemented + server loop.</p> + </item> + </list> + <p>The Environment variable is now declared as <c>protected</c> which + allows the implementation that extends the stub to access it.</p> + </item> + <item> + <p>On the Erlang gen_server stub :</p> + <p></p> + <list type="bulleted"> + <item> + <p><c>stop(Server)</c> which yields to a cast call to the standard + gen_server <c>stop</c> function. This will always terminate the + Erlang gen_server, while it will set the stop flag for the + Java server stub.</p> + </item> + </list> + </item> + </list> + <p>Own Id: OTP-3433</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 4.0</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>New types handled by IC.</p> + <p>The following OMG-IDL types are added in this compiler version :</p> + <list type="bulleted"> + <item> + <p>long long</p> + <p>unsigned long long</p> + <p>wchar</p> + <p>wstring</p> + </item> + </list> + <p>Own Id: OTP-3331</p> + <p></p> + </item> + <item> + <p>TypeCode as built in type and access code files for array and sequence types.</p> + <list type="bulleted"> + <item> + <p>As TypeCode is a <c>pseudo</c>-interface, it is now is a built-in type on IC.</p> + </item> + <item> + <p>Access code files which contain information about TypeCode, ID and Name are + now generated for user defined arrays and sequences.</p> + </item> + </list> + <p>Own Id: OTP-3392</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.8.2</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <p>A bug is fixed on preprocessor directive expansion.</p> + <p>When nested #ifdef - #ifndef directives, a bug caused + improper included file expansion. This is fixed by + repairing the preprocessor expansion function.</p> + <p>Own Id: OTP-3472</p> + </section> + </section> + + <section> + <title>IC 3.8.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Build in Erlang types support for java-backends</p> + <p>The built-in Erlang types <c>term, port, ref</c> and <c>pid</c> + are needed in Java backends in order to support an + efficient mapping between the two languages. + The new types are also supported by additional + helpers and holders to match with OMGs Java mapping + As a result of this, the following classes are added to + the <c>com.ericsson.otp.ic</c> interface :</p> + <list type="bulleted"> + <item> + <p><c>Term,TermHelper,TermHolder</c> which represents the + built-in Erlang type <c>term</c></p> + </item> + <item> + <p><c>Ref,RefHelper,RefHolder</c> which represents the + built-in Erlang type <c>ref</c></p> + </item> + <item> + <p><c>Port,PortHelper, PortHolder</c> which represents the + built-in Erlang type <c>port</c></p> + </item> + <item><c>Pid, PidHelper and PidHolder</c> which represents the + built-in Erlang type <c>pid</c></item> + </list> + <p></p> + <p>Own Id: OTP-3348</p> + <p></p> + </item> + <item> + <p>Compile time preprocessor macro variable definitions</p> + <p>The preprocessor lacked possibility to accept user + defined variables other than the one defined in IDL files. + This limited the use of command-ruled IDL specifications. + Now the build-in preprocessor allows the user to set variables + by using the "preproc_flags" option the same way + as using the "gcc" preprocessor.</p> + <p>Supported flags : </p> + <list type="bulleted"> + <item> + <p><c><![CDATA["-D< Variable >"]]></c> which defines a variable</p> + </item> + <item> + <p><c><![CDATA["-U< Variable >"]]></c> which undefines a variable</p> + </item> + </list> + <p></p> + <p>Own Id: OTP-3349</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <p>A bug on comment type expansion is fixed.</p> + <p>The comment type expansion were erroneous when + inherited types (NOC backend). + This is now fixed and the type naming agree with + the scope of the inheritor interface.</p> + <p>Own Id: OTP-3346</p> + </section> + </section> + + <section> + <title>IC 3.8</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The code generated for java backend is optimized + due to use of streams instead for tuple classes + when (un)marshalling message calls. + Support for building clients using asynchronous + client calls and effective multi-threaded servers.</p> + <p>Own Id: OTP-3310</p> + <p></p> + </item> + <item> + <p>The <c>any</c> type is now supported for java backend.</p> + <p>Own Id: OTP-3311</p> + </item> + </list> + </section> + + <section> + <title>A bug on C generated constants is fixed</title> + <p>While the constants are evaluated and behave well when used + inside an IDL specification their C-export were not working properly. + The constant export definitions were not generated well :</p> + <list type="bulleted"> + <item> + <p>the declared C definition were erroneous ( the name did not always agree + with the scope the constant were declared in ).</p> + </item> + <item> + <p>there were no C- definition generated for the c-server backend when + the constants were declared inside an interface.</p> + </item> + </list> + <p>Own Id: OTP-3219</p> + </section> + + <section> + <title>Incompatibilities</title> + <p>Due to optimizations in java backend, the stub initialization and usage + differs than the previous version.</p> + <p>Client stub interface changes:</p> + <list type="bulleted"> + <item> + <p>Client disconnects by calling the <c>__disconnect()</c> function instead + for the old <c>_closeConnection()</c></p> + <p></p> + </item> + <item> + <p>All <c>marshal</c> operation functions have now the interface :</p> + <p><c><![CDATA[void _< OpName >_marshal(Environment<, Param |, Params >)]]></c></p> + <p>instead for</p> + <p><c><![CDATA[OtpErlangTuple _< OpName >_marshal(< Param, | Params, >OtpErlangPid, OtpErlangRef)]]></c></p> + <p></p> + </item> + <item> + <p>All <c>unmarshal</c> operation functions have now the interface :</p> + <p><c><![CDATA[< Ret value > _< OpName >_unmarshal(Environment<, Param |, Params >)]]></c></p> + <p>instead for</p> + <p><c><![CDATA[< Ret value > _< OpName >_unmarshal(< Param, | Params, >OtpErlangTuple, OtpErlangRef)]]></c></p> + <p></p> + </item> + <item> + <p>Call reference extraction is available by the client function :</p> + <p><c>OtpErlangRef __getRef()</c></p> + <p>instead for previous function :</p> + <p><c>OtpErlangRef _getReference(OtpErlangTuple)</c></p> + <p></p> + </item> + </list> + <p>Server skeleton interface changes:</p> + <list type="bulleted"> + <item> + <p>The implementation function no longer have to contain the + two (2) contractor functions (with <c>super()</c>). This is due + to the fact that there is only one contractor function for each + skeleton file :</p> + <p><c><![CDATA[public _< interface name >ImplBase()]]></c></p> + <p></p> + </item> + <item> + <p>The parameter for the caller identity extraction function <c>_getCallerPid</c> + is now an <c>Environment</c> variable instead for an <c>OtpErlangTuple</c>.</p> + <p></p> + </item> + <item> + <p>There is a new <c>invoke</c> function :</p> + <p><c>OtpOutputStream invoke(OtpInputStream)</c></p> + <p>instead for the old one :</p> + <p><c>OtpErlangTuple invoke(OtpErlangTuple)</c></p> + <p></p> + </item> + <item> + <p>The <c>OtpConnection</c> class function used for receiving messages is now :</p> + <p><c>OtpInputStream receiveBuf()</c></p> + <p>instead for the old one :</p> + <p><c>OtpErlangTuple receive()</c></p> + <p></p> + </item> + <item> + <p>The <c>OtpConnection</c> class function used for sending messages is now :</p> + <p><c>void sendBuf(OtpErlangPid, OtpOutputStream)</c></p> + <p>instead for the old one :</p> + <p><c>void send(OtpErlangPid, OtpErlangTuple)</c></p> + <p></p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.7.1</title> + + <section> + <title>Improvements and New Features</title> + <p>Some memory usage optimizations for the compiler were done.</p> + </section> + + <section> + <title>Fixed bugs and malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed when C backend is used.</p> + <p>When C-union with enumerant discriminator, the size + calculation of the discriminator value were erroneous. + This lead to the side effect that only the first case of the + union were allowed. + The error were fixed by fixing the size calculation of + the discriminator. </p> + <p>Own Id: OTP-3215</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.7</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed when C backend is used.</p> + <p>When unions with enumerant discriminator + were decoded, an error encountered in the + union size calculation. </p> + <p>Own Id: OTP-3209</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.6</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed when NOC backend is used.</p> + <p>When several functions with the same name + were found in the included file tree, + a compile time failure occurred.</p> + <p>Own Id: OTP-3203</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.5</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Noc backend optimization</p> + <p>When NOC backend is choosen, the type code + information on the stub functions is reduced + to a single atom "no_tk". + This is the default behavior. The typecode + generation is enabled by the "use_tk" switch.</p> + <p>Own Id: OTP-3196</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>General java backend bug fixes </p> + <p>Protocol errors on user defined structures and + union types are corrected.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.4</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Semantic test enhancements.</p> + <p>The compiler detects now semantic errors when enumerant + values collide with user defined types on the same name scope.</p> + <p>Own Id: OTP-3157 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>General java backend bug-fixes </p> + <p>Several bugs were fixed on user defined types.</p> + <list type="bulleted"> + <item> + <p>Union discriminators work better when + all possible case values are defined.</p> + </item> + <item> + <p>A bug on Interface inherited operations is + fixed that cause errors on generated server switch.</p> + </item> + <item> + <p>Type definitions on included files are better generated. </p> + </item> + </list> + <p>Own Id: OTP-3156 <br></br> +</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.3</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>A new back-end which generates Java code according to the CORBA IDL to Java mapping for + communication with the Erlang distribution protocol has been added to IC. + For the moment there is no support for the Erlang types Pid, Ref, Port and Term + but this will be added later.</p> + <p>Own Id: OTP-2779 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Fixed the bug that the c code backends sometimes generated incorrect code for + struct arguments. They shall always be pointers. </p> + <p>Own Id: OTP-2732 <br></br> +</p> + </item> + <item> + <p>The code generation is fixed so the array parameters now follow the + CORBA V2.0 C mapping.</p> + <p>Own Id: OTP-2873 <br></br> +</p> + </item> + <item> + <p>Fixed the problem that the checking of the numbers of out-parameters always was true.</p> + <p>Own Id: OTP-2944 <br></br> +</p> + </item> + <item> + <p>Fixed the bug that some temporary variables was not declared when c code.</p> + <p>Own Id: OTP-2950 <br></br> +</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.2.2</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Unions are now supported to agree with OMG's C mapping.</p> + <p>Own Id: OTP-2868 <br></br> +</p> + </item> + <item> + <p>There is now a possibility to use pre- and postcondition methods on the server side + for IC generated Corba Objects. The compiler option is documented in the ic reference manual + and an example of how the pre- and postcondition methods should be designed and used is + added to ic example directory (an ReadMe.txt file exists with some instructions for + running the example code).</p> + <p>Own Id: OTP-3068 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The compiler ignores unknown/non supported pragma directives. A warning is raised + while the generated code will then be the same as if the corresponding + (unknown) pragma directive were missing. </p> + <p>Own Id: OTP-3052 <br></br> +</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.2.1</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Wrong C code was generated for limited strings when they where included + from another IDL specification.</p> + <p>Own Id: OTP-3033 <br></br> +</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.2</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The buffers for in/output used by C-stubs are now expandable. + This fixes buffer overflow problems when messages received/sent + do not fit in buffers.</p> + <p>Own Id: OTP-3001 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <p>The CORBA_Environment structure has now two new fields, the buffers for in/output + must now be dynamically allocated.</p> + </section> + </section> + + <section> + <title>IC 3.1.2</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The generated IFR registration function for constants has been fixed + so the parameters are correct.</p> + <p>Own Id: OTP-2856 <br></br> +</p> + </item> + <item> + <p>Error in the C code generation of ONEWAY operations without parameters + The bug was an decoding error in the operation header. The generated code expected one + parameter instead of zero. This is now fixed.</p> + <p>Own Id: OTP-2909 <br></br> +</p> + </item> + <item> + <p>Type problems on floats and booleans fixed.</p> + <p>Erroneous code for runtime checks on float was removed and + the internal format of the data representing the boolean value + is upgraded.</p> + <p>Own Id: OTP-2925 <br></br> +</p> + </item> + <item> + <p>The generated code for arrays of typedefined strings were + erroneous in the C-backends due to a failure in the compiler internal type + checking.</p> + <p>Own Id: OTP-2936 <br></br> +</p> + </item> + <item> + <p>The generated code for typedefined nested sequences were erroneous + in the C-backends. Pointer mismatches caused compilation failure.</p> + <p>Own Id: OTP-2937 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <p>The IDL specifications must be regenerated for C due to changes in the code generation.</p> + <p>One must regenerate IDL specifications for Erlang CORBA if there are constants in the + specification due to previous errors in the IFR registration functions (OTP-2856).</p> + </section> + </section> + + <section> + <title>IC 3.1.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Improvements on error report on unsupported types by</p> + <p>propagating warning when declaring unions in C -backends</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed when arrays that contained variable size data + on C-backends</p> + <p>The compiler generated erroneous code when IDL + defined arrays that contained variable size data such + as strings, variable size structs or sequences.</p> + <p>Own Id: OTP-2900 <br></br> +</p> + </item> + <item> + <p>A bug is fixed when sequences that contained variable size data + on C_backends</p> + <p>The compiler generated erroneous code when IDL + defined arrays that contained variable size data such + as strings, variable size structs or other sequences.</p> + <p>Own Id: OTP-2901 <br></br> +</p> + </item> + <item> + <p>A bug concerning bounded strings on C-backends is fixed.</p> + <p>The compiler generated erroneous code for IDL + defined bounded strings. Syntax errors were generated + in special cases of typdedefined strings.</p> + <p>Own Id: OTP-2898 <br></br> +</p> + </item> + <item> + <p>A runtime error when sequences that contained integer types is fixed.</p> + <p>When C-clients/server that communicated with Erlang clients/servers, + and the data send by Erlang part were a list of small numbers, + the Erlang runtime compacts the list to a string. This caused a + runtime error when sending sequences of integer types and all had + value less than 256.</p> + <p>Own Id: OTP-2899 <br></br> +</p> + </item> + <item> + <p>An OMG IDL - C mapping problem on enumerant values is fixed.</p> + <p>The enumerant values names is now prefixed by the current scope, + as defined in the specification.</p> + <p>Own Id: OTP-2902 <br></br> +</p> + </item> + <item> + <p>A problem when using constants in array declarations is fixed.</p> + <p>Array dimensions declared with constants generated erroneous code.</p> + <p>Own Id: OTP-2864 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>Changes in C-generation on enumerant values.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.1</title> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug is fixed on the generated structures. </p> + <p>The generated C code for the structures corresponds now + to direct mapping of C-structs. </p> + <p>Own Id: OTP-2843 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>Included structures inside a struct are no longer pointers.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 3.0</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Interface change for C-backends</p> + <p>Major interface change. The new interface is CORBA 2.0 + compliant.</p> + <p>Own Id: OTP-2845 <br></br> +</p> + </item> + <item> + <p>The C-backends functionality is improved</p> + <list type="bulleted"> + <item> + <p>Due to interface change and some unneeded error + checks,the C-generated code is fairly optimized.</p> + </item> + </list> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Several serious bugs on decoding and memory allocation are fixed. </p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>Interface change on the C-backends</p> + <p>In order to be CORBA 2.0 compatible, the new version + generates fully incompatible C code.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 2.5.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>A new backend is added : C-server</p> + <p>This back-ends can be used to create servers, + compatible to c-clients, and Erlang genserver clients. + The code produced is a collection of functions for + encoding and decoding messages and a switch that coordinates + them. These parts can be used to create other servers as well. + All functions are exported to header files.</p> + <p>Own Id: OTP-2713 <br></br> +</p> + </item> + <item> + <p>The C-client functionality is improved</p> + <list type="bulleted"> + <item> + <p>The static buffer used for input/output is removed along + with the <c>memset</c> function that initiated it. + The new client is at least 20-30 percent faster.</p> + </item> + <item> + <p>The internal structure of the client is changed. + The client functions are now a collection of encoding + and decoding message functions ruled by a specific + call function. While the basic client generated is + a synchronous client, the exported functions + support the implementation of threaded asynchronous + clients.</p> + </item> + <item> + <p>The static buffer used for input/output is remove along + with the <c>memset</c> function that initiated it. + The new client is at least 20-30 percent faster.</p> + </item> + <item> + <p>The code generated is generally improved, warnings are + (almost) eliminated, while no unidentified variable + errors occur.</p> + </item> + <item> + <p>The IDL types unsigned shorts, shorts, floats are supported now.</p> + </item> + <item> + <p>All generated functions are exported in client header files..</p> + </item> + </list> + <p>Own Id: OTP-2712 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Changes in compiler usage and code generation.</title> + <list type="bulleted"> + <item> + <p>A new option is added for the C-server back-end : <c>c_server</c>.</p> + </item> + <item> + <p>A new option is added : <c>scoped_op_calls</c>.</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug oneway operations on erl_corba and erl_genserv that caused + en exit due to internal interface error is fixed. </p> + </item> + <item> + <p>A bug on oneway operations on c_genserv back-end that caused several + variables to be unidentified is fixed. </p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>Interface change on the C-client</p> + <p>The client functions are called with two extra variables, a pointer to + an array of char - used for storage and an integer - the array size</p> + </item> + <item> + <p>The IDL type <c>attribute</c> is disabled, due to some implementation problems.</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 2.1</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The compiler now provides more in depth information (printouts) when errors occur.</p> + <p>In some cases the compiler stops compiling + due to an abnormal exit or incompatible input. + In this situation, a "fatal error" may occur but the compiler will + generate information explaining the problem.</p> + <p>Own Id: OTP-2565 <br></br> +</p> + </item> + </list> + </section> + </section> + + <section> + <title>IC 2.0</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The IDL compiler is now a separate application and is longer a part of Orber.</p> + </item> + <item> + <p>Pragma handling implementation.</p> + <p>Pragma ID, prefix + and version are implemented to agree with CORBA revision + 2.0. The compiler accepts and applies these on the + behavior of the compiled code. <br></br> + In this implementation, + pragmas are accepted by the parser and applied by the use + of ic_pragma functions. <br></br> + All IFR-identity handling now + passes through pragma table. As pragma handling in OMG-IDL + is affecting the identity of an ifr-object, all identity + handling and registration is now controlled by pragma + functions. A hash table called "pragmatab" contains vital + identity information used under compilation. <br></br> +</p> + <p>There two major pragma categories :</p> + <list type="bulleted"> + <item> + <p>Normal pragmas, are used in the code where + basic definitions and statements appear. </p> + </item> + <item> + <p>Under certain circumstances, ugly pragmas can now + appear inside code, parameter lists, structure + definitions ... etc. <br></br> + It is quite challenging to + allow ugly pragmas, but the effects of unlimited ugly + pragma implementation on the parser can be enormous. + Ugly pragmas can cause the parser source code to + become time consuming and user unreadable. <br></br> + In order + to allow ugly pragmas but not destroy the current + structure of the parser, the use of ugly pragmas is + limited. Multiple pragma directives are allowed + inside parameter lists, unions, exceptions, + enumerated type, structures... as long as they are do not + appear between two keywords or between keywords and + identifiers. </p> + </item> + </list> + <p>The pragma effect is the same for both scope and basic + pragma rules. </p> + <p>When compiling, an IFR-identity + must be looked up several times but by storing identity aliases inside + the pragma table there this an increase in both speed and + flexibility. </p> + <p>Own Id: OTP-2128 <br></br> +</p> + </item> + <item> + <p>Code for interface inheritance registration for the IFR + registration code .</p> + <p>Inherited interfaces can now + be registered as a list of interface descriptions by + entering code for inherited interface registration under + new interface creation. This is achieved by correcting the + function reg2/6 and adding two more functions, + get_base_interfaces/2 and call_fun_str/2 </p> + <p>Own Id: + OTP-2134 <br></br> +</p> + </item> + <item> + <p>IFR registration checks for included IDL files.</p> + <p>All top level definitions (with respect to the scope) - + modules, interfaces, constants, types or exceptions - found + in an IDL file are either defined inside the compiled IDL + file or inside included files. + By having an extended registration of all top level + definitions it becomes possible to simply produce checks + for those included by the current IDL file. + A function call include_reg_test/1 is added in all + OE_* files that checks for IFR-registration on all included + IDL files. The code for that function is added inside the + OE_* file, while the function is called under OE_*:OE_register/0 + operation. </p> + <p>Own Id: OTP-2138 <br></br> +</p> + </item> + <item> + <p>Exception registration under IFR-operation creation.</p> + <p>By entering code for exception registration under operation + creation, the exceptions of an operation can be checked now. + This is done by correcting the function get_exceptions/4 + and adding two more functions, excdef/5 and get_EXC_ID/5 + ( the last two are cooperating with the first one and + all three are defined in the module "ictk" ). </p> + <p>Own Id: OTP-2102 <br></br> +</p> + </item> + <item> + <p>New back-end to IDL compiler : Plain Erlang.</p> + <p>The new back-end just translates IDL specifications + to Erlang module calls. No pragmas are allowed.</p> + <p>Own Id: OTP-2471 <br></br> +</p> + </item> + <item> + <p>New back-end to IDL compiler : generic server.</p> + <p>A new back-end that translates IDL specifications + to a standard OTP generic server.</p> + <p>Own Id: OTP-2482 <br></br> +</p> + </item> + <item> + <p>New back-end to IDL compiler : c client generation</p> + <p>A new back-end that translates IDL specifications + to a C API for accessing servers in Erlang. </p> + <p>Own Id: OTP-1511 <br></br> +</p> + </item> + <item> + <p>All records in generated files reveal own Erlang modules.</p> + <p>In Erlang related back-ends, every structure + which generates definition form is a record, + (such as union, struct, exception.... ). These records are + held in a generated Erlang files which + contain functions that reveal record information. <br></br> + + The Erlang file which contain these functions is + named after the scope of the record (similar + to the generated module and interface files). <br></br> + + Three functions are available :</p> + <list type="bulleted"> + <item> + <p>tc/0 - returns the record type code,</p> + </item> + <item> + <p>id/0 - returns the record id,</p> + </item> + <item> + <p>name - returns the record name.</p> + </item> + </list> + <p>Own Id: OTP-2473 <br></br> +</p> + </item> + <item> + <p>Changes in compiler usage and code generation.</p> + <list type="bulleted"> + <item> + <p>New compilation flags. + New flag be ( = back-end ) which is + used by the compiler to choose back-end. + Default back-end is set to erl_corba.</p> + </item> + <item> + <p>Stub files have an extra function oe_dependency/0 + indicating file dependency. This + helps the user to determine which IDL files should to + be compiled beside the compiled file. </p> + </item> + </list> + <p>Own Id: OTP-2474 <br></br> +</p> + </item> + <item> + <p>The IDL generation for CORBA is changed so standard gen_server return values can be used + from the implementation module. The change is compatible so that old values remain valid.</p> + <p>Own Id: OTP-2485 <br></br> +</p> + </item> + <item> + <p>It's now possible to generate an API to a CORBA object that accepts + timeout values in the calls in the same manner as gen_server. + The option to the compiler is "timeout".</p> + <p>Own Id: OTP-2487 <br></br> +</p> + </item> + </list> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Empty file generation problem is fixed. + When the IDL module definition did not contain + constant definitions, the generated stub file for that module + definition was empty. After checking the module body, + these files will not be generated anymore.</p> + </item> + </list> + </section> + + <section> + <title>Incompatibilities</title> + <list type="bulleted"> + <item> + <p>Changes in generated files.</p> + <p>Stub-files generated by the compiler had + prefix "OE_" and those used by Orber + had also a register/unregister function + called "OE_register"/"OE_unregister" and + a directive "OE_get_interface" passed + to the gen_server. + This made it difficult/irritating to use, + for example call to the register function + in Orber would appear as shown below:</p> + <list type="bulleted"> + <item> + <p>'OE_filename':'OE_register'().</p> + </item> + </list> + <p>This is changed by using the prefix "oe_" + instead for "OE_" for the above. + A registration call in Orber is now written:</p> + <list type="bulleted"> + <item> + <p>oe_filename:oe_register(). </p> + </item> + </list> + <p>Own Id: OTP-2440 <br></br> +</p> + </item> + </list> + </section> + </section> +</chapter> + diff --git a/lib/ic/doc/src/part.xml b/lib/ic/doc/src/part.xml new file mode 100644 index 0000000000..376a0b3455 --- /dev/null +++ b/lib/ic/doc/src/part.xml @@ -0,0 +1,45 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IC User's Guide</title> + <prepared></prepared> + <docno></docno> + <date>1998-08-07</date> + <rev>2.1</rev> + </header> + <description> + <p>The <em>IC</em> application is an Erlang implementation of an IDL + compiler.</p> + </description> + <xi:include href="ch_introduction.xml"/> + <xi:include href="ch_basic_idl.xml"/> + <xi:include href="ch_ic_protocol.xml"/> + <xi:include href="ch_erl_plain.xml"/> + <xi:include href="ch_erl_genserv.xml"/> + <xi:include href="ch_c_mapping.xml"/> + <xi:include href="ch_c_client.xml"/> + <xi:include href="ch_c_server.xml"/> + <xi:include href="ch_c_corba_env.xml"/> + <xi:include href="ch_java.xml"/> +</part> + diff --git a/lib/ic/doc/src/part_notes.xml b/lib/ic/doc/src/part_notes.xml new file mode 100644 index 0000000000..0aac643c7d --- /dev/null +++ b/lib/ic/doc/src/part_notes.xml @@ -0,0 +1,37 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Idl Compiler Release Notes</title> + <prepared></prepared> + <docno></docno> + <date>1998-05-06</date> + <rev>2.1</rev> + </header> + <description> + <p>The IDL + Compiler Application is an Erlang implementation of a compiler for the IDL language. + </p> + </description> + <xi:include href="notes.xml"/> +</part> + diff --git a/lib/ic/doc/src/ref_man.gif b/lib/ic/doc/src/ref_man.gif Binary files differnew file mode 100644 index 0000000000..b13c4efd53 --- /dev/null +++ b/lib/ic/doc/src/ref_man.gif diff --git a/lib/ic/doc/src/ref_man.xml b/lib/ic/doc/src/ref_man.xml new file mode 100644 index 0000000000..153b25c609 --- /dev/null +++ b/lib/ic/doc/src/ref_man.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE application SYSTEM "application.dtd"> + +<application xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1998</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>IC Reference Manual</title> + <prepared></prepared> + <docno></docno> + <date>2003-12-16</date> + <rev>PB1</rev> + </header> + <description> + <p>The <em>IC</em> application is an Erlang implementation of an IDL + compiler.</p> + </description> + <xi:include href="ic.xml"/> + <xi:include href="ic_clib.xml"/> + <xi:include href="ic_c_protocol.xml"/> +</application> + diff --git a/lib/ic/doc/src/summary.html.src b/lib/ic/doc/src/summary.html.src new file mode 100644 index 0000000000..cb92e51791 --- /dev/null +++ b/lib/ic/doc/src/summary.html.src @@ -0,0 +1 @@ +IDL compiler diff --git a/lib/ic/doc/src/user_guide.gif b/lib/ic/doc/src/user_guide.gif Binary files differnew file mode 100644 index 0000000000..e6275a803d --- /dev/null +++ b/lib/ic/doc/src/user_guide.gif diff --git a/lib/ic/ebin/.gitignore b/lib/ic/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/ebin/.gitignore diff --git a/lib/ic/examples/all-against-all/Makefile b/lib/ic/examples/all-against-all/Makefile new file mode 100644 index 0000000000..a71099ef72 --- /dev/null +++ b/lib/ic/examples/all-against-all/Makefile @@ -0,0 +1,117 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Point this at your version of OTP +OTPROOT=/usr/local/otp/releases/otp_beam_sunos5_r7a + +# Type actual IC Version +ICVSN=4.0.4 + +# Type actual Erl Interface Vesrion +EIVSN=3.2.2 + +# Type actual Erl Interface Vesrion +JIVSN=1.2 + +# IDL file(s) +IDLS=random.idl + +# Own C-server files +CSRV=server callbacks + +# Own C-client files +CCL=client + +# Generated C-server files +GCSRVS=rmod_random__s + +# Generated C-server files +GCCLS=rmod_random + +# Includes +IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ + -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include + +LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ + -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib + +LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket + + +# Erlang compiler +ERLC=$(OTPROOT)/bin/erlc + +# Erlang compiler flags. +EFLAGS='+{scoped_op_calls,true}' + +# C compiler +CC=gcc + +# C compiler flags +CFLAGS=-ggdb -O2 -Wall $(IFLAGS) + +# Java compiler +JAVAC=javac + +CLASSPATH= "./:$(OTPROOT)/lib/ic-$(ICVSN)/priv/ic.jar:$(OTPROOT)/lib/jinterface-$(JIVSN)/priv/OtpErlang.jar" +JFLAGS=-classpath $(CLASSPATH) -O + +JGENJFILES = \ + ./rmod/_randomImplBase.java \ + ./rmod/random.java \ + ./rmod/randomHolder.java \ + ./rmod/_randomStub.java \ + ./rmod/randomHelper.java + + +all: server client eall jall + + +server: + $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS) + $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c) + $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) + +client: + $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) + $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) + $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) + +eall: + $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) + $(ERLC) *.erl + +jall: + $(ERLC) $(EFLAGS) '+{be,java}' $(IDLS) + $(JAVAC) $(JFLAGS) */*.java *.java + + +clean: + /bin/rm -rf $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) rmod.erl rmod_random.erl *.jam *.beam oe* *.h *.hrl *~ core server client *.class + + + + + + + + + + + diff --git a/lib/ic/examples/all-against-all/Makefile.win32 b/lib/ic/examples/all-against-all/Makefile.win32 new file mode 100644 index 0000000000..0085a85aad --- /dev/null +++ b/lib/ic/examples/all-against-all/Makefile.win32 @@ -0,0 +1,138 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2000-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Point this at your version of OTP +OTPROOT=c:\Progra~1\erl5.0.1\ + +# Type actual IC Version +ICVSN=4.0.4 + +# Type actual Erl Interface Vesrion +EIVSN=3.2.2 + +# Type actual Erl Interface Vesrion +JIVSN=1.2 + +# IDL file(s) +IDLS=random.idl + +# Own C-server files +CSRV=server.c callbacks.c +CSRVO=server.obj callbacks.obj + +# Own C-client files +CCL=client.c +CCLO=client.obj + +# Generated C-server files +GCSRVS=rmod_random__s.c +GCSRVSO=rmod_random__s.obj + +# Generated C-client files +GCCLS=rmod_random.c +GCCLSO=rmod_random.obj + +# Includes +IFLAGS=-I"$(OTPROOT)\lib\ic-$(ICVSN)\include" \ + -I"$(OTPROOT)\lib\erl_interface-$(EIVSN)\include" + +LDFLAGS=/LIBPATH:"$(OTPROOT)\lib\ic-$(ICVSN)\priv\lib" \ + /LIBPATH:"$(OTPROOT)\lib\erl_interface-$(EIVSN)\lib" + +LDLIBS=ic.lib erl_interface.lib ei.lib ws2_32.lib + + +# Erlang compiler +ERLC=$(OTPROOT)\bin\erlc + +# Erlang compiler flags. +EFLAGS="+{scoped_op_calls,true}" + + +# C compiler +CC=cl + +# C compiler flags +CFLAGS=-MT -D__WIN32__ $(IFLAGS) + + +# Java compiler +JAVAC=c:\Progra~1\jdk1.3\bin\javac + +# Java +JAVA=c:\Progra~1\jdk1.3\bin\java + + +# Java compiler flags +CLASSPATH= ".;$(OTPROOT)\lib\ic-$(ICVSN)\priv\ic.jar;$(OTPROOT)\lib\jinterface-$(JIVSN)\priv\OtpErlang.jar" +JFLAGS=-classpath $(CLASSPATH) -O + + +all: server.exe client.exe client.beam client.class + + +server.exe: + $(ERLC) $(EFLAGS) "+{be,c_server}" $(IDLS) + $(CC) -c $(CFLAGS) $(CSRV) $(GCSRVS) + $(CC) -o server.exe $(CSRVO) $(GCSRVSO) -link $(LDFLAGS) $(LDLIBS) + + +client.exe: + $(ERLC) $(EFLAGS) "+{be,c_client}" $(IDLS) + $(CC) -c $(CFLAGS) $(CCL) $(GCCLS) + $(CC) -o client.exe $(CCLO) $(GCCLSO) -link $(LDFLAGS) $(LDLIBS) + +client.beam: + $(ERLC) $(EFLAGS) "+{be,erl_genserv}" $(IDLS) + $(ERLC) *.erl + +client.class: + $(ERLC) $(EFLAGS) "+{be,java}" $(IDLS) + $(JAVAC) $(JFLAGS) rmod/*.java + $(JAVAC) $(JFLAGS) *.java + +jclient.run: + $(JAVA) -classpath $(CLASSPATH) client + +jserver.run: + $(JAVA) -classpath $(CLASSPATH) server + + +clean: + -@del /f /q rmod + -@rmdir rmod + -@del *.jam + -@del *.beam + -@del oe* + -@del *.h + -@del *.hrl + -@del server.exe + -@del client.exe + -@del *.obj + -@del rmod_random*.c + -@del *~ + -@del *class + -@del rmod.erl + -@del rmod_random.erl + + + + + + diff --git a/lib/ic/examples/all-against-all/ReadMe b/lib/ic/examples/all-against-all/ReadMe new file mode 100644 index 0000000000..7503291344 --- /dev/null +++ b/lib/ic/examples/all-against-all/ReadMe @@ -0,0 +1,122 @@ +This is a short description on the use of Erlang,C or Java +client and servers against each other. +The base is a client that initiates and uses a random number +generator that lies on an server. + +There are two make files, one for Unix and one for Windows, +the Unix make file is just named "Makefile", while the Windows +is named "Makefile.win32". + +Instructions. + +1) On Makefile : + * Modify the OTPROOT variable on the Makefile to point + to the root for your erlang instalation. + * Modify IC and Erl_Interface versions to agree your + OTP version. + +2) Type "make" to build the example. + + +3) Start the empd deamon by using the command : + + epmd -daemon + + +4) Do this when you want to run : + + * an Erlang server. + + Start erlang with the options + + -setcookie <Some Cookie> -sname <SomeNodeName> + + In this example you should use : + + erl -setcookie flash -sname babbis + + * a C server. + + Just type : + + server + + * a Java server. + + Set and export the CLASSPATH variable to + point to the java classes located in java development kit, + the Otp's classes and the current directory. + Your classpath should look like this : + + .:<OTPROOT>/lib/ic-3.8.1/priv/ic.jar:<OTPROOT>/lib/jinterface_0.9.2/priv/OtpErlang.jar + + where : + + <OTPROOT> is the location there OTP is installed + + Then type : + + java server + + +5) Do this when you want to run : + + * an Erlang client. + + ** If you have no valid named erlang node, + start erlang with the options + + -setcookie <Some Cookie> -sname <SomeNodeName> + + In this example you should use : + + erl -setcookie flash -sname client + + On the erlang shell, type + + client:start(). + + ** If you have a valid named erlang node, started + whith the same "cookie", on the erlang shell, type + + client:start(). + + + * a C client, just type + + client + + + * a Java client. + + + Set and export the CLASSPATH variable to + point to the java classes located in java development kit, + the Otp's classes and the current directory. + Your classpath should look like this : + + .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar + + where : + + <OTPROOT> is the location there OTP is installed + + Then type : + + java client + + + +6) Please note that : + + * you must always have the same cookie in order to eastablish connection + between clients and servers. + + * you cannot start two servers with the same name. + In this example all servers share the same name in order to test + several constallations. Kill a server before starting another one. + + + + + diff --git a/lib/ic/examples/all-against-all/callbacks.c b/lib/ic/examples/all-against-all/callbacks.c new file mode 100644 index 0000000000..f8642f4d2e --- /dev/null +++ b/lib/ic/examples/all-against-all/callbacks.c @@ -0,0 +1,45 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +#include <stdlib.h> +#include "rmod_random__s.h" + + +rmod_random_produce__rs* +rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env) + +{ + *rs = (double) rand(); + + return (rmod_random_produce__rs*) NULL; +} + + +rmod_random_init__rs* +rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env) + +{ + srand(*seed1 * *seed2 * *seed3); + + return (rmod_random_init__rs*) NULL; +} + + + diff --git a/lib/ic/examples/all-against-all/client.c b/lib/ic/examples/all-against-all/client.c new file mode 100644 index 0000000000..e0a52b142d --- /dev/null +++ b/lib/ic/examples/all-against-all/client.c @@ -0,0 +1,153 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +/* Just include the interface function */ +#include "rmod_random.h" + + +/* Assign your own node name here */ +#define CLNODENAME "c50" +#define SNODENAME "babbis" +#define SREGNAME "rmod_random_impl" +#define COOKIE "flash" +#define INBUFSZ 1024 +#define OUTBUFSZ 1024 +#define HOSTNAMESZ 256 + + + +/* Stopping node */ +void client_exit(CORBA_Environment *env) { + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + erl_close_connection(env->_fd); + exit(1); +} + + +int main(){ + + double result=0; + int i=0; + int error = 0; + erlang_pid pid; + char host[HOSTNAMESZ]; + char server_node[HOSTNAMESZ]; + char client_node[HOSTNAMESZ]; + CORBA_Environment *env; + + /* Initiate names */ +#ifdef __WIN32__ + WORD wVersionRequested; + WSADATA wsaData; + + wVersionRequested = MAKEWORD(1, 1); + if ((error = WSAStartup(wVersionRequested, &wsaData))) { + fprintf(stderr,"Can't initialize windows sockets: %d",error); + return 0; + } +#endif + error = gethostname(host,HOSTNAMESZ); + if (error) { +#ifdef __WIN32__ + fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError()); +#else /* not __WIN32__ */ + fprintf(stderr,"can't find own hostname !\n"); +#endif + } + sprintf(client_node,"%s@%s",CLNODENAME,host); + sprintf(server_node,"%s@%s",SNODENAME,host); + + /* Create and init CORBA_Environment */ + env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); + + /* Initiating the connection */ + erl_init(NULL,0); + erl_connect_init(50,COOKIE,0); + + /* Initiating pid*/ + strcpy(pid.node,client_node); + pid.num = 99; + pid.serial = 0; + pid.creation = 0; + + /* Fixing environment variable */ + env->_fd=erl_connect(server_node); + strcpy(env->_regname,SREGNAME); + env->_to_pid = NULL; + env->_from_pid = &pid; + + if (env->_fd < 0) { + fprintf(stderr,"Error : Cannot connect to Server\n"); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + exit(1); + } + + /* Calling the init function */ + rmod_random_init(NULL, 1, 2, 3, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + printf("Init complete !\n"); + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + /* Calling the produce function */ + for(i=1; i<=10; i++) { + result = rmod_random_produce(NULL, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + printf("the random number nr%d is %f\n",i,result); + } + + /* Closing the connection */ + erl_close_connection(env->_fd); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + return 0; +} diff --git a/lib/ic/examples/all-against-all/client.erl b/lib/ic/examples/all-against-all/client.erl new file mode 100644 index 0000000000..921c2c91ea --- /dev/null +++ b/lib/ic/examples/all-against-all/client.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% File : client.erl +%% Purpose : +%%---------------------------------------------------------------------- + +-module(client). + +-export([produce/0,init/3,call/0]). + +-define(SERVER,{rmod_random_impl, + list_to_atom("babbis@"++hd(tl(string:tokens(atom_to_list(node()),"@"))))}). +-define(CLIENTMOD,'rmod_random'). + +produce() -> + ?CLIENTMOD:produce(?SERVER). + + +init(Seed1, Seed2, Seed3) -> + io:format("Init..."), + ?CLIENTMOD:init(?SERVER,Seed1, Seed2, Seed3), + io:format("ok\n"). + + +call() -> + init(1,2,3), + produce(0). + + +produce(10) -> + ok; +produce(Ctr) -> + N = produce(), + io:format("Random~p = ~p\n",[Ctr,N]), + produce(Ctr+1). diff --git a/lib/ic/examples/all-against-all/client.java b/lib/ic/examples/all-against-all/client.java new file mode 100644 index 0000000000..4dc88cffbb --- /dev/null +++ b/lib/ic/examples/all-against-all/client.java @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class client { + + private static java.lang.String SNode = "client"; + private static java.lang.String PNode = "babbis"; + private static java.lang.String Cookie = "flash"; + private static java.lang.String Server = "rmod_random_impl"; + + private static rmod._randomStub stub; + + public static void main(String[] args) { + + try { + + stub = new rmod._randomStub(SNode,PNode,Cookie,Server); + int seed1 = 1; + int seed2 = 2; + int seed3 = 3; + double random = 0; + + System.out.print("\nClient initialization...."); + stub.init(seed1,seed2,seed3); + System.out.println("ok\n"); + + + for (int i = 0; i < 10; i++) { + random = stub.produce(); + System.out.println("Random" + i + " = " + random); + } + System.out.println("\nClient terminated.\n"); + + stub.__disconnect(); + + } catch( Exception e) { + System.out.println("Exception :"); + e.printStackTrace(); + } + + } + +} + diff --git a/lib/ic/examples/all-against-all/random.idl b/lib/ic/examples/all-against-all/random.idl new file mode 100644 index 0000000000..b44f7379f6 --- /dev/null +++ b/lib/ic/examples/all-against-all/random.idl @@ -0,0 +1,50 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + + +#endif + + + + + + + + + + + + + + + diff --git a/lib/ic/examples/all-against-all/rmod_random_impl.erl b/lib/ic/examples/all-against-all/rmod_random_impl.erl new file mode 100644 index 0000000000..8113cfb768 --- /dev/null +++ b/lib/ic/examples/all-against-all/rmod_random_impl.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(rmod_random_impl). +-export([init/1, terminate/2]). +-export([produce/1,init/4]). + + +init(Env) -> + {ok, []}. + +terminate(From, Reason) -> + ok. + + +produce(_Random) -> + case catch random:uniform() of + {'EXIT',_} -> + true; + RUnif -> + {reply,RUnif,[]} + end. + + +init(_Random,S1,S2,S3) -> + case catch random:seed(S1,S2,S3) of + {'EXIT',_} -> + true; + _ -> + {noreply,[]} + end. + diff --git a/lib/ic/examples/all-against-all/server.c b/lib/ic/examples/all-against-all/server.c new file mode 100644 index 0000000000..be4953e9b9 --- /dev/null +++ b/lib/ic/examples/all-against-all/server.c @@ -0,0 +1,261 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +#include <stdio.h> +#include <stdlib.h> +#include <sys/types.h> +#include <string.h> +#ifdef __WIN32__ +#include <winsock2.h> +#include <direct.h> +#include <windows.h> +#include <winbase.h> +#else /* not __WIN32__ */ +#include <errno.h> +#include <unistd.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <arpa/inet.h> +#include <netdb.h> +#endif +#include "rmod_random__s.h" + +/* Used functions */ +static int getport(int sockd); +static int getlisten(int port); +static int init(int *sd, int *portnr, int *epmd_fd); +void terminate(int *fd, int *sd, int *epmd_fd); +static void server_loop(int fd, int sd); + +/* change these, or even better, make command-line args to program... */ +#define COOKIE "flash" +#define SERVER "babbis" +#define NODENAMESZ 512 +#define HOSTNAMESZ 256 +#define INBUFSZ 1024 +#define OUTBUFSZ 1024 + + +int main(int argc, char **argv) +{ + int sd; + int portnr; + int epmd_fd; + + /* crate file descriptors */ + if (init(&sd, &portnr, &epmd_fd) < 0) + return -1; + + /* start server loop */ + server_loop(sd,epmd_fd); + + return 0; +} + + + +static void server_loop(int sd, int epmd_fd) +{ + ErlConnect conn; + erlang_msg msg; + int status=1; + CORBA_Environment *env; + + /* Create and init CORBA_Environment */ + env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); + + while (status >= 0) { + + status = 1; + + if ((env->_fd = erl_accept(sd,&conn)) < 0) { + /* error */ + fprintf(stderr,"Accept failed: %s\n",strerror(errno)); + } + else { + /* connection */ + fprintf(stderr,"Accepted connection from %s\n",conn.nodename); + + while (status >= 0) { + + /* write message to buffer */ + status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin); + switch(status) { + case ERL_SEND: + case ERL_REG_SEND : + /* do transaction with fd */ + rmod_random__switch(NULL,env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + break; + default: /* Should not come here */ + CORBA_exception_free(env); + break; + } + + /* send outdata */ + if (env->_iout > 0) + ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout); + break; + + case ERL_TICK : + break; + default : /* < 0 */ + printf("Connection terminated\n"); + break; + } + } + } + status=0; /* restart */ + } + + /* close file descriptors */ + terminate(&env->_fd, &sd, &epmd_fd); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); +} + + + +static int init(int *sd, int *portnr, int *epmd_fd) +{ + char host[HOSTNAMESZ]; + char servernode[NODENAMESZ]; + struct hostent *h; + int error = 0; + +#ifdef __WIN32__ + WORD wVersionRequested; + WSADATA wsaData; + + wVersionRequested = MAKEWORD(1, 1); + if ((error = WSAStartup(wVersionRequested, &wsaData))) { + fprintf(stderr,"Can't initialize windows sockets: %d",error); + } +#endif + /* get the host name */ + error = gethostname(host,HOSTNAMESZ); + if (error) { +#ifdef __WIN32__ + fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError()); +#else /* not __WIN32__ */ + fprintf(stderr,"can't find own hostname !\n"); +#endif + } + else { + /* identify host */ + if (!(h = erl_gethostbyname(host))) + fprintf(stdout,"can't find own ip address\n"); + else { + + /* get a listen port. 0 means let system choose port number */ + *sd = getlisten(0); + + /* what port did we get? */ + /* this call not necessary if we specified port in call to getlisten() */ + *portnr = getport(*sd); + + /* make the nodename server@host */ + sprintf(servernode,"%s@%s",SERVER,host); + + /* initiate */ + erl_init(NULL,0); + + /* host, alive, alive@host, addr, cookie, creation */ + erl_connect_xinit(host,SERVER,servernode,(Erl_IpAddr)(h->h_addr_list[0]),COOKIE,0); + + /* let epmd know we are here */ + *epmd_fd = erl_publish(*portnr); + + return 0; + } + } + return -1; +} + + +void terminate(int *fd, int *sd, int *epmd_fd) { + + close(*fd); + + /* remove info from epnd */ + close(*epmd_fd); + + /* return socket */ + close(*sd); + +} + + + +/* tells you what port you are using on given socket */ +static int getport(int sockd) +{ + struct sockaddr_in addr; + int namelen = sizeof(addr); + int i; + + memset(&addr,0,sizeof(addr)); + + if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0) + return i; + + return ntohs(addr.sin_port); +} + + + +/* return a listen socket, bound to given port */ +/* specify port = 0 to let system assign port */ +static int getlisten(int port) +{ + int sockd; + struct sockaddr_in inaddr; + int opt = 1; + int i; + + /* get listen socket */ + if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd; + + if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0) + return i; + + /* bind to requested port */ + memset(&inaddr,0,sizeof(inaddr)); + inaddr.sin_family = AF_INET; + inaddr.sin_addr.s_addr = htonl(INADDR_ANY); + inaddr.sin_port = htons(port); + + if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0) + return i; + + listen(sockd,5); + + return sockd; +} + diff --git a/lib/ic/examples/all-against-all/server.erl b/lib/ic/examples/all-against-all/server.erl new file mode 100644 index 0000000000..24ace2e598 --- /dev/null +++ b/lib/ic/examples/all-against-all/server.erl @@ -0,0 +1,40 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(server). +-export([start/0]). + + + +%% This starts up the random number server +start() -> + %% Start the gen server + {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}), + true. + + + + + + + + + + + diff --git a/lib/ic/examples/all-against-all/server.java b/lib/ic/examples/all-against-all/server.java new file mode 100644 index 0000000000..6b5fe8fcfd --- /dev/null +++ b/lib/ic/examples/all-against-all/server.java @@ -0,0 +1,82 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class server { + + private static java.lang.String SNode = "babbis"; + private static java.lang.String Cookie = "flash"; + private static java.lang.String RegName = "rmod_random_impl"; + + public static void main(String[] args) { + + + System.out.println("\nServer running.\n"); + boolean serverState = true; + boolean recState = true; + + try { + + com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie); + self.publishPort(); + + /* Server loop */ + while(serverState == true) { + + com.ericsson.otp.erlang.OtpConnection connection = self.accept(); + serverImpl srv = new serverImpl(); + com.ericsson.otp.erlang.OtpInputStream request; + com.ericsson.otp.erlang.OtpOutputStream reply; + com.ericsson.otp.erlang.OtpErlangPid client; + + /* Server loop */ + while(recState == true) { + + if (connection.isConnected() == true) + try { + + request = connection.receiveBuf(); + + reply = srv.invoke(request); + + if (reply != null) { + client = srv.__getCallerPid(); + + connection.sendBuf(client,reply); + } + + } catch( Exception e) { + System.out.println("Server terminated.\n\n"); + recState = false; + serverState = false; + } + } + + connection.close(); + } + + } catch( Exception e) { + System.out.println("Initialization exception :"); + e.printStackTrace(); + } + } +} + + + + diff --git a/lib/ic/examples/all-against-all/serverImpl.java b/lib/ic/examples/all-against-all/serverImpl.java new file mode 100644 index 0000000000..d5fb66e96b --- /dev/null +++ b/lib/ic/examples/all-against-all/serverImpl.java @@ -0,0 +1,42 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class serverImpl extends rmod._randomImplBase { + + java.util.Random random = null; + + + public void init(int seed1, int seed2, int seed3) throws java.lang.Exception { + + random = new java.util.Random(seed1+seed2+seed3); + }; + + + public double produce() throws java.lang.Exception { + + return random.nextDouble(); + } + +} + + + + + + diff --git a/lib/ic/examples/c-client/Makefile b/lib/ic/examples/c-client/Makefile new file mode 100644 index 0000000000..7c57e4f7ed --- /dev/null +++ b/lib/ic/examples/c-client/Makefile @@ -0,0 +1,86 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Point this at your version of OTP +OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest + +# Type actual IC Version +ICVSN=4.1.1 + +# Type actual Erl Interface Vesrion +EIVSN=3.3.0 + +# IDL file(s) +IDLS=random.idl + +# Own C-client files +CCL=client + +# Generated C-server files +GCCLS=oe_code_seed rmod_random + +# Includes +IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ + -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include + +LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ + -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib + +LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket + + +# Erlang compiler +ERLC=$(OTPROOT)/bin/erlc + +# Erlang compiler flags. +EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}' + + +# C compiler +CC=gcc + +# C compiler flags +CFLAGS=-ggdb -O2 -Wall $(IFLAGS) + + +all: server client + + +server: + $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) + $(ERLC) *.erl + +client: + $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) + $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) + $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) + + + +clean: + /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(CCL:=.o) *.jam *.beam oe* rmod_random.erl *.h *.hrl *~ core client + + + + + + + + + diff --git a/lib/ic/examples/c-client/ReadMe b/lib/ic/examples/c-client/ReadMe new file mode 100644 index 0000000000..28372c3be2 --- /dev/null +++ b/lib/ic/examples/c-client/ReadMe @@ -0,0 +1,46 @@ +This is a short description on the use of the c-client demo, +a client that initiates and uses a random number generator +that lies on an Erlang-genserver. + +Instructions. + +1) On Makefile : + * Modify the OTPROOT variable on the Makefile to point + to the root for your erlang instalation. + * Modify IC and Erl_Interface versions to agree your + OTP version. + +2) Type "make" to build the example. + + +3) Start erlang with the options + -setcookie <Some Cookie> -sname <SomeNodeName> + + In this example you should use : + + erl -setcookie flash -sname babbis + + +4) On the erlang shell type : + -------------------------- + + rmod_random:oe_create([],{local,rmod_random_impl}). ( initializes the server ) + + or + + test:start(). + + + Then start a new terminal window and type : + ------------------------------------------- + + client ( calls the client ) + + + + + + + + + diff --git a/lib/ic/examples/c-client/client.c b/lib/ic/examples/c-client/client.c new file mode 100644 index 0000000000..816477cf15 --- /dev/null +++ b/lib/ic/examples/c-client/client.c @@ -0,0 +1,130 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +/* Include the interface function and ei_connect */ +#include "rmod_random.h" +#include "ei_connect.h" + +/* Assign your own node name here */ +#define SNODE "babbis@balin" +#define SERVER "rmod_random_impl" +#define COOKIE "flash" +#define CLNODE "c47@balin" +#define INBUFSZ 1024 +#define OUTBUFSZ 1024 + +/* Stopping node */ +void client_exit(CORBA_Environment *env) { + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + close(env->_fd); + exit(1); +} + +int main() +{ + double result=0; + int i=0; + erlang_pid pid; + CORBA_Environment *env; + seed idata; + ei_cnode ec; + + /* Create and init CORBA_Environment */ + env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); + + /* Initialize seed */ + idata.seed1 = 1; + idata.seed2 = 2; + idata.seed3 = 3; + + /* Initiating the connection */ + ei_connect_init(&ec, "c47", COOKIE, 0); + + /* Initiating pid*/ + strcpy(pid.node,CLNODE); + pid.num = 99; + pid.serial = 0; + pid.creation = 0; + + /* Fixing environment variable */ + env->_fd = ei_connect(&ec, SNODE); + strcpy(env->_regname, SERVER); + env->_to_pid = NULL; + env->_from_pid = &pid; + + if (env->_fd < 0) { + fprintf(stderr,"Error : Cannot connect to Server\n"); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + exit(1); + } + + /* Calling the init function */ + rmod_random_init(NULL, &idata, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + printf("Init complete !\n"); + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + /* Calling the produce function */ + for(i=1; i<=10; i++) { + result = rmod_random_produce(NULL, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + printf("the random number nr%d is %f\n",i,result); + } + + /* Closing the connection */ + close(env->_fd); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + return 0; +} + diff --git a/lib/ic/examples/c-client/random.idl b/lib/ic/examples/c-client/random.idl new file mode 100644 index 0000000000..cfe38e32d8 --- /dev/null +++ b/lib/ic/examples/c-client/random.idl @@ -0,0 +1,51 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + +struct seed { + long seed1; + long seed2; + long seed3; +}; + +module rmod { + + interface random { + + double produce(); + + oneway void init(in seed idata); + + }; + +}; + +#endif + + + + + + + + + + + + diff --git a/lib/ic/examples/c-client/rmod_random_impl.erl b/lib/ic/examples/c-client/rmod_random_impl.erl new file mode 100644 index 0000000000..863e3e8c24 --- /dev/null +++ b/lib/ic/examples/c-client/rmod_random_impl.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module('rmod_random_impl'). +-include("oe_random.hrl"). +-export([init/1, terminate/2]). +-export([produce/1,init/2]). + + +init(Env) -> + {ok, []}. + +terminate(From, Reason) -> + ok. + + +produce(_Random) -> + case catch random:uniform() of + {'EXIT',_} -> + true; + RUnif -> + {reply,RUnif,[]} + end. + + +init(_Random,IData) -> + S1 = IData#seed.seed1, + S2 = IData#seed.seed2, + S3 = IData#seed.seed3, + case catch random:seed(S1,S2,S3) of + {'EXIT',_} -> + true; + _ -> + {noreply,[]} + end. + diff --git a/lib/ic/examples/c-client/test.erl b/lib/ic/examples/c-client/test.erl new file mode 100644 index 0000000000..0a05ce2944 --- /dev/null +++ b/lib/ic/examples/c-client/test.erl @@ -0,0 +1,43 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +% Start Erlang with : erl -sname <your name> -setcookie <your cookie> + +-module(test). + +-export([start/0,exec/0]). + + +start() -> + io:format("Starting server~n"), + rmod_random:oe_create([],{local,'rmod_random_impl'}). + +exec() -> + io:format("Running client~n"), + OutPut = os:cmd("client"), + io:format("~s",[OutPut]). + + + + + + + + + diff --git a/lib/ic/examples/c-server/Makefile b/lib/ic/examples/c-server/Makefile new file mode 100644 index 0000000000..caf4306932 --- /dev/null +++ b/lib/ic/examples/c-server/Makefile @@ -0,0 +1,89 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Point this at your version of OTP +OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest + +# Type actual IC Version +ICVSN=4.1.1 + +# Type actual Erl Interface Vesrion +EIVSN=3.3.0 + +# IDL file(s) +IDLS=random.idl + +# Own C-server files +CSRV=server callbacks + +# Own C-client files +CCL=client + +# Generated C-server files +GCSRVS=rmod_random__s + +# Generated C-server files +GCCLS=rmod_random + +# Includes +IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ + -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include + +LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ + -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib + +LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket + + +# Erlang compiler +ERLC=$(OTPROOT)/bin/erlc + +# Erlang compiler flags. +EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}' + + +# C compiler +CC=gcc + +# C compiler flags +CFLAGS=-ggdb -O2 -Wall $(IFLAGS) + + +all: server client erlclient + + +server: + $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS) + $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c) + $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) + +client: + $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) + $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) + $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) + +erlclient: + $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) + $(ERLC) *.erl + + +clean: + /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) *.jam *.beam oe* *.h *.hrl *~ core server client + + diff --git a/lib/ic/examples/c-server/ReadMe b/lib/ic/examples/c-server/ReadMe new file mode 100644 index 0000000000..69fce4cd07 --- /dev/null +++ b/lib/ic/examples/c-server/ReadMe @@ -0,0 +1,45 @@ +This is a short description on the use of the client demo, +a client that initiates and uses a random number generator +that lies on a C-server. + +Instructions. + +1) Modify the OTPROOT variable on the Makefile to point + to the root for your erlang instalation. + Modify IC and Erl_Interface versions to agree your + OTP version. + +2) + Type : + ------ + + make ( generates and compiles all code ) + + server ( starts the c-server ) + + + To test the c-client against the c-server start a new terminal window and type : + -------------------------------------------------------------------------------- + + client ( calls the server ) + + + To test the erlang-client against the c-server start a new terminal window and type : + ------------------------------------------------------------------------------------- + + + erl -sname client -setcookie flash ( start erlang ) + + client:init(1,2,3). ( initiates the random generator ) + + client:produce(). ( calls the random generator ) + + + + + + + + + + diff --git a/lib/ic/examples/c-server/callbacks.c b/lib/ic/examples/c-server/callbacks.c new file mode 100644 index 0000000000..d50d26ced1 --- /dev/null +++ b/lib/ic/examples/c-server/callbacks.c @@ -0,0 +1,45 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +#include <stdlib.h> +#include "rmod_random__s.h" + + +rmod_random_produce__rs* +rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env) + +{ + *rs = (double) rand(); + + return (rmod_random_produce__rs*) NULL; +} + + +rmod_random_init__rs* +rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env) + +{ + srand(*seed1 * *seed2 * *seed3); + + return (rmod_random_init__rs*) NULL; +} + + + diff --git a/lib/ic/examples/c-server/client.c b/lib/ic/examples/c-server/client.c new file mode 100644 index 0000000000..fa570089b5 --- /dev/null +++ b/lib/ic/examples/c-server/client.c @@ -0,0 +1,124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +/* Include the interface function, and ei_connect */ +#include "rmod_random.h" +#include "ei_connect.h" + +/* Assign your own node name here */ +#define SNODE "babbis@balin" +#define SERVER "rmod_random_impl" +#define COOKIE "flash" +#define CLNODE "c47@balin" +#define INBUFSZ 1024 +#define OUTBUFSZ 1024 + +/* Stopping node */ +void client_exit(CORBA_Environment *env) { + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + close(env->_fd); + exit(1); +} + +int main() +{ + double result=0; + int i=0; + erlang_pid pid; + CORBA_Environment *env; + ei_cnode ec; + + /* Create and init CORBA_Environment */ + env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); + + /* Initiating the connection */ + ei_connect_init(&ec, "c47", COOKIE, 0); + + /* Initiating pid*/ + strcpy(pid.node, CLNODE); + pid.num = 99; + pid.serial = 0; + pid.creation = 0; + + /* Fixing environment variable */ + env->_fd = ei_connect(&ec, SNODE); + strcpy(env->_regname,SERVER); + env->_to_pid = NULL; + env->_from_pid = &pid; + + if (env->_fd < 0) { + fprintf(stderr,"Error : Cannot connect to Server\n"); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + exit(1); + } + + /* Calling the init function */ + rmod_random_init(NULL, 1, 2, 3, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + printf("Init complete !\n"); + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + /* Calling the produce function */ + for(i=1; i<=10; i++) { + result = rmod_random_produce(NULL, env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + client_exit(env); + default: /* Should not come here */ + client_exit(env); + } + + printf("the random number nr%d is %f\n",i,result); + } + + /* Closing the connection */ + close(env->_fd); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); + + return 0; +} + diff --git a/lib/ic/examples/c-server/client.erl b/lib/ic/examples/c-server/client.erl new file mode 100644 index 0000000000..e225fc5789 --- /dev/null +++ b/lib/ic/examples/c-server/client.erl @@ -0,0 +1,44 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%%---------------------------------------------------------------------- +%%% File : client.erl +%%% Author : Babbis Xagorarakis <babbis@balin> +%%% Purpose : +%%% Created : 22 Oct 1998 by Babbis Xagorarakis <babbis@balin> +%%%---------------------------------------------------------------------- + +-module(client). +-author('babbis@balin'). + +-export([produce/0,init/3]). + +-define(SERVER,{rmod_random_impl,'babbis@balin'}). +-define(CLIENTMOD,'rmod_random'). + +produce() -> + ?CLIENTMOD:produce(?SERVER). + + +init(Seed1, Seed2, Seed3) -> + ?CLIENTMOD:init(?SERVER, Seed1, Seed2, Seed3). + + + + diff --git a/lib/ic/examples/c-server/random.idl b/lib/ic/examples/c-server/random.idl new file mode 100644 index 0000000000..b2c21bdbfd --- /dev/null +++ b/lib/ic/examples/c-server/random.idl @@ -0,0 +1,49 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + +#endif + + + + + + + + + + + + + + + diff --git a/lib/ic/examples/c-server/server.c b/lib/ic/examples/c-server/server.c new file mode 100644 index 0000000000..7e3c620040 --- /dev/null +++ b/lib/ic/examples/c-server/server.c @@ -0,0 +1,245 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +#include <stdio.h> +#include <stdlib.h> +#include <sys/types.h> +#include <string.h> +#ifdef __WIN32__ +#include <winsock2.h> +#include <direct.h> +#include <windows.h> +#include <winbase.h> +#else /* not __WIN32__ */ +#include <errno.h> +#include <unistd.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <arpa/inet.h> +#include <netdb.h> +#endif +#include "rmod_random__s.h" +#include "ei_connect.h" + +/* Used functions */ +extern int gethostname(char *buf, int buflen); +static int getport(int sockd); +static int getlisten(int port); +static int init(ei_cnode *ec, int *sd, int *portnr, int *epmd_fd); +void terminate(int *fd, int *sd, int *epmd_fd); +static void server_loop(ei_cnode *ec, int fd, int sd); + +/* change these, or even better, make command-line args to program... */ +#define COOKIE "flash" +#define SERVER "babbis" +#define NODENAMESZ 512 +#define HOSTNAMESZ 256 +#define INBUFSZ 1024 +#define OUTBUFSZ 1024 + + +int main(int argc, char **argv) +{ + int sd; + int portnr; + int epmd_fd; + ei_cnode ec; + + /* crate file descriptors */ + if (init(&ec, &sd, &portnr, &epmd_fd) < 0) + return -1; + + /* start server loop */ + server_loop(&ec, sd, epmd_fd); + + return 0; +} + + + +static void server_loop(ei_cnode *ec, int sd, int epmd_fd) +{ + ErlConnect conn; + erlang_msg msg; + int status=1; + CORBA_Environment *env; + + /* Create and init CORBA_Environment */ + env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); + + while (status >= 0) { + status = 1; + + if ((env->_fd = ei_accept(ec, sd, &conn)) < 0) { + /* error */ + fprintf(stderr,"Accept failed: %s\n",strerror(errno)); + } else { + /* connection */ + fprintf(stderr,"Accepted connection from %s\n",conn.nodename); + + while (status >= 0) { + + /* write message to buffer */ + status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin); + switch(status) { + case ERL_SEND: + case ERL_REG_SEND : + /* do transaction with fd */ + rmod_random__switch(NULL,env); + + switch(env->_major) { + case CORBA_NO_EXCEPTION: /* Success */ + break; + case CORBA_SYSTEM_EXCEPTION: /* System exception */ + printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env)); + CORBA_exception_free(env); + break; + default: /* Should not come here */ + CORBA_exception_free(env); + break; + } + + /* send outdata */ + if (env->_iout > 0) + ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout); + break; + + case ERL_TICK : + break; + default : /* < 0 */ + printf("Connection terminated\n"); + break; + } + } + } + status=0; /* restart */ + } + + /* close file descriptors */ + terminate(&env->_fd, &sd, &epmd_fd); + + /* Free env & buffers */ + CORBA_free(env->_inbuf); + CORBA_free(env->_outbuf); + CORBA_free(env); +} + + + +static int init(int *sd, int *portnr, int *epmd_fd) +{ + char host[HOSTNAMESZ]; + char servernode[NODENAMESZ]; + struct hostent *h; + + /* get the host name */ + if ((gethostname(host,HOSTNAMESZ))) + fprintf(stderr,"can't find own hostname\n"); + else { + /* identify host */ + if (!(h = erl_gethostbyname(host))) + fprintf(stdout,"can't find own ip address\n"); + else { + + /* get a listen port. 0 means let system choose port number */ + *sd = getlisten(0); + + /* what port did we get? */ + /* this call not necessary if we specified port in call to getlisten() */ + *portnr = getport(*sd); + + /* make the nodename server@host */ + sprintf(servernode,"%s@%s",SERVER,host); + + /* initiate */ + /* cnode, host, alive, alive@host, addr, cookie, creation */ + if (ei_connect_xinit(ec, host, SERVER, servernode, + (Erl_IpAddr)(h->h_addr_list[0]), + COOKIE, 0) == 0) { + /* let epmd know we are here */ + *epmd_fd = ei_publish(ec, *portnr); + if (*epmd_fd >= 0) + return 0; + } + } + } + return -1; +} + + +void terminate(int *fd, int *sd, int *epmd_fd) { + + close(*fd); + + /* remove info from epnd */ + close(*epmd_fd); + + /* return socket */ + close(*sd); + +} + + + +/* tells you what port you are using on given socket */ +static int getport(int sockd) +{ + struct sockaddr_in addr; + int namelen = sizeof(addr); + int i; + + memset(&addr,0,sizeof(addr)); + + if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0) + return i; + + return ntohs(addr.sin_port); +} + + + +/* return a listen socket, bound to given port */ +/* specify port = 0 to let system assign port */ +static int getlisten(int port) +{ + int sockd; + struct sockaddr_in inaddr; + int opt = 1; + int i; + + /* get listen socket */ + if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd; + + if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0) + return i; + + /* bind to requested port */ + memset(&inaddr,0,sizeof(inaddr)); + inaddr.sin_family = AF_INET; + inaddr.sin_addr.s_addr = htonl(INADDR_ANY); + inaddr.sin_port = htons(port); + + if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0) + return i; + + listen(sockd,5); + + return sockd; +} diff --git a/lib/ic/examples/erl-genserv/ReadMe b/lib/ic/examples/erl-genserv/ReadMe new file mode 100644 index 0000000000..cde588e269 --- /dev/null +++ b/lib/ic/examples/erl-genserv/ReadMe @@ -0,0 +1,30 @@ +This is a short description on the use of the c-client demo, +a client that initiates and uses a random number generator +that lies on an Erlang-genserver. + +Instructions. + + On the erlang shell type : + -------------------------- + + ic:gen(random,[{be,erl_genserv}]). ( generates the plain code ) + + make:all(). ( compiles the erlang code ) + + {ok,R} = rmod_random:oe_create(). ( initializes the server ) + + + Running the example : + --------------------- + + rmod_random:init(R,1,2,3). ( initializes the generator ) + + rmod_random:produce(R). ( generates a random number ) + + + + + + + + diff --git a/lib/ic/examples/erl-genserv/random.idl b/lib/ic/examples/erl-genserv/random.idl new file mode 100644 index 0000000000..4527988b48 --- /dev/null +++ b/lib/ic/examples/erl-genserv/random.idl @@ -0,0 +1,50 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + + +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + +#endif + + + + + + + + + + + + + + + diff --git a/lib/ic/examples/erl-genserv/rmod_random_impl.erl b/lib/ic/examples/erl-genserv/rmod_random_impl.erl new file mode 100644 index 0000000000..70f5887f1c --- /dev/null +++ b/lib/ic/examples/erl-genserv/rmod_random_impl.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module('rmod_random_impl'). +-export([init/1, terminate/2, start/0]). +-export([produce/1,init/4]). + + +init(Env) -> + {ok, []}. + +terminate(From, Reason) -> + ok. + + +produce(_Random) -> + case catch random:uniform() of + {'EXIT',_} -> + true; + RUnif -> + {reply,RUnif,[]} + end. + + +init(_Random,S1,S2,S3) -> + case catch random:seed(S1,S2,S3) of + {'EXIT',_} -> + true; + _ -> + {noreply,[]} + end. + + +%% This starts up the random number server +start() -> + %% Start the gen server + {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}), + true. + + + + + + + + + diff --git a/lib/ic/examples/erl-plain/ReadMe b/lib/ic/examples/erl-plain/ReadMe new file mode 100644 index 0000000000..26440b4d4f --- /dev/null +++ b/lib/ic/examples/erl-plain/ReadMe @@ -0,0 +1,27 @@ +This is a short description on the use of the erl-plain demo, +a client that initiates and uses a random number generator +that lies on an Erlang-genserver. + +Instructions. + + On the erlang shell type : + -------------------------- + + ic:gen(random,[{be,erl_plain}]). ( generates the plain code ) + + make:all(). ( compiles the erlang code ) + + + Running the example : + --------------------- + + rmod_random:init(1,2,3). ( initializes the generator ) + + rmod_random:produce(). ( generates a random number ) + + + + + + + diff --git a/lib/ic/examples/erl-plain/random.idl b/lib/ic/examples/erl-plain/random.idl new file mode 100644 index 0000000000..f7762236ca --- /dev/null +++ b/lib/ic/examples/erl-plain/random.idl @@ -0,0 +1,52 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// +#pragma CODEOPT "[{be,c_genserv}]" + + +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + + +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + +#endif + + + + + + + + + + + + + + + diff --git a/lib/ic/examples/erl-plain/rmod_random_impl.erl b/lib/ic/examples/erl-plain/rmod_random_impl.erl new file mode 100644 index 0000000000..7e7b2f0821 --- /dev/null +++ b/lib/ic/examples/erl-plain/rmod_random_impl.erl @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module('rmod_random_impl'). + +-export([produce/0,init/3]). + + +produce() -> + random:uniform(). + + +init(S1,S2,S3) -> + random:seed(S1,S2,S3), + ok. + diff --git a/lib/ic/examples/java-client-server/ReadMe b/lib/ic/examples/java-client-server/ReadMe new file mode 100644 index 0000000000..9fde464e09 --- /dev/null +++ b/lib/ic/examples/java-client-server/ReadMe @@ -0,0 +1,69 @@ +This is a short description on the use of the java demo, +a client that initiates and uses a random number generator +that lies on a java-server. You will be able to shift the +existing client/server with the ones refered to the other +examples. + +Instructions. + +1) Start erlang + + On the erlang shell type : + -------------------------- + + ic:gen(random,[{be,java}]). ( generates the java code ) + + +2) Modify the "SNode" string on file "server.java" to the server + node name thet suites for your machine. + + +3) Modify the "SNode" string on file "client.java" to the client + node for your machine and the "PNode" string for the server + node ( = the same as the SNode for the "server.java" file ). + + +4) Set and export the CLASSPATH variable to point to the + java classes located in java development kit, the + Otp's classes and the current directory. + Your classpath should look like this : + + .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar + + where : + + <OTPROOT> is the location there OTP is installed + + +5) Start the empd deamon by using the command : + + epmd -daemon + + +6) Compile the generated java code : + + javac rmod/*.java ( compiles all generated java code ) + + javac *.java ( compiles all manually writen java code ) + + +7) Start the java on an terminal window : + + java server ( starts the java-server ) + + +8) Start the client on an terminal window : + + java client ( calls the server ) + + + + + + + + + + + + diff --git a/lib/ic/examples/java-client-server/client.java b/lib/ic/examples/java-client-server/client.java new file mode 100644 index 0000000000..4dc88cffbb --- /dev/null +++ b/lib/ic/examples/java-client-server/client.java @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class client { + + private static java.lang.String SNode = "client"; + private static java.lang.String PNode = "babbis"; + private static java.lang.String Cookie = "flash"; + private static java.lang.String Server = "rmod_random_impl"; + + private static rmod._randomStub stub; + + public static void main(String[] args) { + + try { + + stub = new rmod._randomStub(SNode,PNode,Cookie,Server); + int seed1 = 1; + int seed2 = 2; + int seed3 = 3; + double random = 0; + + System.out.print("\nClient initialization...."); + stub.init(seed1,seed2,seed3); + System.out.println("ok\n"); + + + for (int i = 0; i < 10; i++) { + random = stub.produce(); + System.out.println("Random" + i + " = " + random); + } + System.out.println("\nClient terminated.\n"); + + stub.__disconnect(); + + } catch( Exception e) { + System.out.println("Exception :"); + e.printStackTrace(); + } + + } + +} + diff --git a/lib/ic/examples/java-client-server/random.idl b/lib/ic/examples/java-client-server/random.idl new file mode 100644 index 0000000000..b2c21bdbfd --- /dev/null +++ b/lib/ic/examples/java-client-server/random.idl @@ -0,0 +1,49 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +#ifndef _RANDOM_IDL +#define _RANDOM_IDL + +module rmod { + + interface random { + + double produce(); + + oneway void init(in long seed1, in long seed2, in long seed3); + + }; + +}; + +#endif + + + + + + + + + + + + + + + diff --git a/lib/ic/examples/java-client-server/server.java b/lib/ic/examples/java-client-server/server.java new file mode 100644 index 0000000000..6b5fe8fcfd --- /dev/null +++ b/lib/ic/examples/java-client-server/server.java @@ -0,0 +1,82 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class server { + + private static java.lang.String SNode = "babbis"; + private static java.lang.String Cookie = "flash"; + private static java.lang.String RegName = "rmod_random_impl"; + + public static void main(String[] args) { + + + System.out.println("\nServer running.\n"); + boolean serverState = true; + boolean recState = true; + + try { + + com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie); + self.publishPort(); + + /* Server loop */ + while(serverState == true) { + + com.ericsson.otp.erlang.OtpConnection connection = self.accept(); + serverImpl srv = new serverImpl(); + com.ericsson.otp.erlang.OtpInputStream request; + com.ericsson.otp.erlang.OtpOutputStream reply; + com.ericsson.otp.erlang.OtpErlangPid client; + + /* Server loop */ + while(recState == true) { + + if (connection.isConnected() == true) + try { + + request = connection.receiveBuf(); + + reply = srv.invoke(request); + + if (reply != null) { + client = srv.__getCallerPid(); + + connection.sendBuf(client,reply); + } + + } catch( Exception e) { + System.out.println("Server terminated.\n\n"); + recState = false; + serverState = false; + } + } + + connection.close(); + } + + } catch( Exception e) { + System.out.println("Initialization exception :"); + e.printStackTrace(); + } + } +} + + + + diff --git a/lib/ic/examples/java-client-server/serverImpl.java b/lib/ic/examples/java-client-server/serverImpl.java new file mode 100644 index 0000000000..d5fb66e96b --- /dev/null +++ b/lib/ic/examples/java-client-server/serverImpl.java @@ -0,0 +1,42 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +public class serverImpl extends rmod._randomImplBase { + + java.util.Random random = null; + + + public void init(int seed1, int seed2, int seed3) throws java.lang.Exception { + + random = new java.util.Random(seed1+seed2+seed3); + }; + + + public double produce() throws java.lang.Exception { + + return random.nextDouble(); + } + +} + + + + + + diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile new file mode 100644 index 0000000000..68e2168e1e --- /dev/null +++ b/lib/ic/examples/pre_post_condition/Makefile @@ -0,0 +1,128 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved via the world wide web at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# The Initial Developer of the Original Code is Ericsson Utvecklings AB. +# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +# AB. All Rights Reserved.'' +# +# $Id$ +# +include $(ERL_TOP)/make/target.mk + +EBIN= ./ + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(IC_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +IDL_FILES = \ + ex.idl + +GEN_ERL_MODULES = \ + oe_ex \ + m_i \ + m_NotAnInteger + +MODULES= \ + m_i_impl \ + tracer + +GEN_HRL_FILES = \ + oe_ex.hrl \ + m.hrl \ + m_i.hrl + +HRL_FILES = +TXT_FILES = ReadMe.txt + +ERL_FILES= $(MODULES:%=%.erl) + + +TARGET_FILES = \ + $(GEN_ERL_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ + $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin +# The -pa option is just used temporary until erlc can handle +# includes from other directories than ../include . +ERL_COMPILE_FLAGS += \ + $(ERL_LOCAL_FLAGS) \ + -pa $(ERL_TOP)/lib/orber -I$(ERL_TOP)/lib/orber +YRL_FLAGS = + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) + rm -f errs core *~ + +docs: + +test: $(TEST_TARGET_FILES) + + +$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): ex.idl + erlc $(ERL_LOCAL_FLAGS) +'{precond,{tracer,pre}}' \ + +'{{postcond,"m::i::f"},{tracer,post}}' ex.idl + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples/pre_post_condition + $(INSTALL_DATA) $(ERL_FILES) $(IDL_FILES) $(TXT_FILES) $(RELSYSDIR)/examples/pre_post_condition + + +release_docs_spec: + + diff --git a/lib/ic/examples/pre_post_condition/ReadMe.txt b/lib/ic/examples/pre_post_condition/ReadMe.txt new file mode 100644 index 0000000000..9db54f438d --- /dev/null +++ b/lib/ic/examples/pre_post_condition/ReadMe.txt @@ -0,0 +1,73 @@ + ``The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved via the world wide web at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson Utvecklings AB. + Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + AB. All Rights Reserved.'' + + $Id$ + + +This example shows how pre and post condition can be used for a Corba server object. + + +The example consists of three files; + +ex.idl - the interface specification +m_i_impl.erl - the server implementation +tracer.erl - a module which contains a pre and a post condition + + +The IDL file can for example be compiled with the following options: + +ic:gen(ex, [{precond, {tracer, pre}},{{postcond, "m::i::f"}, {tracer, post}}]). + +The result is that the function m::i::f gets both a pre and post condition call while +the function m::i::g just get a pre condition call. + + +A pre/post condition function should always return the atom ok and if something is wrong +it should raise an exception ( ex: corba:raise(#userexception{}) ). + + + + +Compile all erlang files and test the application. + +First start an erlang node, then type the following commands in the erlang shell. + +1> mnesia:create_schema([]). +2> orber:install([]). +3> orber:start(). +3> +3> X = m_i:oe_create(). +4> catch m_i:f(X, 17). +Precond called in process <0.139.0>: m_i:f() [[],17] +f working .... +Postcond called in process <0.139.0>: m_i:f() [[],17] {reply,{17,17},[]} +17 +5> +5> catch m_i:f(X, q). +6> {'EXCEPTION',{m_NotAnInteger,"IDL:m/NotAnInteger:1.0"}} +7> +7>m_i:g(X, 17). +Precond called in process <0.139.0>: m_i:g() [[],17] +ok +g working .... +8> +8>corba_boa:dispose(X). +9> orber:stop(). +10> + + + + + diff --git a/lib/ic/examples/pre_post_condition/ex.idl b/lib/ic/examples/pre_post_condition/ex.idl new file mode 100644 index 0000000000..e632448cc5 --- /dev/null +++ b/lib/ic/examples/pre_post_condition/ex.idl @@ -0,0 +1,29 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +module m { + + exception NotAnInteger {}; + + interface i { + short f(in short i); + oneway void g(in long i); + }; + +}; + diff --git a/lib/ic/examples/pre_post_condition/m_i_impl.erl b/lib/ic/examples/pre_post_condition/m_i_impl.erl new file mode 100644 index 0000000000..d43ee0ac94 --- /dev/null +++ b/lib/ic/examples/pre_post_condition/m_i_impl.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%------------------------------------------------------------ +%% +%% Example +%% +%%------------------------------------------------------------ +-module(m_i_impl). + +%% Standard functions +-export([init/1, terminate/2]). +%% Interface functions +-export([f/2, g/2]). + +init(_Env) -> + {ok, []}. + +terminate(_From, _Reason) -> + ok. + +f(State, In) -> + io:format("f working ....\n", []), + {reply, In, State}. + +g(State, _In) -> + io:format("g working ....\n", []), + {noreply, State}. + + + + + diff --git a/lib/ic/examples/pre_post_condition/tracer.erl b/lib/ic/examples/pre_post_condition/tracer.erl new file mode 100644 index 0000000000..4cba7ba9bb --- /dev/null +++ b/lib/ic/examples/pre_post_condition/tracer.erl @@ -0,0 +1,56 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%----------------------------------------------------------------- +%% File: tracer.erl +%% +%% Description: +%% This file contains an example of pre and post conditions for +%% the corba backend. +%% +%%----------------------------------------------------------------- +-module(tracer). +-include("m.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([pre/3, post/4]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- +pre(M, F, [State, I]) when is_integer(I) -> + io:format("Precond called in process ~p: ~s:~s() ~p\n", [self(), M, F, [State, I]]), + ok; +pre(_M, _F, _A) -> %% Just an silly example to get an exception case + corba:raise(#'m_NotAnInteger'{}). + +post(M, F, A, R) -> + io:format("Postcond called in process ~p: ~s:~s() ~p ~p\n", [self(), M, F, A, R]), + ok. + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/ic/include/erlang.idl b/lib/ic/include/erlang.idl new file mode 100644 index 0000000000..78acc7c5de --- /dev/null +++ b/lib/ic/include/erlang.idl @@ -0,0 +1,57 @@ +// ``The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved via the world wide web at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// The Initial Developer of the Original Code is Ericsson Utvecklings AB. +// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +// AB. All Rights Reserved.'' +// +// $Id$ +// + +#ifndef _ERLANG_IDL_ +#define _ERLANG_IDL_ + +module erlang +{ + + // an erlang pid + struct pid { + string<256> node; + unsigned long num; + unsigned long serial; + unsigned long creation; + }; + + // an erlang port + struct port { + string<256> node; + unsigned long id; + unsigned long creation; + }; + + // port and ref have identical structure + struct ref { + string<256> node; + unsigned long id; + unsigned long creation; + }; + + + // an erlang term + typedef any term; + + + // an erlang binary + typedef sequence<octet> binary; + +}; + +#endif diff --git a/lib/ic/include/ic.h b/lib/ic/include/ic.h new file mode 100644 index 0000000000..b3b8a2fd47 --- /dev/null +++ b/lib/ic/include/ic.h @@ -0,0 +1,431 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <stdlib.h> +#include <string.h> +#include <assert.h> +#include <ei.h> +#include <erl_interface.h> + +#ifdef __WIN32__ +/* Windows.h #defines interface to struct, get rid of it! */ +#ifdef interface +#undef interface +#endif +#endif + +#ifndef __IC_H__ +#define __IC_H__ + +#ifdef __cplusplus +extern "C" { +#endif + +/* Standard type mapping */ + +#ifndef __CORBA_SHORT__ +#define __CORBA_SHORT__ + typedef short CORBA_short; +#endif + +#ifndef __CORBA_LONG__ +#define __CORBA_LONG__ + typedef long CORBA_long; +#endif + +/* CORBA_long_long = long because of erl_interface limitation */ +#ifndef __CORBA_LONG_LONG__ +#define __CORBA_LONG_LONG__ + typedef long CORBA_long_long; /* LONG LONG */ +#endif + +#ifndef __CORBA_UNSIGNED_SHORT__ +#define __CORBA_UNSIGNED_SHORT__ + typedef unsigned short CORBA_unsigned_short; +#endif + +#ifndef __CORBA_UNSIGNED_LONG__ +#define __CORBA_UNSIGNED_LONG__ + typedef unsigned long CORBA_unsigned_long; +#endif + +/* CORBA_unsigned long_long = unsigned long because of erl_interface + limitation */ + +#ifndef __CORBA_UNSIGNED_LONG_LONG__ +#define __CORBA_UNSIGNED_LONG_LONG__ + typedef unsigned long CORBA_unsigned_long_long; +#endif + +#ifndef __CORBA_FLOAT__ +#define __CORBA_FLOAT__ + typedef float CORBA_float; +#endif + +#ifndef __CORBA_DOUBLE__ +#define __CORBA_DOUBLE__ + typedef double CORBA_double; +#endif + + +#ifndef __CORBA_LONG_DOUBLE__ +#define __CORBA_LONG_DOUBLE__ + typedef double CORBA_long_double; +#endif + +#ifndef __CORBA_CHAR__ +#define __CORBA_CHAR__ + typedef char CORBA_char; +#endif + +#ifndef __CORBA_WCHAR__ +#define __CORBA_WCHAR__ + typedef unsigned long CORBA_wchar; +#endif + +#ifndef __CORBA_BOOLEAN__ +#define __CORBA_BOOLEAN__ + typedef unsigned char CORBA_boolean; +#endif + +#ifndef __CORBA_OCTET__ +#define __CORBA_OCTET__ + typedef char CORBA_octet; +#endif + +#ifndef CORBA_enum +#define CORBA_enum enum +#endif + +#ifndef __ERLANG_BINARY__ +#define __ERLANG_BINARY__ + typedef struct { + CORBA_unsigned_long _maximum; + CORBA_unsigned_long _length; + CORBA_octet* _buffer; + } erlang_binary; +#endif + + +/* Object definition */ + typedef void* CORBA_Object; + + +/* Exception discriminators */ +#ifndef CORBA_NO_EXCEPTION +#define CORBA_NO_EXCEPTION 0 +#endif + +#ifndef CORBA_SYSTEM_EXCEPTION +#define CORBA_SYSTEM_EXCEPTION -1 +#endif + +#ifndef CORBA_USER_EXCEPTION +#define CORBA_USER_EXCEPTION -2 +#endif + +/* System exceptions */ + +#define UNKNOWN "UNKNOWN" +#define BAD_PARAM "BAD_PARAM" +#define NO_MEMORY "NO_MEMORY" +#define IMPL_LIMIT "IMP_LIMIT" +#define COMM_FAILURE "COMM_FAILURE" +#define INV_OBJREF "INV_OBJREF" +#define NO_PERMISSION "NO_PERMISSION" +#define INTERNAL "INTERNAL" +#define MARSHAL "MARSHAL" +#define INITIALIZE "INITIALIZE" +#define NO_IMPLEMENT "NO_IMPLEMENT" +#define BAD_TYPECODE "BAD_TYPECODE" +#define BAD_OPERATION "BAD_OPERATION" +#define NO_RESOURCES "NO_RESOURCES" +#define NO_RESPONSE "NO_RESPONSE" +#define PERSIST_STORE "PERSIST_STORE" +#define BAD_INV_ORDER "BAD_INV_ORDER" +#define TRANSIENT "TRANSIENT" +#define FREE_MEM "FREE_MEM" +#define INV_IDENT "INV_IDENT" +#define INV_FLAG "INV_FLAG" +#define INTF_REPOS "INTF_REPOS" +#define BAD_CONTEXT "BAD_CONTEXT" +#define OBJ_ADAPTER "OBJ_ADAPTER" +#define DATA_CONVERSION "DATA_CONVERSION" +#define OBJ_NOT_EXIST "OBJECT_NOT_EXIST" + + + +/* Exception type */ + typedef int CORBA_exception_type; + + +#ifndef __CORBA_ENVIRONMENT__ +#define __CORBA_ENVIRONMENT__ + +/* Environment definition */ + typedef struct { + + /*----- CORBA compatibility part ------------------------------------*/ + CORBA_exception_type _major; /* Exception tag, initially set + to CORBA_NO_EXCEPTION */ + + /*----- External Implementation part - initiated by the user --------*/ + int _fd; /* File descriptor */ + int _inbufsz; /* Size of input buffer */ + char *_inbuf; /* Pointer to always + dynamically allocated + buffer for input */ + int _outbufsz; /* Size of output buffer */ + char *_outbuf; /* Pointer to always + dynamically + allocated buffer + for output */ + int _memchunk; /* Size of memory + chunks in bytes, + used for increasing + the output buffer, + set to >= 32, + should be around >= + 1024 for + performance reasons */ + char _regname[256]; /* Pointer for + registered name */ + erlang_pid *_to_pid; /* Process identity + for caller */ + erlang_pid *_from_pid; /* Process identity + for callee */ + /*----- Internal Implementation part - used by the server/client ----*/ + int _iin; /* Index for input buffer */ + int _iout; /* Index for output buffer */ + char _operation[256]; /* Pointer for operation name*/ + int _received; /* Used to count parameters */ + erlang_pid _caller; /* Used to identify + the caller*/ + erlang_ref _unique; /* Used to identify the call */ + CORBA_char *_exc_id; /* Exception id field */ + void *_exc_value; /* Exception value field */ + + unsigned int _ref_counter_1; /* Counter for reference */ + unsigned int _ref_counter_2; /* Counter for reference */ + unsigned int _ref_counter_3; /* Counter for reference */ + + } CORBA_Environment; + +#endif + + +/* Corba standard functions */ + + void CORBA_free(void *); + CORBA_char *CORBA_string_alloc(CORBA_unsigned_long); + CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long); + CORBA_char *CORBA_exception_id(CORBA_Environment *env); + void *CORBA_exception_value(CORBA_Environment *env); + void CORBA_exception_free(CORBA_Environment *env); + void CORBA_exc_set(CORBA_Environment *env, + CORBA_exception_type Major, + CORBA_char *Id, + CORBA_char *Value); + CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz); + void ic_init_ref(CORBA_Environment *env, erlang_ref *ref); + int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2); + +/* Used internally */ + +#define __OE_MEMCHUNK__ 1024 +#define __OE_VSNSZ__ 1 +#define __OE_LONGSZ__ 7 +#define __OE_LONGLONGSZ__ 7 +#define __OE_ULONGSZ__ 7 +#define __OE_ULONGLONGSZ__ 7 +#define __OE_DOUBLESZ__ 32 +#define __OE_CHARSZ__ 2 +#define __OE_WCHARSZ__ 7 +#define __OE_TUPLEHDRSZ__ 5 +#define __OE_LISTHDRSZ__ 5 + +/* The actual size of a wide char (used to be #define __OE_WCHAR_SIZE_OF__ 4) */ +#define __OE_WCHAR_SIZE_OF__ sizeof(CORBA_wchar) + +/* Size check macro */ +#define OE_MALLOC_SIZE_CHECK(env,x) { \ + assert((x) > 0); \ + if (!((x) > 0)) { \ + CORBA_exc_set((env), CORBA_SYSTEM_EXCEPTION, INTERNAL, \ + "Bad malloc size calculation"); \ + return -1; \ + } \ +} + +/* Exec function -- probably not needed */ + typedef int oe_exec_function_t(CORBA_Object, CORBA_Environment*); +/* These are for backward compatibility */ + typedef oe_exec_function_t ___exec_function___; + typedef oe_exec_function_t ___generic___; + +/* Operation declaration */ + typedef struct { + char *interface; + char *name; + oe_exec_function_t *function; + } oe_operation_t; + +/* For backward compatibility */ + typedef oe_operation_t ___operation___; + +/* Map declaration */ + typedef struct { + int length; + oe_operation_t *operations; + } oe_map_t; +/* For backward compatibility */ + typedef oe_map_t ___map___; + +/* Align macro */ +#define OE_ALIGN(x) (((x) + sizeof(double) - 1) & ~(sizeof(double) - 1)) + +/* Encoders */ + int oe_ei_encode_version(CORBA_Environment *env); + int oe_ei_encode_long(CORBA_Environment *env, long p); + int oe_ei_encode_longlong(CORBA_Environment *env, CORBA_long_long p); + int oe_ei_encode_ulong(CORBA_Environment *env, unsigned long p); + int oe_ei_encode_ulonglong(CORBA_Environment *env, + CORBA_unsigned_long_long p); + int oe_ei_encode_double(CORBA_Environment *env, double p); + int oe_ei_encode_char(CORBA_Environment *env, char p); + int oe_ei_encode_wchar(CORBA_Environment *env, CORBA_wchar p); + int oe_ei_encode_string(CORBA_Environment *env, const char *p); + int oe_ei_encode_wstring(CORBA_Environment *env, CORBA_wchar *p); + int oe_ei_encode_atom(CORBA_Environment *env, const char *p); + int oe_ei_encode_pid(CORBA_Environment *env, const erlang_pid *p); + int oe_ei_encode_port(CORBA_Environment *env, const erlang_port *p); + int oe_ei_encode_ref(CORBA_Environment *env, const erlang_ref *p); + int oe_ei_encode_term(CORBA_Environment *env, void *t); + int oe_ei_encode_tuple_header(CORBA_Environment *env, int arity); + int oe_ei_encode_list_header(CORBA_Environment *env, int arity); + int oe_encode_erlang_binary(CORBA_Environment *env, erlang_binary *binary); + +#define oe_ei_encode_empty_list(ev) oe_ei_encode_list_header(ev,0) + +/* Decoders */ + int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p); + int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p); + int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p); + int oe_ei_decode_ulonglong(const char *buf, int *index, + CORBA_unsigned_long_long *p); + int oe_decode_erlang_binary(CORBA_Environment *env, char *buf, int *index, + erlang_binary *binary); + +/* Generic client encoders (gen_server protocol) */ + int oe_prepare_notification_encoding(CORBA_Environment *env); + int oe_prepare_request_encoding(CORBA_Environment *env); + +/* Generic client decoders (gen_server protocol) */ + int oe_prepare_reply_decoding(CORBA_Environment *env); + +/* Generic client send and receive functions (Erlang distribution protocol) */ + int oe_send_notification(CORBA_Environment *env); + int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms); + int oe_send_request_and_receive_reply(CORBA_Environment *env); + int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, + unsigned int send_ms, + unsigned int recv_ms); + +/* Generic server decoder */ + int oe_prepare_request_decoding(CORBA_Environment *env); + +/* Generic server encoder */ + int oe_prepare_reply_encoding(CORBA_Environment *env); + +/* -------- */ + +/* Generic server receive (possibly send reply) */ + int oe_server_receive(CORBA_Environment *env, oe_map_t *map); + int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, + unsigned int send_ms, + unsigned int recv_ms); + +/* -------- */ + +/* Size calculators */ + int oe_sizecalc_erlang_binary(CORBA_Environment *env, int *index, + int *size); +/* Print functions */ + int print_erlang_binary(erlang_binary*); + +/* Length counter for wide strings */ + int ic_wstrlen(CORBA_wchar * p); + +/* Wide string comparison */ + int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2); + +/* Put for 64-bits integer type */ +#define put64le(s,n) do { \ + (s)[0] = (n) & 0xff; \ + (s)[1] = ((n) >> 8) & 0xff; \ + (s)[2] = ((n) >> 16) & 0xff; \ + (s)[3] = ((n) >> 24) & 0xff; \ + (s)[4] = ((n) >> 32) & 0xff; \ + (s)[5] = ((n) >> 40) & 0xff; \ + (s)[6] = ((n) >> 48) & 0xff; \ + (s)[7] = ((n) >> 56) & 0xff; \ + (s)[8] = ((n) >> 64) & 0xff; \ + (s) += 8; \ +} while (0) + +/* Get for 64-bits integer type */ +#define get64le(s) \ + ((s) += 8, \ + ((((unsigned char *)(s))[-1] << 56) | \ + (((unsigned char *)(s))[-2] << 48) | \ + (((unsigned char *)(s))[-3] << 40) | \ + (((unsigned char *)(s))[-4] << 32) | \ + (((unsigned char *)(s))[-5] << 24) | \ + (((unsigned char *)(s))[-6] << 16) | \ + (((unsigned char *)(s))[-7] << 8) | \ + ((unsigned char *)(s))[-8])) + + + +/* Exec function switch */ + int oe_exec_switch(CORBA_Object, CORBA_Environment*, oe_map_t*); +/* For backward compatibility */ + int ___switch___(CORBA_Object, CORBA_Environment*, oe_map_t*); + +/* For backward compatibility -- replaced by oe_prepare_request_decoding() */ + int ___call_info___(CORBA_Object, CORBA_Environment*); + +/* Map merging */ + oe_map_t* oe_merge_maps(oe_map_t*, int); +/* For backward compatibility */ + oe_map_t* ___merge___(oe_map_t*, int); + +/* Macro for error reporting */ + +#ifdef OE_C_REPORT +#define OE_RPT_ERR(x) fprintf(stderr, (x)) +#else +#define OE_RPT_ERR(x) +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/ic/info b/lib/ic/info new file mode 100644 index 0000000000..96cb88d01f --- /dev/null +++ b/lib/ic/info @@ -0,0 +1,2 @@ +group: orb Object Request Broker & IDL Applications +short: IDL compiler diff --git a/lib/ic/internal_doc/c-improvements-1.txt b/lib/ic/internal_doc/c-improvements-1.txt new file mode 100644 index 0000000000..ccfdec7cbe --- /dev/null +++ b/lib/ic/internal_doc/c-improvements-1.txt @@ -0,0 +1,84 @@ +Peter Hogfeldt 2003-08-14 PA1 + +IC C BACK-ENDS IMPROVEMENTS + +1 C CLIENT + +1.1 Cast + + Each oneway operation roughly consists of the following code + parts: + + - encoding the cast message + - setting index of the out buffer to zero (1.1.1) + - encoding the magic (1.1.1) + - encoding a tuple header of size 2 (1.1.1) + - encoding '$gen_cast' (1.1.1) + - encoding the operation parameters (1.1.2) + - sending the cast message (1.1.3) + + Only (1.1.2) is unique for the operation in question. + +1.1.1 Todo + + Define functions: + + int oe_ei_encode_cast(CORBA_environment *) that performs (1.1.1) + + int oe_ei_cast(CORBA_environment *) that performs (1.1.3) + + This will reduce code size. + + As compiler options + + oe_ei_encode_cast(), and + oe_ei_cast() + + may be replaced by user defined functions. + +1.2 Call + + Each (non-oneway) operation roughly consists of the following code + parts: + + - encoding the call message + - setting index of the out buffer to zero (1.2.1) + - encoding the magic (1.2.1) + - encoding a tuple header of size 3 (1.2.1) + - encoding '$gen_call' (1.2.1) + - encoding a tuple header of size 2 (1.2.1) + - encoding the from pid (1.2.1) + - encoding the unique ref (1.2.1) + - encoding the operation parameters (1.2.2) + - sending the call message (1.2.3) + - receiving the reply message (1.2.3) + - decoding the reply parameters (1.2.4) + + Only (1.2.2) and (1.2.4) are unique for the operation in question. + +1.2.1 Todo + + Define functions: + + int oe_ei_encode_send(CORBA_environment *) that performs (1.2.1) + + int oe_ei_send_and_receive(CORBA_environment *) that performs (1.2.3) + + This will reduce code size. + + As compiler options + + oe_ei_encode_send(), and + oe_ei_send_and_receive() + + may be replaced by user defined function. + + +2 SERVER + + We do not provide any code for receiving operation messages, execute + operations, and send the result back. Should we not do that? + + + +
\ No newline at end of file diff --git a/lib/ic/internal_doc/protocol.txt b/lib/ic/internal_doc/protocol.txt new file mode 100644 index 0000000000..54e1ef55cf --- /dev/null +++ b/lib/ic/internal_doc/protocol.txt @@ -0,0 +1,182 @@ +Peter Hogfeldt 2003-08-18 PA3 + +THE IC PROTOCOL + +1 INTRODUCTION + + The IDL Compiler (IC) transforms Interface Definition Language + (IDL) specifications files to interface code for Erlang, C, and + Java. The Erlang language mapping is described in the Orber + documentation, while the other mappings are described in the IC + documentation (they are of course in accordance with the CORBA C + and Java language mapping specifications, with some restrictions). + + The most important parts of an IDL specification are the operation + declarations. An operation defines what information a client + provides to a server, and what information (if any) the client + gets back from the server. We consider IDL operations and language + mappings in section 2. + + What we here call the IC protocol, is the description of messages + exchanged between IC end-points (client and servers). It is valid + for all IC back-ends, except the 'erl_plain' and 'erl_corba' + back-ends. The protocol is described in section 3. + + The IC protocol is in turn embedded into the Erlang gen_server + protocol, which is described in section 4. + + Finally, the gen_server protocol is embedded in the Erlang + distribution protocol. Pertinent parts of that protocol is + described in section 5. + + +2 LANGUAGE MAPPINGS AND IDL OPERATIONS + +2.1 IDL Operations + + An IDL operation is declared as follows: + + [oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN, + out OType1 O1, out OType2 O2, ..., out OTypeM OM) + N, M = 0, 1, 2, ... (2.1.1) + + `Op' is the operation name, RetType is the return type, and ITypei, + i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types + and `out' types, respectively. The values I1, I2, ..., IN are + provided by the caller, and the value of RetType, and the values + O1, O2, ..., OM, are provided as results to the caller. + + The types can be any basic types or derived types declared in the + IDL specification of which the operation declaration is a part. + + If the RetType has the special name `void' there is no return + value (but there might still be result values O1, 02, ..., OM). + + The `in' and `out' parameters can be declared in any order, but + for clarity we have listed all `in' parameters before the `out' + parameters in the declaration above. + + If the keyword `oneway' is present, the operation is a cast, i.e. + there is no confirmation of the operation, and consequently there + must be no result values: RetType must be equal to `void', and M = + 0 must hold. + + Otherwise the operation is a call, i.e. it is confirmed (or else + an exception is raised). + + Note carefully that an operation declared without `oneway' is + always a call, even if RetType is `void' and M = 0. + +2.2 Language Mappings + + There are several CORBA Language Mapping specifications. These are + about mapping interfaces to various programming languages. IC + supports the CORBA C and Java mapping specifications, and the + Erlang language mapping specified in the Orber documentation. + + Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide: + + Functions with return type void will return the atom ok. + + Excerpt from "6.13 Invocations of Operations" in the Orber User's Guide: + + A function call will invoke an operation. The first parameter + of the function should be the object reference and then all in + and inout parameters follow in the same order as specified in + the IDL specification. The result will be a return value + unless the function has inout or out parameters specified; in + which case, a tuple of the return value, followed by the + parameters will be returned. + + Hence the function that is mapped from an IDL operation to Erlang + always have a return value (an Erlang function always has). That + fact has influenced the IC protocol, in that there is always a + return value (which is 'ok' if the return type was declared 'void'). + + +3 IC PROTOCOL + + Given the operation declaration (2.1.1) the IC protocol maps to + messages as follows, defined in terms of Erlang terms. + +3.1 Call (Request/Reply, i.e. not oneway) + + request: Op atom() N = 0 + {Op, I1, I2, ..., IN} tuple() N > 0 + (3.1.1) + + reply: Ret M = 0 + {Ret, O1, O2, ..., OM} M > 0 + (3.1.2) + + Notice; Even if the RetType of the operation Op is declared to be + 'void', a return value 'ok' is returned in the reply message. That + return value is of no significance, and is therefore ignored (note + however that a C server back-end returns the atom 'void' instead + of 'ok'). + +3.2 Cast (oneway) + + notification: Op atom() N = 0 + {Op, I1, I2, ..., IN} tuple() N > 0 + (3.2.1) + (There is of course no return message). + +3.3 Propagation of Exceptions + + Currently there is no propagation of exceptions from the server to + the client. As it is now a an exception detected by the server + will hang the client in a receive. That is unacceptable. + + Exception propagation is only meaningful for Call (request/reply). + + +4 GEN_SERVER PROTOCOL + + Most of the IC generated code deals with encoding and decoding the + gen_server protocol. + +4.1 Call + + request: {'$gen_call', {self(), Ref}, Request} (4.1.1) + + reply: {Ref, Reply} (4.1.2) + + where Request and Reply are the messages defined in 3.1 Call. + +4.2 Cast + + notification: {'$gen_cast', Notification} (4.2.1) + + where Notification is the message defined in 3.2 Cast. + + +5 ERLANG DISTRIBUTION PROTOCOL + + Messages (of interest here) between Erlang nodes are of the form: + + Len(4), Type(1), CtrlBin(N), MsgBin(M) (5.1) + + Type is equal to 112 = PASS_THROUGH. + + CtrlBin and MsgBin are Erlang terms in binary form (as if created + by term_to_binary/1), whence for each of them the first byte is + equal to 131 = VERSION_MAGIC. + + CtrlBin (of interest here) contains the SEND and REG_SEND control + messages, which are binary forms of the Erlang terms + + {2, Cookie, ToPid} , (5.2) + + and + + {6, FromPid, Cookie, ToName} , (5.3) + + respectively. + + The CtrlBin(N) message is read and written by erl_interface code + (C), j_interface code (Java), or the Erlang distribution + implementation, which are invoked from IC generated code. + + The MsgBin(N) is the "real" message, i.e. of the form described + in section 4. diff --git a/lib/ic/java_src/Makefile b/lib/ic/java_src/Makefile new file mode 100644 index 0000000000..e6a4cd7e4d --- /dev/null +++ b/lib/ic/java_src/Makefile @@ -0,0 +1,41 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(ORBER_VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +SUB_DIRECTORIES = com/ericsson/otp/ic + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_subdir.mk + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Any.java b/lib/ic/java_src/com/ericsson/otp/ic/Any.java new file mode 100644 index 0000000000..7337241908 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Any.java @@ -0,0 +1,1023 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + + +/** + +The Any class is the java mapping of the any OMG-IDL type. + + +**/ + + +public class Any { + + // Typecode value holder + protected TypeCode tcV; + + // Primitive value holder + protected java.lang.String stringV; + protected byte byteV; + protected boolean booleanV; + protected char charV; + protected short shortV; + protected int intV; + protected long longV; + protected float floatV; + protected double doubleV; + + // Streams used for user defined types + protected com.ericsson.otp.erlang.OtpInputStream is; + protected com.ericsson.otp.erlang.OtpOutputStream os; + + + // Constructor + public Any() { + tcV = null; + } + + // Equal function + + /** + Any comparison method + @return true if the input Any is equal to the object, false otherwize + **/ + public boolean equal(com.ericsson.otp.ic.Any _any) { + + int _is1Len,_is2Len; + byte _compressed[]; + com.ericsson.otp.erlang.OtpInputStream _is1,_is2; + TypeCode _tc = _any.type(); + + if (!tcV.equal(_tc)) + return false; + + try { + + TCKind _tck = _tc.kind(); + + switch (_tck.value()) { + + case TCKind._tk_short: + return (_any.extract_short() == shortV); + + case TCKind._tk_ushort: + return (_any.extract_ushort() == shortV); + + case TCKind._tk_long: + return (_any.extract_long() == intV); + + case TCKind._tk_longlong: + return (_any.extract_longlong() == longV); + + case TCKind._tk_ulong: + return (_any.extract_ulong() == intV); + + case TCKind._tk_ulonglong: + return (_any.extract_ulonglong() == longV); + + case TCKind._tk_float: + return equal(_any.extract_float(),floatV); + + case TCKind._tk_double: + return equal(_any.extract_double(),doubleV); + + case TCKind._tk_boolean: + return (_any.extract_boolean() == booleanV); + + case TCKind._tk_char: + return (_any.extract_char() == charV); + + case TCKind._tk_wchar: + return (_any.extract_wchar() == charV); + + case TCKind._tk_octet: + return (_any.extract_octet() == byteV); + + case TCKind._tk_string: + return (_any.extract_string().compareTo(stringV) == 0); + + case TCKind._tk_wstring: + return (_any.extract_wstring().compareTo(stringV) == 0); + + case TCKind._tk_sequence: + + _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + + _is2 = _any.extract_Streamable(); + + if (_is1.peek() != _is2.peek()) { + + // _is1's sequence is compressed to string + if(_is1.peek() == com.ericsson.otp.erlang.OtpExternal.stringTag) { + + _compressed = (_is1.read_string()).getBytes(); + _is1Len = _compressed.length; + + _is2.read_list_head(); + + for(int i = 0; i < _is1Len; i++) { + if ((long)(_compressed[i] & 0xff) != _is2.read_long()) + return false; + } + + _is2.read_nil(); + } + else { // _is2's sequence is compressed to string + + _compressed = (_is2.read_string()).getBytes(); + _is2Len = _compressed.length; + + _is1.read_list_head(); + + for(int i = 0; i < _is2Len; i++) + if ((long)(_compressed[i] & 0xff) != _is1.read_long()) + return false; + + _is1.read_nil(); + } + } + else { // None of them is compressed + + _is2Len = _is2.available(); + + if (_is1.available() != _is2Len) + return false; + + for(int i = 0; i < _is2Len; i++) { + if (_is1.read() != _is2.read()) + return false; + } + } + + return true; + + case TCKind._tk_struct: + case TCKind._tk_union: + case TCKind._tk_array: + case TCKind._tk_enum: + + _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + + _is2 = _any.extract_Streamable(); + + _is2Len = _is2.available(); + + if (_is1.available() != _is2Len) + return false; + + for(int i = 0; i < _is2Len; i++) { + if (_is1.read() != _is2.read()) + return false; + } + + return true; + + // Not used in real + case TCKind._tk_any: + case TCKind._tk_void: + case TCKind._tk_atom: + case TCKind._tk_null: + case TCKind._tk_TypeCode: + case TCKind._tk_Principal: + case TCKind._tk_objref: + case TCKind._tk_alias: + case TCKind._tk_except: + case TCKind._tk_longdouble: + case TCKind._tk_fixed: + return true; + + default : + return false; + + } + } catch (Exception e) { + //e.printStackTrace(); + return false; + } + + } + + + /* Equal function for floats ( relative diff ) */ + boolean equal(float x, float y) { + + if (x != 0) + return (java.lang.Math.abs((x-y)/x) < 1.0E-15); + + if (y != 0) + return (java.lang.Math.abs((y-x)/y) < 1.0E-15); + + return (x==y); + } + + /* Equal function for doubles ( relative diff ) */ + boolean equal(double x, double y) { + + if (x != 0) + return (java.lang.Math.abs((x-y)/x) < 1.0E-15); + + if (y != 0) + return (java.lang.Math.abs((y-x)/y) < 1.0E-15); + + return (x==y); + } + + + + /** + TypeCode accessor method + @return the Any's TypeCode + **/ + public TypeCode type() { + return tcV; + } + + + /** + TypeCode insertion method + **/ + public void type(TypeCode _tc) { + tcV = _tc; + } + + + /* Value accessors */ + + /** + Reads a value from the stream, according to the inserted TypeCode + **/ + public void read_value(com.ericsson.otp.erlang.OtpInputStream _is, + TypeCode _tc) + throws java.lang.Exception { + + tcV = _tc; + + switch(tcV.kind().value()) { + + case TCKind._tk_short : + shortV = _is.read_short(); + break; + case TCKind._tk_ushort : + shortV = _is.read_ushort(); + break; + case TCKind._tk_long : + intV = _is.read_int(); + break; + case TCKind._tk_ulong : + intV = _is.read_uint(); + break; + case TCKind._tk_longlong : + longV = _is.read_long(); + break; + case TCKind._tk_ulonglong : + longV = _is.read_ulong(); + break; + case TCKind._tk_float : + floatV = _is.read_float(); + break; + case TCKind._tk_double : + doubleV = _is.read_double(); + break; + case TCKind._tk_boolean : + booleanV = _is.read_boolean(); + break; + case TCKind._tk_char : + case TCKind._tk_wchar : + charV = _is.read_char(); + break; + case TCKind._tk_octet : + byteV = _is.read_byte(); + break; + case TCKind._tk_string : + case TCKind._tk_wstring : + stringV = _is.read_string(); + break; + case TCKind._tk_atom : + stringV = _is.read_atom(); + break; + case TCKind._tk_void : + _is.read_atom(); + break; + + /* + * Not supported types + */ + case TCKind._tk_any : + case TCKind._tk_null : + case TCKind._tk_TypeCode : + case TCKind._tk_Principal : + case TCKind._tk_objref : + case TCKind._tk_alias : + case TCKind._tk_except : + case TCKind._tk_longdouble : + case TCKind._tk_fixed : + throw new java.lang.Exception("Unsupported type"); + + default: // User defined type + + if (os == null) + os = new com.ericsson.otp.erlang.OtpOutputStream(); + else + os.reset(); + + try { + read_user_defined(_is, _tc); + is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + } catch (Exception e) { + throw new java.lang.Exception("BAD VALUE"); + } + } + + } + + void read_user_defined(com.ericsson.otp.erlang.OtpInputStream _is, TypeCode _tc) + throws java.lang.Exception { + + TypeCode memberTC = null; + int len = -1; + int __tag; + + switch(_tc.kind().value()) { + + case TCKind._tk_short : + os.write_short(_is.read_short()); + break; + case TCKind._tk_ushort : + os.write_ushort(_is.read_ushort()); + break; + case TCKind._tk_long : + os.write_int(_is.read_int()); + break; + case TCKind._tk_longlong : + os.write_long(_is.read_long()); + break; + case TCKind._tk_ulong : + os.write_uint(_is.read_uint()); + break; + case TCKind._tk_ulonglong : + os.write_ulong(_is.read_ulong()); + break; + case TCKind._tk_float : + os.write_float(_is.read_float()); + break; + case TCKind._tk_double : + os.write_double(_is.read_double()); + break; + case TCKind._tk_boolean : + os.write_boolean(_is.read_boolean()); + break; + case TCKind._tk_char : + case TCKind._tk_wchar : + os.write_char(_is.read_char()); + break; + case TCKind._tk_octet : + os.write_byte(_is.read_byte()); + break; + case TCKind._tk_string : + case TCKind._tk_wstring : + os.write_string(_is.read_string()); + break; + + case TCKind._tk_struct: + len = _is.read_tuple_head(); + os.write_tuple_head(len); + os.write_atom(_is.read_atom()); + // Member list + len -=1; + for(int i=0; i<len; i++) + read_user_defined(_is,_tc.member_type(i)); + break; + + case TCKind._tk_union: + os.write_tuple_head(_is.read_tuple_head()); + os.write_atom(_is.read_atom()); + + int __mlen = _tc.member_count(); + __tag = _is.peek(); + boolean __found = false; + + switch (__tag) { + case (com.ericsson.otp.erlang.OtpExternal.atomTag): + java.lang.String __elabel = _is.read_atom(); // Enumerant or Boolean + os.write_atom(__elabel); + + for (int i=0; i<__mlen; i++) { + java.lang.String __mlabel; + if (_tc.member_label(i).type().kind().value() == TCKind._tk_string) + __mlabel = _tc.member_label(i).extract_string(); + else // Default + __mlabel = _tc.member_label(i).extract_atom(); + + if (__elabel.compareTo(__mlabel)==0) { + read_user_defined(_is,_tc.member_type(i)); + i = __mlen; + __found = true; + } + } + break; + + default: // Integer type + long __ilabel = _is.read_long(); + os.write_long(__ilabel); + + for (int i=0; i<__mlen; i++) { + boolean __itype = true; + long __mlabel = 0; + + switch (_tc.member_label(i).type().kind().value()) { + + case TCKind._tk_short : + __mlabel = _tc.member_label(i).extract_short(); + break; + case TCKind._tk_ushort : + __mlabel = _tc.member_label(i).extract_ushort(); + break; + case TCKind._tk_long : + __mlabel = _tc.member_label(i).extract_long(); + break; + case TCKind._tk_longlong : + __mlabel = _tc.member_label(i).extract_longlong(); + break; + case TCKind._tk_ulong : + __mlabel = _tc.member_label(i).extract_ulong(); + break; + case TCKind._tk_ulonglong : + __mlabel = _tc.member_label(i).extract_ulonglong(); + break; + case TCKind._tk_char : + __mlabel = _tc.member_label(i).extract_char(); + break; + case TCKind._tk_wchar : + __mlabel = _tc.member_label(i).extract_wchar(); + break; + + default : // Default label + __itype = false; + + } + + if (__itype) { + if (__ilabel == __mlabel) { + read_user_defined(_is,_tc.member_type(i)); + i = __mlen; + __found = true; + } + } + } + } + + // Use the default label instead + if (!__found) + read_user_defined(_is,_tc.member_type(_tc.default_index())); + + break; + + case TCKind._tk_sequence: + __tag = _is.peek(); + + switch(__tag) { + case com.ericsson.otp.erlang.OtpExternal.stringTag: + os.write_string(_is.read_string()); + break; + default: + len = _is.read_list_head(); + os.write_list_head(len); + + for (int i=0; i<len; i++) + read_user_defined(_is,_tc.content_type()); + + _is.read_nil(); + os.write_nil(); + } + break; + + case TCKind._tk_array: + len = _is.read_tuple_head(); + os.write_tuple_head(len); + for (int i=0; i<len; i++) + read_user_defined(_is,_tc.content_type()); + break; + + case TCKind._tk_enum: + os.write_atom(_is.read_atom()); + break; + + case TCKind._tk_void : + os.write_atom(_is.read_atom()); + break; + + case TCKind._tk_any : + AnyHelper.marshal(os,AnyHelper.unmarshal(_is)); + break; + + /* + * Not supported types + */ + default : + throw new java.lang.Exception(""); + + } + + } + + + /** + Writes the Any's value to the ouput stream + **/ + public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os) + throws java.lang.Exception { + + switch(tcV.kind().value()) { + + case TCKind._tk_short : + _os.write_short(shortV); + break; + case TCKind._tk_ushort : + _os.write_ushort(shortV); + break; + case TCKind._tk_long : + _os.write_int(intV); + break; + case TCKind._tk_ulong : + _os.write_uint(intV); + break; + case TCKind._tk_longlong : + _os.write_long(longV); + break; + case TCKind._tk_ulonglong : + _os.write_ulong(longV); + break; + case TCKind._tk_float : + _os.write_float(floatV); + break; + case TCKind._tk_double : + _os.write_double(doubleV); + break; + case TCKind._tk_boolean : + _os.write_boolean(booleanV); + break; + case TCKind._tk_char : + case TCKind._tk_wchar : + _os.write_char(charV); + break; + case TCKind._tk_octet : + _os.write_byte(byteV); + break; + case TCKind._tk_string : + case TCKind._tk_wstring : + _os.write_string(stringV); + break; + case TCKind._tk_atom : + _os.write_atom(stringV); + break; + case TCKind._tk_void : + _os.write_atom("ok"); + break; + + /* + * Not supported types + */ + case TCKind._tk_any : + case TCKind._tk_null : + case TCKind._tk_TypeCode : + case TCKind._tk_Principal : + case TCKind._tk_objref : + case TCKind._tk_alias : + case TCKind._tk_except : + case TCKind._tk_longdouble : + case TCKind._tk_fixed : + throw new java.lang.Exception("BAD KIND"); + + default: + _os.write(os.toByteArray()); + } + } + + + /* + * Insert and extract each primitive type + */ + + /* short */ + + /** + Short value extractor method + @return short, the value of Any + **/ + public short extract_short() + throws java.lang.Exception { + if (tcV.kind() == TCKind.tk_short) + return shortV; + + throw new java.lang.Exception(""); + } + + /** + Short value insertion method + **/ + public void insert_short(short s) { + shortV = s; + tcV = new TypeCode(TCKind.tk_short); + }; + + + /* long */ + /** + Long value extractor method + @return int, the value of Any + **/ + public int extract_long() + throws java.lang.Exception { + if (tcV.kind() == TCKind.tk_long) + return intV; + + throw new java.lang.Exception(""); + } + + /** + Long value insertion method + **/ + public void insert_long(int i){ + intV = i; + tcV = new TypeCode(TCKind.tk_long); + } + + + + /* long long */ + /** + Long Long value extractor method + @return long, the value of Any + **/ + public long extract_longlong() + throws java.lang.Exception { + if (tcV.kind() == TCKind.tk_longlong) + return longV; + + throw new java.lang.Exception(""); + } + + /** + Long Long value insertion method + **/ + public void insert_longlong(long l){ + longV = l; + tcV = new TypeCode(TCKind.tk_longlong); + } + + + /* ushort */ + /** + Unsigned Short value extractor method + @return short, the value of Any + **/ + public short extract_ushort() + throws java.lang.Exception { + if (tcV.kind() == TCKind.tk_ushort) + return shortV; + + throw new java.lang.Exception(""); + } + + /** + Unsigned Short value insertion method + **/ + public void insert_ushort(short s){ + shortV = s; + tcV = new TypeCode(TCKind.tk_ushort); + } + + + /* ulong */ + + /** + Unsigned Long value extractor method + @return int, the value of Any + **/ + public int extract_ulong() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_ulong) + return intV; + + throw new java.lang.Exception(""); + } + + /** + Unsigned Long value insertion method + **/ + public void insert_ulong(int i){ + intV = i; + tcV = new TypeCode(TCKind.tk_ulong); + } + + + + + /* unsigned long long */ + /** + Unsigned Long Long value extractor method + @return long, the value of Any + **/ + public long extract_ulonglong() + throws java.lang.Exception { + if (tcV.kind() == TCKind.tk_ulonglong) + return longV; + + throw new java.lang.Exception(""); + } + + /** + Unsigned Long Long value insertion method + **/ + public void insert_ulonglong(long l){ + longV = l; + tcV = new TypeCode(TCKind.tk_ulonglong); + } + + + /* float */ + /** + Float value extractor method + @return float, the value of Any + **/ + public float extract_float() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_float) + return floatV; + + throw new java.lang.Exception(""); + } + + /** + Float value insertion method + **/ + public void insert_float(float f){ + floatV = f; + tcV = new TypeCode(TCKind.tk_float); + } + + + /* double */ + /** + Double value extractor method + @return double, the value of Any + **/ + public double extract_double() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_double) + return doubleV; + + throw new java.lang.Exception(""); + } + + /** + Double value insertion method + **/ + public void insert_double(double d){ + doubleV = d; + tcV = new TypeCode(TCKind.tk_double); + } + + + /* boolean */ + /** + Boolean value extractor method + @return boolean, the value of Any + **/ + public boolean extract_boolean() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_boolean) + return booleanV; + + throw new java.lang.Exception(""); + } + + /** + Boolean value insertion method + **/ + public void insert_boolean(boolean b){ + booleanV = b; + tcV = new TypeCode(TCKind.tk_boolean); + } + + + + /* char */ + /** + Char value extractor method + @return char, the value of Any + **/ + public char extract_char() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_char) + return charV; + + throw new java.lang.Exception(""); + } + + /** + Char value insertion method + **/ + public void insert_char(char c) { + charV = c; + tcV = new TypeCode(TCKind.tk_char); + } + + + /* wchar */ + /** + Wchar value extractor method + @return char, the value of Any + **/ + public char extract_wchar() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_wchar) + return charV; + + throw new java.lang.Exception(""); + } + + /** + Wchar value insertion method + **/ + public void insert_wchar(char c) { + charV = c; + tcV = new TypeCode(TCKind.tk_wchar); + } + + + + /* octet */ + /** + Octet value extractor method + @return byte, the value of Any + **/ + public byte extract_octet() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_octet) + return byteV; + + throw new java.lang.Exception(""); + } + + /** + Octet value insertion method + **/ + public void insert_octet(byte b){ + byteV = b; + tcV = new TypeCode(TCKind.tk_octet); + } + + + /* string */ + /** + String value extractor method + @return String, the value of Any + **/ + public java.lang.String extract_string() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_string) + return stringV; + + throw new java.lang.Exception(""); + } + + /** + String value insertion method + **/ + public void insert_string(java.lang.String s) { + stringV = s; + tcV = new TypeCode(TCKind.tk_string); + } + + + + /* wstring */ + /** + Wstring value extractor method + @return String, the value of Any + **/ + public java.lang.String extract_wstring() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_wstring) + return stringV; + + throw new java.lang.Exception(""); + } + + /** + Wstring value insertion method + **/ + public void insert_wstring(java.lang.String s) { + stringV = s; + tcV = new TypeCode(TCKind.tk_wstring); + } + + + + /* atom */ + /** + Atom value extractor method + @return atom, the value of Any + **/ + public java.lang.String extract_atom() + throws java.lang.Exception{ + if (tcV.kind() == TCKind.tk_atom) + return stringV; + + throw new java.lang.Exception(""); + } + + /** + Atom value insertion method + **/ + public void insert_atom(java.lang.String s) { + stringV = s; + tcV = new TypeCode(TCKind.tk_atom); + } + + + /** + Object Stream insertion method + **/ + public void insert_Streamable(com.ericsson.otp.erlang.OtpOutputStream _os) { + os = _os; + } + + /** + Object Stream extractor method + @return OtpInputStream, the stream value of Any + **/ + public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() { + + if (is == null) { + if (os == null) + return null; + else { + is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + } + } + + is.reset(); + return is; + } + +} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java new file mode 100644 index 0000000000..d80d299db8 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java @@ -0,0 +1,78 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + +Helper class for Any, according to OMG-IDL java mapping. +<p>Instead for write,read methods, the methods marshal respective +unmarshal are used to denote the implementation difference. + +**/ + + +public class AnyHelper { + + // Constructors + private AnyHelper() {} + + // Methods + /** + Marshal method for the Any class, encodes the Any object to the output stream. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Any _any) + throws java.lang.Exception { + + TypeCode _tc = _any.type(); + + _out.write_tuple_head(3); + _out.write_atom("any"); + + TypeCode.marshal(_out, _tc); + _any.write_value(_out); + + } + + /** + Unmarshal method for the Any class, decodes an Any object from the stream. + @return Any, read from the input stream + **/ + public static Any unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) + throws java.lang.Exception { + + Any _value; + TypeCode _tc; + + _in.read_tuple_head(); + + if ((_in.read_atom()).compareTo("any") != 0) + throw new java.lang.Exception(""); + + _tc = TypeCode.unmarshal(_in); + _value = new Any(); + _value.read_value(_in,_tc); + + return _value; + } + +} + + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java new file mode 100644 index 0000000000..fa28bd0e5d --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Any, according to OMG-IDL java mapping. +<p>Instead for _write,_read methods, the methods _marshal respective +_unmarshal are used to denote the implementation difference. + +**/ + +final public class AnyHolder { + + // Instance variables + public Any value; + + // Constructors + public AnyHolder() {} + + public AnyHolder(Any initial) { + value = initial; + } + + // Methods + /** + Marshal method for the Any class, encodes the Any object to the output stream. + **/ + public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) + throws java.lang.Exception { + AnyHelper.marshal(out, value); + } + + /** + Unmarshal method for the Any class, decodes an Any object from the stream and + assigns it to the Holder value. + **/ + public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) + throws java.lang.Exception { + value = AnyHelper.unmarshal(in); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java new file mode 100644 index 0000000000..5e91ae81af --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java @@ -0,0 +1,62 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for boolean + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Boolean, according to OMG-IDL java mapping. + +**/ + + +final public class BooleanHolder implements Holder { + public boolean value; + + public BooleanHolder() {} + + public BooleanHolder(boolean initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Booleans. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Boolean ) + return ( value == ((Boolean)obj).booleanValue()); + else + return false; + } + + /** + Comparisson method for Booleans. + @return true if the input boolean value equals the value of the current object, false otherwize + **/ + public boolean equals( boolean b ) { + return ( value == b ); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java new file mode 100644 index 0000000000..cd70573ab4 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java @@ -0,0 +1,61 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for byte + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Byte, according to OMG-IDL java mapping. + +**/ + +final public class ByteHolder implements Holder { + public byte value; + + public ByteHolder() {} + + public ByteHolder(byte initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Bytes. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Byte ) + return ( value == ((Byte)obj).byteValue()); + else + return false; + } + + /** + Comparisson method for Byte. + @return true if the input boolean value equals the value of the current object, false otherwize + **/ + public boolean equals( byte b ) { + return ( value == b); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java new file mode 100644 index 0000000000..6005269a38 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java @@ -0,0 +1,63 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for char + * + */ +package com.ericsson.otp.ic; + + +/** + +Holder class for Char, according to OMG-IDL java mapping. + +**/ + + +final public class CharHolder implements Holder { + public char value; + + public CharHolder() {} + + public CharHolder(char initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Chars. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Character ) + return ( value == ((Character)obj).charValue()); + else + return false; + } + + /** + Comparisson method for Chars. + @return true if the input char value equals the value of the current object, false otherwize + **/ + public boolean equals( char c ) { + return ( value == c); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java new file mode 100644 index 0000000000..d0da72cc2c --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java @@ -0,0 +1,61 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for double + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Double, according to OMG-IDL java mapping. + +**/ + +final public class DoubleHolder implements Holder { + public double value; + + public DoubleHolder() {} + + public DoubleHolder(double initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Doubles. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Double ) + return ( value == ((Double)obj).doubleValue()); + else + return false; + } + + /** + Comparisson method for Doubles. + @return true if the input double value equals the value of the current object, false otherwize + **/ + public boolean equals( double d ) { + return ( value == d); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java new file mode 100644 index 0000000000..f0c66f0726 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java @@ -0,0 +1,475 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * The Environment class for Java IDL + * + */ +package com.ericsson.otp.ic; + +/** + + The Environment class handles communication + setup and stub state. The methods of this class + are specially designed for the generated stubs. + This class must be used when designing asynchronous + message passing. + + **/ + + +public class Environment { + + // Private variables + private com.ericsson.otp.erlang.OtpSelf self; + private com.ericsson.otp.erlang.OtpPeer peer; + private java.lang.Object server; + private java.lang.String cookie; + private com.ericsson.otp.erlang.OtpConnection connection; + private com.ericsson.otp.erlang.OtpErlangRef send_ref; /* Client side send reference */ + private com.ericsson.otp.erlang.OtpErlangRef receive_ref; /* Client side received reference */ + private com.ericsson.otp.erlang.OtpErlangPid clientP; + private com.ericsson.otp.erlang.OtpErlangPid serverP; + private com.ericsson.otp.erlang.OtpOutputStream os; /* Output stream */ + private com.ericsson.otp.erlang.OtpInputStream is; /* Input stream */ + private boolean stopped; + + // Private variables used by server only + private int tag; + private java.lang.String operation; + private java.lang.String type; + private com.ericsson.otp.erlang.OtpErlangRef ref; /* Server side client reference */ + private com.ericsson.otp.erlang.OtpErlangPid caller; /* Server side client pid */ + + // Tags to distiguish client / server environments + private boolean clientT; + private boolean serverT; + + + /** + Client stub side constructor. + **/ + public Environment(com.ericsson.otp.erlang.OtpSelf _Self, + com.ericsson.otp.erlang.OtpPeer _Peer, + java.lang.Object _Server) throws java.lang.Exception { + + init(); + clientT = true; + self = _Self; + peer = _Peer; + server = _Server; + os = new com.ericsson.otp.erlang.OtpOutputStream(); + } + + + /** + Client stub side constructor. + **/ + public Environment(java.lang.String _SelfNode, + java.lang.String _PeerNode, + java.lang.String _Cookie, + java.lang.Object _Server) throws java.lang.Exception { + + init(); + clientT = true; + self = new com.ericsson.otp.erlang.OtpSelf(_SelfNode, _Cookie); + peer = new com.ericsson.otp.erlang.OtpPeer(_PeerNode); + cookie = _Cookie; + server = _Server; + os = new com.ericsson.otp.erlang.OtpOutputStream(); + } + + + /** + Client stub side constructor. + **/ + public Environment(com.ericsson.otp.erlang.OtpConnection _connection, + java.lang.Object _Server) throws java.lang.Exception { + + init(); + clientT = true; + self = _connection.self(); + peer = _connection.peer(); + connection = _connection; + server = _Server; + os = new com.ericsson.otp.erlang.OtpOutputStream(); + } + + + /** + Server skeleton side constructor. + **/ + public Environment() throws java.lang.Exception { + + init(); + serverT = true; + stopped = false; + os = new com.ericsson.otp.erlang.OtpOutputStream(); + + } + + + /* Communication toolbox */ + + /** + Client stub side connector. + **/ + public void connect() throws java.lang.Exception { + + if (connection == null) + connection = self.connect(peer); + + clientP = new com.ericsson.otp.erlang.OtpErlangPid(self); /* This is not perfect */ + send_ref = new com.ericsson.otp.erlang.OtpErlangRef(self); + + } + + /** + Reconnects a client by closing existing connection + and connecting. + **/ + public void reconnect() throws java.lang.Exception { + + if (connection.isConnected()) + connection.close(); + + connection = self.connect(peer); + + } + + /** + Closes the established connection. + **/ + public void disconnect() { + + connection.close(); + + } + + + /** + Client side message sender. + **/ + public void send() throws java.lang.Exception { + + if (server instanceof java.lang.String) + connection.sendBuf((java.lang.String)server, os); + else + connection.sendBuf((com.ericsson.otp.erlang.OtpErlangPid)server, os); + + } + + + /** + Client message receiver. + **/ + public void receive() throws java.lang.Exception { + + is = connection.receiveBuf(); + + if (clientT) { // If client, decode message reference too + is.read_tuple_head(); + receive_ref = is.read_ref(); + } + } + + + /** + Universal message receiver. + **/ + public void receive(com.ericsson.otp.erlang.OtpConnection _connection) throws java.lang.Exception { + + is = _connection.receiveBuf(); + + if (clientT) { // If client, decode message reference too + is.read_tuple_head(); + receive_ref = is.read_ref(); + } + } + + + /* Accessors */ + + /** + Server RegName/OtpErlangPid accessor. + Used to access the server Reg/Pid, which + initiated the connection. + @return java.lang.Object, the server for the active OtpConnection. + **/ + public java.lang.Object server() { + + return server; + + } + + /** + Caller identity accessor. Used by a server stub to access the + caller identity of the received message. + @return OtpErlangPid, the caller identity. + **/ + public com.ericsson.otp.erlang.OtpErlangPid caller_pid() { + + return clientP; + + } + + + /** + Received message reference accessor. Used by a server stub to access the + reference of the received message. + @return OtpErlangRef, the reference of the received message. + **/ + public com.ericsson.otp.erlang.OtpErlangRef received_ref() { + + return receive_ref; + + } + + + /* Encoders */ + + /** + Client Pid Encoder. Used by a server stub to encode the + enclosed client process identity. + **/ + public void write_client_pid() { + + os.write_pid(clientP.node(),clientP.id(),clientP.serial(),clientP.creation()); + + } + + /** + Client Ref Encoder. Used by a server stub to encode the + enclosed client message reference. + **/ + public void write_client_ref() { + + os.write_ref(send_ref.node(),send_ref.id(),send_ref.creation()); + + } + + + + /* Field access functions */ + + /** + Output Stream accessor. + @return OtpOutputStream, the enclosed output stream. + **/ + public com.ericsson.otp.erlang.OtpOutputStream getOs() { + return os; + } + + /** + Input Stream accessor. + @return OtpInputStream, the enclosed input stream. + **/ + public com.ericsson.otp.erlang.OtpInputStream getIs() { + return is; + } + + /** + Server skeleton side client (caller) pid accessor. + @return OtpErlangPid, the caller process identity. + **/ + public com.ericsson.otp.erlang.OtpErlangPid getScaller() { + return caller; + } + + /** + Server skeleton side client call reference accessor. + @return OtpErlangRef, the latest call message reference. + **/ + public com.ericsson.otp.erlang.OtpErlangRef getSref() { + return ref; + } + + + + /* Field modifiers */ + + + + /* Decoders */ + + /** + Decodes the message head from existing stream. + Assignes message data to private variables of the Environment Object. + **/ + public void uHead() throws java.lang.Exception { + uHead(is); + } + + /** + Decodes the message head and writes over input stream. + Assignes message data to private variables of the Environment Object. + **/ + public void uHead(com.ericsson.otp.erlang.OtpInputStream _is) throws java.lang.Exception { + + is = _is; + is.read_tuple_head(); + type = is.read_atom(); + + if (type.equals("$gen_call")) { // Call type operation + is.read_tuple_head(); + caller = is.read_pid(); + ref = is.read_ref(); + tag = is.peek(); + + switch (tag) { + case com.ericsson.otp.erlang.OtpExternal.atomTag: + operation = is.read_atom(); + break; + default: + is.read_tuple_head(); + operation = is.read_atom(); + } + } else { // Cast type operation + tag = is.peek(); + switch (tag) { + case com.ericsson.otp.erlang.OtpExternal.atomTag: + operation = is.read_atom(); + break; + default: + is.read_tuple_head(); + operation = is.read_atom(); + } + } + } + + /** + Operation label accessor. + @return int, the label hash value. + **/ + public int uLabel(java.util.Dictionary _operations) { + + java.lang.Integer __label = + (java.lang.Integer) _operations.get(operation); + + if(__label == null) + return -1; + + return __label.intValue(); + } + + + + /* Controllers */ + + /** + Operation controller. + @return boolean, true if the operation variable found in Environment class + is supported in the input operation dictionary, false otherwize. + **/ + public boolean validOp(java.util.Dictionary _operations) { + + if((_operations.get(operation)) == null) + return false; + + return true; + } + + + /** + Server stop request controller. + @return boolean, true if there is a client request for the server + to be stopped, false otherwize. + **/ + public boolean isStopped() { + return stopped; + }; + + + + /* Destroy functions */ + + /* + Creates and sends a stop message. + Called by client stub to terminate the server. + */ + public void client_stop_server() + throws java.lang.Exception { + + // Message header assembly + os.reset(); + os.write_tuple_head(2); + os.write_atom("$gen_cast"); + + os.write_atom("stop"); + + send(); + + } + + /* + Sets the stop flag for the server. + Called by server skeleton when stop message is received. + */ + public void server_stop_server() { + + // Note at server is dead ! + stopped = true; + } + + + /* Private methods */ + + /** + Private variable initialization. + **/ + public void init() { + + clientT = false; + serverT = false; + stopped = false; + self = null; + peer = null; + server = null; + cookie = null; + connection = null; + clientP = null; + serverP = null; + send_ref = null; + receive_ref = null; + os = null; + is = null; + + tag = -1; + operation = null; + type = null; + + }; + +} + + + + + + + + + + + + + + + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java new file mode 100644 index 0000000000..4904fd5fc1 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java @@ -0,0 +1,62 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for float + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Float, according to OMG-IDL java mapping. + +**/ + + +final public class FloatHolder implements Holder { + public float value; + + public FloatHolder() {} + + public FloatHolder(float initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Floats. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Float ) + return ( value == ((Float)obj).floatValue()); + else + return false; + } + + /** + Comparisson method for Floats. + @return true if the input float value equals the value of the current object, false otherwize + **/ + public boolean equals( float f ) { + return ( value == f); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Holder.java b/lib/ic/java_src/com/ericsson/otp/ic/Holder.java new file mode 100644 index 0000000000..a00efcef68 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Holder.java @@ -0,0 +1,33 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * Holder interface class. +*/ +package com.ericsson.otp.ic; +import java.io.Serializable; + +/** + Holder interface class. + **/ + +public interface Holder extends Serializable +{ + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java new file mode 100644 index 0000000000..1037af4f08 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java @@ -0,0 +1,62 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for long + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Int, according to OMG-IDL java mapping. + +**/ + +final public class IntHolder implements Holder { + public int value; + + public IntHolder() {} + + public IntHolder(int initial) { + value = initial; + } + + /* Extra methods not in standard. */ + + /** + Comparisson method for Ints. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Integer ) + return ( value == ((Integer)obj).intValue()); + else + return false; + } + + /** + Comparisson method for Ints. + @return true if the input int value equals the value of the current object, false otherwize + **/ + public boolean equals( int i ) { + return ( value == i); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java new file mode 100644 index 0000000000..8fa4430018 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for long + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Long, used by the Term class. + +**/ + +final public class LongHolder implements Holder { + public long value; + + public LongHolder() {} + + public LongHolder(long initial) { + value = initial; + } + + /** + Comparisson method for Longs. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Long ) + return ( value == ((Long)obj).longValue()); + else + return false; + } + + /** + Comparisson method for Longs. + @return true if the input long value equals the value of the current object, false otherwize + **/ + public boolean equals( long l ) { + return ( value == l); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Makefile b/lib/ic/java_src/com/ericsson/otp/ic/Makefile new file mode 100644 index 0000000000..f730749ccb --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Makefile @@ -0,0 +1,118 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk + + +JAVA_DEST_ROOT = $(ERL_TOP)/lib/ic/priv/ +JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/ +JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/ +JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/ + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include $(ERL_TOP)/lib/ic/vsn.mk +VSN=$(IC_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) + +# +# JAVA macros +# +JAVA_CLASSES = \ + Holder \ + BooleanHolder \ + ByteHolder \ + CharHolder \ + DoubleHolder \ + FloatHolder \ + IntHolder \ + LongHolder \ + ShortHolder \ + StringHolder \ + Environment \ + Any \ + AnyHelper \ + AnyHolder \ + TypeCode \ + TCKind \ + Pid \ + PidHolder \ + PidHelper \ + Ref \ + RefHolder \ + RefHelper \ + Port \ + PortHolder \ + PortHelper \ + Term \ + TermHolder \ + TermHelper + +TARGET_FILES= $(JAVA_CLASSES:%=$(JAVA_DEST_ROOT)$(JAVA_CLASS_SUBDIR)%.class) +JAVA_FILES= $(JAVA_CLASSES:%=%.java) + +JARFILE= ic.jar + +# ---------------------------------------------------- +# Programs and Flags +# ---------------------------------------------------- +CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT) + +JAR= jar + +JAVADOCFLAGS=-d $(DOCDIR) +JAVAFLAGS=-d $(JAVA_DEST_ROOT) +JARFLAGS= -cvf + +JAVA_OPTIONS = + +# ---------------------------------------------------- +# Make Rules +# ---------------------------------------------------- + +debug opt: $(JAVA_DEST_ROOT)$(JARFILE) + +$(JAVA_DEST_ROOT)$(JARFILE): $(TARGET_FILES) + @(cd $(JAVA_DEST_ROOT) ; $(JAR) $(JARFLAGS) $(JARFILE) $(JAVA_CLASS_SUBDIR)) + +clean: + rm -f $(TARGET_FILES) *~ + +docs: + +# ---------------------------------------------------- +# Release Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/java_src/com/ericsson/otp/ic + $(INSTALL_DATA) $(JAVA_FILES) $(RELSYSDIR)/java_src/com/ericsson/otp/ic + $(INSTALL_DIR) $(RELSYSDIR)/priv + $(INSTALL_DATA) $(JAVA_DEST_ROOT)$(JARFILE) $(RELSYSDIR)/priv + +release_docs_spec: + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Pid.java b/lib/ic/java_src/com/ericsson/otp/ic/Pid.java new file mode 100644 index 0000000000..8d0608bf58 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Pid.java @@ -0,0 +1,55 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + + +/** + +Pid class mapps the built-in erlang type pid, a process identity. + +**/ + + +final public class Pid extends com.ericsson.otp.erlang.OtpErlangPid { + + public Pid(com.ericsson.otp.erlang.OtpSelf self) { + super(self); + } + + public Pid(com.ericsson.otp.erlang.OtpInputStream buf) + throws com.ericsson.otp.erlang.OtpErlangDecodeException { + super(buf); + } + + + public Pid(String node, int id, int serial, int creation) { + super(node,id,serial,creation); + } + + + /** + Comparisson method for Pid. + @return true if the input Pid value equals the value of the current object, false otherwize + **/ + public boolean equal(Pid _pid) { + return super.equals(_pid); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java new file mode 100644 index 0000000000..a51ff2fe80 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java @@ -0,0 +1,144 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Helper class for Pid. + **/ + +public class PidHelper { + + // constructors + private PidHelper() {} + + // methods + /** + Marshal method for the Pid class, encodes the Pid object to the output stream. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Pid _value) + throws java.lang.Exception { + + _out.write_pid(_value.node(),_value.id(),_value.serial(),_value.creation()); + } + + /** + Unmarshal method for the Pid class, decodes a Pid object from the stream. + @return Pid, read from the input stream + **/ + public static Pid unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) + throws java.lang.Exception { + + // Double job is done here, there should be + // a function returning a Pid instead of an + // OtpErlangPid + com.ericsson.otp.erlang.OtpErlangPid oep = _in.read_pid(); + + return new Pid(oep.node(),oep.id(),oep.serial(),oep.creation()); + } + + /** + Standard method that returns the interface repository identity. + @return String containing the interface repository identity of Pid + **/ + public static String id() { + return "IDL:com/ericsson/otp/ic/Pid:1.0"; + } + + /** + Standard method that returns the Pid class name. + @return String containing the class name of Pid + **/ + public static String name() { + return "Pid"; + } + + /** + Holds the TypeCode + **/ + private static com.ericsson.otp.ic.TypeCode _tc; + + /** + Standard TypeCode accessor method. + @return the TypeCode for Pid + **/ + synchronized public static com.ericsson.otp.ic.TypeCode type() { + + if (_tc != null) + return _tc; + + com.ericsson.otp.ic.TypeCode _tc0 = + new com.ericsson.otp.ic.TypeCode(); + _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); + _tc0.id("IDL:com/ericsson/otp/ic/Pid:1.0"); + _tc0.name("Pid"); + _tc0.member_count(4); + _tc0.member_name(0,"node"); + com.ericsson.otp.ic.TypeCode _tc1 = + new com.ericsson.otp.ic.TypeCode(); + _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); + _tc1.length(256); + _tc0.member_type(0,_tc1); + _tc0.member_name(1,"num"); + com.ericsson.otp.ic.TypeCode _tc2 = + new com.ericsson.otp.ic.TypeCode(); + _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(1,_tc2); + _tc0.member_name(2,"serial"); + com.ericsson.otp.ic.TypeCode _tc3 = + new com.ericsson.otp.ic.TypeCode(); + _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(2,_tc3); + _tc0.member_name(3,"creation"); + com.ericsson.otp.ic.TypeCode _tc4 = + new com.ericsson.otp.ic.TypeCode(); + _tc4.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(3,_tc4); + + _tc = _tc0; + + return _tc0; + } + + + /** + Standard method for inserting a Pid to an Any. + **/ + public static void insert(com.ericsson.otp.ic.Any _any, Pid _this) + throws java.lang.Exception { + + com.ericsson.otp.erlang.OtpOutputStream _os = + new com.ericsson.otp.erlang.OtpOutputStream(); + + _any.type(type()); + marshal(_os, _this); + _any.insert_Streamable(_os); + } + + /** + Standard method for extracting a Pid from an Any. + @return Pid, the value found in an Any contained stream. + **/ + public static Pid extract(com.ericsson.otp.ic.Any _any) + throws java.lang.Exception { + + return unmarshal(_any.extract_Streamable()); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java new file mode 100644 index 0000000000..9e42385dec --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java @@ -0,0 +1,54 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Holder class for Pid. + **/ + +final public class PidHolder { + + /** + Pid instance variable. + **/ + public Pid value; + + // constructors + public PidHolder() {} + public PidHolder(Pid initial) { + value = initial; + } + + // methods + /** + Marshal method for the PidHolder class, encodes the Pid object value to the output stream. + **/ + public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception { + PidHelper.marshal(out, value); + } + + /** + Unmarshal method for the PidHolder class, decodes a Pid object from the output stream + and assigns it to the Holder value field. + **/ + public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception { + value = PidHelper.unmarshal(in); + } +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Port.java b/lib/ic/java_src/com/ericsson/otp/ic/Port.java new file mode 100644 index 0000000000..e830365d5c --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Port.java @@ -0,0 +1,48 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + +Port class mapps the built-in erlang type port, a process port. + +**/ + +final public class Port extends com.ericsson.otp.erlang.OtpErlangPort { + + public Port(com.ericsson.otp.erlang.OtpInputStream buf) + throws com.ericsson.otp.erlang.OtpErlangDecodeException { + super(buf); + } + + public Port(String node, int id, int creation) { + super(node,id,creation); + } + + /** + Comparisson method for Port. + @return true if the input Port value equals the value of the current object, false otherwize + **/ + public boolean equal(Port _port) { + return super.equals(_port); + } + + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java new file mode 100644 index 0000000000..26c79713e0 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java @@ -0,0 +1,140 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Helper class for Port. + **/ + +public class PortHelper { + + // constructors + private PortHelper() {} + + // methods + + /** + Marshal method for the Port class, encodes the Port object to the output stream. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Port _value) + throws java.lang.Exception { + + _out.write_port(_value.node(),_value.id(),_value.creation()); + } + + /** + Unmarshal method for the Port class, decodes a Port object from the stream. + @return Port, read from the input stream + **/ + public static Port unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) + throws java.lang.Exception { + + // Double job is done here, there should be + // a function returning a Port instead of an + // OtpErlangPort + com.ericsson.otp.erlang.OtpErlangPort oep = _in.read_port(); + + return new Port(oep.node(),oep.id(),oep.creation()); + } + + /** + Standard method that returns the interface repository identity. + @return String containing the interface repository identity of Port + **/ + public static String id() { + return "IDL:com/ericsson/otp/ic/Port:1.0"; + } + + /** + Standard method that returns the Port class name. + @return String containing the class name of Port + **/ + public static String name() { + return "Port"; + } + + /** + Holds the TypeCode + **/ + private static com.ericsson.otp.ic.TypeCode _tc; + + /** + Standard TypeCode accessor method. + @return the TypeCode for Port + **/ + synchronized public static com.ericsson.otp.ic.TypeCode type() { + + if (_tc != null) + return _tc; + + com.ericsson.otp.ic.TypeCode _tc0 = + new com.ericsson.otp.ic.TypeCode(); + _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); + _tc0.id("IDL:com/ericsson/otp/ic/Port:1.0"); + _tc0.name("Port"); + _tc0.member_count(3); + _tc0.member_name(0,"node"); + com.ericsson.otp.ic.TypeCode _tc1 = + new com.ericsson.otp.ic.TypeCode(); + _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); + _tc1.length(256); + _tc0.member_type(0,_tc1); + _tc0.member_name(1,"id"); + com.ericsson.otp.ic.TypeCode _tc2 = + new com.ericsson.otp.ic.TypeCode(); + _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(1,_tc2); + _tc0.member_name(2,"creation"); + com.ericsson.otp.ic.TypeCode _tc3 = + new com.ericsson.otp.ic.TypeCode(); + _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(2,_tc3); + + _tc = _tc0; + + return _tc0; + } + + + /** + Standard method for inserting a Port to an Any. + **/ + public static void insert(com.ericsson.otp.ic.Any _any, Port _this) + throws java.lang.Exception { + + com.ericsson.otp.erlang.OtpOutputStream _os = + new com.ericsson.otp.erlang.OtpOutputStream(); + + _any.type(type()); + marshal(_os, _this); + _any.insert_Streamable(_os); + } + + /** + Standard method for extracting a Port from an Any. + @return Port, the value found in an Any contained stream. + **/ + public static Port extract(com.ericsson.otp.ic.Any _any) + throws java.lang.Exception { + + return unmarshal(_any.extract_Streamable()); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java new file mode 100644 index 0000000000..80744f223f --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java @@ -0,0 +1,56 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Holder class for Port. + **/ + +final public class PortHolder { + + /** + Port instance variable. + **/ + public Port value; + + // constructors + public PortHolder() {} + public PortHolder(Port initial) { + value = initial; + } + + // methods + /** + Marshal method for the PortHolder class, encodes the Port object value to the output stream. + **/ + public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) + throws java.lang.Exception { + PortHelper.marshal(out, value); + } + + /** + Unmarshal method for the PortHolder class, decodes a Port object from the output stream + and assigns it to the Holder value field. + **/ + public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) + throws java.lang.Exception { + value = PortHelper.unmarshal(in); + } +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Ref.java b/lib/ic/java_src/com/ericsson/otp/ic/Ref.java new file mode 100644 index 0000000000..0a3876989e --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Ref.java @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + +Ref class mapps the built-in erlang type Ref, a message reference. + +**/ + +final public class Ref extends com.ericsson.otp.erlang.OtpErlangRef { + + public Ref(com.ericsson.otp.erlang.OtpSelf self) { + super(self); + } + + + public Ref(com.ericsson.otp.erlang.OtpInputStream buf) + throws com.ericsson.otp.erlang.OtpErlangDecodeException { + super(buf); + } + + /** + Old style Ref costructor. Costructs an Ref that coresponds to the + old erlang Ref type. + **/ + public Ref(String node, int id, int creation) { + super(node,id,creation); + } + + public Ref(String node, int[] ids, int creation) { + super(node,ids,creation); + } + + /** + Comparisson method for Ref. + @return true if the input Ref value equals the value of the current object, false otherwize + **/ + public boolean equal(Ref _ref) { + return super.equals(_ref); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java new file mode 100644 index 0000000000..a58dec7905 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java @@ -0,0 +1,141 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Helper class for Ref. + **/ + +public class RefHelper { + + // constructors + private RefHelper() {} + + // methods + /** + Marshal method for the Ref class, encodes the Ref object to the output stream. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Ref _value) + throws java.lang.Exception { + + _out.write_ref(_value.node(),_value.id(),_value.creation()); + } + + /** + Unmarshal method for the Ref class, decodes a Ref object from the stream. + @return Ref, read from the input stream + **/ + public static Ref unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) + throws java.lang.Exception { + + // Double job is done here, there should be + // a function returning a Ref instead of an + // OtpErlangRef + com.ericsson.otp.erlang.OtpErlangRef oer = _in.read_ref(); + + if (oer.isNewRef()) + return new Ref(oer.node(),oer.ids(),oer.creation()); + else + return new Ref(oer.node(),oer.id(),oer.creation()); + } + + /** + Standard method that returns the interface repository identity. + @return String containing the interface repository identity of Ref + **/ + public static String id() { + return "IDL:com/ericsson/otp/ic/Ref:1.0"; + } + + /** + Standard method that returns the Ref class name. + @return String containing the class name of Ref + **/ + public static String name() { + return "Ref"; + } + + /** + Holds the TypeCode + **/ + private static com.ericsson.otp.ic.TypeCode _tc; + + /** + Standard TypeCode accessor method. + @return the TypeCode for Ref + **/ + synchronized public static com.ericsson.otp.ic.TypeCode type() { + + if (_tc != null) + return _tc; + + com.ericsson.otp.ic.TypeCode _tc0 = + new com.ericsson.otp.ic.TypeCode(); + _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); + _tc0.id("IDL:com/ericsson/otp/ic/Ref:1.0"); + _tc0.name("Ref"); + _tc0.member_count(3); + _tc0.member_name(0,"node"); + com.ericsson.otp.ic.TypeCode _tc1 = + new com.ericsson.otp.ic.TypeCode(); + _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); + _tc1.length(256); + _tc0.member_type(0,_tc1); + _tc0.member_name(1,"id"); + com.ericsson.otp.ic.TypeCode _tc2 = + new com.ericsson.otp.ic.TypeCode(); + _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(1,_tc2); + _tc0.member_name(2,"creation"); + com.ericsson.otp.ic.TypeCode _tc3 = + new com.ericsson.otp.ic.TypeCode(); + _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); + _tc0.member_type(2,_tc3); + + _tc = _tc0; + + return _tc0; + } + + /** + Standard method for inserting a Ref to an Any. + **/ + public static void insert(com.ericsson.otp.ic.Any _any, Ref _this) + throws java.lang.Exception { + + com.ericsson.otp.erlang.OtpOutputStream _os = + new com.ericsson.otp.erlang.OtpOutputStream(); + + _any.type(type()); + marshal(_os, _this); + _any.insert_Streamable(_os); + } + + /** + Standard method for extracting a Ref from an Any. + @return Ref, the value found in an Any contained stream. + **/ + public static Ref extract(com.ericsson.otp.ic.Any _any) + throws java.lang.Exception { + + return unmarshal(_any.extract_Streamable()); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java new file mode 100644 index 0000000000..2dc3f4b42a --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java @@ -0,0 +1,54 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Holder class for Ref. + **/ + +final public class RefHolder { + + /** + Ref instance variable. + **/ + public Ref value; + + // constructors + public RefHolder() {} + public RefHolder(Ref initial) { + value = initial; + } + + // methods + /** + Marshal method for the RefHolder class, encodes the Ref object value to the output stream. + **/ + public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception { + RefHelper.marshal(out, value); + } + + /** + Unmarshal method for the RefHolder class, decodes a Ref object from the output stream + and assigns it to the Holder value field. + **/ + public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception { + value = RefHelper.unmarshal(in); + } +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java new file mode 100644 index 0000000000..81fd7656b8 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java @@ -0,0 +1,61 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for long + * + */ +package com.ericsson.otp.ic; + +/** + +Holder class for Short, according to OMG-IDL java mapping. + +**/ + +final public class ShortHolder implements Holder { + public short value; + + public ShortHolder() {} + + public ShortHolder(short initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Shorts. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof Short ) + return ( value == ((Short)obj).shortValue()); + else + return false; + } + + /** + Comparisson method for Shorts. + @return true if the input short value equals the value of the current object, false otherwize + **/ + public boolean equals( short s ) { + return ( value == s); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java new file mode 100644 index 0000000000..09b42dc270 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java @@ -0,0 +1,62 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * A Holder class for IDL's out/inout argument passing modes for string + * + */ +package com.ericsson.otp.ic; + + +/** + +Holder class for String, according to OMG-IDL java mapping. + +**/ + +final public class StringHolder implements Holder { + public String value; + + public StringHolder() {} + + public StringHolder(String initial) { + value = initial; + } + + /* Extra methods not in standard. */ + /** + Comparisson method for Strings. + @return true if the input object equals the current object, false otherwize + **/ + public boolean equals( Object obj ) { + if( obj instanceof String ) + return ( value == obj); + else + return false; + } + + /** + Comparisson method for Strings. + @return true if the input String value equals the value of the current object, false otherwize + **/ + public boolean equals( String s ) { + return ( value == s); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java b/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java new file mode 100644 index 0000000000..210f7f6216 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java @@ -0,0 +1,199 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * The TCKind class for Java IDL + * + */ +package com.ericsson.otp.ic; + +/** + The TCKind class is the implementation of the OMG-IDL enumerant type TCKind. + **/ + +final public class TCKind { + + // instance variables + public static final int _tk_null = 0, + _tk_void = 1, + _tk_short = 2, + _tk_long = 3, + _tk_ushort = 4, + _tk_ulong = 5, + _tk_float = 6, + _tk_double = 7, + _tk_boolean = 8, + _tk_char = 9, + _tk_octet = 10, + _tk_any = 11, + _tk_TypeCode = 12, + _tk_Principal = 13, + _tk_objref = 14, + _tk_struct = 15, + _tk_union = 16, + _tk_enum = 17, + _tk_string = 18, + _tk_sequence = 19, + _tk_array = 20, + _tk_alias = 21, + _tk_except = 22, + _tk_longlong = 23, + _tk_ulonglong = 24, + _tk_longdouble = 25, + _tk_wchar = 26, + _tk_wstring = 27, + _tk_fixed = 28, + _tk_atom = 20000, /* Used for union label default value only */ + _tk_pid = 20001, /* Used for special pid struct */ + _tk_port = 20002, /* Used for special port struct */ + _tk_ref = 20003, /* Used for special ref struct */ + _tk_term = 20004; /* Used for special term struct */ + + public static final TCKind tk_null = new TCKind(_tk_null); + public static final TCKind tk_void = new TCKind(_tk_void); + public static final TCKind tk_short = new TCKind(_tk_short); + public static final TCKind tk_long = new TCKind(_tk_long); + public static final TCKind tk_ushort = new TCKind(_tk_ushort); + public static final TCKind tk_ulong = new TCKind(_tk_ulong); + public static final TCKind tk_float = new TCKind(_tk_float); + public static final TCKind tk_double = new TCKind(_tk_double); + public static final TCKind tk_boolean = new TCKind(_tk_boolean); + public static final TCKind tk_char = new TCKind(_tk_char); + public static final TCKind tk_octet = new TCKind(_tk_octet); + public static final TCKind tk_any = new TCKind(_tk_any); + public static final TCKind tk_TypeCode = new TCKind(_tk_TypeCode); + public static final TCKind tk_Principal = new TCKind(_tk_Principal); + public static final TCKind tk_objref = new TCKind(_tk_objref); + public static final TCKind tk_struct = new TCKind(_tk_struct); + public static final TCKind tk_union = new TCKind(_tk_union); + public static final TCKind tk_enum = new TCKind(_tk_enum); + public static final TCKind tk_string = new TCKind(_tk_string); + public static final TCKind tk_sequence = new TCKind(_tk_sequence); + public static final TCKind tk_array = new TCKind(_tk_array); + public static final TCKind tk_alias = new TCKind(_tk_alias); + public static final TCKind tk_except = new TCKind(_tk_except); + public static final TCKind tk_longlong = new TCKind(_tk_longlong); + public static final TCKind tk_ulonglong = new TCKind(_tk_ulonglong); + public static final TCKind tk_longdouble = new TCKind(_tk_longdouble); + public static final TCKind tk_wchar = new TCKind(_tk_wchar); + public static final TCKind tk_wstring = new TCKind(_tk_wstring); + public static final TCKind tk_fixed = new TCKind(_tk_fixed); + protected static final TCKind tk_atom = new TCKind(_tk_atom); + protected static final TCKind tk_pid = new TCKind(_tk_pid); + protected static final TCKind tk_port = new TCKind(_tk_port); + protected static final TCKind tk_ref = new TCKind(_tk_ref); + protected static final TCKind tk_term = new TCKind(_tk_term); + private int _value; + + // constructors + private TCKind(int __value) { + _value = __value; + } + + // methods + + /** + Accessor method for the value of TCKind. + @return int, the value of TCKind object + **/ + public int value() { + return _value; + } + + /** + Translator method for TCKind. + Traslates the input integer value to a TCKind enumerant object. + @return TCKind, a TCKind object + **/ + public static final TCKind from_int(int __value) throws java.lang.Exception { + switch (__value) { + case _tk_null: + return tk_null; + case _tk_void: + return tk_void; + case _tk_short: + return tk_short; + case _tk_long: + return tk_long; + case _tk_ushort: + return tk_ushort; + case _tk_ulong: + return tk_ulong; + case _tk_float: + return tk_float; + case _tk_double: + return tk_double; + case _tk_boolean: + return tk_boolean; + case _tk_char: + return tk_char; + case _tk_octet: + return tk_octet; + case _tk_any: + return tk_any; + case _tk_TypeCode: + return tk_TypeCode; + case _tk_Principal: + return tk_Principal; + case _tk_objref: + return tk_objref; + case _tk_struct: + return tk_struct; + case _tk_union: + return tk_union; + case _tk_enum: + return tk_enum; + case _tk_string: + return tk_string; + case _tk_sequence: + return tk_sequence; + case _tk_array: + return tk_array; + case _tk_alias: + return tk_alias; + case _tk_except: + return tk_except; + case _tk_longlong: + return tk_longlong; + case _tk_ulonglong: + return tk_ulonglong; + case _tk_longdouble: + return tk_longdouble; + case _tk_wchar: + return tk_wchar; + case _tk_wstring: + return tk_wstring; + case _tk_fixed: + return tk_fixed; + case _tk_atom: + return tk_atom; + case _tk_pid: + return tk_pid; + case _tk_port: + return tk_port; + case _tk_ref: + return tk_ref; + case _tk_term: + return tk_term; + default: + throw new java.lang.Exception(""); + } + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Term.java b/lib/ic/java_src/com/ericsson/otp/ic/Term.java new file mode 100644 index 0000000000..9219cb7038 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/Term.java @@ -0,0 +1,1109 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + +The Term class is intended to represent the erlang term generic type. +It extends the Any class and is basically used the same way as the Any class. +<p>The main difference between Term and Any is the use of guard methods +instead for TypeCode to determine the data included in the Term. +This actual when cannot determine a Term's value class returned at compile time. + +**/ + +final public class Term extends Any { + + // Primitive value holder + protected java.lang.String atomV; + protected long longV; + protected Pid PidV; + protected Ref RefV; + protected Port PortV; + protected com.ericsson.otp.erlang.OtpErlangObject ObjV; + protected int tag; + + /** + Tag accessor method + @return int, the tag of the Object that denotes the erlang external format tag + **/ + public int tag() { + return tag; + } + + /* Guards */ + + /** + Guard method + @return true if the Term is an OtpErlangAtom, false otherwize + **/ + public boolean isAtom() { + + if (ObjV == null) { + if (tag == com.ericsson.otp.erlang.OtpExternal.atomTag) + return true; + + return false; + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangAtom) ; + } + + /** + Guard method + @return true if the Term is not an OtpErlangList nor an OtpErlangTuple, false otherwize + **/ + public boolean isConstant() { + if (isList()) + return false; + + if (isTuple()) + return false; + + return true; + } + + /** + Guard method + @return true if the Term is an OtpErlangFloat, false otherwize + **/ + public boolean isFloat() { + if (tag == com.ericsson.otp.erlang.OtpExternal.floatTag) + return true; + + return false; + } + + /** + Guard method + @return true if the Term is an OtpErlangInt, false otherwize + **/ + public boolean isInteger() { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.smallIntTag: + case com.ericsson.otp.erlang.OtpExternal.intTag: + case com.ericsson.otp.erlang.OtpExternal.smallBigTag: + return true; + default: + return false; + } + } + + /** + Guard method + @return true if the Term is an OtpErlangList, false otherwize + **/ + public boolean isList() { + + if (ObjV == null) { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.listTag: + case com.ericsson.otp.erlang.OtpExternal.stringTag: + case com.ericsson.otp.erlang.OtpExternal.nilTag: + return true; + default: + return false; + } + } + + if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangList) + return true; + + if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString) + return true; + + return false; + } + + + /** + Guard method + @return true if the Term is an OtpErlangString, false otherwize + **/ + public boolean isString() { + + if (ObjV == null) { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.stringTag: + case com.ericsson.otp.erlang.OtpExternal.nilTag: + return true; + default: + try { + stringV = extract_string(); + return true; + } catch (Exception e) { + return false; + } + } + } + + if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString) + return true; + + try { + stringV = extract_string(); + return true; + } catch (Exception e) { + return false; + } + } + + /** + Guard method + @return true if the Term is an OtpErlangInteger or an OtpErlangFloat, false otherwize + **/ + public boolean isNumber() { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.smallIntTag: + case com.ericsson.otp.erlang.OtpExternal.intTag: + case com.ericsson.otp.erlang.OtpExternal.smallBigTag: + case com.ericsson.otp.erlang.OtpExternal.floatTag: + return true; + default : + return false; + } + } + + + /** + Guard method + @return true if the Term is an OtpErlangPid or Pid, false otherwize + **/ + public boolean isPid() { + + if (ObjV == null) { + if (tag == com.ericsson.otp.erlang.OtpExternal.pidTag) + return true; + + return false; + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPid) ; + } + + + /** + Guard method + @return true if the Term is an OtpErlangPort or Port, false otherwize + **/ + public boolean isPort() { + if (ObjV == null) { + if (tag == com.ericsson.otp.erlang.OtpExternal.portTag) + return true; + + return false; + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPort); + } + + + /** + Guard method + @return true if the Term is an OtpErlangRef, false otherwize + **/ + public boolean isReference() { + if (ObjV == null) { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.refTag: + case com.ericsson.otp.erlang.OtpExternal.newRefTag: + return true; + default : + return false; + } + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangRef) ; + } + + + /** + Guard method + @return true if the Term is an OtpErlangTuple, false otherwize + **/ + public boolean isTuple() { + if (ObjV == null) { + switch(tag) { + case com.ericsson.otp.erlang.OtpExternal.smallTupleTag: + case com.ericsson.otp.erlang.OtpExternal.largeTupleTag: + return true; + default : + return false; + } + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangTuple); + } + + + /** + Guard method + @return true if the Term is an OtpErlangBinary, false otherwize + **/ + public boolean isBinary() { + if (ObjV == null) { + if (tag == com.ericsson.otp.erlang.OtpExternal.binTag) + return true; + + return false; + } + + return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangBinary); + } + + + + + // Equal function + /** + Term comparison method + @return true if the input Term is equal to the object, false otherwize + **/ + public boolean equal(Term _any) { + + try { + + /* Pids */ + if ((PidV != null) && (_any.PidV != null)) + if (PidV.equal(_any.PidV)) + return true; + + /* Refs */ + if ((RefV != null) && (_any.RefV != null)) + if (RefV.equal(_any.RefV)) + return true; + + /* Ports */ + if ((PortV != null) && (_any.PortV != null)) + if (PortV.equals(_any.PortV)) + return true; + + /* strings */ + if ((stringV != null) && (_any.stringV != null)) + if (stringV.equals(_any.stringV)) + return true; + + /* atoms and booleans */ + if ((atomV != null) && (_any.atomV != null)) + if (atomV.equals(_any.atomV)) + return true; + + /* booleans */ + if (atomV != null) + if (_any.booleanV == Boolean.valueOf(atomV).booleanValue()) + return true; + + if (_any.atomV != null) + if (booleanV == Boolean.valueOf(_any.atomV).booleanValue()) + return true; + + /* integer types plus floating point types */ + double _ownNS = + longV+doubleV; + + double _othersNS = + _any.longV+_any.doubleV; + + if ((equal(_ownNS,_othersNS)) && + (!equal(_ownNS,0))) + return true; + + /* All together, 0 or false */ + if ((equal(_ownNS,_othersNS)) && + booleanV == _any.booleanV) + return true; + + + return false; + + } catch (Exception e) { + e.printStackTrace(); + return false; + } + } + + /** + Writes the value of Term to a stream + **/ + public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os) + throws java.lang.Exception { + + if ((tcV == null) && (ObjV != null)) + _os.write_any(ObjV); // Type not generated by IC + + else { + + switch(tcV.kind().value()) { + + case TCKind._tk_octet : + case TCKind._tk_char : + case TCKind._tk_wchar : + case TCKind._tk_short : + case TCKind._tk_ushort : + case TCKind._tk_long : + case TCKind._tk_longlong : + case TCKind._tk_ulong : + case TCKind._tk_ulonglong : + _os.write_long(longV); + break; + + case TCKind._tk_float : + _os.write_double(doubleV); + break; + + case TCKind._tk_double : + _os.write_double(doubleV); + break; + + case TCKind._tk_boolean : + _os.write_boolean(booleanV); + break; + + case TCKind._tk_string : + case TCKind._tk_wstring : + _os.write_string(stringV); + break; + + case TCKind._tk_atom : + _os.write_atom(stringV); + break; + + case TCKind._tk_struct: + if (isPid()) + PidHelper.marshal(_os, PidV); + else { + if (isReference()) + RefHelper.marshal(_os, RefV); + else { + if (isPort()) + PortHelper.marshal(_os, PortV); + else + _os.write(os.toByteArray()); + } + } + break; + + case TCKind._tk_union: + case TCKind._tk_array: + case TCKind._tk_sequence: + case TCKind._tk_enum: + _os.write(os.toByteArray()); + break; + + case TCKind._tk_void : + _os.write_atom("ok"); + break; + + /* + * Not supported types + */ + default: + throw new java.lang.Exception("BAD KIND"); + } + } + } + + + + /* + * Insert and extract each primitive type + */ + + + /* short */ + + /** + Short value extractor method + @return short, the value of Term + **/ + public short extract_short() + throws java.lang.Exception { + + if (tcV == null) + return (short) longV; + + if (tcV.kind() == TCKind.tk_short) + return (short) longV; + + throw new java.lang.Exception(""); + } + + /** + Short value insertion method + **/ + public void insert_short(short s) { + longV = s; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_short); + }; + + /** + Short value insertion method + **/ + public void insert_short(long l) { + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_short); + }; + + + /* long */ + + /** + Long value extractor method + @return int, the value of Term + **/ + public int extract_long() + throws java.lang.Exception { + + if (tcV == null) + return (int) longV; + + if (tcV.kind() == TCKind.tk_long) + return (int) longV; + + throw new java.lang.Exception(""); + } + + /** + Long value insertion method + **/ + public void insert_long(int i){ + longV = i; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_long); + } + + /** + Long value insertion method + **/ + public void insert_long(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_long); + } + + + /* longlong */ + + /** + Long Long value extractor method + @return long, the value of Term + **/ + public long extract_longlong() + throws java.lang.Exception { + + if (tcV == null) + return longV; + + if (tcV.kind() == TCKind.tk_longlong) + return longV; + + throw new java.lang.Exception(""); + } + + + /** + Long Long value insertion method + **/ + public void insert_longlong(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_longlong); + } + + + /* ushort */ + + /** + Unsigned Short value extractor method + @return short, the value of Term + **/ + public short extract_ushort() + throws java.lang.Exception { + + if (tcV == null) + return (short) longV; + + if (tcV.kind() == TCKind.tk_ushort) + return (short) longV; + + throw new java.lang.Exception(""); + } + + /** + Unsigned Short value insertion method + **/ + public void insert_ushort(short s){ + longV = s; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_ushort); + } + + /** + Unsigned Short value insertion method + **/ + public void insert_ushort(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_ushort); + } + + + /* ulong */ + + /** + Unsigned Long value extractor method + @return int, the value of Term + **/ + public int extract_ulong() + throws java.lang.Exception{ + + if (tcV == null) + return (int) longV; + + if (tcV.kind() == TCKind.tk_ulong) + return (int) longV; + + throw new java.lang.Exception(""); + } + + /** + Unsigned Long value insertion method + **/ + public void insert_ulong(int i){ + longV = i; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_ulong); + } + + + /** + Unsigned Long value insertion method + **/ + public void insert_ulong(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_ulong); + } + + + + /* ulonglong */ + + /** + Unsigned Long Long value extractor method + @return long, the value of Term + **/ + public long extract_ulonglong() + throws java.lang.Exception { + + if (tcV == null) + return longV; + + if (tcV.kind() == TCKind.tk_ulonglong) + return longV; + + throw new java.lang.Exception(""); + } + + + /** + Unsigned Long Long value insertion method + **/ + public void insert_ulonglong(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.intTag; + tcV = new TypeCode(TCKind.tk_ulonglong); + } + + + + /* float */ + /** + Float value extractor method + @return float, the value of Term + **/ + public float extract_float() + throws java.lang.Exception{ + + if (tcV == null) + return (float) doubleV; + + if (tcV.kind() == TCKind.tk_float) + return (float) doubleV; + + throw new java.lang.Exception(""); + } + + + /** + Float value insertion method + **/ + public void insert_float(float f){ + doubleV = f; + tag = com.ericsson.otp.erlang.OtpExternal.floatTag; + tcV = new TypeCode(TCKind.tk_float); + } + + /** + Float value insertion method + **/ + public void insert_float(double f){ + doubleV = f; + tag = com.ericsson.otp.erlang.OtpExternal.floatTag; + tcV = new TypeCode(TCKind.tk_float); + } + + + /* double */ + /** + Double value extractor method + @return double, the value of Term + **/ + public double extract_double() + throws java.lang.Exception{ + + if (tcV == null) + return doubleV; + + if (tcV.kind() == TCKind.tk_double) + return doubleV; + + throw new java.lang.Exception(""); + } + + /** + Double value insertion method + **/ + public void insert_double(double d){ + doubleV = d; + tag = com.ericsson.otp.erlang.OtpExternal.floatTag; + tcV = new TypeCode(TCKind.tk_double); + } + + + /* boolean */ + /** + Boolean value extractor method + @return boolean, the value of Term + **/ + public boolean extract_boolean() + throws java.lang.Exception{ + + if ((tcV == null) && (atomV != null)) + return Boolean.valueOf(atomV).booleanValue(); + + if (tcV.kind() == TCKind.tk_boolean) + return booleanV; + + throw new java.lang.Exception(""); + } + + /** + Boolean value insertion method + **/ + public void insert_boolean(boolean b){ + booleanV = b; + tag = com.ericsson.otp.erlang.OtpExternal.atomTag; + tcV = new TypeCode(TCKind.tk_boolean); + } + + + /* char */ + /** + Char value extractor method + @return char, the value of Term + **/ + public char extract_char() + throws java.lang.Exception{ + + if (tcV == null) + return (char) longV; + + if (tcV.kind() == TCKind.tk_char) + return (char) longV; + + throw new java.lang.Exception(""); + } + + /** + Char value insertion method + **/ + public void insert_char(char c) { + longV = c; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_char); + } + + /** + Char value insertion method + **/ + public void insert_char(long l) { + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_char); + } + + + + /* wchar */ + /** + Wchar value extractor method + @return char, the value of Term + **/ + public char extract_wchar() + throws java.lang.Exception{ + + if (tcV == null) + return (char) longV; + + if (tcV.kind() == TCKind.tk_wchar) + return (char) longV; + + throw new java.lang.Exception(""); + } + + /** + Wchar value insertion method + **/ + public void insert_wchar(char c) { + longV = c; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_wchar); + } + + /** + Wchar value insertion method + **/ + public void insert_wchar(long l) { + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_wchar); + } + + + /* octet */ + /** + Octet value extractor method + @return byte, the value of Term + **/ + public byte extract_octet() + throws java.lang.Exception{ + + if (tcV == null) + return (byte) longV; + + if (tcV.kind() == TCKind.tk_octet) + return (byte) longV; + + throw new java.lang.Exception(""); + } + + /** + Octet value insertion method + **/ + public void insert_octet(byte b){ + longV = b; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_octet); + } + + /** + Octet value insertion method + **/ + public void insert_octet(long l){ + longV = l; + tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; + tcV = new TypeCode(TCKind.tk_octet); + } + + + + /* string */ + + /** + String value extractor method + @return String, the value of Term + **/ + public java.lang.String extract_string() + throws java.lang.Exception{ + + if (tcV == null) { + if (stringV != null) + return stringV; + else { + is = this.extract_Streamable(); + stringV = is.read_string(); + return stringV; + } + } + else + if (tcV.kind() == TCKind.tk_string) + return stringV; + + throw new java.lang.Exception(""); + } + + /** + String value insertion method + **/ + public void insert_string(java.lang.String s) { + stringV = s; + tag = com.ericsson.otp.erlang.OtpExternal.stringTag; + tcV = new TypeCode(TCKind.tk_string); + } + + + + /* wstring */ + /** + Wstring value extractor method + @return String, the value of Term + **/ + public java.lang.String extract_wstring() + throws java.lang.Exception{ + + if (tcV == null) { + if (stringV != null) + return stringV; + else { + is = this.extract_Streamable(); + stringV = is.read_string(); + return stringV; + } + } + else + if (tcV.kind() == TCKind.tk_wstring) + return stringV; + + throw new java.lang.Exception(""); + } + + /** + Wstring value insertion method + **/ + public void insert_wstring(java.lang.String s) { + stringV = s; + tag = com.ericsson.otp.erlang.OtpExternal.stringTag; + tcV = new TypeCode(TCKind.tk_wstring); + } + + + + /* atom */ + /** + Atom value extractor method + @return atom, the value of Term + **/ + public java.lang.String extract_atom() + throws java.lang.Exception{ + + if ((tcV == null) && (atomV != null)) + return atomV; + + if (tcV.kind() == TCKind.tk_atom) + return stringV; + + throw new java.lang.Exception(""); + } + + + /** + Atom value insertion method + **/ + public void insert_atom(java.lang.String s) { + stringV = s; + tag = com.ericsson.otp.erlang.OtpExternal.atomTag; + tcV = new TypeCode(TCKind.tk_atom); + } + + + /* Pid */ + /** + Pid value extractor method + @return Pid, the value of Term + **/ + public Pid extract_Pid() + throws java.lang.Exception{ + + if ((tcV == null) && (PidV != null)) + return PidV; + + if (tcV.equal(PidHelper.type())) + return PidV; + + throw new java.lang.Exception(""); + } + + + /** + Pid value insertion method + **/ + public void insert_Pid(Pid p) { + PidV = p; + tag = com.ericsson.otp.erlang.OtpExternal.pidTag; + tcV = PidHelper.type(); + } + + + + /* Ref */ + /** + Ref value extractor method + @return Ref, the value of Term + **/ + public Ref extract_Ref() + throws java.lang.Exception{ + + if ((tcV == null) && (RefV != null)) + return RefV; + + if (tcV.equal(RefHelper.type())) + return RefV; + + throw new java.lang.Exception(""); + } + + /** + Ref value insertion method + **/ + public void insert_Ref(Ref r) { + RefV = r; + + if (r.isNewRef()) + tag = com.ericsson.otp.erlang.OtpExternal.newRefTag; + else + tag = com.ericsson.otp.erlang.OtpExternal.refTag; + + tcV = RefHelper.type(); + } + + + + /* Port */ + /** + Port value extractor method + @return Port, the value of Term + **/ + public Port extract_Port() + throws java.lang.Exception{ + + if ((tcV == null) && (PortV != null)) + return PortV; + + if (tcV.equal(PortHelper.type())) + return PortV; + + throw new java.lang.Exception(""); + } + + /** + Port value insertion method + **/ + public void insert_Port(Port p) { + PortV = p; + tag = com.ericsson.otp.erlang.OtpExternal.portTag; + tcV = PortHelper.type(); + } + + + /** + Object Stream extractor method + @return OtpInputStream, the stream value of Term + **/ + public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() { + + if (is == null) { + if (os == null) { + if (stringV == null) + return null; + else { + // A sequence that become a string ! + os = new com.ericsson.otp.erlang.OtpOutputStream(); + os.write_string(stringV); + is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + } + } + else { + is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); + } + } + + is.reset(); + return is; + } + + /** + Inserts Objects to Term + **/ + public void insert_Object(com.ericsson.otp.erlang.OtpErlangObject o) { + ObjV = o; + } + + /** + Extract Object value from Term + @return OtpErlangObject, the Object value of Term + **/ + public com.ericsson.otp.erlang.OtpErlangObject extract_Object() { + return ObjV; + } + + +} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java new file mode 100644 index 0000000000..437d38743b --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java @@ -0,0 +1,139 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Helper class for Term. + **/ + +public class TermHelper { + + // Constructors + private TermHelper() {} + + // Methods + /** + Marshal method for the Term class, encodes the Term object to the output stream. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Term _any) + throws java.lang.Exception { + + _any.write_value(_out); + } + + /** + Unmarshal method for the Term class, decodes a Term object from the stream. + @return Term, read from the input stream + **/ + public static Term unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) + throws java.lang.Exception { + + Term _value = new Term(); + + int tag = _in.peek(); + if (tag == com.ericsson.otp.erlang.OtpExternal.versionTag) { + _in.read1(); + tag = _in.peek(); + } + _value.tag = tag; + + + // Allways save the object in OtpErlangObject form + _in.mark(0); + com.ericsson.otp.erlang.OtpErlangObject _obj = _in.read_any(); + _value.insert_Object(_obj); + + switch (tag) { + case com.ericsson.otp.erlang.OtpExternal.smallIntTag: + case com.ericsson.otp.erlang.OtpExternal.intTag: + case com.ericsson.otp.erlang.OtpExternal.smallBigTag: + _in.reset(); + _value.longV = _in.read_long(); + break; + + case com.ericsson.otp.erlang.OtpExternal.atomTag: + _in.reset(); + _value.atomV = _in.read_atom(); + break; + + case com.ericsson.otp.erlang.OtpExternal.floatTag: + _in.reset(); + _value.doubleV = _in.read_double(); + break; + + case com.ericsson.otp.erlang.OtpExternal.refTag: + case com.ericsson.otp.erlang.OtpExternal.newRefTag: + _in.reset(); + com.ericsson.otp.erlang.OtpErlangRef _eref = + _in.read_ref(); + + if (_eref.isNewRef()) + _value.RefV = new Ref(_eref.node(),_eref.ids(),_eref.creation()); + else + _value.RefV = new Ref(_eref.node(),_eref.id(),_eref.creation()); + + break; + + case com.ericsson.otp.erlang.OtpExternal.portTag: + _in.reset(); + com.ericsson.otp.erlang.OtpErlangPort _eport = + _in.read_port(); + + _value.PortV = new Port(_eport.node(),_eport.id(),_eport.creation()); + break; + + case com.ericsson.otp.erlang.OtpExternal.pidTag: + _in.reset(); + com.ericsson.otp.erlang.OtpErlangPid _epid = + _in.read_pid(); + + _value.PidV = new Pid(_epid.node(),_epid.id(),_epid.serial(),_epid.creation()); + break; + + case com.ericsson.otp.erlang.OtpExternal.stringTag: + _in.reset(); + _value.stringV = _in.read_string(); + break; + + case com.ericsson.otp.erlang.OtpExternal.listTag: + case com.ericsson.otp.erlang.OtpExternal.nilTag: + case com.ericsson.otp.erlang.OtpExternal.smallTupleTag: + case com.ericsson.otp.erlang.OtpExternal.largeTupleTag: + case com.ericsson.otp.erlang.OtpExternal.binTag: + + com.ericsson.otp.erlang.OtpOutputStream _os = + new com.ericsson.otp.erlang.OtpOutputStream(); + + _obj.encode(_os); + _value.insert_Streamable(_os); + break; + + case com.ericsson.otp.erlang.OtpExternal.largeBigTag: + default: + throw new com.ericsson.otp.erlang.OtpErlangDecodeException("Uknown data type: " + tag); + } + + return _value; + } + +} + + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java new file mode 100644 index 0000000000..9c92de9523 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java @@ -0,0 +1,58 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +package com.ericsson.otp.ic; + +/** + Holder class for Term. + **/ + +final public class TermHolder { + + /** + Term instance variable. + **/ + public Term value; + + // Constructors + public TermHolder() {} + + public TermHolder(Term initial) { + value = initial; + } + + // Methods + /** + Marshal method for the TermHolder class, encodes the Term object value to the output stream. + **/ + public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) + throws java.lang.Exception { + TermHelper.marshal(out, value); + } + + /** + Unmarshal method for the TermHolder class, decodes a Term object from the output stream + and assigns it to the Holder value field. + **/ + public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) + throws java.lang.Exception { + value = TermHelper.unmarshal(in); + } + +} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java b/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java new file mode 100644 index 0000000000..6d049f75f7 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java @@ -0,0 +1,875 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +/** + * The TypeCode class for Java IDL + * + */ +package com.ericsson.otp.ic; + +/** + The TypeCode class is the implementation of the OMG-IDL TypeCode type. + **/ + +public class TypeCode { + + private TCKind _kind; + private java.lang.String _id,_name; + private int _length,_member_count,_default_index; + private TypeCode _member_type,_discriminator_type,_content_type; + private Any _member_label; + private boolean extracted; + private TypeCode _members[]; + private java.lang.String _member_names[]; + private Any _member_labels[]; + + + + /* + * Constructors + */ + public TypeCode() { + extracted = false; + _members = null; + _member_names = null; + _member_labels = null; + _kind = null; + _id = null; + _name = null; + _length = -1; + _member_count = -1; + _default_index = -1; + _member_type = null; + _content_type = null; + _discriminator_type = null; + _member_label = null; + } + + public TypeCode(TCKind __kind) { + _kind = __kind; + } + + + /* + * Operation "TypeCode::equal" + */ + + /** + Comparisson method for TypeCode. + @return true if the input TypeCode value equals the value of the current object, false otherwize + **/ + public boolean equal(TypeCode tc) { + + try { + + TCKind tck = tc.kind(); + + switch (tck.value()) { + + case TCKind._tk_short: + case TCKind._tk_long: + case TCKind._tk_longlong: + case TCKind._tk_ushort: + case TCKind._tk_ulong: + case TCKind._tk_ulonglong: + case TCKind._tk_float: + case TCKind._tk_double: + case TCKind._tk_boolean: + case TCKind._tk_char: + case TCKind._tk_wchar: + case TCKind._tk_octet: + case TCKind._tk_string: + case TCKind._tk_wstring: + case TCKind._tk_any: + case TCKind._tk_void: + case TCKind._tk_atom: + + return (tck.value() == _kind.value()); + + case TCKind._tk_struct: + + if((tc.id().compareTo(_id) == 0) && + (tc.name().compareTo(_name) == 0) && + (tc.member_count() == _member_count)){ + + for (int i = 0; i < _member_count; i++) + if (!tc.member_type(i).equal(_members[i])) + return false; + + return true; + } + else + return false; + + case TCKind._tk_union: + + if((tc.id().compareTo(_id) == 0) && + (tc.name().compareTo(_name) == 0) && + (tc.member_count() == _member_count) && + (tc.discriminator_type().equal(_discriminator_type))){ + + for (int i = 0; i < _member_count; i++) + if ((!tc.member_type(i).equal(_members[i])) && + (tc.member_name(i).compareTo(_member_names[i]) != 0)) + return false; + + return true; + } + else + return false; + + case TCKind._tk_sequence: + case TCKind._tk_array: + + if((tck.value() == _kind.value()) && + (tc.content_type().equal(_content_type))) + return true; + else + return false; + + case TCKind._tk_enum: + if((tck.value() == _kind.value()) && + (tc.member_count() == _member_count)) { + + for (int i = 0; i < _member_count; i++) + if (tc.member_name(i).compareTo(_member_names[i]) != 0) + return false; + + return true; + } + else + return false; + + // Not used in real + case TCKind._tk_null: + case TCKind._tk_TypeCode: + case TCKind._tk_Principal: + case TCKind._tk_objref: + case TCKind._tk_alias: + case TCKind._tk_except: + case TCKind._tk_longdouble: + case TCKind._tk_fixed: + + return (tck.value() == _kind.value()); + + default : + return false; + + } + } catch (Exception e) { + return false; + } + + } + + + /* + * Operation "TypeCode::kind" + */ + + /** + Accessor method for the TCKind value of TypeCode. + @return TCKind, the TCKind value of the TypeCode object. + **/ + public TCKind kind() { + return _kind; + } + + /** + Insertion method for the TCKind value of TypeCode. + Sets the TCKind value of the object. + **/ + public void kind(TCKind __kind) { + _kind = __kind; + } + + /** + Insertion method for the TCKind value of TypeCode. + Sets the TCKind value of the object. + **/ + public static TCKind kind(java.lang.String atom) + throws java.lang.Exception { + + if (atom.equals("tk_null")) + return TCKind.tk_null; + else + if (atom.equals("tk_void")) + return TCKind.tk_void; + else + if (atom.equals("tk_short")) + return TCKind.tk_short; + else + if (atom.equals("tk_long")) + return TCKind.tk_long; + else + if (atom.equals("tk_ushort")) + return TCKind.tk_ushort; + else + if (atom.equals("tk_ulong")) + return TCKind.tk_ulong; + else + if (atom.equals("tk_float")) + return TCKind.tk_float; + else + if (atom.equals("tk_double")) + return TCKind.tk_double; + else + if (atom.equals("tk_boolean")) + return TCKind.tk_boolean; + else + if (atom.equals("tk_char")) + return TCKind.tk_char; + else + if (atom.equals("tk_octet")) + return TCKind.tk_octet; + else + if (atom.equals("tk_any")) + return TCKind.tk_any; + else + if (atom.equals("tk_TypeCode")) + return TCKind.tk_TypeCode; + else + if (atom.equals("tk_Principal")) + return TCKind.tk_Principal; + else + if (atom.equals("tk_objref")) + return TCKind.tk_objref; + else + if (atom.equals("tk_struct")) + return TCKind.tk_struct; + else + if (atom.equals("tk_union")) + return TCKind.tk_union; + else + if (atom.equals("tk_enum")) + return TCKind.tk_enum; + else + if (atom.equals("tk_string")) + return TCKind.tk_string; + else + if (atom.equals("tk_sequence")) + return TCKind.tk_sequence; + else + if (atom.equals("tk_array")) + return TCKind.tk_array; + else + if (atom.equals("tk_alias")) + return TCKind.tk_alias; + else + if (atom.equals("tk_except")) + return TCKind.tk_except; + else + if (atom.equals("tk_longlong")) + return TCKind.tk_longlong; + else + if (atom.equals("tk_ulonglong")) + return TCKind.tk_ulonglong; + else + if (atom.equals("tk_longdouble")) + return TCKind.tk_longdouble; + else + if (atom.equals("tk_wchar")) + return TCKind.tk_wchar; + else + if (atom.equals("tk_wstring")) + return TCKind.tk_wstring; + else + if (atom.equals("tk_fixed")) + return TCKind.tk_fixed; + else + if (atom.equals("tk_atom")) + return TCKind.tk_atom; + else + throw new java.lang.Exception("BAD KIND"); + + } + + + + /* + * Operation "TypeCode::id" + */ + + /** + Accessor method for the id value of TypeCode. + @return String, the id value of TypeCode object + **/ + public java.lang.String id() + throws java.lang.Exception{ + + if (_id == null) + throw new java.lang.Exception("BAD KIND"); + + return _id; + } + + + /** + Insertion method for the id value of TypeCode. + Sets the id value of the object. + **/ + public void id(java.lang.String __id) { + + _id = __id; + } + + + + /* + * Operation "TypeCode::name" + */ + + /** + Accessor method for the name value of TypeCode. + @return String, the name value of TypeCode object + **/ + public java.lang.String name() + throws java.lang.Exception{ + + if (_name == null) + throw new java.lang.Exception("BAD KIND"); + + return _name; + } + + /** + Insertion method for the name value of TypeCode. + Sets the name value of the object. + **/ + public void name(java.lang.String __name) { + _name = __name; + } + + + + /* + * Operation "TypeCode::member_count" + */ + + /** + Accessor method for the member number value of TypeCode. + @return int, the number of members of TypeCode object + **/ + public int member_count() + throws java.lang.Exception{ + + if (_member_count == -1) + throw new java.lang.Exception("BAD KIND"); + + return _member_count; + } + + /** + Insertion method for the member number value of TypeCode. + Sets the number of members value of the object. + **/ + public void member_count(int __member_count) { + + switch(_kind.value()) { + case TCKind._tk_struct: + _members = new TypeCode[__member_count]; + _member_names = new java.lang.String[__member_count]; + _member_count = __member_count; + break; + case TCKind._tk_union: + _members = new TypeCode[__member_count]; + _member_names = new java.lang.String[__member_count]; + _member_labels = new Any[__member_count]; + _member_count = __member_count; + break; + case TCKind._tk_enum: + _member_names = new java.lang.String[__member_count]; + _member_count = __member_count; + break; + default : + // Do nothing + } + } + + + /* + * Operation "TypeCode::member_name" + */ + + /** + Member name accessor method for TypeCode. + @return String, the name value of the member of the TypeCode object + on the selected index + **/ + public java.lang.String member_name(int __index) + throws java.lang.Exception{ + + return _member_names[__index]; + } + + /** + Insertion method for the indexed member name of TypeCode. + Sets the name of a member value of the object at the selected index.. + **/ + public void member_name(int __index, java.lang.String __member_name) { + _member_names[__index] = __member_name; + } + + + /* + * Operation "TypeCode::member_type" + */ + + /** + Member type accessor method for TypeCode. + @return TypeCOde, the type of the member of the TypeCode object + on the selected index + **/ + public TypeCode member_type(int __index) + throws java.lang.Exception{ + + return _members[__index]; + } + + /** + Insertion method for the indexed member type of TypeCode. + Sets the type of a member value of the object at the selected index.. + **/ + public void member_type(int __index, TypeCode __member_type) { + _members[__index] = __member_type; + } + + + /* + * Operation "TypeCode::member_label" + */ + + /** + Member label accessor method for TypeCode. + @return Any, the label of the member of the TypeCode object + on the selected index + **/ + public Any member_label(int __index) + throws java.lang.Exception{ + + return _member_labels[__index]; + } + + /** + Insertion method for the indexed member label of TypeCode. + Sets the label of a member value of the object at the selected index. + **/ + public void member_label(int __index, Any __member_label) { + _member_labels[__index] = __member_label; + } + + + /* + * Operation "TypeCode::discriminator_type" + */ + + /** + Discriminator type accessor method for TypeCode. + @return TypeCode, the type of the discriminator of the TypeCode object + **/ + public TypeCode discriminator_type() + throws java.lang.Exception{ + + if (_discriminator_type == null) + throw new java.lang.Exception("BAD KIND"); + + return _discriminator_type; + } + + /** + Insertion method for the type of the discriminator value of TypeCode. + Sets the discriminator type value of the object. + **/ + public void discriminator_type(TypeCode __discriminator_type) { + _discriminator_type = __discriminator_type; + } + + + /* + * Operation "TypeCode::default_index" + */ + + /** + Index accessor method for TypeCode. + @return int, the default index value of the member of the TypeCode object + **/ + public int default_index() + throws java.lang.Exception{ + + if (_default_index == -1) + throw new java.lang.Exception("BAD KIND"); + + return _default_index; + } + + /** + Insertion method for the default index value of TypeCode. + Sets the default index value of the object. + **/ + public void default_index(int __default_index) { + _default_index = __default_index; + } + + + /* + * Operation "TypeCode::length" + */ + + /** + Length accessor method for TypeCode. + @return int, the length of the TypeCode object + **/ + public int length() + throws java.lang.Exception{ + + if (_length == -1) + throw new java.lang.Exception("BAD KIND"); + + return _length; + } + + /** + Insertion method for the length value of TypeCode. + Sets the length value of the object. + **/ + public void length(int __length) { + _length = __length; + } + + + /* + * Operation "TypeCode::content_type" + */ + + /** + Content type accessor method for TypeCode. + @return TypeCode, the content type of the TypeCode object + **/ + public TypeCode content_type() + throws java.lang.Exception { + + if (_content_type == null) + throw new java.lang.Exception("BAD KIND"); + + return _content_type; + } + + /** + Insertion method for the content type value of TypeCode. + Sets the content type value of the object. + **/ + public void content_type(TypeCode __content_type) { + _content_type = __content_type; + } + + + /** + Marshal operation for TypeCode. + **/ + public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _os, TypeCode _tc) + throws java.lang.Exception { + + TypeCode memberTC = null; + int len = -1; + + switch(_tc.kind().value()) { + + case TCKind._tk_short : + _os.write_atom("tk_short"); + break; + case TCKind._tk_ushort : + _os.write_atom("tk_ushort"); + break; + case TCKind._tk_long : + _os.write_atom("tk_long"); + break; + case TCKind._tk_longlong : + _os.write_atom("tk_longlong"); + break; + case TCKind._tk_ulong : + _os.write_atom("tk_ulong"); + break; + case TCKind._tk_ulonglong : + _os.write_atom("tk_ulonglong"); + break; + case TCKind._tk_float : + _os.write_atom("tk_float"); + break; + case TCKind._tk_double : + _os.write_atom("tk_double"); + break; + case TCKind._tk_boolean : + _os.write_atom("tk_boolean"); + break; + case TCKind._tk_char : + _os.write_atom("tk_char"); + break; + case TCKind._tk_wchar : + _os.write_atom("tk_wchar"); + break; + case TCKind._tk_octet : + _os.write_atom("tk_octet"); + break; + case TCKind._tk_string : + _os.write_tuple_head(2); + _os.write_atom("tk_string"); + _os.write_ulong(_tc.length()); + break; + case TCKind._tk_wstring : + _os.write_tuple_head(2); + _os.write_atom("tk_wstring"); + _os.write_ulong(_tc.length()); + break; + case TCKind._tk_struct: + len = _tc.member_count(); + _os.write_tuple_head(4); + _os.write_atom("tk_struct"); + _os.write_string(_tc.id()); + _os.write_string(_tc.name()); + // Member list + _os.write_list_head(len); + for(int i=0; i<len; i++) { + _os.write_tuple_head(2); + _os.write_string(_tc.member_name(i)); + marshal(_os,_tc.member_type(i)); + } + _os.write_nil(); + break; + case TCKind._tk_union: + len = _tc.member_count(); + _os.write_tuple_head(6); + _os.write_atom("tk_union"); + _os.write_string(_tc.id()); + _os.write_string(_tc.name()); + marshal(_os,_tc.discriminator_type()); + _os.write_int(_tc.default_index()); + // Member list + _os.write_list_head(len); + for(int i=0; i<len; i++) { + _os.write_tuple_head(3); + _tc.member_label(i).write_value(_os); + _os.write_string(_tc.member_name(i)); + marshal(_os,_tc.member_type(i)); + } + _os.write_nil(); + break; + case TCKind._tk_sequence: + _os.write_tuple_head(3); + _os.write_atom("tk_sequence"); + marshal(_os,_tc.content_type()); + _os.write_int(_tc.length()); + break; + case TCKind._tk_array: + _os.write_tuple_head(3); + _os.write_atom("tk_array"); + marshal(_os,_tc.content_type()); + _os.write_int(_tc.length()); + break; + case TCKind._tk_enum: + len = _tc.member_count(); + _os.write_tuple_head(4); + _os.write_atom("tk_enum"); + _os.write_string(_tc.id()); + _os.write_string(_tc.name()); + _os.write_list_head(len); + for(int i=0; i<len; i++) + _os.write_string(_tc.member_name(i)); + _os.write_nil(); + break; + case TCKind._tk_any: + _os.write_atom("tk_any"); + break; + case TCKind._tk_void : + _os.write_atom("tk_void"); + break; + /* + * Not supported types + */ + default : + throw new java.lang.Exception("Unsupported type"); + + } + + } + + + /** + Unmarshal operation for TypeCode. + @return TypeCode, the TypeCode read from the input stream. + **/ + public static TypeCode unmarshal(com.ericsson.otp.erlang.OtpInputStream _is) + throws java.lang.Exception { + + TypeCode _tc, __member; + TCKind __kind; + int __len; + int __tag = _is.peek(); + + switch(__tag) { + case (com.ericsson.otp.erlang.OtpExternal.atomTag): + __kind = TypeCode.kind(_is.read_atom()); + + switch(__kind.value()) { + case TCKind._tk_short : + case TCKind._tk_ushort : + case TCKind._tk_long : + case TCKind._tk_longlong : + case TCKind._tk_ulong : + case TCKind._tk_ulonglong : + case TCKind._tk_float : + case TCKind._tk_double : + case TCKind._tk_boolean : + case TCKind._tk_char : + case TCKind._tk_wchar : + case TCKind._tk_octet : + case TCKind._tk_void : + case TCKind._tk_any : + _tc = new TypeCode(); + _tc.kind(__kind); + + return _tc; + default : + throw new java.lang.Exception("Unsupported type"); + } + + case (com.ericsson.otp.erlang.OtpExternal.smallTupleTag): + case (com.ericsson.otp.erlang.OtpExternal.largeTupleTag): + + __len = _is.read_tuple_head(); + __tag = _is.peek(); + + switch(__tag) { + + case (com.ericsson.otp.erlang.OtpExternal.atomTag): + + __kind = TypeCode.kind(_is.read_atom()); + _tc = new TypeCode(); + _tc.kind(__kind); + + switch(__kind.value()) { + + case TCKind._tk_string : + _tc.length((int)_is.read_ulong()); + return _tc; + + case TCKind._tk_wstring : + _tc.length((int)_is.read_ulong()); + return _tc; + + case TCKind._tk_struct: + + _tc.id(_is.read_string()); + _tc.name(_is.read_string()); + __len = _is.read_list_head(); + _tc.member_count(__len); + + for(int i=0; i<__len; i++) { + _is.read_tuple_head(); + _tc.member_name(i,_is.read_string()); + _tc.member_type(i,unmarshal(_is)); + } + _is.read_nil(); + + return _tc; + + + case TCKind._tk_union: + + _tc.id(_is.read_string()); + _tc.name(_is.read_string()); + _tc.discriminator_type(unmarshal(_is)); + _tc.default_index(_is.read_int()); + __len = _is.read_list_head(); + _tc.member_count(__len); + + for(int i=0; i<__len; i++) { + _is.read_tuple_head(); + + __tag = _is.peek(); + Any __label = new Any(); + TypeCode __label_type = new TypeCode(); + + __label_type.kind(com.ericsson.otp.ic.TCKind.tk_long); + __label.type(__label_type); + + switch(__tag) { + case (com.ericsson.otp.erlang.OtpExternal.stringTag): + java.lang.String __enum = _is.read_string(); + __label.insert_string(__enum); + break; + case (com.ericsson.otp.erlang.OtpExternal.atomTag): + java.lang.String __default = _is.read_atom(); + __label.insert_atom(__default); + break; + default: + __label.insert_long(_is.read_int()); + } + + _tc.member_label(i,__label); + _tc.member_name(i,_is.read_string()); + _tc.member_type(i,unmarshal(_is)); + } + _is.read_nil(); + + return _tc; + + + case TCKind._tk_sequence: + _tc.content_type(unmarshal(_is)); + _tc.length(_is.read_int()); + return _tc; + + + case TCKind._tk_array: + _tc.content_type(unmarshal(_is)); + _tc.length(_is.read_int()); + return _tc; + + + case TCKind._tk_enum: + + _tc.id(_is.read_string()); + _tc.name(_is.read_string()); + __len = _is.read_list_head(); + _tc.member_count(__len); + + for(int i=0; i<__len; i++) + _tc.member_name(i,_is.read_string()); + + _is.read_nil(); + + return _tc; + + default: + throw new java.lang.Exception("Unsupported type"); + + } + + default: + throw new java.lang.Exception("Unsupported type"); + } + + } + + return null; + } + +} + + diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf b/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf new file mode 100644 index 0000000000..34e5586175 --- /dev/null +++ b/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf @@ -0,0 +1 @@ +Dummy to speed up compilatio diff --git a/lib/ic/prebuild.skip b/lib/ic/prebuild.skip new file mode 100644 index 0000000000..8d1ef24091 --- /dev/null +++ b/lib/ic/prebuild.skip @@ -0,0 +1 @@ +priv diff --git a/lib/ic/priv/lib/.gitignore b/lib/ic/priv/lib/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/priv/lib/.gitignore diff --git a/lib/ic/priv/obj/.gitignore b/lib/ic/priv/obj/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ic/priv/obj/.gitignore diff --git a/lib/ic/src/Makefile b/lib/ic/src/Makefile new file mode 100644 index 0000000000..5dac304e32 --- /dev/null +++ b/lib/ic/src/Makefile @@ -0,0 +1,218 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug -W +endif + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(IC_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + ic \ + ic_erlbe \ + ic_cbe \ + icscan \ + icparse \ + iceval \ + ictype \ + ictk \ + icstruct \ + icenum \ + icpreproc \ + icunion \ + ic_pp \ + ic_pragma \ + ic_noc \ + ic_plainbe \ + ic_cclient \ + ic_cserver \ + ic_fetch \ + ic_code \ + ic_codegen \ + ic_error \ + ic_file \ + ic_forms \ + ic_genobj \ + ic_options \ + ic_symtab \ + ic_util \ + ic_jbe \ + ic_struct_java \ + ic_union_java \ + ic_enum_java \ + ic_constant_java \ + ic_sequence_java \ + ic_array_java \ + ic_attribute_java \ + ic_java_type \ + ic_erl_template + + +CCL_EX_FILES = \ + ../examples/c-client/ReadMe \ + ../examples/c-client/Makefile \ + ../examples/c-client/client.c \ + ../examples/c-client/random.idl \ + ../examples/c-client/rmod_random_impl.erl \ + ../examples/c-client/test.erl + +CSRV_EX_FILES = \ + ../examples/c-server/ReadMe \ + ../examples/c-server/Makefile \ + ../examples/c-server/client.c \ + ../examples/c-server/client.erl \ + ../examples/c-server/server.c \ + ../examples/c-server/callbacks.c \ + ../examples/c-server/random.idl + +EPL_EX_FILES = \ + ../examples/erl-plain/ReadMe \ + ../examples/erl-plain/rmod_random_impl.erl \ + ../examples/erl-plain/random.idl + + +ESRV_EX_FILES = \ + ../examples/erl-genserv/ReadMe \ + ../examples/erl-genserv/rmod_random_impl.erl \ + ../examples/erl-genserv/random.idl + +JAVA_EX_FILES = \ + ../examples/java-client-server/ReadMe \ + ../examples/java-client-server/client.java \ + ../examples/java-client-server/server.java \ + ../examples/java-client-server/serverImpl.java \ + ../examples/java-client-server/random.idl + +MIXED_EX_FILES = \ + ../examples/all-against-all/ReadMe \ + ../examples/all-against-all/Makefile \ + ../examples/all-against-all/client.erl \ + ../examples/all-against-all/server.erl \ + ../examples/all-against-all/client.c \ + ../examples/all-against-all/server.c \ + ../examples/all-against-all/callbacks.c \ + ../examples/all-against-all/client.java \ + ../examples/all-against-all/server.java \ + ../examples/all-against-all/serverImpl.java \ + ../examples/all-against-all/random.idl + + +EXTERNAL_HRL_FILES= + +INTERNAL_HRL_FILES = \ + ic.hrl \ + ic_debug.hrl \ + icforms.hrl + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +YRL_FILE = icparse.yrl + +GEN_FILES = icparse.erl + +APP_FILE = ic.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_LOCAL_FLAGS += -pa ../../ic/ebin +# The -pa option is just used temporary until erlc can handle +# includes from other directories than ../include . +ERL_COMPILE_FLAGS += \ + $(ERL_LOCAL_FLAGS) \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,"ic_$(VSN)"}' \ + -D'COMPILERVSN="$(VSN)"' +YRL_FLAGS = -Iicyeccpre.hrl + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +debug: + @${MAKE} TYPE=debug opt + +opt: $(TARGET_FILES) $(APP_TARGET) + +clean: + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) + rm -f errs core *~ + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- +../ebin/icparse.beam: icparse.erl + $(ERLC) $(ERL_COMPILE_FLAGS) +nowarn_unused_vars +nowarn_unused_function -o$(EBIN) +pj $< + +icparse.erl: icparse.yrl icyeccpre.hrl + +### $(ERLC) $(YRL_FLAGS) $< + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/examples + $(INSTALL_DIR) $(RELSYSDIR)/examples/c-client + $(INSTALL_DATA) $(CCL_EX_FILES) $(RELSYSDIR)/examples/c-client + $(INSTALL_DIR) $(RELSYSDIR)/examples/c-server + $(INSTALL_DATA) $(CSRV_EX_FILES) $(RELSYSDIR)/examples/c-server + $(INSTALL_DIR) $(RELSYSDIR)/examples/erl-plain + $(INSTALL_DATA) $(EPL_EX_FILES) $(RELSYSDIR)/examples/erl-plain + $(INSTALL_DIR) $(RELSYSDIR)/examples/erl-genserv + $(INSTALL_DATA) $(ESRV_EX_FILES) $(RELSYSDIR)/examples/erl-genserv + $(INSTALL_DIR) $(RELSYSDIR)/examples/java-client-server + $(INSTALL_DATA) $(JAVA_EX_FILES) $(RELSYSDIR)/examples/java-client-server + $(INSTALL_DIR) $(RELSYSDIR)/examples/all-against-all + $(INSTALL_DATA) $(MIXED_EX_FILES) $(RELSYSDIR)/examples/all-against-all + +release_docs_spec: + diff --git a/lib/ic/src/ic.app.src b/lib/ic/src/ic.app.src new file mode 100644 index 0000000000..29aa6def00 --- /dev/null +++ b/lib/ic/src/ic.app.src @@ -0,0 +1,52 @@ +{application, ic, + [{description, "The IDL Compiler"}, + {vsn, "%VSN%"}, + {modules, + [ + ic, + ic_cclient, + ic_cbe, + ic_cserver, + ic_erlbe, + ic_fetch, + ic_noc, + ic_plainbe, + ic_pp, + ic_pragma, + icenum, + iceval, + icparse, + icpreproc, + icscan, + icstruct, + ictk, + ictype, + ic_array_java, + ic_attribute_java, + ic_code, + ic_codegen, + ic_constant_java, + ic_enum_java, + ic_error, + ic_file, + ic_forms, + ic_genobj, + ic_java_type, + ic_jbe, + ic_options, + ic_sequence_java, + ic_struct_java, + ic_symtab, + ic_union_java, + ic_util, + icunion, + ic_erl_template + ] + }, + {registered, []}, + {applications, [stdlib, kernel]}, + {env, []}, + {mod, {ic, []}} +]}. + + diff --git a/lib/ic/src/ic.erl b/lib/ic/src/ic.erl new file mode 100644 index 0000000000..3c6ce3d9d6 --- /dev/null +++ b/lib/ic/src/ic.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic). + + +-export([sgen/1, gen/1, gen/2, help/0, compile/3]). + + +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-export([filter_params/2, handle_preproc/4, do_gen/4]). + +-import(lists, [foldr/3]). + + +-include("icforms.hrl"). +-include("ic.hrl"). + +-include_lib("stdlib/include/erl_compile.hrl"). + +-export([make_erl_options/1]). % For erlc + +-export([main/3, do_scan/1, do_parse/2, do_type/2]). + + +%%------------------------------------------------------------ +%% +%% Entry point +%% +%%------------------------------------------------------------ + +%% compile(AbsFileName, Outfile, Options) +%% Compile entry point for erl_compile. + +compile(File, _OutFile, Options) -> + case gen(File, make_erl_options(Options)) of + ok -> ok; + Other -> Other + end. + + +%% Entry for the -s switch +sgen(ArgList) -> +%%% io:format("sgen called w ~p~n", [ArgList]), + apply(?MODULE, gen, ArgList). + + +gen(File) -> + gen(File, []). + +gen(File, Opts) -> + G = ic_genobj:new(Opts), + IdlFile = ic_file:add_dot_idl(File), + case ic_options:get_opt(G, show_opts) of + true -> + io:format("Opts: ~p~n", [ic_options:which_opts(G)]); + _ -> ok + end, + ic_genobj:set_idlfile(G, IdlFile), + case catch gen2(G, File, Opts) of + {_, {'EXIT', R}} -> + ic_genobj:free_table_space(G), %% Free space for all ETS tables + io:format("Fatal error : ~p~n",[R]), + error; + {_, {'EXIT', _, R}} -> + ic_genobj:free_table_space(G), %% Free space for all ETS tables + io:format("Fatal error : ~p~n",[R]), + error; + {'EXIT', R} -> + ic_genobj:free_table_space(G), %% Free space for all ETS tables + io:format("Fatal error : ~p~n",[R]), + error; + {'EXIT', _, R} -> + ic_genobj:free_table_space(G), %% Free space for all ETS tables + io:format("Fatal error : ~p~n",[R]), + error; + %% In this case, the pragma registration + %% found errors so this should return error. + error -> + ic_genobj:free_table_space(G), %% Free space for all ETS tables + error; + _ -> + X = ic_error:return(G), + ic_genobj:free_table_space(G), %% Free space for all ETS tables + X + end. + + +gen2(G, File, Opts) -> + case ic_options:get_opt(G, time) of + true -> + time("TOTAL ", ic, main, [G, File, Opts]); + _ -> + case main(G, File, Opts) of + error -> + error; + _ -> + ok + end + end. + + + +do_gen(erl_corba, G, File, T) -> + ic_erlbe:do_gen(G, File, T); +do_gen(erl_template, G, File, T) -> + ic_erl_template:do_gen(G, File, T); +do_gen(erl_genserv, G, File, T) -> + ic_erlbe:do_gen(G, File, T); +do_gen(c_genserv, G, File, T) -> + ic_cclient:do_gen(G, File, T); +do_gen(noc, G, File, T) -> + ic_noc:do_gen(G, File, T); +do_gen(erl_plain, G, File, T) -> + ic_plainbe:do_gen(G, File, T); +do_gen(c_server, G, File, T) -> + ic_cserver:do_gen(G, File, T); +do_gen(c_client, G, File, T) -> + ic_cclient:do_gen(G, File, T); +%% Java backend +do_gen(java, G, File, T) -> + ic_jbe:do_gen(G, File, T); +%% No language choice +do_gen(_,_,_,_) -> + ok. + +do_scan(G) -> + icscan:scan(G, ic_genobj:idlfile(G)). + + +do_parse(G, Tokens) -> + case icparse:parse(Tokens) of + {ok, L} -> L; + X when element(1, X) == error -> + Err = element(2, X), + ic_error:fatal_error(G, {parse_error, element(1, Err), + element(3, Err)}); + X -> exit(X) + end. + + +do_type(G, Form) -> + ictype:type_check(G, Form). + +time(STR,M,F,A) -> + case timer:tc(M, F, A) of + {_, {'EXIT', R}} -> exit(R); + {_, {'EXIT', _, R}} -> exit(R); + {_, _X} when element(1, _X)==error -> throw(_X); + {_T, _R} -> + io:format("Time for ~s: ~10.2f~n", [STR, _T/1000000]), + _R + end. + + + +%% Filters parameters so that only those with certain attributes are +%% seen. The filter parameter is a list of attributes that will be +%% seen, ex. [in] or [inout, out] +filter_params(Filter, Params) -> + lists:filter(fun(P) -> + lists:member(get_param_attr(P#param.inout), Filter) end, + Params). + + +%% Access primitive to get the attribute name (and discard the line +%% number). +get_param_attr({A, _N}) -> A. + + +%% +%% Fixing the preproc directives +%% +handle_preproc(G, _N, line_nr, X) -> + Id = ic_forms:get_id2(X), + Flags = X#preproc.aux, + case Flags of + [] -> ic_genobj:push_file(G, Id); + _ -> + foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id); + ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); + ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, + G, Flags) + end; +handle_preproc(G, _N, _Other, _X) -> + G. + + + +%%------------------------------------------------------------ +%% +%% The help department +%% +%% +%% +%%------------------------------------------------------------ + +help() -> + io:format("No help available at the moment~n", []), + ok. + +print_version_str(G) -> + case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of + {true, _} -> ok; + {_, true} -> ok; + _ -> + io:format("Erlang IDL compiler version ~s~n", [?COMPILERVSN]) + end. + + + +%% +%% Converts generic compiler options to specific options. +%% +%% Used by erlc +%% + +make_erl_options(Opts) -> + + %% This way of extracting will work even if the record passed + %% has more fields than known during compilation. + + Includes1 = Opts#options.includes, + Defines = Opts#options.defines, + Outdir = Opts#options.outdir, + Warning = Opts#options.warning, + Verbose = Opts#options.verbose, + Specific = Opts#options.specific, + Optimize = Opts#options.optimize, + PreProc = + lists:flatten( + lists:map(fun(D) -> io_lib:format("-I~s ", [ic_util:to_list(D)]) end, + Includes1)++ + lists:map( + fun ({Name, Value}) -> + io_lib:format("-D~s=~s ", [ic_util:to_list(Name), ic_util:to_list(Value)]); + (Name) -> + io_lib:format("-D~s ", [ic_util:to_list(Name)]) + end, + Defines)), + Options = + case Verbose of + true -> []; + false -> [] + end ++ + case Warning of + 0 -> [nowarn]; + _ -> ['Wall'] + end ++ + case Optimize of + 0 -> []; + _ -> [] + end, + + Options++[{outdir, Outdir}, {preproc_flags, PreProc}]++Specific. + + +%%% +%%% NEW main, avoids memory fragmentation +%%% +main(G, File, _Opts) -> + print_version_str(G), + ?ifopt(G, time, io:format("File ~p compilation started : ~p/~p/~p ~p:~2.2.0p~n", + [ic_genobj:idlfile(G), + element(1,date()), + element(2, date()), + element(3, date()), + element(1, time()), + element(2, time())])), + + case ic_options:get_opt(G, help) of + true -> help(); + + _ -> + scanning(G, File) + end. + + + +scanning(G, File) -> + S = ?ifopt2(G, time, + time("input file scanning ", ic, do_scan, [G]), + ic:do_scan(G)), + ?ifopt2(G, tokens, io:format("TOKENS: ~p~n", [S]), + parsing(G, File, S)). + +parsing(G, File, S) -> + T = ?ifopt2(G, + time, + time("input file parsing ", ic, do_parse, [G,S]), + ic:do_parse(G,S)), + ?ifopt2(G, form, io:format("PARSE FORM: ~p~n", [T]), + pragma(G, File, T)). + + + +pragma(G, File, T) -> + case ?ifopt2(G, + time, + time("pragma registration ", ic_pragma, pragma_reg, [G,T]), + ic_pragma:pragma_reg(G,T)) of + %% All pragmas were succesfully applied + {ok,Clean} -> + typing(G, File, Clean); + + error -> + error + end. + + +typing(G, File, Clean) -> + case catch ?ifopt2(G, + time, + time("type code appliance ", ic, do_type, [G,Clean]), + ic:do_type(G,Clean)) of + {'EXIT',Reason} -> + io:format("Error under type appliance : ~p~n",[Reason]), + error; + + T2 -> + ?ifopt2(G, tform, io:format("TYPE FORM: ~p~n", [T2]), + generation(G, File, T2)) + end. + + + +generation(G, File, T2) -> + case ic_options:get_opt(G, multiple_be) of + false -> + single_generation(G, File, T2); + List -> + OutDir = + case ic_options:get_opt(G, outdir) of + false -> + []; + Dir -> + Dir + end, + + case ic_options:get_opt(G, be) of + false -> + ok; + Be -> + %% Generate this first + ic_options:add_opt(G,[{outdir,OutDir++atom_to_list(Be)}],true), + single_generation(G, File, T2) + end, + multiple_generation(G, File, T2, OutDir, List) + end. + +multiple_generation(_G, _File, _T2, _RootDir, []) -> + ok; +multiple_generation(G, File, T2, RootDir, [Be|Bes]) -> + ic_options:add_opt(G,[{outdir,RootDir++atom_to_list(Be)}],true), + ic_options:add_opt(G,[{be,Be}],true), + single_generation(G, File, T2), + + case ic_error:get_error_count(G) of + 0 -> + multiple_generation(G,File,T2,RootDir,Bes); + _ -> + %% Errors reported, abort + ok + end. + + +single_generation(G, File, T2) -> + case ic_error:get_error_count(G) of + 0 -> + %% Check if user has sett backend option + case ic_options:get_opt(G, be) of + false -> + %% Use default backend option + DefaultBe = ic_options:defaultBe(), + ic_options:add_opt(G,[{be,DefaultBe}],true), + + ?ifopt2(G, + time, + time("code generation ", ic, do_gen, [DefaultBe, G, File, T2]), + ic:do_gen(DefaultBe, G, File, T2)); + Be -> + %% Use user defined backend + ?ifopt2(G, + time, + time("code generation ", ic, do_gen, [Be, G, File, T2]), + ic:do_gen(Be, G, File, T2)) + end; + _ -> + ok %% Does not matter + end. + + + diff --git a/lib/ic/src/ic.hrl b/lib/ic/src/ic.hrl new file mode 100644 index 0000000000..974e6088f4 --- /dev/null +++ b/lib/ic/src/ic.hrl @@ -0,0 +1,158 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + + +%%------------------------------------------------------------ +%% Configuration macros +-define(CORBAMOD, corba). +-define(ORBNAME, orber). +-define(CORBAHRL, "corba.hrl"). +-define(CALL, "call"). +-define(CAST, "cast"). +-define(IFRREGID, "register"). +-define(IFRTYPESHRL, "ifr_types.hrl"). + +-define(GENSERVMOD, gen_server). + +%%------------------------------------------------------------ +%% Flags. NOTE! Once assigned value may NOT be changed. Deprecate ok. +%% Default flags. Can be changed if we change the default behavior. +-define(IC_FLAG_TEMPLATE_1, 16#01). +-define(IC_FLAG_TEMPLATE_2, 16#02). + +-define(IC_INIT_FLAGS, 16#00). + +%% Flag operations +%% USAGE: Boolean = ?IC_FLAG_TEST(Flags, ?IC_ATTRIBUTE) +-define(IC_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)). + +%% USAGE: NewFlags = ?IC_SET_TRUE(Flags, ?IC_ATTRIBUTE) +-define(IC_SET_TRUE(_F2, _I2), (_I2 bor _F2)). + +%% USAGE: NewFlags = ?IC_SET_FALSE(Flags, ?IC_ATTRIBUTE) +-define(IC_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)). + +%% USAGE: NewFlags = ?IC_SET_FALSE_LIST(Flags, [?IC_SEC_ATTRIBUTE, ?IC_SOME]) +-define(IC_SET_FALSE_LIST(_F4, _IList1), + lists:foldl(fun(_I4, _F5) -> + ((_I4 bxor 16#ff) band _F5) + end, + _F4, _IList1)). + +%% USAGE: NewFlags = ?IC_SET_TRUE_LIST(Flags, [?IC_ATTRIBUTE, ?IC_SOME]) +-define(IC_SET_TRUE_LIST(_F6, _IList2), + lists:foldl(fun(_I6, _F7) -> + (_I6 bor _F7) + end, + _F6, _IList2)). + +%% USAGE: Boolean = ?IC_FLAG_TEST_LIST(Flags, [?IC_CONTEXT, ?IC_THING]) +-define(IC_FLAG_TEST_LIST(_F8, _IList3), + lists:all(fun(_I7) -> + ((_F8 band _I7) == _I7) + end, + _IList3)). + + +%%------------------------------------------------------------ +%% Usefull macros + +-define(ifthen(P,ACTION), if P -> ACTION; true->true end). + + +%%------------------------------------------------------------ +%% Option macros + +-define(ifopt(G,OPT,ACTION), + case ic_options:get_opt(G,OPT) of true -> ACTION; _ -> ok end). + +-define(ifopt2(G,OPT,ACT1,ACT2), + case ic_options:get_opt(G,OPT) of true -> ACT1; _ -> ACT2 end). + +-define(ifnopt(G,OPT,ACTION), + case ic_options:get_opt(G,OPT) of false -> ACTION; _ -> ok end). + + +%% Internal record +-record(id_of, {id, type, tk}). + +%%-------------------------------------------------------------------- +%% The generator object definition + +-record(genobj, {symtab, impl, options, warnings, auxtab, + tktab, pragmatab, c_typedeftab, + skelfile=[], skelfiled=[], skelscope=[], + stubfile=[], stubfiled=[], stubscope=[], + includefile=[], includefiled=[], + interfacefile=[],interfacefiled=[], + helperfile=[],helperfiled=[], + holderfile=[],holderfiled=[], + filestack=0, do_gen=true, sysfile=false}). + +%%-------------------------------------------------------------------- +%% The scooped id definition +-record(scoped_id, {type=local, line=-1, id=""}). + + + + + + + + +%%-------------------------------------------------------------------- +%% Secret macros +%% +%% NOTE these macros are not general, they cannot be used +%% everywhere. +%% +-define(lookup(T,K), case ets:lookup(T, K) of [{_X, _Y}] -> _Y; _->[] end). +-define(insert(T,K,V), ets:insert(T, {K, V})). + + +%%--------------------------------------------------------------------- +%% +%% Java specific macros +%% +%% +-define(ERLANGPACKAGE,"com.ericsson.otp.erlang."). +-define(ICPACKAGE,"com.ericsson.otp.ic."). + + +%% +%% Macros for reporting encode/decode errors in C back-ends. +%% +%% + +-define(emit_c_enc_rpt(Fd, Fill, Fmt, Vals), + begin + CType = ic_cbe:mk_c_type2(G, N, T), + ic_codegen:emit_c_enc_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) + end). +-define(emit_c_dec_rpt(Fd, Fill, Fmt, Vals), + begin + CType = ic_cbe:mk_c_type2(G, N, T), + ic_codegen:emit_c_dec_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) + end). + + + + + diff --git a/lib/ic/src/ic_array_java.erl b/lib/ic/src/ic_array_java.erl new file mode 100644 index 0000000000..e21d646bf5 --- /dev/null +++ b/lib/ic/src/ic_array_java.erl @@ -0,0 +1,295 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_array_java). + +-export([gen/4]). + +-include("ic.hrl"). +-include("icforms.hrl"). + + +gen(G, N, X, Array) when is_record(X, member) -> + ArrayName = ic_forms:get_java_id(Array), + ArrayElement = ic_forms:get_type(X), + emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), + emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); +gen(G, N, X, Array) when is_record(X, case_dcl) -> + ArrayName = ic_forms:get_java_id(Array), + ArrayElement = ic_forms:get_type(X), + emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), + emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); +gen(G, N, X, Array) -> + ArrayName = ic_forms:get_java_id(Array), + ArrayElement = ic_forms:get_body(X), + emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), + emit_helper_class(G, N, X, Array, ArrayName, ArrayElement). + + + +%%----------------------------------------------------------------- +%% Func: emit_holder_class/4 +%%----------------------------------------------------------------- +emit_holder_class(G, N, _X, Array, ArrayName, ArrayElement) -> + SName = string:concat(ArrayName, "Holder"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + ArrayElementName = ic_java_type:getType(G, N, ArrayElement), + EmptyDim = arrayEmptyDim(Array), + + ic_codegen:emit(Fd, "final public class ~sHolder {\n",[ArrayName]), + + ic_codegen:emit(Fd, " // instance variables\n", []), + ic_codegen:emit(Fd, " public ~s~s value;\n\n", + [ArrayElementName,EmptyDim]), + + ic_codegen:emit(Fd, " // constructors\n", []), + ic_codegen:emit(Fd, " public ~sHolder() {}\n", [ArrayName]), + ic_codegen:emit(Fd, " public ~sHolder(~s~s initial) {\n", + [ArrayName,ArrayElementName,EmptyDim]), + ic_codegen:emit(Fd, " value = initial;\n", []), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, " // methods\n", []), + + ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out)\n", [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [ArrayName]), + ic_codegen:emit(Fd, " }\n"), + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in)\n", [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [ArrayName]), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, "}\n", []), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_helper_class/4 +%%----------------------------------------------------------------- +emit_helper_class(G, N, X, Array, ArrayName, ArrayElement) -> + SName = string:concat(ArrayName, "Helper"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + ArrayElementName = ic_java_type:getType(G, N, ArrayElement), + EmptyDim = arrayEmptyDim(Array), +% Dim = arrayDim(G,N,Array), + + ic_codegen:emit(Fd, "public class ~sHelper {\n",[ArrayName]), + + ic_codegen:emit(Fd, " // constructors\n"), + ic_codegen:emit(Fd, " private ~sHelper() {}\n\n", [ArrayName]), + + ic_codegen:emit(Fd, " // methods\n"), + + ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s~s _value)\n", + [?ERLANGPACKAGE,ArrayElementName,EmptyDim]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + emit_array_marshal_loop(G,N,X,Array,ArrayElement,Fd), + ic_codegen:emit(Fd, " }\n"), + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, " public static ~s~s unmarshal(~sOtpInputStream _in)\n", + [ArrayElementName,EmptyDim,?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + ic_codegen:emit(Fd, " ~s~s _value = new ~s;\n\n", + [ArrayElementName,EmptyDim,ic_java_type:getFullType(G, N, X, Array)]), + emit_array_unmarshal_loop(G,N,X,Array,ArrayElement,Fd), + ic_codegen:emit(Fd, " return _value;\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static String id() {\n", []), + ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, Array)]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static String name() {\n", []), + ic_codegen:emit(Fd, " return ~p;\n",[ArrayName]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_jbe:emit_type_function(G, N, X, Fd), + + ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s~s _this)\n", + [?ICPACKAGE,ArrayElementName,EmptyDim]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), + + ic_codegen:emit(Fd, " _any.type(type());\n"), + ic_codegen:emit(Fd, " marshal(_os, _this);\n"), + ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static ~s~s extract(~sAny _any)\n", + [ArrayElementName,EmptyDim,?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, "}\n"), + file:close(Fd). + + + + +emit_array_marshal_loop(G,N,X,Array,AEl,Fd) -> + DimList = mk_array_dim_list(G,N,Array), + emit_array_marshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd). + + +emit_array_marshal_loop_1(G,N,X,Array,AEl,[D],C,Fd) -> + + DimList = mk_array_dim_list(G,N,Array), + + ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), + + ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++)\n",[C,C,D,C]), + + case ic_java_type:isBasicType(G, N, AEl) of + true -> + ic_codegen:emit(Fd, " _out~s(_value", + [ic_java_type:marshalFun(G, N, X, AEl)]); + false -> + ic_codegen:emit(Fd, " ~s(_out, _value", + [ic_java_type:marshalFun(G, N, X, AEl)]) + end, + + emit_array_dimensions(DimList,0,Fd), + + ic_codegen:emit(Fd, ");\n\n"); + +emit_array_marshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> +% DimList = mk_array_dim_list(G,N,Array), + + ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), + + ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n",[C,C,D,C]), + + emit_array_marshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), + + ic_codegen:emit(Fd, " }\n\n"). + + + + + +emit_array_unmarshal_loop(G,N,X,Array,AEl,Fd) -> + DimList = mk_array_dim_list(G,N,Array), + case length(DimList) > 0 of + true -> + ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), + + ic_codegen:emit(Fd, " for(int _tmp0 = 0; _tmp0 < ~s; _tmp0++) {\n\n",[hd(DimList)]), + emit_array_unmarshal_loop_1(G,N,X,Array,AEl,tl(DimList),1,Fd), + ic_codegen:emit(Fd, " }\n\n"); + false -> + emit_array_unmarshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd) + end. + +emit_array_unmarshal_loop_1(G,N,X,_Array,AEl,[],1,Fd) -> %% One dimensional array + case ic_java_type:isBasicType(G, N, AEl) of + true -> + ic_codegen:emit(Fd, " _value[_tmp0] = _in~s;\n", + [ic_java_type:unMarshalFun(G, N, X, AEl)]); + false -> + ic_codegen:emit(Fd, " _value[_tmp0] = ~s.unmarshal(_in);\n\n", + [ic_java_type:getUnmarshalType(G, N, X, AEl)]) + end; +emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[],_C,Fd) -> + DimList = mk_array_dim_list(G,N,Array), + ic_codegen:emit(Fd, " _value"), + emit_array_dimensions(DimList,0,Fd), + case ic_java_type:isBasicType(G,N,AEl) of + true -> + ic_codegen:emit(Fd, " = _in~s;\n", + [ic_java_type:unMarshalFun(G, N, X, AEl)]); + false -> + ic_codegen:emit(Fd, " = ~s.unmarshal(_in);\n", + [ic_java_type:getUnmarshalType(G, N, X, AEl)]) + end; +emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> + ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), + + ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n\n",[C,C,D,C]), + emit_array_unmarshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), + ic_codegen:emit(Fd, " }\n"). + + + + + +%%--------------------------------------------------- +%% Utilities +%%--------------------------------------------------- + +mk_array_dim_list(G,N,Array) -> + mk_array_dim_list2(G,N,Array#array.size). + + +mk_array_dim_list2(_G,_N,[]) -> + []; + +mk_array_dim_list2(G,N,[D |Ds]) when is_record(D,scoped_id) -> + {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), + [ ic_util:to_dot(G,FSN) | mk_array_dim_list2(G,N,Ds)]; + +mk_array_dim_list2(G,N,[D |Ds]) -> + [ic_util:eval_java(G,N,D) | mk_array_dim_list2(G,N,Ds)]. + + + +%% Array dimension string +%arrayDim(G,N,X) -> +% arrayDim2(G,N,X#array.size). + +%arrayDim2(_G,_N,[]) -> +% ""; +%arrayDim2(G,N,[D|Ds]) when record(D,scoped_id) -> +% {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), +% "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ arrayDim2(G,N,Ds); +%arrayDim2(G,N,[D|Ds]) -> +% "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ arrayDim2(G,N,Ds). + + +%% Array Empty dimension string +arrayEmptyDim(X) -> + arrayEmptyDim2(X#array.size). + +arrayEmptyDim2([_D]) -> + "[]"; +arrayEmptyDim2([_D |Ds]) -> + "[]" ++ arrayEmptyDim2(Ds). + + +emit_array_dimensions([_D],C,Fd) -> + ic_codegen:emit(Fd, "[_tmp~p]",[C]); +emit_array_dimensions([_D|Ds],C,Fd) -> + ic_codegen:emit(Fd, "[_tmp~p]",[C]), + emit_array_dimensions(Ds,C+1,Fd). + + + + + + diff --git a/lib/ic/src/ic_attribute_java.erl b/lib/ic/src/ic_attribute_java.erl new file mode 100644 index 0000000000..6352dcf608 --- /dev/null +++ b/lib/ic/src/ic_attribute_java.erl @@ -0,0 +1,412 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_attribute_java). + +-include("icforms.hrl"). +-include("ic.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([emit_attribute_prototype/4, + emit_attribute_stub_code/4, + emit_atrribute_on_dictionary/5, + emit_attribute_switch_case/5]). + + + + + +%%%----------------------------------------------------- +%%% +%%% Generates operation in interface +%%% +%%%----------------------------------------------------- +emit_attribute_prototype(G, N, X, Fd) -> + emit_attribute_prototype(G, N, X, Fd, ic_forms:get_idlist(X)). + +emit_attribute_prototype(_G, _N, _X, _Fd, []) -> + ok; +emit_attribute_prototype(G, N, X, Fd, [V|Vs]) -> + WireAttrName = ic_forms:get_id(V), + AttrName = ic_forms:get_java_id(WireAttrName), + emit_attr_prototype(G, N, X, Fd, AttrName,WireAttrName), + emit_attribute_prototype(G, N, X, Fd, Vs). + + +emit_attr_prototype(G, N, X, Fd, OpName, WireOpName) -> + + ic_codegen:emit(Fd, "/****\n"), + ic_codegen:emit(Fd, " * Attribute ~p interface functions \n", [ic_util:to_colon([WireOpName|N])]), + ic_codegen:emit(Fd, " *\n"), + ic_codegen:emit(Fd, " */\n\n"), + + AT = ic_forms:get_type(X), + Type = ic_java_type:getType(G, N, AT), +% HolderType = ic_java_type:getHolderType(G, N, AT), + + ic_codegen:emit(Fd, " ~s ~s() throws java.lang.Exception;\n\n",[Type, OpName]), + + case X#attr.readonly of + {readonly, _} -> + ok; + _ -> + ic_codegen:emit(Fd, " void ~s(~s _value) throws java.lang.Exception;\n\n",[OpName, Type]) + end. + + + +%%%----------------------------------------------------- +%%% +%%% Generates attribute insertion in dictionary +%%% +%%%----------------------------------------------------- +emit_atrribute_on_dictionary(G, N, X, Fd, C) -> + emit_atrribute_on_dictionary(G, N, X, Fd, C, ic_forms:get_idlist(X)). + +emit_atrribute_on_dictionary(_G, _N, _X, _Fd, C, []) -> + C; +emit_atrribute_on_dictionary(G, N, X, Fd, C, [V|Vs]) -> + + WireAttrName = ic_forms:get_id(V), + + ic_codegen:emit(Fd, " _operations.put(\"_get_~s\", new java.lang.Integer(~p));\n", + [WireAttrName,C]), + + case X#attr.readonly of + {readonly, _} -> + + emit_atrribute_on_dictionary(G, N, X, Fd, C+1, Vs); + + _ -> + + ic_codegen:emit(Fd, " _operations.put(\"_set_~s\", new java.lang.Integer(~p));\n", + [WireAttrName,C+1]), + + emit_atrribute_on_dictionary(G, N, X, Fd, C+2, Vs) + end. + + + +%%%----------------------------------------------------- +%%% +%%% Generates attribute case in server switch +%%% +%%%----------------------------------------------------- +emit_attribute_switch_case(G, N, X, Fd, C) -> + Tk = ic_forms:get_tk(X), + emit_attribute_switch_case(G, N, X, Fd, Tk, C, ic_forms:get_idlist(X)). + +emit_attribute_switch_case(_G, _N, _X, _Fd, _Tk, C, []) -> + C; +emit_attribute_switch_case(G, N, X, Fd, Tk, C, [V|Vs]) -> + AttrName = ic_forms:get_java_id(V), + + emit_attribute_switch_case1(G,N,X,Fd,"_get_",AttrName,Tk,C), + + case X#attr.readonly of + {readonly, _} -> + emit_attribute_switch_case(G, N, X, Fd, Tk, C+1, Vs); + + _ -> + emit_attribute_switch_case1(G,N,X,Fd,"_set_",AttrName,Tk,C+1), + emit_attribute_switch_case(G, N, X, Fd, Tk, C+2, Vs) + end. + + +emit_attribute_switch_case1(G, N, X, Fd, "_get_", Name, _Tk, C) -> + + R = ic_forms:get_type(X), + RT = ic_java_type:getParamType(G,N,R,ret), + + ic_codegen:emit(Fd, " case ~p: { // Get operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), + + ic_codegen:emit(Fd, " // Calling implementation function\n"), + ic_codegen:emit(Fd, " ~s _result = this.~s();\n\n", [RT, Name]), + + ic_codegen:emit(Fd, " // Marshalling output\n"), + ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), + + case ic_java_type:isBasicType(G,N,R) of + true -> + ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", + [ic_java_type:marshalFun(G,N,X,R)]); + false -> + ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", + [ic_java_type:marshalFun(G,N,X,R)]) + end, + + ic_codegen:emit(Fd, " } break;\n\n"); + + +emit_attribute_switch_case1(G, N, X, Fd, "_set_", Name, _Tk, C) -> + ic_codegen:emit(Fd, " case ~p: { // Set operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), + + Type = ic_forms:get_type(X), + + ic_codegen:emit(Fd, " // Preparing input\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n",[?ERLANGPACKAGE]), + + case ic_java_type:isBasicType(G,N,Type) of + true -> + ic_codegen:emit(Fd, " ~s _value = __is~s; // In value\n\n", + [ic_java_type:getParamType(G,N,Type,in), + ic_java_type:unMarshalFun(G,N,X,Type)]); + false -> + ic_codegen:emit(Fd, " ~s _value = ~s.unmarshal(__is); // In value\n\n", + [ic_java_type:getParamType(G,N,Type,in), + ic_java_type:getUnmarshalType(G,N,X,Type)]) + end, + + + ic_codegen:emit(Fd, " // Calling implementation function\n"), + ic_codegen:emit(Fd, " this.~s(_value);\n\n", [Name]), + + ic_codegen:emit(Fd, " // Marshalling output\n"), + ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n"), + + ic_codegen:emit(Fd, " } break;\n\n"). + + + + + + + +%%%----------------------------------------------------- +%%% +%%% Generates attribute function in stub +%%% +%%%----------------------------------------------------- +emit_attribute_stub_code(G, N, X, Fd) -> + emit_attribute_stub_code(G, N, X, Fd, ic_forms:get_idlist(X)). + +emit_attribute_stub_code(_G, _N, _X, _Fd, []) -> + ok; +emit_attribute_stub_code(G, N, X, Fd, [V|Vs]) -> + WireAttrName = ic_forms:get_id(V), + AttrName = ic_forms:get_java_id(WireAttrName), + + emit_attribute_stub_code1(G,N,X,Fd,"_get_",AttrName,WireAttrName), + + case X#attr.readonly of + {readonly, _} -> + emit_attribute_stub_code(G, N, X, Fd, Vs); + + _ -> + emit_attribute_stub_code1(G,N,X,Fd,"_set_",AttrName,WireAttrName), + emit_attribute_stub_code(G, N, X, Fd, Vs) + end. + + +emit_attribute_stub_code1(G,N,X,Fd,"_get_",Name,WireName) -> + + Type = ic_forms:get_type(X), + RT = ic_java_type:getType(G,N,Type), + + %% + %% Main get operation + %% + ic_codegen:emit(Fd, " // Attribute ~p get operation implementation\n", [ic_util:to_colon([WireName|N])]), + ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n\n", [RT, Name]), + + %% Function marshal call + ic_codegen:emit(Fd, " // Calling the marshal function\n"), + ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n", [Name]), + + %% Sending call + ic_codegen:emit(Fd, " // Message send\n"), + ic_codegen:emit(Fd, " _env.send();\n\n"), + + %% Receiving return value + ic_codegen:emit(Fd, " // Message receive\n"), + ic_codegen:emit(Fd, " _env.receive();\n\n"), + + ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), + ic_codegen:emit(Fd, " return _~s_get_unmarshal(_env);\n", [Name]), + ic_codegen:emit(Fd, " }\n\n"), + + + %% + %% Marshal get operation + %% + ic_codegen:emit(Fd, " // Marshal operation for get attribute ~p\n", [Name]), + ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", + [Name, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Get output stream\n"), + ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), + + %% Initiating Message header + ic_codegen:emit(Fd, " // Message header assembly\n"), + ic_codegen:emit(Fd, " __os.reset();\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), + + + %% Creating call identity tuple + ic_codegen:emit(Fd, " // Message identity part creation\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __env.write_client_pid();\n"), + ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), + + OpCallName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ic_util:to_undersc(["_get_"++WireName|N]); + false -> + "_get_"++WireName + end, + + %% Creating operation identity + ic_codegen:emit(Fd, " // Message operation part creation\n"), + ic_codegen:emit(Fd, " __os.write_atom(~p);\n\n",[OpCallName]), + + ic_codegen:emit(Fd, " }\n\n"), + + + %% + %% Unmarshal get operation + %% + MRT = ic_java_type:getParamType(G,N,Type,ret), + + ic_codegen:emit(Fd, " // Unmarshal operation for get attribute ~p\n", [Name]), + ic_codegen:emit(Fd, " public static ~s _~s_get_unmarshal(~sEnvironment __env)\n", + [MRT, Name, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + + ic_codegen:emit(Fd, " // Get input stream\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), + + ic_codegen:emit(Fd, " // Extracting return value\n"), + case ic_java_type:isBasicType(G, N, Type) of + true -> + ic_codegen:emit(Fd, " return __is~s;\n", + [ic_java_type:unMarshalFun(G, N, X, Type)]); + false -> + ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", + [ic_java_type:getUnmarshalType(G, N, X, Type)]) + end, + + ic_codegen:emit(Fd, " }\n\n"); + + +emit_attribute_stub_code1(G,N,X,Fd,"_set_",Name,WireName) -> + + Type = ic_forms:get_type(X), + + %% + %% Main set operation + %% + IT = ic_java_type:getType(G,N,Type), + + ic_codegen:emit(Fd, " // Attribute ~p set operation implementation\n", [ic_util:to_colon([WireName|N])]), + ic_codegen:emit(Fd, " public void ~s(~s _value) throws java.lang.Exception {\n\n", [Name,IT]), + + %% Function marshal call + ic_codegen:emit(Fd, " // Calling the marshal function\n"), + ic_codegen:emit(Fd, " _~s_marshal(_env, _value);\n\n", [Name]), + + %% Sending call + ic_codegen:emit(Fd, " // Message send\n"), + ic_codegen:emit(Fd, " _env.send();\n\n"), + + %% Receiving return value + ic_codegen:emit(Fd, " // Message receive\n"), + ic_codegen:emit(Fd, " _env.receive();\n\n"), + + ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), + ic_codegen:emit(Fd, " _~s_set_unmarshal(_env);\n", [Name]), + + ic_codegen:emit(Fd, " }\n\n"), + + + %% + %% Marshal set operation + %% + IP = ic_java_type:getParamType(G, N, Type, in), + OpCallName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ic_util:to_undersc(["_set_"++WireName|N]); + false -> + "_set_"++WireName + end, + + ic_codegen:emit(Fd, " // Marshal operation for set attribute ~p\n", [Name]), + ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s _value)\n", + [Name, ?ICPACKAGE, IP]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Get output stream\n"), + ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), + + %% Initiating Message header + ic_codegen:emit(Fd, " // Message header assembly\n"), + ic_codegen:emit(Fd, " __os.reset();\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), + + + %% Creating call identity tuple + ic_codegen:emit(Fd, " // Message identity part creation\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __env.write_client_pid();\n"), + ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), + + + %% Creating operation identity + ic_codegen:emit(Fd, " // Message operation part creation\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_atom(~p);\n",[OpCallName]), + + case ic_java_type:isBasicType(G, N, Type) of + true -> + ic_codegen:emit(Fd, " __os~s(_value);\n\n", + [ic_java_type:marshalFun(G, N, X, Type)]); + false -> + ic_codegen:emit(Fd, " ~s(__os, _value);\n\n", + [ic_java_type:marshalFun(G, N, X, Type)]) + end, + ic_codegen:emit(Fd, " }\n\n"), + + + ic_codegen:emit(Fd, " // Unmarshal operation for set attribute ~p\n", [Name]), + ic_codegen:emit(Fd, " public static void _~s_set_unmarshal(~sEnvironment __env)\n", + [Name, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Get input stream\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), + + ic_codegen:emit(Fd, " __is.read_atom();\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + + + + diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl new file mode 100644 index 0000000000..1000e0d962 --- /dev/null +++ b/lib/ic/src/ic_cbe.erl @@ -0,0 +1,1306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%------------------------------------------------------------ +%% +%% This module is a main module for generation of C code, both +%% for ic_cclient and ic_cserver. +%% +%% The former role of this module (ic_cbe) was to generate client +%% code only. +%% +-module(ic_cbe). + +-export([emit_malloc_size_stmt/7, emit_encoding_stmt/6, + emit_encoding_stmt/7, emit_decoding_stmt/10, + emit_decoding_stmt/11, emit_dealloc_stmts/3, + mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3, + is_variable_size/1, is_variable_size/3, mk_dim/1, + mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2, + extract_info/3, normalize_type/1]). + +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). + +-include("icforms.hrl"). +-include ("ic.hrl"). + +%%------------------------------------------------------------ +%% ENCODING +%%------------------------------------------------------------ + +emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n} \n"); + "erlang_ref" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer); + FSN -> + emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer) + end; + +%% XXX T is a string +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + false -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))" + " < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list + emit(Fd, " return oe_error_code;\n }\n") + end; +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, " + " ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, " + "~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) -> + case normalize_type(T) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + %% XXX Why only returns? + {void, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {sequence, _, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {_ArrayType, {array, _, _}} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {union, _, _, _, _} -> + %% Union as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {struct, _, _, _} -> + %% Struct as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%% Arity = 7. +%% +emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer); + FSN -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer) + end; + +%% XXX T is a string +emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) -> + %% Already a fullscoped name + case get_param_tk(LName,X) of + error -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + ParamTK -> + case is_variable_size(ParamTK) of + true -> + if is_tuple(ParamTK) -> + case element(1,ParamTK) of + tk_array -> + %% Array of dynamic data + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, + "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, + " return " + "oe_error_code;\n }\n"); + _ -> + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, + "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return " + "oe_error_code;\n }\n") + end; + true -> + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end; + false -> + if is_atom(ParamTK) -> + case normalize_type(ParamTK) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, + Type, + LName); + _ -> + %% Why only return? + ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok + end; + true -> + case element(1,ParamTK) of + tk_enum -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_array -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_struct -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_union -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, &~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end + end + end + end; +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) -> + case normalize_type(T) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + {void, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {sequence, _, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {_ArrayType, {array, _, _}} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {struct, _, _, _} -> %% Struct as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + _ -> + %%io:format("2 ------------> ~p~n", [T]), + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%%------------------------------------------------------------ +emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) -> + {Cast, DecType} = + case Type of + ushort -> {"(unsigned long) ", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"", "ulonglong"}; + short -> {"(long) ", "long"}; + long -> {"", "long"}; + longlong -> {"", "longlong"}; + float -> {"(double) ", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} % Fix for any + end, + case Type of + boolean -> + %% Note prefix: oe_ei + emit(Fd, " switch(~s) {\n",[LName]), + emit(Fd, " case 0 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"false\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"true\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default :\n"), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n\n"); + _ -> + Fmt = + " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n", + emit(Fd, Fmt, [DecType, Cast, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end. + + +%%------------------------------------------------------------ +%% MALLOC SIZE (for Decode) +%%------------------------------------------------------------ + +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, + Align, CalcType) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "ETERM*", []), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType); + FSN -> + %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN, + %% CalcType]), + emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType) + end; + +%% XXX T is a string +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, + _Align, CalcType) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); + false -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), T]), + ?emit_c_dec_rpt(Fd, " ", "~s", [T]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), T]), + ?emit_c_dec_rpt(Fd, " ", "~s", [T]), + emit(Fd, " return oe_error_code;\n }\n") + end + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, + CalcType) when is_record(T, string) -> + Tname = mk_variable_name(op_variable_count), + store_tmp_decl(" int ~s = 0;\n",[Tname]), + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "oe_size_count_index, &oe_type, &~s)) < 0) {\n", + [InBuffer, Tname]); + _ -> + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_temp = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", + [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + if + T#string.length == 0 -> + ok; + true -> + Length = ic_util:eval_c(G, N, T#string.length), + case CalcType of + generator -> + emit(Fd, " if (~s > ~s)\n",[Tname, Length]), + emit(Fd, " return -1;\n\n"); + _ -> + emit(Fd, " if (oe_temp > ~s)\n",[Length]), + emit(Fd, " return -1;\n\n") + end + end, + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); + _ -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + case CalcType of + generator -> + emit(Fd, " oe_malloc_size = ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]); + _ -> + emit(Fd, " oe_malloc_size = ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + oe_temp+1")]) + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, + CalcType) when is_record(T, wstring) -> + Tname = mk_variable_name(op_variable_count), + store_tmp_decl(" int ~s = 0;\n",[Tname]), + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "oe_size_count_index, &oe_type, &~s)) < 0) {\n", + [InBuffer, Tname]); + _ -> + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_temp = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", + [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + if + T#wstring.length == 0 -> + ok; + true -> + Length = ic_util:eval_c(G, N, T#wstring.length), + case CalcType of + generator -> + emit(Fd, " if (~s > ~s)\n",[Tname, Length]), + emit(Fd, " return -1;\n\n"); + _ -> + emit(Fd, " if (oe_temp > ~s)\n",[Length]), + emit(Fd, " return -1;\n\n") + end + end, + case CalcType of + generator -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); + _ -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []), + emit(Fd, " return oe_error_code;\n }\n"), + case CalcType of + generator -> + emit(Fd, " oe_malloc_size =\n ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + ((" + ++ Tname + ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]); + _ -> + emit(Fd, " oe_malloc_size =\n ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + ((" + "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")]) + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) -> + case Align of + 0 -> + emit(Fd, " oe_malloc_size += sizeof(~s);\n\n", + [mk_c_type(G, N, T)]); + _ -> + ok + end, + case normalize_type(T) of + {basic, Type} -> + emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); + {void, _} -> + ok; + {sequence, _, _} -> + ok; + {_, {array, SId, _}} -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(SId)]), + ?emit_c_dec_rpt(Fd, " ", "array1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(SId)]), + ?emit_c_dec_rpt(Fd, " ", "array2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {union, UId, _, _, _} -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "union1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "union2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {struct, UId, _, _} -> %% Struct as a member in struct ! + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "struct1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "struct2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {any, _} -> %% Fix for any type + emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " + "oe_size_count_index, NULL)) < 0) {\n", + [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "any", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%%------------------------------------------------------------ + +emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) -> + {Pre, DecType} = + case Type of + ushort -> {"", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"oe_", "ulonglong"}; + short -> {"", "long"}; + long -> {"", "long"}; + longlong -> {"oe_", "longlong"}; + float -> {"", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"oe_", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} + end, + Fmt = + " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, " + "NULL)) < 0) {\n", + emit(Fd, Fmt, [Pre, DecType, InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]), + emit(Fd, " return oe_error_code;\n }\n"). + +%%------------------------------------------------------------ +%% DECODING +%%------------------------------------------------------------ + +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, + NextPos, DecType) -> + emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, + NextPos, DecType, []). + +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, + DecType, AllocedPars) when element(1, T) == scoped_id -> + Fmt = + " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)" + " {\n", + Emit = fun(Type) -> + emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n") + end, + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + Emit("pid"); + "erlang_port" -> + Emit("port"); + "erlang_ref" -> + Emit("ref"); + "ETERM*" -> + Emit("term"); + {enum, FSN} -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, + Align, NextPos, DecType, AllocedPars); + FSN -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, + Align, NextPos, DecType, AllocedPars) + end; + +%% XXX T is a string +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, + DecType, AllocedPars) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + false -> + case DecType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " + "~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + caller -> %% No malloc used, define oe_first + emit(Fd, " {\n"), + emit(Fd, " void *oe_first = NULL;\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + caller_dyn -> %% Malloc used + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_dyn -> %% Malloc used + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_fix_ret -> + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s,*~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_fix_out -> %% No malloc used, define oe_first + emit(Fd, " {\n"), + emit(Fd, " void *oe_first = NULL;\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n") + end + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + DecType, AllocedPars) when is_record(T, string) -> + case DecType of + caller_dyn -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + _ -> + emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", + [IndOp, LName]), + emit(Fd, " {\n"), + emit(Fd, " int oe_type=0;\n"), + emit(Fd, " int oe_string_ctr=0;\n\n"), + + emit(Fd, " (int) ei_get_type(~s, " + "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", + [InBuffer]), + + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *oe_outindex = ~s;\n", + [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), + emit(Fd, " }\n\n") + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + DecType, AllocedPars) when is_record(T, wstring) -> + case DecType of + caller_dyn -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }/* --- */\n"); % XXX + _ -> + emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", + [IndOp, LName]), + + emit(Fd, " {\n"), + emit(Fd, " int oe_type=0;\n"), + emit(Fd, " int oe_string_ctr=0;\n\n"), + emit(Fd, " (int) ei_get_type(~s, " + "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", + [InBuffer]), + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *oe_outindex = ~s;\n", + [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), + emit(Fd, " }\n") + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, + _DecType, AllocedPars) -> + case normalize_type(T) of + {basic, Type} -> + emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + {void, _} -> + emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, NULL)) < 0) {\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + {sequence, _, _} -> + ok; + {_, {array, SId, Dims}} -> + AName = ic_forms:get_id2({array, SId, Dims}), + Ptr = "oe_out->"++AName, + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + ic_forms:get_id2(SId), + NextPos, Ptr]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + {struct, _, _, _} -> %% Struct as a member in struct ! + ok; + _ -> + %%io:format("3 ------------> ~p~n", [T]), + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%% XXX DecType used in two senses in this file. +emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars) -> + Fmt = + " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " + "~s~s)) < 0) {\n", + Ret = + " return oe_error_code;\n" + "}\n", + + {Pre, DecType} = + case Type of + ushort -> {"", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"oe_", "ulonglong"}; + short -> {"", "long"}; + long -> {"", "long"}; + longlong -> {"oe_", "longlong"}; + float -> {"", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"oe_", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} + end, + case Type of + ushort -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " + "&oe_env->_iin, &oe_ulong)) < 0) {\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n", + [LName]), + emit(Fd, " if (*(~s) != oe_ulong){\n", + [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n\n"); + short -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " + "&oe_env->_iin, &oe_long)) < 0){\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]), + emit(Fd, " if (*(~s) != oe_long){\n", [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + float -> + emit(Fd, " {\n"), + emit(Fd, " double oe_double;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " + "&oe_env->_iin, &oe_double)) < 0){\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (float) oe_double;\n",[LName]), + emit(Fd, " }\n"); + boolean -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, "}\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " *(~s) = 0;\n",[LName]), + emit(Fd, " }\n"), + emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)" + " {\n"), + emit(Fd, " *(~s) = 1;\n",[LName]), + emit(Fd, " }\n"), + emit(Fd, " else {\n"), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + _ -> + emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + emit(Fd, Ret) + end. + +%%------------------------------------------------------------ +%% +%%------------------------------------------------------------ +emit_dealloc_stmts(Fd, Prefix, AllocedPars) -> + Fmt = Prefix ++ "CORBA_free(~s);\n", + lists:foreach( + fun(Par) -> emit(Fd, Fmt, [Par]) end, + AllocedPars). + + +%%------------------------------------------------------------ +%% +%%------------------------------------------------------------ + +mk_variable_name(Var) -> + Nr = get(Var), + put(Var, Nr + 1), + "oe_tmp" ++ integer_to_list(Nr). + +%% IDL to C type conversion +%%------------------------------------------------------------ +mk_c_type(G, N, S) -> + mk_c_type(G, N, S, evaluate). + +mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + {enum, Type} -> + mk_c_type(G, N, Type, evaluate); + Type -> + mk_c_type(G, N, Type, evaluate) + end; + +mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + Type -> + Type + end; +mk_c_type(_G, _N, S, _) when is_list(S) -> + S; +mk_c_type(_G, _N, S, _) when is_record(S, string) -> + "CORBA_char *"; +mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> + "CORBA_wchar *"; +mk_c_type(_G, _N, {boolean, _}, _) -> + "CORBA_boolean"; +mk_c_type(_G, _N, {octet, _}, _) -> + "CORBA_octet"; +mk_c_type(_G, _N, {void, _}, _) -> + "void"; +mk_c_type(_G, _N, {unsigned, U}, _) -> + case U of + {short,_} -> + "CORBA_unsigned_short"; + {long,_} -> + "CORBA_unsigned_long"; + {'long long',_} -> + "CORBA_unsigned_long_long" + end; + +mk_c_type(_G, _N, {'long long', _}, _) -> + "CORBA_long_long"; + +mk_c_type(_G, _N, S, _) when is_record(S, union)-> + ic_forms:get_id2(S); + +mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member + Fullname = [ic_forms:get_id2(S) | N], + ic_util:to_undersc(Fullname); + +mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type + "CORBA_long"; + +mk_c_type(_G, _N, {T, _}, _) -> + "CORBA_" ++ atom_to_list(T). + +%%------------------------------------------------------------------- +%% IDL to C type conversion used by the emit_c_*_rpt macros. +%%------------------------------------------------------------------- +mk_c_type2(G, N, S) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + {enum, Type} -> + mk_c_type2(G, N, Type); + Type -> + mk_c_type2(G, N, Type) + end; + +mk_c_type2(_G, _N, S) when is_list(S) -> + S; +mk_c_type2(_G, _N, S) when is_record(S, string) -> + "CORBA_char *"; +mk_c_type2(_G, _N, S) when is_record(S, wstring) -> + "CORBA_wchar *"; +mk_c_type2(_G, _N, {boolean, _}) -> + "CORBA_boolean"; +mk_c_type2(_G, _N, {octet, _}) -> + "CORBA_octet"; +mk_c_type2(_G, _N, {void, _}) -> + "void"; +mk_c_type2(_G, _N, {unsigned, U}) -> + case U of + {short,_} -> + "CORBA_unsigned_short"; + {long,_} -> + "CORBA_unsigned_long"; + {'long long',_} -> + "CORBA_unsigned_long_long" + end; + +mk_c_type2(_G, _N, {'long long', _}) -> + "CORBA_long_long"; + +mk_c_type2(_G, _N, S) when is_record(S, union)-> + ic_forms:get_id2(S); + +mk_c_type2(_G, N, S) when is_record(S, struct) -> + Fullname = [ic_forms:get_id2(S) | N], + ic_util:to_undersc(Fullname); + +mk_c_type2(_G, _N, S) when is_record(S, sequence) -> + mk_c_type2(_G, _N, S#sequence.type); + +mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type + "CORBA_long"; + +mk_c_type2(_G, _N, {T, _}) -> + "CORBA_" ++ atom_to_list(T). + +%%----- + +is_variable_size_rec(Es) -> + lists:any( + fun({_N, T}) -> is_variable_size(T); + ({_, _N, T}) -> is_variable_size(T) + end, Es). + +is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) -> + is_variable_size_rec(ElementList); +is_variable_size({'tk_array', ElemTC, _Length}) -> + is_variable_size(ElemTC); +is_variable_size({'tk_string', _}) -> + true; +is_variable_size({'tk_wstring', _}) -> + true; +is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) -> + true; +is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) -> + is_variable_size_rec(ElementList); +is_variable_size(_Other) -> + false. + + +is_variable_size(_G, _N, T) when is_record(T, string) -> + true; +is_variable_size(_G, _N, T) when is_record(T, wstring) -> + true; +is_variable_size(_G, _N, T) when is_record(T, sequence) -> + true; +is_variable_size(G, N, T) when is_record(T, union) -> + %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]), + is_variable_size(ictype:fetchTk(G, N, T)); +is_variable_size(G, N, T) when is_record(T, struct) -> + is_variable_size(ictype:fetchTk(G, N, T)); +is_variable_size(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, TK, _} -> + is_variable_size(TK); + _ -> + ic_error:fatal_error(G, {name_not_found, T}) + end; +is_variable_size(_G, _N, _Other) -> + false. + +%% mk_dim produces +mk_dim([Arg | Args]) -> + "[" ++ Arg ++ "]" ++ mk_dim(Args); +mk_dim([]) -> []. + +mk_slice_dim(Args) -> + mk_dim(tl(Args)). + + +emit_tmp_variables(Fd) -> + DeclList = get(tmp_declarations), + emit_tmp_variables(Fd, DeclList), + ok. + +emit_tmp_variables(Fd, [Decl |Rest]) -> + emit_tmp_variables(Fd, Rest), + emit(Fd, "~s", [Decl]); +emit_tmp_variables(_Fd, []) -> + ok. + +store_tmp_decl(Format, Args) -> + Decl = io_lib:format(Format, Args), + DeclList = get(tmp_declarations), + put(tmp_declarations, [Decl |DeclList]). + +%%------------------------------------------------------------ +%% +%% Parser utilities +%% +%% Called from the yecc parser. Expands the identifier list of an +%% attribute so that the attribute generator never has to handle +%% lists. +%% +%%------------------------------------------------------------ + +extract_info(_G, N, X) when is_record(X, op) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + Args = X#op.params, + ArgNames = mk_c_vars(Args), + TypeList = {ic_forms:get_type(X), + lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), + [] + }, + {Name, ArgNames, TypeList}; +extract_info(_G, N, X) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + {Name, [], []}. + + + +%% Usefull functions +get_param_tk(Name, Op) -> + case get_param(Name, Op) of + error -> + error; + Param -> + ic_forms:get_tk(Param) + end. + +get_param(Name, Op) when is_record(Op, op) -> + get_param_loop(Name, Op#op.params); +get_param(_Name, _Op) -> + error. + +get_param_loop(Name,[Param|Params]) -> + case ic_forms:get_id2(Param) of + Name -> + Param; + _ -> + get_param_loop(Name,Params) + end; +get_param_loop(_Name, []) -> + error. + + +%% Input is a list of parameters (in parse form) and output is a list +%% of parameter attribute and variable names. +mk_c_vars(Params) -> + lists:map(fun(P) -> {A, _} = P#param.inout, + {A, ic_forms:get_id(P#param.id)} + end, + Params). + +normalize_type({unsigned, {short, _}}) -> {basic, ushort}; +normalize_type({unsigned, {long, _}}) -> {basic, ulong}; +normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong}; +normalize_type({short,_}) -> {basic, short}; +normalize_type({long, _}) -> {basic, long}; +normalize_type({'long long', _}) -> {basic, longlong}; +normalize_type({float,_}) -> {basic, float}; +normalize_type({double, _}) -> {basic, double}; +normalize_type({boolean, _}) -> {basic, boolean}; +normalize_type({char, _}) -> {basic, char}; +normalize_type({wchar, _}) -> {basic, wchar}; +normalize_type({octet, _}) -> {basic, octet}; +normalize_type({any, _}) -> {basic, any}; +normalize_type(tk_ushort) -> {basic, ushort}; +normalize_type(tk_ulong) -> {basic, ulong}; +normalize_type(tk_ulonglong) -> {basic, ulonglong}; +normalize_type(tk_short) -> {basic, short}; +normalize_type(tk_long) -> {basic, long}; +normalize_type(tk_longlong) -> {basic, longlong}; +normalize_type(tk_float) -> {basic, float}; +normalize_type(tk_double) -> {basic, double}; +normalize_type(tk_boolean) -> {basic, boolean}; +normalize_type(tk_char) -> {basic, char}; +normalize_type(tk_wchar) -> {basic, wchar}; +normalize_type(tk_octet) -> {basic, octet}; +normalize_type(tk_any) -> {basic, any}; +normalize_type(ushort) -> {basic, ushort}; +normalize_type(ulong) -> {basic, ulong}; +normalize_type(ulonglong) -> {basic, ulonglong}; +normalize_type(short) -> {basic, short}; +normalize_type(long) -> {basic, long}; +normalize_type(longlong) -> {basic, longlong}; +normalize_type(float) -> {basic, float}; +normalize_type(double) -> {basic, double}; +normalize_type(boolean) -> {basic, boolean}; +normalize_type(char) -> {basic, char}; +normalize_type(wchar) -> {basic, wchar}; +normalize_type(octet) -> {basic, octet}; +normalize_type(any) -> {basic, any}; +normalize_type(Type) -> Type. + diff --git a/lib/ic/src/ic_cclient.erl b/lib/ic/src/ic_cclient.erl new file mode 100644 index 0000000000..ebe7e0c207 --- /dev/null +++ b/lib/ic/src/ic_cclient.erl @@ -0,0 +1,1209 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_cclient). + +%% This module implements generation of C client code, where the +%% client acts as an Erlang C-node, and where the communication thus +%% is according to the Erlang distribution protocol. +%% + +-export([do_gen/3]). + +%%------------------------------------------------------------ +%% IMPLEMENTATION CONVENTIONS +%%------------------------------------------------------------ +%% Functions: +%% +%% mk_* returns things to be used. No side effects. +%% emit_* Writes to file. Has Fd in arguments. +%% gen_* Same, but has no Fd. Usually for larger things. +%% +%% Terminology for generating C: +%% +%% par_list list of identifiers with types, types only, or with +%% parameters (arguments) only. +%% arg_list list of identifiers only (for function calls) +%% + +%%------------------------------------------------------------ +%% Internal stuff +%%------------------------------------------------------------ + +-import(lists, [foreach/2, foldl/3, foldr/3]). +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). + +-include("icforms.hrl"). +-include("ic.hrl"). +-include_lib("stdlib/include/erl_compile.hrl"). + +-define(IC_HEADER, "ic.h"). +-define(ERL_INTERFACEHEADER, "erl_interface.h"). +-define(EICONVHEADER, "ei.h"). +-define(ERLANGATOMLENGTH, "256"). + + +%%------------------------------------------------------------ +%% ENTRY POINT +%%------------------------------------------------------------ +do_gen(G, File, Form) -> + OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), + G2 = ic_file:filename_push(G, [], OeName, c), + gen_headers(G2, [], Form), + R = gen(G2, [], Form), + ic_file:filename_pop(G2, c), + R. + +remove_ext(File) -> + filename:rootname(filename:basename(File)). + +%%------------------------------------------------------------ +%% +%% Generate client side C stubs. +%% +%% - each module definition results in a separate file. +%% - each interface definition results in a separate file. +%% +%% G = record(genobj) (see ic.hrl) +%% N = scoped names in reverse +%% X = current form to consider. +%%------------------------------------------------------------ + +gen(G, N, [X| Xs]) when is_record(X, preproc) -> + G1 = change_file_stack(G, N, X), + gen(G1, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, module) -> + CD = ic_code:codeDirective(G, X), + G2 = ic_file:filename_push(G, N, X, CD), + N2 = [ic_forms:get_id2(X)| N], + gen_headers(G2, N2, X), + gen(G2, N2, ic_forms:get_body(X)), + G3 = ic_file:filename_pop(G2, CD), + gen(G3, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, interface) -> + + G2 = ic_file:filename_push(G, N, X, c), + N2 = [ic_forms:get_id2(X)| N], + + %% Sets the temporary variable counter. + put(op_variable_count, 0), + put(tmp_declarations, []), + + gen_headers(G2, N2, X), + + gen(G2, N2, ic_forms:get_body(X)), + + lists:foreach( + fun({_Name, Body}) -> + gen(G2, N2, Body) end, + X#interface.inherit_body), + + %% Generate Prototypes + gen_prototypes(G2, N2, X), + + %% Generate generic preparation for decoding + gen_receive_info(G2, N2, X), + + G3 = ic_file:filename_pop(G2, c), + + gen(G3, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, const) -> + emit_constant(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, op) -> + {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X), + %% XXX Note: N is the list of scoped ids of the *interface*. + gen_operation(G, N, X, OpName, ArgNames, RetParTypes), + gen_encoder(G, N, X, OpName, ArgNames, RetParTypes), + gen_decoder(G, N, X, OpName, ArgNames, RetParTypes), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, attr) -> + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, except) -> + icstruct:except_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, enum) -> + icenum:enum_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, typedef) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, struct) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, union) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [_X| Xs]) -> + %% XXX Should have debug message here. + gen(G, N, Xs); + +gen(_G, _N, []) -> + ok. + +%%------------------------------------------------------------ +%% Change file stack +%%------------------------------------------------------------ + +change_file_stack(G, _N, X) when X#preproc.cat == line_nr -> + Id = ic_forms:get_id2(X), + Flags = X#preproc.aux, + case Flags of + [] -> + ic_genobj:push_file(G, Id); + _ -> + foldr( + fun({_, _, "1"}, G1) -> + ic_genobj:push_file(G1, Id); + ({_, _, "2"}, G1) -> + ic_genobj:pop_file(G1, Id); + ({_, _, "3"}, G1) -> + ic_genobj:sys_file(G1, Id) + end, G, Flags) + end; +change_file_stack(G, _N, _X) -> + G. + +%%------------------------------------------------------------ +%% Generate headers in stubfiles and header files +%%------------------------------------------------------------ + +gen_headers(G, N, X) when is_record(X, interface) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + %% Set the temporary variable counter + put(op_variable_count, 0), + put(tmp_declarations, []), + HFd = ic_genobj:hrlfiled(G), + IncludeFileStack = ic_genobj:include_file_stack(G), + L = length(N), + Filename = + if + L < 2 -> + lists:nth(L + 1, IncludeFileStack); + true -> + lists:nth(2, IncludeFileStack) + end, + emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), + ic_code:gen_includes(HFd, G, X, c_client), + + IfName = ic_util:to_undersc(N), + IfNameUC = ic_util:to_uppercase(IfName), + emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]), + emit(HFd, "#define __~s__\n", [IfNameUC]), + LCmt = io_lib:format("Interface object definition: ~s", [IfName]), + ic_codegen:mcomment_light(HFd, [LCmt], c), + case get_c_timeout(G, "") of + "" -> + ok; + {SendTmo, RecvTmo} -> + emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", + [IfNameUC, SendTmo]), + emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", + [IfNameUC, RecvTmo]), + emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"), + emit(HFd, "#error Functions for send and receive with " + "timeout not defined in erl_interface\n"), + emit(HFd, "#endif\n\n") + end, + + emit(HFd, "typedef CORBA_Object ~s;\n", [IfName]), + emit(HFd, "#endif\n\n"); + + false -> ok + end, + case ic_genobj:is_stubfile_open(G) of + true -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:nl(Fd), + emit(Fd, "#include <stdlib.h>\n"), + emit(Fd, "#include <string.h>\n"), + case ic_options:get_opt(G, c_report) of + true -> + emit(Fd, "#ifndef OE_C_REPORT\n"), + emit(Fd, "#define OE_C_REPORT\n"), + emit(Fd, "#include <stdio.h>\n"), + emit(Fd, "#endif\n"); + _ -> + ok + end, + emit(Fd, "#include \"~s\"\n", [?IC_HEADER]), + emit(Fd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), + emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]), + emit(Fd, "#include \"~s\"\n", + [filename:basename(ic_genobj:include_file(G))]), + ic_codegen:nl(Fd), ic_codegen:nl(Fd), + Fd; % XXX ?? + false -> + ok + end; + +%% Some items have extra includes +gen_headers(G, N, X) when is_record(X, module) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + HFd = ic_genobj:hrlfiled(G), + IncludeFileStack = ic_genobj:include_file_stack(G), + Filename = lists:nth(length(N) + 1, IncludeFileStack), + emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), + ic_code:gen_includes(HFd, G, X, c_client); + false -> ok + end; +gen_headers(G, [], _X) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + HFd = ic_genobj:hrlfiled(G), + case ic_options:get_opt(G, c_report) of + true -> + emit(HFd, "#ifndef OE_C_REPORT\n"), + emit(HFd, "#define OE_C_REPORT\n"), + emit(HFd, "#include <stdio.h>\n"), + emit(HFd, "#endif\n"); + _ -> + ok + end, + emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), + emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), + emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), + ic_code:gen_includes(HFd, G, c_client); + false -> ok + end; +gen_headers(_G, _N, _X) -> + ok. + + +%%------------------------------------------------------------ +%% Generate all prototypes (for interface) +%%------------------------------------------------------------ +gen_prototypes(G, N, X) -> + case ic_genobj:is_hrlfile_open(G) of + false -> + ok; + true -> + HFd = ic_genobj:hrlfiled(G), + IfName = ic_util:to_undersc(N), + + %% Emit generated function prototypes + emit(HFd, "\n/* Operation functions */\n"), + lists:foreach(fun({_Name, Body}) -> + emit_operation_prototypes(G, HFd, N, Body) + end, [{x, ic_forms:get_body(X)}| + X#interface.inherit_body]), + + UserProto = get_user_proto(G, false), + %% Emit generic function prototypes + case UserProto of + false -> + ok; + UserProto -> + emit(HFd, + "\n/* Generic user defined encoders */\n"), + emit(HFd, + "int ~s_prepare_notification_encoding(" + "CORBA_Environment*);" + "\n", [UserProto]), + emit(HFd, + "int ~s_prepare_request_encoding(CORBA_Environment*);" + "\n", [UserProto]) + end, + %% Emit encoding function prototypes + emit(HFd, "\n/* Input encoders */\n"), + lists:foreach(fun({_Name, Body}) -> + emit_encoder_prototypes(G, HFd, N, Body) + end, + [{x, ic_forms:get_body(X)}| + X#interface.inherit_body]), + + %% Emit generic function prototypes + emit(HFd, "\n/* Generic decoders */\n"), + emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n", + [IfName, IfName]), + + case UserProto of + false -> + ok; + UserProto -> + emit(HFd, "\n/* Generic user defined decoders */\n"), + emit(HFd, + "int ~s_prepare_reply_decoding(CORBA_Environment*);" + "\n", [UserProto]) + end, + %% Emit decode function prototypes + emit(HFd, "\n/* Result decoders */\n"), + lists:foreach(fun({_Name, Body}) -> + emit_decoder_prototypes(G, HFd, N, Body) + end, [{x, ic_forms:get_body(X)}| + X#interface.inherit_body]), + case UserProto of + false -> + ok; + UserProto -> + %% Emit generic send and receive_prototypes + {Sfx, TmoType} = case get_c_timeout(G, "") of + "" -> + {"", ""}; + _ -> + {"_tmo", ", unsigned int"} + end, + emit(HFd, + "\n/* Generic user defined send and receive " + "functions */\n"), + emit(HFd, + "int ~s_send_notification~s(CORBA_Environment*~s);\n", + [UserProto, Sfx, TmoType]), + emit(HFd, + "int ~s_send_request_and_receive_reply~s(" + "CORBA_Environment*~s~s);\n", + [UserProto, Sfx, TmoType, TmoType]) + end + end. + +%%------------------------------------------------------------ +%% Generate receive_info() (generic part for message reception) +%% (for interface). For backward compatibility only. +%%------------------------------------------------------------ + +gen_receive_info(G, N, _X) -> + case ic_genobj:is_stubfile_open(G) of + false -> + ok; + true -> + Fd = ic_genobj:stubfiled(G), + IfName = ic_util:to_undersc(N), + UserProto = get_user_proto(G, oe), + Code = + " +/* + * Generic function, used to return received message information. + * Not used by oneways. Always generated. For backward compatibility only. + */ + +int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env) +{ + return ~s_prepare_reply_decoding(oe_env); +}\n", + emit(Fd, Code, [IfName, IfName, UserProto]) +end. + +%%------------------------------------------------------------ +%% Emit constant +%%------------------------------------------------------------ + +emit_constant(G, N, ConstRecord) -> + case ic_genobj:is_hrlfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:hrlfiled(G), + CName = ic_util:to_undersc( + [ic_forms:get_id(ConstRecord#const.id)| N]), + UCName = ic_util:to_uppercase(CName), + + emit(Fd, "\n#ifndef __~s__\n", [UCName]), + emit(Fd, "#define __~s__\n", [UCName]), + + emit(Fd, "/* Constant: ~s */\n", [CName]), + + if is_record(ConstRecord#const.type, wstring) -> + %% If wstring, add 'L' + emit(Fd, "#define ~s L~p\n", + [CName, ConstRecord#const.val]); + true -> + emit(Fd, "#define ~s ~p\n", + [CName, ConstRecord#const.val]) + end, + emit(Fd, "#endif\n\n") + end. + +%%------------------------------------------------------------ +%% Generate operation (for interface) +%%------------------------------------------------------------ + +%% N is the list of scoped ids of the *interface*. +%% X is the operation +gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> + case ic_genobj:is_stubfile_open(G) of + true -> + do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes); + false -> + ok + end. + +do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> + Fd = ic_genobj:stubfiled(G), + IfName = ic_util:to_undersc(N), + IfNameUC = ic_util:to_uppercase(IfName), + + {R, ParTypes, _} = RetParTypes, + + IsOneway = ic_forms:is_oneway(X), + + emit(Fd, "\n" + "/***\n" + " *** Operation function \"~s\" ~s\n" + " ***/\n\n", + [OpName, ifelse(IsOneway, "(oneway)", "")]), + + RV = element(1, R), + Ret = case IsOneway of + false -> + if RV /= void -> + mk_ret_type(G, N, R); + true -> + "void" + end; + true -> + "void" + end, + ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out], + [types, args], + ParTypes, ArgNames), ", "), + emit(Fd, + "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n", + [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]), + + case IsOneway of + true -> + ok; + false -> + case ictype:isArray(G, N, R) of + true -> + emit(Fd, " ~s oe_return = NULL;\n\n", + [mk_ret_type(G, N, R)]); + false -> + if RV /= void -> + emit(Fd, " ~s oe_return;\n\n", + [Ret]); + true -> + ok + end + end, + emit(Fd, + " /* Initiating the message reference */\n" + " ic_init_ref(oe_env, &oe_env->_unique);\n") + end, + + emit(Fd, + " /* Initiating exception indicator */ \n" + " oe_env->_major = CORBA_NO_EXCEPTION;\n"), + + %% XXX Add pointer checks: checks of in-parameter + %% pointers, and non-variable out-parameter pointers. + + emit(Fd," /* Creating ~s message */ \n", + [ifelse(IsOneway, "cast", "call")]), + + EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X, + ParTypes, ArgNames), + ", "), + emit(Fd, + " if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n", + [OpName, EncParListStr]), + emit(Fd, + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "DATA_CONVERSION, \"Cannot encode message\");\n"), + + RetVar = ifelse(RV /= void, " oe_return", ""), + emit_c_enc_rpt(Fd, " ", "client operation ~s\\n====\\n", [OpName]), + + emit(Fd, " return~s;\n }\n", [RetVar]), + + emit(Fd," /* Sending ~s message */ \n", + [ifelse(IsOneway, "cast", "call")]), + + UserProto = get_user_proto(G, oe), + {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of + "" -> + {"", "", ""}; + _ -> + {"_tmo", + [", OE_", IfNameUC, "_SEND_TIMEOUT"], + [", OE_", IfNameUC, "_RECV_TIMEOUT"]} + end, + + case IsOneway of + true -> + emit(Fd, + " if (~s_send_notification~s(oe_env~s) < 0)\n" + " return~s;\n", [UserProto, Sfx, SendTmo, RetVar]); + false -> + emit(Fd, + " if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n" + " return~s;\n", + [UserProto, Sfx, SendTmo, RecvTmo, RetVar]), + + DecParList0 = mk_arg_list_for_decoder(G, N, X, + ParTypes, ArgNames), + DecParList1 = case mk_ret_type(G, N, R) of + "void" -> + DecParList0; + _ -> + ["&oe_return"| DecParList0] + end, + + DecParListStr = ic_util:chain(DecParList1, ", "), + %% YYY Extracting results + emit(Fd, + " /* Extracting result value(s) */ \n" + " if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n", + [OpName, DecParListStr]), + emit(Fd, + " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " + "\"Bad result value(s)\");\n"), + emit_c_dec_rpt(Fd, " ", "client operation ~s\\n=====\\n", [OpName]), + emit(Fd, + " return~s;\n" + " }\n", [RetVar]) + end, + emit(Fd, " return~s;\n", [RetVar]), + emit(Fd, "}\n\n\n"). + +%%------------------------------------------------------------ +%% Generate encoder +%%------------------------------------------------------------ +%% N is the list of scoped ids of the *interface*. +%% X is the operation +gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)-> + case ic_genobj:is_stubfile_open(G) of + true -> + Fd = ic_genobj:stubfiled(G), + IfName = ic_util:to_undersc(N), + {_R, ParTypes, _} = RetParTypes, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + emit(Fd, "/*\n * Encode operation input for \"~s\"\n */\n\n", + [OpName]), + ParList = ic_util:chain( + mk_par_type_list(G, N, X, [in], [types, args], + ParTypes, ArgNames), ", "), + emit(Fd, + "int ~s__client_enc(~s oe_obj, ~s" + "CORBA_Environment *oe_env)\n{\n", + [OpName, IfName, ParList]), + + InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true; + ({_, _, _}) -> false + end, TypeAttrArgs), + case InTypeAttrArgs of + [] -> + ok; + _ -> + emit(Fd, + " int oe_error_code = 0;\n\n") + end, + + emit_encodings(G, N, Fd, X, InTypeAttrArgs, + ic_forms:is_oneway(X)), + emit(Fd, " return 0;\n}\n\n"), + ok; + + false -> + ok + end. + +%%------------------------------------------------------------ +%% Generate decoder +%%------------------------------------------------------------ +%% N is the list of scoped ids of the *interface*. +%% X is the operation +gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)-> + case ic_forms:is_oneway(X) of + true -> + ok; + false -> + case ic_genobj:is_stubfile_open(G) of + true -> + Fd = ic_genobj:stubfiled(G), + IfName = ic_util:to_undersc(N), + {R, ParTypes, _} = RetParTypes, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + emit(Fd, "/*\n * Decode operation results for " + "\"~s\"\n */\n\n", [OpName]), + ParList0 = mk_par_type_list(G, N, X, [out], + [types, args], + ParTypes, ArgNames), + PARLIST = case mk_ret_type(G, N, R) of + "void" -> + ParList0; + Else -> + [Else ++ "* oe_return"| ParList0] + end, + PLFCD = ic_util:chain(PARLIST, ", "), + emit(Fd, + "int ~s__client_dec(~s oe_obj, ~s" + "CORBA_Environment *oe_env)\n{\n", + [OpName, IfName, PLFCD]), + emit(Fd, " int oe_error_code = 0;\n"), + OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true; + ({_, _, _}) -> false + end, TypeAttrArgs), + emit_decodings(G, N, Fd, R, OutTypeAttrArgs), + emit(Fd, " return 0;\n}\n\n"), + ok; + + false -> + ok + end + end. + +%%------------------------------------------------------------ +%% EMIT ENCODINGS/DECODINGS +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Emit encodings +%%------------------------------------------------------------ +%% N is the list of scoped ids of the *interface*. +%% X is the operation +%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay) +%% +emit_encodings(G, N, Fd, X, TypeAttrArgs, true) -> + %% Cast + UserProto = get_user_proto(G, oe), + emit(Fd, + " if (~s_prepare_notification_encoding(oe_env) < 0)\n" + " return -1;\n", [UserProto]), + emit_encodings_1(G, N, Fd, X, TypeAttrArgs); +emit_encodings(G, N, Fd, X, TypeAttrArgs, false) -> + %% Call + UserProto = get_user_proto(G, oe), + emit(Fd, + " if (~s_prepare_request_encoding(oe_env) < 0)\n" + " return -1;\n", [UserProto]), + emit_encodings_1(G, N, Fd, X, TypeAttrArgs). + +emit_encodings_1(G, N, Fd, X, TypeAttrArgs) -> + {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), + Name = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ScopedName; + false -> + ic_forms:get_id2(X) + end, + if + TypeAttrArgs /= [] -> + emit(Fd, " if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n", + [length(TypeAttrArgs) + 1]), + emit_c_enc_rpt(Fd, " ", "ei_encode_tuple_header", []), + emit(Fd, " return -1;\n }\n"); + true -> + ok + end, + emit(Fd, " if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return -1;\n }\n"), + + foreach(fun({{'void', _}, _, _}) -> + ok; + ({T1, A1, N1}) -> + IndOp = mk_ind_op(A1), + emit_coding_comment(G, N, Fd, "Encode", IndOp, + T1, N1), + ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1, + "oe_env->_outbuf") + end, TypeAttrArgs), + ok. + +%%------------------------------------------------------------ +%% Emit dedodings +%%------------------------------------------------------------ +%% XXX Unfortunately we have to retain the silly `oe_first' variable, +%% since its name is hardcoded in other modules (icstruct, icunion, +%% etc). +%% N is the list of scoped ids of the *interface*. +%% X is the operation +emit_decodings(G, N, Fd, RetType, TypeAttrArgs) -> + if + TypeAttrArgs /= [] -> + %% Only if there are out parameters + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(" + "oe_env->_inbuf, &oe_env->_iin, " + "&oe_env->_received)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + Len = length(TypeAttrArgs) + 1, + emit(Fd, " if (oe_env->_received != ~p) {\n", [Len]), + emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Len]), + emit(Fd, " return -1;\n }\n"); + true -> + ok + end, + + %% Fetch the return value + emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"), + APars = + case ic_cbe:is_variable_size(G, N, RetType) of + true -> + emit(Fd, + " {\n" + " int oe_size_count_index = oe_env->_iin;\n" + " int oe_malloc_size = 0;\n" + " void *oe_first = NULL;\n"), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, + "oe_env->_inbuf", + 1, caller), + %% XXX Add malloc prefix from option + emit(Fd, + " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" + " if ((*oe_return = oe_first = " + "malloc(oe_malloc_size)) == NULL) {\n" + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "NO_MEMORY, \"Cannot malloc\");\n" + " return -1;\n" + " }\n"), + Pars = ["*oe_return"], + DecType = case ictype:isArray(G, N, RetType) of + true -> array_dyn; + false -> caller_dyn + end, + ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, + "(*oe_return)", + "", "oe_env->_inbuf", 1, + "&oe_outindex", DecType, + Pars), + emit(Fd, " }\n"), + Pars; + false -> + case ictype:isArray(G, N, RetType) of + true -> + Pars = ["*oe_return"], + emit(Fd, + " {\n" + " int oe_size_count_index = oe_env->_iin;\n" + " int oe_malloc_size = 0;\n" + " void *oe_first = NULL;\n"), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, + "oe_env->_inbuf", + 1, caller), + %% XXX Add malloc prefix from option + emit(Fd, + " OE_MALLOC_SIZE_CHECK(oe_env, " + "oe_malloc_size);\n" + " if ((*oe_return = oe_first = " + "malloc(oe_malloc_size)) == NULL) {\n" + " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, " + "\"Cannot malloc\");\n" + " return -1;" + " }\n"), + ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, + "oe_return", "", + "oe_env->_inbuf", 1, + "&oe_outindex", + array_fix_ret, + Pars), + emit(Fd, " }\n"), + Pars; + false -> + Pars = [], + %% The last parameter "oe_outindex" is not interesting + %% in the static case. + ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, + "oe_return", "", + "oe_env->_inbuf", 1, + "&oe_outindex", + caller, Pars), + ic_codegen:nl(Fd), + Pars + end + end, + + foldl(fun({{'void', _}, _, _}, Acc) -> + Acc; + ({T, A, N1}, Acc) -> + emit_one_decoding(G, N, Fd, T, A, N1, Acc) + end, APars, TypeAttrArgs), + ok. + +emit_one_decoding(G, N, Fd, T, A, N1, Acc) -> + IndOp = mk_ind_op(A), + case ic_cbe:is_variable_size(G, N, T) of + true -> + emit_coding_comment(G, N, Fd, "Decode", IndOp, + T, N1), + emit(Fd, + " {\n" + " int oe_size_count_index = oe_env->_iin;\n" + " int oe_malloc_size = 0;\n" + " void *oe_first = NULL;\n"), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, T, + "oe_env->_inbuf", + 1, caller), + %% XXX Add malloc prefix from option + emit(Fd, + " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" + " if ((~s~s = oe_first = " + "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]), + ic_cbe:emit_dealloc_stmts(Fd, " ", Acc), + emit(Fd, + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "NO_MEMORY, \"Cannot malloc\");\n" + " return -1;\n" + " }\n"), + NAcc = [IndOp ++ N1| Acc], + DecType = case ictype:isArray(G, N, T) of + true -> + array_dyn; + false -> + caller_dyn + end, + ic_cbe:emit_decoding_stmt(G, N, Fd, T, + "(" ++ IndOp + ++ N1 ++ ")", "", + "oe_env->_inbuf", 1, + "&oe_outindex", + DecType, NAcc), + emit(Fd, " }\n"), + NAcc; + false -> + case ictype:isArray(G, N, T) of + true -> + emit_coding_comment(G, N, Fd, "Decode", "", + T, N1), + ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, + "", "oe_env->_inbuf", + 1, "&oe_outindex", + array_fix_out, Acc), + ic_codegen:nl(Fd), + [N1| Acc]; + false -> + %% The last parameter "oe_outindex" is + %% not interesting in the static case, but + %% must be present anyhow. + emit_coding_comment(G, N, Fd, "Decode", + IndOp, T, N1), + ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, + "", "oe_env->_inbuf", + 1, "&oe_outindex", + caller, Acc), + ic_codegen:nl(Fd), + Acc + end + end. + +%%------------------------------------------------------------ +%% GENERATE PROTOTYPES +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Generate operation prototypes +%%------------------------------------------------------------ +emit_operation_prototypes(G, Fd, N, Xs) -> + lists:foreach( + fun(X) when is_record(X, op) -> + {ScopedName, ArgNames, RetParTypes} = + ic_cbe:extract_info(G, N, X), + {R, ParTypes, _} = RetParTypes, + IfName = ic_util:to_undersc(N), + RT = mk_ret_type(G, N, R), + ParList = + ic_util:chain( + mk_par_type_list(G, N, X, [in, out], [types], + ParTypes, ArgNames), + ", "), + emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n", + [RT, ScopedName, IfName, ParList]); + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% Generate encoder prototypes +%%------------------------------------------------------------ +emit_encoder_prototypes(G, Fd, N, Xs) -> + lists:foreach( + fun(X) when is_record(X, op) -> + {ScopedName, ArgNames, RetParTypes} = + ic_cbe:extract_info(G, N, X), + {_R, ParTypes, _} = RetParTypes, + IfName = ic_util:to_undersc(N), + ParList = ic_util:chain( + mk_par_type_list(G, N, X, [in], [types], + ParTypes, ArgNames), + ", "), + emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n", + [ScopedName, IfName, ParList]); + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% Generate decoder prototypes +%%------------------------------------------------------------ +emit_decoder_prototypes(G, Fd, N, Xs) -> + lists:foreach( + fun(X) when is_record(X, op) -> + case ic_forms:is_oneway(X) of + true -> + true; + false -> + IfName = ic_util:to_undersc(N), + {ScopedName, ArgNames, RetParTypes} = + ic_cbe:extract_info(G, N, X), + {R, ParTypes, _} = RetParTypes, + ParList0 = + mk_par_type_list(G, N, X, [out], [types], + ParTypes, ArgNames), + PARLIST = case mk_ret_type(G, N, R) of + "void" -> + ParList0; + Else -> + [Else ++ "*"| ParList0] + end, + ParList = ic_util:chain(PARLIST, ", "), + emit(Fd, "int ~s__client_dec(~s, ~s" + "CORBA_Environment*);\n", + [ScopedName, IfName, ParList]) + end; + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% PARAMETER TYPE LISTS +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Make parameter type list +%% +%% InOrOut = in | out | [in | out] +%% TypesOrArgs = types | args | [types | args] +%%------------------------------------------------------------ +mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) -> + TypeAttrArgs = + filterzip( + fun(_, {inout, Arg}) -> + ic_error:error(G, {inout_spec_for_c, X, Arg}), + false; + (Type, {Attr, Arg}) -> + case lists:member(Attr, InOrOut) of + true -> + {true, {Type, Attr, Arg}}; + false -> + false + end + end, Types, Args), + lists:map( + fun({Type, Attr, Arg}) -> + Ctype = ic_cbe:mk_c_type(G, N, Type), + IsArray = ictype:isArray(G, N, Type), + IsStruct = ictype:isStruct(G, N, Type), + IsUnion = ictype:isUnion(G, N, Type), + Dyn = + case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> ""; + Ctype == "CORBA_char *" -> ""; + is_record(Type, wstring) -> ""; + Ctype == "CORBA_wchar *" -> ""; + true -> + case IsArray of + true -> + "_slice*"; + false -> + "*" + end + end; + false -> + if + Attr == in, Ctype == "erlang_pid" -> + "*"; + Attr == in, Ctype == "erlang_port" -> + "*"; + Attr == in, Ctype == "erlang_ref" -> + "*"; + Attr == in, IsStruct == true -> + "*"; + Attr == in, IsUnion == true -> + "*"; + Attr == in, IsArray == true -> + "_slice*"; + Attr == out, IsArray == true -> + "_slice"; + true -> + "" + end + end, + IndOp = mk_ind_op(Attr), + case {lists:member(types, TypesOrArgs), + lists:member(args, TypesOrArgs)} of + {true, true} -> + Ctype ++ Dyn ++ IndOp ++ " " ++ Arg; + {true, false} -> + Ctype ++ Dyn ++ IndOp; + {false, true} -> + Arg; + {false, false} -> + "" + end + end, TypeAttrArgs). + +%%------------------------------------------------------------ +%% ENCODER ARG LIST +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Make encoder argument list XXX +%%------------------------------------------------------------ +mk_arg_list_for_encoder(G, _N, X, Types, Args) -> + filterzip( + fun(_, {out, _}) -> + false; + (_, {inout, Arg}) -> + ic_error:error(G, {inout_spec_for_c, X, Arg}), + false; + (_Type, {in, Arg}) -> + {true, Arg} + end, Types, Args). + +%%------------------------------------------------------------ +%% DECODER ARG LIST +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Make decoder argument list XXX +%%------------------------------------------------------------ +mk_arg_list_for_decoder(G, _N, X, Types, Args) -> + filterzip(fun(_, {in, _}) -> + false; + (_, {inout, Arg}) -> + ic_error:error(G, {inout_spec_for_c, X, Arg}), + false; + (_, {out, Arg}) -> + {true, Arg} + end, Types, Args). + +%%------------------------------------------------------------ +%% MISC +%%------------------------------------------------------------ +%%------------------------------------------------------------ +%% Make list of {Type, Attr, Arg} +%%------------------------------------------------------------ +mk_type_attr_arg_list(Types, Args) -> + filterzip(fun(Type, {Attr, Arg}) -> + {true, {Type, Attr, Arg}} + end, Types, Args). + +%%------------------------------------------------------------ +%% Make return type +%%------------------------------------------------------------ +mk_ret_type(G, N, Type) -> + Ctype = ic_cbe:mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + ""; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> + ""; + Ctype == "CORBA_wchar *" -> + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + "_slice*"; + false -> + "*" + end + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + "_slice*"; + false -> + "" + end + end, + Ctype ++ Dyn. + + +%%------------------------------------------------------------ +%% Make indirection operator (to "*" or not to "*"). +%%------------------------------------------------------------ +mk_ind_op(in) -> + ""; +mk_ind_op(inout) -> + error; +mk_ind_op(out) -> + "*". + +%%------------------------------------------------------------ +%% Emit encoding/decoding comment +%%------------------------------------------------------------ +emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) -> + emit(Fd, " /* ~s parameter: ~s~s ~s */\n", + [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]). + +%%------------------------------------------------------------ +%% User protocol prefix for generic functions +%%------------------------------------------------------------ +get_user_proto(G, Default) -> + case ic_options:get_opt(G, user_protocol) of + false -> + Default; + Pfx -> + Pfx + end. + +%%------------------------------------------------------------ +%% Timeout. Returns a string (or Default). +%%------------------------------------------------------------ +get_c_timeout(G, Default) -> + case ic_options:get_opt(G, c_timeout) of + Tmo when is_integer(Tmo) -> + TmoStr = integer_to_list(Tmo), + {TmoStr, TmoStr}; + {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> + {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; + false -> + Default + end. + +%%------------------------------------------------------------ +%% ZIPPERS (merging of successive elements of two lists). +%%------------------------------------------------------------ + +%% zip([H1| T1], [H2| T2]) -> +%% [{H1, H2}| zip(T1, T2)]; +%% zip([], []) -> +%% []. + +filterzip(F, [H1| T1], [H2| T2]) -> + case F(H1, H2) of + false -> + filterzip(F, T1, T2); + {true, Val} -> + [Val| filterzip(F, T1, T2)] + end; +filterzip(_, [], []) -> + []. + + +ifelse(true, A, _) -> + A; +ifelse(false, _, B) -> + B. diff --git a/lib/ic/src/ic_code.erl b/lib/ic/src/ic_code.erl new file mode 100644 index 0000000000..6802b9ca65 --- /dev/null +++ b/lib/ic/src/ic_code.erl @@ -0,0 +1,584 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_code). + + +-include_lib("ic/src/ic.hrl"). +-include_lib("ic/src/icforms.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([get_basetype/2, insert_typedef/3, codeDirective/2]). +-export([gen_includes/3, gen_includes/4, mk_list/1]). + +-export([type_expand_op/4, type_expand_handle_op/4]). +-export([ type_expand_op_exec/4, type_expand_all/6, type_expand/7]). + +-export([type_expand_null/3, type_expand_void/3, type_expand_float/3, type_expand_double/3]). +-export([type_expand_short/3, type_expand_ushort/3, type_expand_long/3, type_expand_ulong/3]). +-export([type_expand_longlong/3, type_expand_ulonglong/3]). +-export([type_expand_char/3, type_expand_wchar/3, type_expand_boolean/3]). +-export([type_expand_octet/3, type_expand_any/3, type_expand_wstring/3]). +-export([type_expand_object/3, type_expand_string/3, type_expand_struct/7, type_expand_union/7]). +-export([type_expand_enum/4, type_expand_sequence/7, type_expand_array/7, type_expand_error/3]). + +-export([type_expand_struct_rule/3, type_expand_union_rule/2, type_expand_enum_rule/4]). +-export([type_expand_enum_elements/3, type_expand_longdouble/3, type_expand_typecode/3]). +-export([type_expand_principal/3, type_expand_exception/7]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%------------------------------------------------------------------------------------- +%% +%% Trackrecording of generated sequence type structs, thist is just used for C today. +%% +%%------------------------------------------------------------------------------------- + +get_basetype(G, MyId) -> + case ?lookup(ic_genobj:typedeftab(G), MyId) of + [] -> + MyId; + X -> + get_basetype(G, X) + end. + +insert_typedef(_G, "erlang_term", _) -> + ok; +insert_typedef(G, MyId, DefinedAsId) -> + ?insert(ic_genobj:typedeftab(G), MyId, DefinedAsId). + +codeDirective(G,X) -> + case produceCode(X) of + true -> + case ic_options:get_opt(G, be) of + c_genserv -> + c; + c_client -> + c; + c_server -> + c_server; + _ -> + erlang + end; + false -> + case ic_options:get_opt(G, be) of + c_genserv -> + c_no_stub; + c_client -> + c_no_stub; + c_server -> + c_server_no_stub; + _ -> + erlang_no_stub + end + end. + +%% Checks if X should produce code +produceCode(X) when is_record(X, module) -> + case ic_forms:get_body(X) of + [] -> + true; + List -> + produceModuleCode(List) + end; +produceCode(_X) -> + false. + +produceModuleCode([]) -> + false; +produceModuleCode([X|_Xs]) when is_record(X, const) -> + true; +produceModuleCode([_X|Xs]) -> + produceModuleCode(Xs). + +%% Includes needed c file headers for included idl files +gen_includes(Fd,G,Type) -> + case Type of + c_client -> + IncludeList = + ic_pragma:get_included_c_headers(G), + gen_includes_loop(Fd,IncludeList,Type); + c_server -> + IncludeList = + ic_pragma:get_included_c_headers(G), + gen_includes_loop(Fd,IncludeList,Type); + _ -> + ok + end, + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), + ic_codegen:emit(Fd, "extern \"C\" {\n"), + ic_codegen:emit(Fd, "#endif\n\n"). + + +%% Includes needed c file headers for local interfaces +gen_includes(Fd,G,X,Type) -> + case Type of + c_client -> + IncludeList = + ic_pragma:get_local_c_headers(G,X), + gen_includes_loop(Fd,IncludeList,Type); + c_server -> + IncludeList = + ic_pragma:get_local_c_headers(G,X), + gen_includes_loop(Fd,IncludeList,Type); + _ -> + ok + end, + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), + ic_codegen:emit(Fd, "extern \"C\" {\n"), + ic_codegen:emit(Fd, "#endif\n\n"). + + +gen_includes_loop(_,[],_) -> + ok; +gen_includes_loop(Fd,[I|Is],Type) -> + L = string:tokens(I,"/"), + File = lists:last(L), + case File of + "erlang" -> % Erlang is NOT generated that way ! + gen_includes_loop(Fd,Is,Type); + "oe_erlang" -> % Erlang is NOT generated that way ! + gen_includes_loop(Fd,Is,Type); + _ -> + case Type of + c_client -> + ic_codegen:emit(Fd, "#include \"~s.h\"\n", [File]); + c_server -> + ic_codegen:emit(Fd, "#include \"~s__s.h\"\n", [File]) + end, + gen_includes_loop(Fd,Is,Type) + end. + + + + +%% +%% Used in NOC only +%% + + +%% +%% Type expand on function head comments +%% +type_expand_op(G,N,X,Fd) -> + case catch type_expand_op_exec(G,N,X,Fd) of + {'EXIT',_Reason} -> + ic_codegen:nl(Fd), + ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); + _ -> + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) + end. + + +type_expand_op_exec(G,N,X,Fd) -> + InArgs = ic:filter_params([in,inout], X#op.params), + OutArgs = ic:filter_params([out,inout], X#op.params), + ParamNr = length(InArgs)+1, + Tabs = "", + + ic_codegen:nl(Fd), + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), + + case ic_forms:is_oneway(X) of + false -> + ic_codegen:emit(Fd,"%% Operation: ~s/~p~n",[ic_forms:get_id2(X),ParamNr]); + true -> + ic_codegen:emit(Fd,"%% Operation: ~s/~p (oneway)~n",[ic_forms:get_id2(X),ParamNr]) + end, + + if X#op.raises == [] -> []; + true -> + ic_codegen:emit(Fd,"%%~n",[]), + RaisesList=["%% Raises: " ++ + mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, + X#op.raises))], + ic_codegen:emit(Fd,RaisesList,[]), + ic_codegen:nl(Fd) + end, + + %% Print argument names + ic_codegen:emit(Fd,"%%\n",[]), + InArgNames = ["OE_Ref"]++[ic_util:mk_var(ic_forms:get_id(InArg#param.id)) || InArg <- InArgs ], + OutArgNames = ["Ret"]++[ic_util:mk_var(ic_forms:get_id(OutArg#param.id)) || OutArg <- OutArgs ], + case length(InArgNames) > 1 of + true -> + ic_codegen:emit(Fd,"%% Input value(s) : ~s~n",[mk_list(InArgNames)]); + false -> + ic_codegen:emit(Fd,"%% Input value : ~s~n",[mk_list(InArgNames)]) + end, + case length(OutArgNames) > 1 of + true -> + ic_codegen:emit(Fd,"%% Return value(s) : ~s~n",[mk_list(OutArgNames)]); + false -> + ic_codegen:emit(Fd,"%% Return value : ~s~n",[mk_list(OutArgNames)]) + end, + ic_codegen:emit(Fd,"%%\n",[]), + + InArgsTypeList = + [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)),ic_forms:get_tk(InArg)} || InArg <- InArgs ], + case InArgsTypeList of + [] -> %% no input parameters + ok; + _ -> + ic_codegen:emit(Fd,"%% --input-params-~n",[]), + type_expand_all(G,N,X,Fd,Tabs,InArgsTypeList) + end, + + ReturnTypeList =[{"Ret",X#op.tk}], + ic_codegen:emit(Fd,"%% --return-value-~n",[]), + type_expand_all(G,N,X,Fd,Tabs,ReturnTypeList), + + OutArgsTypeList = + [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)),ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], + case OutArgsTypeList of + [] -> %% no input parameters + ok; + _ -> + ic_codegen:emit(Fd,"%% -output-values-~n",[]), + type_expand_all(G,N,X,Fd,Tabs,OutArgsTypeList) + end. + + + + +type_expand_handle_op(G,N,X,Fd) -> + case catch type_expand_handle_op_exec(G,N,X,Fd) of + {'EXIT',_Reason} -> + ic_codegen:nl(Fd), + ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); + _ -> + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) + end. + + +type_expand_handle_op_exec(_G,_N,X,Fd) -> + InArgs = ic:filter_params([in,inout], X#op.params), + ParamNr = length(InArgs)+1, + + ic_codegen:nl(Fd), + ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), + + case ic_forms:is_oneway(X) of + false -> + ic_codegen:emit(Fd,"%% Handle operation: handle_call/3~n",[]); + true -> + ic_codegen:emit(Fd,"%% Handle operation: handle_cast/3~n",[]) + end, + ic_codegen:emit(Fd,"%%~n",[]), + ic_codegen:emit(Fd,"%% Used for operation ~s/~p implementation~n",[ic_forms:get_id2(X),ParamNr]). + + + +type_expand_all(_G,_N,_X,_Fd,_Tabs,[]) -> + ok; +type_expand_all(G,N,X,Fd,Tabs,[{ArgName,Type}|Rest]) -> + type_expand(G,N,X,Fd,Tabs,ArgName,Type), + type_expand_all(G,N,X,Fd,Tabs,Rest); +type_expand_all(G,N,X,Fd,Tabs,[{default,_ArgName,Type}|Rest]) -> + type_expand(G,N,X,Fd,Tabs,"Def",Type), + type_expand_all(G,N,X,Fd,Tabs,Rest); +type_expand_all(G,N,X,Fd,Tabs,[{LabelNr,_ArgName,Type}|Rest]) when is_integer(LabelNr) -> + type_expand(G,N,X,Fd,Tabs,"V" ++ integer_to_list(LabelNr),Type), + type_expand_all(G,N,X,Fd,Tabs,Rest); +type_expand_all(G,N,X,Fd,Tabs,[{Label,_ArgName,Type}|Rest]) -> + type_expand(G,N,X,Fd,Tabs,Label,Type), + type_expand_all(G,N,X,Fd,Tabs,Rest). + + + +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_null) -> + type_expand_null(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_void) -> + type_expand_void(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_float) -> + type_expand_float(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_double) -> + type_expand_double(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longdouble) -> + type_expand_longdouble(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_short) -> + type_expand_short(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ushort) -> + type_expand_ushort(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_long) -> + type_expand_long(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longlong) -> + type_expand_longlong(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulong) -> + type_expand_ulong(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulonglong) -> + type_expand_ulonglong(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_char) -> + type_expand_char(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_wchar) -> + type_expand_wchar(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_boolean) -> + type_expand_boolean(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_octet) -> + type_expand_octet(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_any) -> + type_expand_any(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_TypeCode) -> + type_expand_typecode(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,tk_Principal) -> + type_expand_principal(Fd,Tabs,Name); +type_expand(G, N, X,Fd,Tabs,Name, {tk_except, Id, ExcName, ElementList}) -> + type_expand_exception(G, N, X, Fd,Tabs,Name, + {tk_except, Id, ExcName, ElementList}); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_fixed, _Digits, _Scale}) -> + type_expand_fixed(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjTabs, _ObjName}) -> + type_expand_object(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjName}) -> + type_expand_object(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_string, _Length}) -> + type_expand_string(Fd,Tabs,Name); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_wstring, _Length}) -> + type_expand_wstring(Fd,Tabs,Name); +type_expand(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}) -> + type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}); +type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}) -> + type_expand_enum(Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}); +type_expand(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}) -> + type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}); +type_expand(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}) -> + type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}); +type_expand(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> + type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}); +type_expand(_G,_N,_X,Fd,Tabs,Name,_) -> + type_expand_error(Fd,Tabs,Name). + + +%% Basic OMG IDL types + +type_expand_null(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = null()~n",[Tabs,Name]). + +type_expand_void(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = void()~n",[Tabs,Name]). + +type_expand_float(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = float()~n",[Tabs,Name]). + +type_expand_double(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = double()~n",[Tabs,Name]). + +type_expand_longdouble(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = long_double()~n",[Tabs,Name]). + +type_expand_short(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = short()~n",[Tabs,Name]). + +type_expand_ushort(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = unsigned_Short()~n",[Tabs,Name]). + +type_expand_long(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = long()~n",[Tabs,Name]). + +type_expand_longlong(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = long_Long()~n",[Tabs,Name]). + +type_expand_ulong(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long()~n",[Tabs,Name]). + +type_expand_ulonglong(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long_Long()~n",[Tabs,Name]). + +type_expand_char(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = char()~n",[Tabs,Name]). + +type_expand_wchar(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = wchar()~n",[Tabs,Name]). + +type_expand_boolean(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = boolean()~n",[Tabs,Name]). + +type_expand_octet(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = octet()~n",[Tabs,Name]). + +type_expand_any(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = any()~n",[Tabs,Name]). + +type_expand_typecode(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = TypeCode()~n",[Tabs,Name]). + +type_expand_principal(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = principal()~n",[Tabs,Name]). + + +type_expand_fixed(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = fixed()~n",[Tabs,Name]). + +type_expand_object(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = Object_Ref()~n",[Tabs,Name]). + + +%% Constructed OMG IDL types + +type_expand_string(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = String()~n",[Tabs,Name]). + +type_expand_wstring(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = WString()~n",[Tabs,Name]). + +type_expand_exception(G, N, X, Fd, Tabs, Name, {tk_except, Id, ExcName, ElementList}) -> + ScopedStructName = getScopedName(G, N, ExcName, Id), + ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs, Name]), + type_expand_exception_rule(Fd, ScopedStructName, ElementList), + type_expand_all(G, N, X, Fd, Tabs, ElementList). + +type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> + ScopedStructName = getScopedName(G,N,StructName,IFRId), + ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), + type_expand_struct_rule(Fd,ScopedStructName,TcList), + type_expand_all(G,N,X,Fd,Tabs,TcList). + +type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, _DNr, LblList}) -> + ScopedUnionName = getScopedName(G,N,UnionName,IFRId), + ic_codegen:emit(Fd,"%%~s ~s = #'~s'{label, value}\n",[Tabs,Name,ScopedUnionName]), + type_expand(G,N,X,Fd,Tabs,"label",DTC), + ic_codegen:emit(Fd,"%%~s value = ",[Tabs]), + type_expand_union_rule(Fd,LblList), + type_expand_all(G,N,X,Fd,Tabs,LblList). + +type_expand_enum(Fd,Tabs,Name,{tk_enum, _IFRId, EnumName, ElemNameList}) -> + ic_codegen:emit(Fd,"%%~s ~s = ~s~n",[Tabs,Name,EnumName]), + type_expand_enum_rule(Fd,Tabs,EnumName,ElemNameList). + +type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, _Length}) -> + ic_codegen:emit(Fd,"%%~s ~s = [ ~sElem ]~n",[Tabs,Name,Name]), + type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). + +type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, _Length}) -> + ic_codegen:emit(Fd,"%%~s ~s = { ~sElem[,..~sElem] }~n",[Tabs,Name,Name,Name]), + type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). + +type_expand_error(Fd,Tabs,Name) -> + ic_codegen:emit(Fd,"%%~s ~s = ????~n",[Tabs,Name]). + + +type_expand_exception_rule(Fd,_Name,[]) -> + ic_codegen:emit(Fd," ???? "); +type_expand_exception_rule(Fd,Name,TcList) -> + ic_codegen:emit(Fd,"#'~s'{",[Name]), + type_expand_exception_rule(Fd,TcList). + +type_expand_exception_rule(Fd,[{Name,_TC}]) -> + ic_codegen:emit(Fd,"~s}~n",[Name]); +type_expand_exception_rule(Fd,[{Name,_TC}|Rest]) -> + ic_codegen:emit(Fd,"~s,",[Name]), + type_expand_exception_rule(Fd,Rest). + +type_expand_struct_rule(Fd,_Name,[]) -> + ic_codegen:emit(Fd," ???? "); +type_expand_struct_rule(Fd,Name,TcList) -> + ic_codegen:emit(Fd,"#'~s'{",[Name]), + type_expand_struct_rule(Fd,TcList). + +type_expand_struct_rule(Fd,[{Name,_TC}]) -> + ic_codegen:emit(Fd,"~s}~n",[Name]); +type_expand_struct_rule(Fd,[{Name,_TC}|Rest]) -> + ic_codegen:emit(Fd,"~s,",[Name]), + type_expand_struct_rule(Fd,Rest). + + +type_expand_union_rule(Fd,[]) -> + ic_codegen:emit(Fd," ????"); +type_expand_union_rule(Fd,[{default,_Name,_TC}]) -> + ic_codegen:emit(Fd,"Def~n",[]); +type_expand_union_rule(Fd,[{LNr,_Name,_TC}]) when is_integer(LNr)-> + ic_codegen:emit(Fd,"V~p~n",[LNr]); +type_expand_union_rule(Fd,[{Label,_Name,_TC}]) -> + ic_codegen:emit(Fd,"~s~n",[Label]); +type_expand_union_rule(Fd,[{default,_Name,_TC}|Rest]) -> + ic_codegen:emit(Fd,"Default | "), + type_expand_union_rule(Fd,Rest); +type_expand_union_rule(Fd,[{LNr,_Name,_TC}|Rest]) when is_integer(LNr) -> + ic_codegen:emit(Fd,"V~p | ",[LNr]), + type_expand_union_rule(Fd,Rest); +type_expand_union_rule(Fd,[{Label,_Name,_TC}|Rest]) -> + ic_codegen:emit(Fd,"~s | ",[Label]), + type_expand_union_rule(Fd,Rest). + + +type_expand_enum_rule(Fd,Tabs,Name,[]) -> + ic_codegen:emit(Fd,"%%~s ~s = ????",[Tabs,Name]); +type_expand_enum_rule(Fd,Tabs,Name,ElList) -> + ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), + type_expand_enum_rule(Fd,ElList). + +type_expand_enum_rule(Fd,[ElName]) -> + ic_codegen:emit(Fd,"'~s' ~n",[ElName]); +type_expand_enum_rule(Fd,[First|Rest]) -> + ic_codegen:emit(Fd,"'~s' | ",[First]), + type_expand_enum_rule(Fd,Rest). + +type_expand_enum_elements(_Fd,_Tabs,[]) -> + ok; +type_expand_enum_elements(Fd,Tabs,[Elem|Elems]) -> + ic_codegen:emit(Fd,"%%~s ~s = Atom()~n",[Tabs,Elem]), + type_expand_enum_elements(Fd,Tabs,Elems). + + + +%% Returns the right scoped name to be used +%% along with the expansion comments +getScopedName(G,N,Name,IfrId) -> + PTab = ic_genobj:pragmatab(G), + case ets:match(PTab,{alias,'$0',IfrId}) of + [] -> %% No Alias - should never happen + ic_util:to_undersc(ic_pragma:mk_scope(IfrId)); + [[[_S|N]]] -> %% An alias + ic_util:to_undersc([Name|N]); + [[[S|FoundScope]]] -> %% Maybe inherited + case ic_pragma:is_inherited_by(FoundScope,N,PTab) of + false -> %% Not inherited + ic_util:to_undersc([S|FoundScope]); + true -> %% inherited + ic_util:to_undersc([Name|N]) + end + end. + + +%% mk_list produces a nice comma separated +%% string of variable names +mk_list([]) -> []; +mk_list([Arg | Args]) -> + Arg ++ mk_list2(Args). +mk_list2([Arg | Args]) -> + ", " ++ Arg ++ mk_list2(Args); +mk_list2([]) -> []. + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + + + diff --git a/lib/ic/src/ic_codegen.erl b/lib/ic/src/ic_codegen.erl new file mode 100644 index 0000000000..f611c69bea --- /dev/null +++ b/lib/ic/src/ic_codegen.erl @@ -0,0 +1,419 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_codegen). + +-include_lib("ic/src/ic.hrl"). +-include_lib("ic/src/icforms.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([emit/2, emit/3]). +-export([emit_c_enc_rpt/4, emit_c_dec_rpt/4]). +-export([comment/2, comment/3, comment/4, comment_inlined/5, comment_prefixed/4]). +-export([mcomment/2, mcomment/3, mcomment_inlined/5, mcomment_prefixed/3]). +-export([mcomment_light/2, mcomment_light/3, mcomment_light_inlined/5, mcomment_light_prefixed/3]). +-export([nl/1, export/2]). +-export([record/5]). +-export([emit_stub_head/4, emit_hrl_head/4, emit_hrl_foot/2]). +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Emit output as a formatted string, (old emit) +%%-------------------------------------------------------------------- +emit(nil, _) -> ok; +emit(Fd, Str) -> + file:write(Fd, Str). + +emit(nil, _, _) -> ok; +emit(Fd, Fmt, Args) -> + file:write(Fd, io_lib:format(Fmt, Args)). + +emit_c_enc_rpt(Fd, Prefix, Fmt, Args) -> + emit(Fd, Prefix ++ "OE_RPT_ERR(\"Encode error: " ++ Fmt ++ "\");\n", Args). + +emit_c_dec_rpt(Fd, Prefix, Fmt, Args) -> + emit(Fd, Prefix ++ "OE_RPT_ERR(\"Decode error: " ++ Fmt ++ "\");\n", Args). + +%%-------------------------------------------------------------------- +%% Emit comments +%%-------------------------------------------------------------------- +comment(Fd, C) -> + comment_prefixed(Fd, C, [], "%%"). + +comment(Fd, C, A) -> + comment_prefixed(Fd, C, A, "%%"). + +comment(Fd, C, A, c) -> + comment_inlined(Fd, C, A, "/*", "*/"); +comment(Fd, C, A, erl) -> + comment_prefixed(Fd, C, A, "%%"); +comment(Fd, C, A, java) -> + comment_prefixed(Fd, C, A, "//"); +%% Should be removed after a check if it's used !!!!! (LTH) +comment(Fd, C, A, CommentSequence) when is_list(CommentSequence) -> + comment_prefixed(Fd, C, A, CommentSequence). + +comment_inlined(Fd, C, A, Start, End) -> + emit(Fd, Start ++ " " ++ C ++ " " ++ End ++"\n", A). + +comment_prefixed(Fd, C, A, Prefix) -> + emit(Fd, Prefix ++ " " ++ C ++ "\n", A). + +%%-------------------------------------------------------------------- +%% Emit multiline comments with nice delimiters +%%-------------------------------------------------------------------- +mcomment(Fd, List) -> + mcomment_prefixed(Fd, List, "%%"). + +mcomment(Fd, List, c) -> + mcomment_inlined(Fd, List, "/*", "*/", " *"); +mcomment(Fd, List, erl) -> + mcomment_prefixed(Fd, List, "%%"); +mcomment(Fd, List, java) -> + mcomment_prefixed(Fd, List, "//"). + +mcomment_inlined(Fd, List, Start, End, Intermediate) -> + emit(Fd, Start ++ + "------------------------------------------------------------\n"), + emit(Fd, Intermediate ++ "\n"), + lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), + emit(Fd, Intermediate ++ "\n"), + emit(Fd, Intermediate ++ + "------------------------------------------------------------" ++ End ++ "\n"), + ok. +mcomment_prefixed(Fd, List, Prefix) -> + emit(Fd, Prefix ++ + "------------------------------------------------------------\n"), + emit(Fd, Prefix ++ "\n"), + lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), + emit(Fd, Prefix ++ "\n"), + emit(Fd, Prefix ++ + "------------------------------------------------------------\n"), + ok. + + +%%-------------------------------------------------------------------- +%% Emit multiline comments with nice delimiters as above but a +%% little lighter +%%-------------------------------------------------------------------- +mcomment_light(Fd, List) -> + mcomment_light_prefixed(Fd, List, "%%"). + +mcomment_light(Fd, List, c) -> + mcomment_light_inlined(Fd, List, "/*", " */", " *"); +mcomment_light(Fd, List, erl) -> + mcomment_light_prefixed(Fd, List, "%%"); +mcomment_light(Fd, List, java) -> + mcomment_light_prefixed(Fd, List, "//"); +%% Should be removed after a check if it's used !!!!! (LTH) +mcomment_light(Fd, List, Prefix) when is_list(Prefix) -> + mcomment_light_prefixed(Fd, List, Prefix). + +mcomment_light_inlined(Fd, List, Start, End, Intermediate) -> + emit(Fd, "\n" ++ Start ++ "\n"), + lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), + emit(Fd, End ++ "\n"), + ok. + +mcomment_light_prefixed(Fd, List, Prefix) -> + emit(Fd, Prefix), + lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), + emit(Fd, Prefix ++ "\n"), + ok. + +%%-------------------------------------------------------------------- +%% New line +%%-------------------------------------------------------------------- +nl(Fd) -> + emit(Fd, "\n"). + + +%%-------------------------------------------------------------------- +-define(IFRIDFIELD(G), ic_util:mk_name(G, "ID")). + +%%-------------------------------------------------------------------- +%% Emit record definitions for erlang +%%-------------------------------------------------------------------- +record(G, X, Name, _IFRID, Recs) when is_record(X, struct) -> + F = ic_genobj:hrlfiled(G), + emit(F, "-record(~p, {~p", [ic_util:to_atom(Name),hd(Recs)]), + lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, tl(Recs)), + emit(F, "}).\n"); +record(G, X, Name, _IFRID, _Recs) when is_record(X, union) -> + F = ic_genobj:hrlfiled(G), + emit(F, "-record(~p, {label, value}).\n",[ic_util:to_atom(Name)]); +record(G, _X, Name, IFRID, Recs) when length(Recs) > 3 -> + F = ic_genobj:hrlfiled(G), + emit(F, "-record(~p,~n {~p=~p", + [ic_util:to_atom(Name), ic_util:to_atom(?IFRIDFIELD(G)), IFRID]), + rec2(F, "", ", ", Recs), + emit(F, "}).\n"); +record(G, _X, Name, IFRID, Recs) -> + F = ic_genobj:hrlfiled(G), + emit(F, "-record(~p, {~p=~p", [ic_util:to_atom(Name), + ic_util:to_atom(?IFRIDFIELD(G)), + IFRID]), + lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, Recs), + emit(F, "}).\n"). + + +rec2(F, Align, Delim, [M1 , M2, M3 | Ms]) -> + emit(F, "~s~s~p, ~p, ~p", [Delim, Align, M1, M2, M3]), + rec2(F, " ", ",\n", Ms); +rec2(F, Align, Delim, [M1 , M2]) -> + emit(F, "~s~s~p, ~p", [Delim, Align, M1, M2]); +rec2(F, Align, Delim, [M]) -> + emit(F, "~s~s~p", [Delim, Align, M]); +rec2(_F, _Align, _Delim, []) -> + ok. + + +%%-------------------------------------------------------------------- +%% Emit export lists for erlang +%%-------------------------------------------------------------------- +export(F, [E1, E2, E3 | Exports]) -> + emit(F, "-export([~s]).\n", [exp_list([E1, E2, E3])]), + export(F, Exports); +export(_F, []) -> ok; +export(F, Exports) -> + emit(F, "-export([~s]).\n", [exp_list(Exports)]). + +exp_list([E1 | L]) -> + exp_to_string(E1) ++ + lists:map(fun(E) -> ", " ++ exp_to_string(E) end, L). + + +exp_to_string({F,N}) -> io_lib:format("~p/~p", [ic_util:to_atom(F), N]). + + +%%-------------------------------------------------------------------- +%% Emit Stub file header +%%-------------------------------------------------------------------- +emit_stub_head(_G, ignore, _Name, _) -> ignore; +emit_stub_head(G, F1, Name, erlang) -> + mcomment(F1, stub_header(G, Name)), + nl(F1), + emit(F1, "-module(~p).\n", [list_to_atom(Name)]), + emit(F1, "-ic_compiled(~p).\n", [compiler_vsn(?COMPILERVSN)]), + emit(F1, "\n\n"), F1; +emit_stub_head(G, F1, Name, erlang_template) -> + ic_erl_template:emit_header(G, F1, Name), + F1; +emit_stub_head(_G, F1, _Name, erlang_template_no_gen) -> + F1; +emit_stub_head(G, F1, Name, c) -> + mcomment(F1, stub_header(G, Name), c), + emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), Name]), + emit(F1, "\n\n"), F1; +emit_stub_head(G, F1, Name, c_server) -> + CSName = [Name, "__s"], + mcomment(F1, stub_header(G, CSName), c), + emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), CSName]), + emit(F1, "\n\n"), F1; +emit_stub_head(G, F1, Name, java) -> + mcomment(F1, stub_header(G, Name), java), + emit(F1, "\n\n"), F1. + +stub_header(G, Name) -> + ["Implementation stub file", + "", + io_lib:format("Target: ~s", [Name]), + io_lib:format("Source: ~s", [ic_genobj:idlfile(G)]), + io_lib:format("IC vsn: ~s", [?COMPILERVSN]), + "", + "This file is automatically generated. DO NOT EDIT IT."]. + +compiler_vsn(Vsn) -> + lists:map(fun($.) -> $_; + (C) -> C + end, Vsn). + +%%-------------------------------------------------------------------- +%% Emit include file header +%%-------------------------------------------------------------------- +%% Name is Fully scoped (undescore) name of interface or module +emit_hrl_head(_G, ignore, _Name, _) -> ignore; +emit_hrl_head(G, Fd, Name, erlang) -> + mcomment(Fd, ["Erlang header file" | + hrl_header(G, Name)]), + nl(Fd), + nl(Fd), + IfdefName = ic_util:to_uppercase(Name++"_HRL"), + emit(Fd, "-ifndef(~s).~n", [IfdefName]), + emit(Fd, "-define(~s, true).~n", [IfdefName]), + nl(Fd), + nl(Fd), + Fd; +emit_hrl_head(G, Fd, Name, c) -> + mcomment(Fd, ["C header file" | + hrl_header(G, Name)], c), + nl(Fd), + nl(Fd), + IfdefName = ic_util:to_uppercase(Name++"_H"), + emit(Fd, "#ifndef ~s~n", [IfdefName]), + emit(Fd, "#define ~s ~n", [IfdefName]), + nl(Fd), + nl(Fd), + Fd; +emit_hrl_head(G, Fd, Name, c_server) -> + mcomment(Fd, ["C header file" | + hrl_header(G, [Name, "__s"])], c), + nl(Fd), + nl(Fd), + IfdefName = ic_util:to_uppercase(Name++"__S_H"), + emit(Fd, "#ifndef ~s~n", [IfdefName]), + emit(Fd, "#define ~s ~n", [IfdefName]), + nl(Fd), + nl(Fd), + Fd. + +hrl_header(G, Name) -> + ["", + io_lib:format("Target: ~s", [Name]), + io_lib:format("Source: ~s", [ic_genobj:idlfile(G)]), + io_lib:format("IC vsn: ~s", [?COMPILERVSN]), + "", + "This file is automatically generated. DO NOT EDIT IT."]. + + + + +%%-------------------------------------------------------------------- +%% Emit include file footer +%%-------------------------------------------------------------------- +emit_hrl_foot(_G, erlang_template) -> + ok; +emit_hrl_foot(_G, erlang_template_no_gen) -> + ok; +emit_hrl_foot(G, erlang) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "-endif.\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end; +emit_hrl_foot(G, erlang_no_stub) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "-endif.\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end; +emit_hrl_foot(G, c) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "#ifdef __cplusplus\n"), + emit(Fd, "}\n"), + emit(Fd, "#endif\n"), + nl(Fd), + emit(Fd, "#endif\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end; +emit_hrl_foot(G, c_server) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "#ifdef __cplusplus\n"), + emit(Fd, "}\n"), + emit(Fd, "#endif\n"), + nl(Fd), + emit(Fd, "#endif\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end; +emit_hrl_foot(G, c_no_stub) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "#ifdef __cplusplus\n"), + emit(Fd, "}\n"), + emit(Fd, "#endif\n"), + nl(Fd), + emit(Fd, "#endif\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end; +emit_hrl_foot(G, c_server_no_stub) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + nl(Fd), + nl(Fd), + emit(Fd, "#ifdef __cplusplus\n"), + emit(Fd, "}\n"), + emit(Fd, "#endif\n"), + nl(Fd), + emit(Fd, "#endif\n"), + nl(Fd), + nl(Fd), + Fd; + false -> + ok + end. + + + + + + + + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_constant_java.erl b/lib/ic/src/ic_constant_java.erl new file mode 100644 index 0000000000..0a3172363f --- /dev/null +++ b/lib/ic/src/ic_constant_java.erl @@ -0,0 +1,99 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_constant_java). + + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([gen/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: gen/3 +%%----------------------------------------------------------------- +gen(G, N, X) when is_record(X, const) -> + ConstantName = ic_forms:get_java_id(X), + case inInterface(G, N) of + true -> + emit_constant(G, N, X, ConstantName); + false -> + emit_constant_interface(G, N, X, ConstantName) + end; +gen(_G, _N, _X) -> + ok. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: emit_constant/4 +%%----------------------------------------------------------------- +emit_constant(G, N, X, ConstantName) -> + Fd = ic_genobj:interfacefiled(G), + %%?PRINTDEBUG2("~p", [Fd]), + Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), + ic_codegen:emit(Fd, " public static final ~s ~s = (~s) ~p;\n", + [Type, ConstantName, Type, X#const.val]), + ic_codegen:nl(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_constant_interface/4 +%%----------------------------------------------------------------- +emit_constant_interface(G, N, X, ConstantName) -> + {Fd, _} = ic_file:open_java_file(G, N, ConstantName), + + ic_codegen:emit(Fd, "final public class ~s {\n",[ConstantName]), + + Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), + ic_codegen:emit(Fd, " public static final ~s value = (~s) ~p;\n", + [Type, Type, X#const.val]), + ic_codegen:emit(Fd, "}\n", []), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_constant_interface/4 +%%----------------------------------------------------------------- +inInterface(_G, []) -> % Global constant + false; +inInterface(G, N) -> + [N1 |Ns] = N, + {_FullScopedName, T, _TK, _} = + ic_symtab:get_full_scoped_name(G, Ns, ic_symtab:scoped_id_new(N1)), + case T of + interface -> % Constant declare in an interface + true; + _ -> % Constant declared in a module + false + end. + diff --git a/lib/ic/src/ic_cserver.erl b/lib/ic/src/ic_cserver.erl new file mode 100644 index 0000000000..52d98c5795 --- /dev/null +++ b/lib/ic/src/ic_cserver.erl @@ -0,0 +1,2419 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_cserver). + +%% This module implements generation of C server code, where the +%% server acts as an Erlang C-node, where the functionality is that of +%% a gen_server (in C), and where the communication thus is according +%% to the Erlang distribution protocol. +%% + +-export([do_gen/3]). + +%% Silly dialyzer. +-export([filterzip/3]). + +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-import(lists, [foreach/2, foldl/3, foldr/3, map/2]). +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). + +-include("icforms.hrl"). +-include("ic.hrl"). +-include_lib("stdlib/include/erl_compile.hrl"). + +-define(IC_HEADER, "ic.h"). +-define(ERL_INTERFACEHEADER, "erl_interface.h"). +-define(EICONVHEADER, "ei.h"). +-define(OE_MSGBUFSIZE, "OE_MSGBUFSIZE"). +-define(ERLANGATOMLENGTH, "256"). + +%%------------------------------------------------------------ +%% +%% Entry point +%% +%%------------------------------------------------------------ +do_gen(G, File, Form) -> + OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), + G2 = ic_file:filename_push(G, [], OeName, c_server), + gen_headers(G2, [], Form), + R = gen(G2, [], Form), + ic_file:filename_pop(G2, c), + R. + +remove_ext(File) -> + filename:rootname(filename:basename(File)). + +%%------------------------------------------------------------ +%% +%% Generate the server side C stub and header files. +%% +%% For each module a separate file is generated. +%% +%% +%%------------------------------------------------------------ + +gen(G, N, [X| Xs]) when is_record(X, preproc) -> + NewG = change_file_stack(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, module) -> + CD = ic_code:codeDirective(G, X), + G2 = ic_file:filename_push(G, N, X, CD), + N2 = [ic_forms:get_id2(X)| N], + gen_headers(G2, N2, X), + gen(G2, N2, ic_forms:get_body(X)), + G3 = ic_file:filename_pop(G2, CD), + gen(G3, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, interface) -> + G2 = ic_file:filename_push(G, N, X, c_server), + N2 = [ic_forms:get_id2(X)| N], + gen_prototypes(G2, N2, X), + gen_serv(G2, N2, X), + G3 = ic_file:filename_pop(G2, c), + gen(G3, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, const) -> + emit_constant(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, op) -> + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, attr) -> + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, except) -> + icstruct:except_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, enum) -> + icenum:enum_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, typedef) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, struct) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [X| Xs]) when is_record(X, union) -> + icstruct:struct_gen(G, N, X, c), + gen(G, N, Xs); + +gen(G, N, [_| Xs]) -> + gen(G, N, Xs); + +gen(_G, _N, []) -> + ok. + +%%------------------------------------------------------------ +%% Change file stack +%%------------------------------------------------------------ + +change_file_stack(G, _N, line_nr, X) -> + Id = ic_forms:get_id2(X), + Flags = X#preproc.aux, + case Flags of + [] -> ic_genobj:push_file(G, Id); + _ -> + foldr( + fun({_, _, "1"}, G1) -> ic_genobj:push_file(G1, Id); + ({_, _, "2"}, G1) -> ic_genobj:pop_file(G1, Id); + ({_, _, "3"}, G1) -> ic_genobj:sys_file(G1, Id) + end, G, Flags) + end; +change_file_stack(G, _N, _Other, _X) -> + G. + +%%------------------------------------------------------------ +%% Generate headers +%%------------------------------------------------------------ + +%% Some items have extra includes +gen_headers(G, N, X) when is_record(X, module) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + HFd = ic_genobj:hrlfiled(G), + IncludeFileStack = ic_genobj:include_file_stack(G), + Filename = lists:nth(length(N) + 1, IncludeFileStack), + emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), + ic_code:gen_includes(HFd, G, X, c_server); + false -> ok + end; +gen_headers(G, [], _X) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + HFd = ic_genobj:hrlfiled(G), + emit(HFd, "#include <stdlib.h>\n"), + case ic_options:get_opt(G, c_report) of + true -> + emit(HFd, "#ifndef OE_C_REPORT\n"), + emit(HFd, "#define OE_C_REPORT\n"), + emit(HFd, "#include <stdio.h>\n"), + emit(HFd, "#endif\n"); + _ -> + ok + end, + emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), + emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), + emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), + ic_code:gen_includes(HFd, G, c_server); + false -> ok + end; +gen_headers(_G, _N, _X) -> + ok. + +%%------------------------------------------------------------ +%% Generate prototypes +%%------------------------------------------------------------ + +gen_prototypes(G, N, X) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + HFd = ic_genobj:hrlfiled(G), + IncludeFileStack = ic_genobj:include_file_stack(G), + L = length(N), + Filename = + if + L < 2 -> + lists:nth(L + 1, IncludeFileStack); + true -> + lists:nth(2, IncludeFileStack) + end, + + IName = ic_util:to_undersc(N), + INameUC = ic_util:to_uppercase(IName), + + emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), + ic_code:gen_includes(HFd, G, X, c_server), + ic_codegen:nl(HFd), + + emit(HFd, "\n#ifndef __~s__\n", [ic_util:to_uppercase(IName)]), + emit(HFd, "#define __~s__\n", [ic_util:to_uppercase(IName)]), + ic_codegen:mcomment_light(HFd, + [io_lib:format("Interface " + "object " + "definition: ~s", + [IName])], c), + case get_c_timeout(G, "") of + "" -> + ok; + {SendTmo, RecvTmo} -> + emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", + [INameUC, SendTmo]), + emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", + [INameUC, RecvTmo]), + emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"), + emit(HFd, "#error Functions for send and receive with " + "timeout not defined in erl_interface\n"), + emit(HFd, "#endif\n\n") + end, + + emit(HFd, "typedef CORBA_Object ~s;\n\n", [IName]), + emit(HFd, "#endif\n\n"), + + Bodies = [{N, ic_forms:get_body(X)}| X#interface.inherit_body], + + emit(HFd, "\n/* Structure definitions */\n", []), + foreach(fun({N2, Body}) -> + emit_structs_inside_module(G, HFd, N2, Body) end, + Bodies), + + emit(HFd, "\n/* Switch and exec functions */\n", []), + emit(HFd, "int ~s__switch(~s oe_obj, CORBA_Environment " + "*oe_env);\n", [IName, IName]), + foreach(fun({_N2, Body}) -> + emit_exec_prototypes(G, HFd, N, Body) end, + Bodies), + + emit(HFd, "\n/* Generic decoder */\n", []), + emit(HFd, "int ~s__call_info(~s oe_obj, CORBA_Environment " + "*oe_env);\n", [IName, IName]), + + emit(HFd, "\n/* Restore function typedefs */\n", []), + foreach(fun({_N2, Body}) -> + emit_restore_typedefs(G, HFd, N, Body) end, + Bodies), + + emit(HFd, "\n/* Callback functions */\n", []), + foreach(fun({_N2, Body}) -> + emit_callback_prototypes(G, HFd, N, Body) end, + Bodies), + + emit(HFd, "\n/* Parameter decoders */\n", []), + foreach(fun({_N2, Body}) -> + emit_decoder_prototypes(G, HFd, N, Body) end, + Bodies), + + emit(HFd, "\n/* Message encoders */\n", []), + foreach(fun({_N2, Body}) -> + emit_encoder_prototypes(G, HFd, N, Body) end, + Bodies), + + %% Emit operation mapping structures + emit_operation_mapping_declaration(G, HFd, N, Bodies), + + ok; + + false -> + ok + end. + +%%------------------------------------------------------------ +%% Generate the server encoding/decoding function +%%------------------------------------------------------------ + + +gen_serv(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + Fd = ic_genobj:stubfiled(G), + + emit_switch(G, Fd, N, X), + emit_server_generic_decoding(G, Fd, N), + + %% Sets the temporary variable counter. + put(op_variable_count, 0), + put(tmp_declarations, []), + + %% Generate exec, decode and encoding functions, and + %% table of exec functions. + Bodies = [{N, ic_forms:get_body(X)}| + X#interface.inherit_body], + + foreach(fun({_N2, Body}) -> + emit_dispatch(G, Fd, N, Body) end, + Bodies), + emit_operation_mapping(G, Fd, N, Bodies); + false -> + ok + end. + +%%------------------------------------------------------------ +%% Emit structs inside module +%%------------------------------------------------------------ + +emit_structs_inside_module(G, _Fd, N, Xs)-> + lists:foreach( + fun(X) when is_record(X, enum) -> + icenum:enum_gen(G, N, X, c); + (X) when is_record(X, typedef) -> + icstruct:struct_gen(G, N, X, c); + (X) when is_record(X, struct) -> + icstruct:struct_gen(G, N, X, c); + (X) when is_record(X, union) -> + icstruct:struct_gen(G, N, X, c); + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% Emit exec prototypes +%%------------------------------------------------------------ + +emit_exec_prototypes(G, Fd, N, Xs) -> + lists:foreach( + fun(X) when is_record(X, op) -> + {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), + emit(Fd, + "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env);\n", + [ScopedName, ic_util:to_undersc(N)]); + (X) when is_record(X, const) -> + emit_constant(G, N, X); + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% Emit restore typedefs +%%------------------------------------------------------------ + +emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, op) -> + %% Check if to use scoped call names + {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), + {RetType, ParTypes, _} = Types, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + RT = mk_c_ret_type(G, N, RetType), + + PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X, + TypeAttrArgs)), + RPL = case PL of + "" -> + ""; + _PL -> + ", " ++ PL + end, + + case RT of + "void" -> + case PL of + "" -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N)]); + _ -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), PL]) + end; + + "erlang_port*" -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), RT, RPL]); + + "erlang_pid*" -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), RT, RPL]); + + "erlang_ref*" -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), RT, RPL]); + + _ -> + case ictype:isArray(G, N, RetType) of + true -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), RT, RPL]); + false -> + emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s*~s, " + "CORBA_Environment *oe_env));\n", + [ScopedName, ic_util:to_undersc(N), RT, RPL]) + end + end, + emit_restore_typedefs(G, Fd, N, Xs); +emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, attr) -> + emit_restore_typedefs(G, Fd, N, Xs); +emit_restore_typedefs(G, Fd, N, [_X| Xs]) -> + emit_restore_typedefs(G, Fd, N, Xs); +emit_restore_typedefs(_G, _Fd, _N, []) -> ok. + + +%%------------------------------------------------------------ +%% Emit call-back prototypes +%%------------------------------------------------------------ + +emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> + %% Check scoped names XXX + {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), + {RetType, ParTypes, _} = Types, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + RT = mk_c_ret_type(G, N, RetType), + + PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X, + TypeAttrArgs)), + CBPL = case PL of + "" -> + ""; + _PL -> + ", " ++ PL + end, + case RT of + "void" -> + case PL of + "" -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N)]); + _ -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), PL]) + end; + "erlang_port*" -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); + + "erlang_pid*" -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); + + "erlang_ref*" -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); + + _ -> + case ictype:isArray(G, N, RetType) of + true -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), RT, + CBPL]); + false -> + emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s*~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ScopedName, ic_util:to_undersc(N), RT, + CBPL]) + end + end, + emit_callback_prototypes(G, Fd, N, Xs); +emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> + emit_callback_prototypes(G, Fd, N, Xs); +emit_callback_prototypes(G, Fd, N, [_X| Xs]) -> + emit_callback_prototypes(G, Fd, N, Xs); +emit_callback_prototypes(_G, _Fd, _N, []) -> ok. + +%%------------------------------------------------------------ +%% Emit decoder prototypes +%%------------------------------------------------------------ + +emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> + %% Check if to use scoped call names + {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), + {_RetType, ParTypes, _} = Types, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + case ic_util:mk_list(mk_par_list_for_decoder_prototypes(G, N, X, + TypeAttrArgs)) of + "" -> + ok; + PLFDP -> + emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment " + "*oe_env);\n", + [ScopedName, ic_util:to_undersc(N), PLFDP]) + end, + emit_decoder_prototypes(G, Fd, N, Xs); +emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> + emit_decoder_prototypes(G, Fd, N, Xs); +emit_decoder_prototypes(G, Fd, N, [_X| Xs]) -> + emit_decoder_prototypes(G, Fd, N, Xs); +emit_decoder_prototypes(_G, _Fd, _N, []) -> ok. + + +%%------------------------------------------------------------ +%% Emit encoder prototypes +%%------------------------------------------------------------ + +emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> + case ic_forms:is_oneway(X) of + true -> + emit_encoder_prototypes(G, Fd, N, Xs); + false -> + %% Check if to use scoped call names + {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), + {RetType, ParTypes, _} = Types, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + RType = mk_c_ret_type(G, N, RetType), + case ic_util:mk_list(mk_par_list_for_encoder_prototypes( + G, N, X, TypeAttrArgs)) of + "" -> + case RType of + "void" -> + emit(Fd, "int ~s__enc(~s oe_obj, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ic_util:to_undersc(N)]); + _ -> + emit(Fd, "int ~s__enc(~s oe_obj, ~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ic_util:to_undersc(N), RType]) + end; + PLFEP -> + case RType of + "void" -> + emit(Fd, "int ~s__enc(~s oe_obj, ~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ic_util:to_undersc(N), PLFEP]); + _ -> + emit(Fd, "int ~s__enc(~s oe_obj, ~s, ~s, " + "CORBA_Environment *oe_env);\n", + [ScopedName, ic_util:to_undersc(N), RType, + PLFEP]) + end + end, + emit_encoder_prototypes(G, Fd, N, Xs) + end; +emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> + emit_encoder_prototypes(G, Fd, N, Xs); +emit_encoder_prototypes(G, Fd, N, [_X| Xs]) -> + emit_encoder_prototypes(G, Fd, N, Xs); +emit_encoder_prototypes(_G, _Fd, _N, []) -> ok. + +%%------------------------------------------------------------ +%% Emit operation mapping declaration +%%------------------------------------------------------------ + +emit_operation_mapping_declaration(G, Fd, N, Bodies) -> + Interface = ic_util:to_undersc(N), + Length = erlang:length(get_all_opnames(G, N, Bodies)), + emit(Fd, "\n/* Operation mapping */\n", []), + emit(Fd, "extern oe_map_t oe_~s_map;\n", [Interface]), + emit(Fd, "/* For backward compatibility */\n"), + emit(Fd, "#define ___~s_map___ oe_~s_map\n", + [Interface, Interface]), + case Length of + 0 -> + ok; + _ -> + emit(Fd, "extern oe_operation_t oe_~s_operations[];\n", + [Interface]), + emit(Fd, "/* For backward compatibility */\n"), + emit(Fd, "#define ___~s_operations___ oe_~s_operations\n", + [Interface, Interface]) + end. + + +%% Returns a list of {OpName, ScopedOpName} for all operations, where +%% OpName == ScopedOpName in case the `scoped_op_calls' option has +%% been set. +%% +get_all_opnames(G, N, Bodies) -> + ScNF = fun(X) -> + {ScName, _, _} = ic_cbe:extract_info(G, N, X), + ScName + end, + NF = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ScNF; + false -> + fun(X) -> ic_forms:get_id2(X) end + end, + Filter = fun(X) when is_record(X, op) -> + {true, {NF(X), ScNF(X)}}; + (_) -> + false + end, + %% zf == filtermap + lists:flatmap(fun({_, Xs}) -> lists:zf(Filter, Xs) end, Bodies). + +%%------------------------------------------------------------ +%% Emit switch +%%------------------------------------------------------------ + +emit_switch(G, Fd, N, _X) -> + emit(Fd, "#include <string.h>\n"), + case ic_options:get_opt(G, c_report) of + true -> + emit(Fd, "#ifndef OE_C_REPORT\n"), + emit(Fd, "#define OE_C_REPORT\n"), + emit(Fd, "#include <stdio.h>\n"), + emit(Fd, "#endif\n"); + _ -> + ok + end, + StartCode = + "#include \"ic.h\"\n" + "#include \"erl_interface.h\"\n" + "#include \"ei.h\"\n" + "#include \"~s__s.h\"\n\n" + "/*\n" + " * Main switch\n" + " */\n\n" + "int ~s__switch(~s oe_obj, CORBA_Environment *oe_env)\n" + "{\n" + " return oe_exec_switch(oe_obj, oe_env, &oe_~s_map);\n" + "}\n\n", + ScopedName = ic_util:to_undersc(N), + emit(Fd, StartCode, [ScopedName, ScopedName, ScopedName, ScopedName]). + +%%------------------------------------------------------------ +%% Emit server generic decoding. +%%------------------------------------------------------------ + +emit_server_generic_decoding(G, Fd, N) -> + UserProto = get_user_proto(G, oe), + Code = + "/*\n" + " * Returns call identity (left only for backward compatibility)\n" + " */\n\n" + "int ~s__call_info(~s oe_obj, CORBA_Environment *oe_env)\n" + "{\n" + " return ~s_prepare_request_decoding(oe_env);\n" + "}\n\n", + IName = ic_util:to_undersc(N), + emit(Fd, Code, [IName, IName, UserProto]). + +%%------------------------------------------------------------ +%% Emit dispatch +%%------------------------------------------------------------ + +emit_dispatch(G, Fd, N, Xs) -> + lists:foreach( + fun(X) when is_record(X, op) -> + {Name, ArgNames, Types} = ic_cbe:extract_info(G, N, X), + {RetType, ParTypes, _} = Types, + TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), + emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs), + emit_parameter_decoder(G, Fd, N, X, Name, RetType, TypeAttrArgs), + emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs); + (_) -> + ok + end, Xs). + +%%------------------------------------------------------------ +%% Emit operation mapping +%%------------------------------------------------------------ + +emit_operation_mapping(G, Fd, N, Bodies) -> + OpNames = get_all_opnames(G, N, Bodies), + Interface = ic_util:to_undersc(N), + Length = erlang:length(OpNames), + emit(Fd, "\n/* Operation mapping */\n\n", []), + case Length of + 0 -> + emit(Fd, "oe_map_t oe_~s_map = { 0, NULL };\n\n", [Interface]); + _ -> + emit(Fd, "\noe_operation_t oe_~s_operations[~p] = {\n", + [Interface, Length]), + Members = lists:map( + fun({OpN, ScOpN}) -> + Name = ic_util:to_undersc([OpN]), + ScName = ic_util:to_undersc([ScOpN]), + io_lib:fwrite(" {~p, ~p, ~s__exec}", + [Interface, Name, ScName]) + end, OpNames), + emit(Fd, ic_util:join(Members, ",\n")), + emit(Fd, "};\n\n", []), + emit(Fd, "oe_map_t oe_~s_map = " + "{~p, oe_~s_operations};\n\n", + [Interface, Length, Interface]) + end. + +%%------------------------------------------------------------ +%% Emit constant +%%------------------------------------------------------------ + +emit_constant(G, N, ConstRecord) -> + case ic_genobj:is_hrlfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:hrlfiled(G), + CName = ic_util:to_undersc( + [ic_forms:get_id(ConstRecord#const.id)| N]), + UCName = ic_util:to_uppercase(CName), + + emit(Fd, "\n#ifndef __~s__\n", [UCName]), + emit(Fd, "#define __~s__\n\n", [UCName]), + + emit(Fd, "/* Constant: ~s */\n", [CName]), + + if is_record(ConstRecord#const.type, wstring) -> + %% If wstring, add 'L' + emit(Fd, "#define ~s L~p\n\n", [CName, + ConstRecord#const.val]); + true -> + emit(Fd, "#define ~s ~p\n\n", [CName, + ConstRecord#const.val]) + end, + + emit(Fd, "#endif\n\n") + end. + +%%------------------------------------------------------------ +%% Emit exec function +%%------------------------------------------------------------ + +emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> + %% Decoding operation specific part + InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true; + ({_, _, _}) -> false + end, TypeAttrArgs), + ic_codegen:nl(Fd), + + emit(Fd, + "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env)\n" + "{\n", + [Name, ic_util:to_undersc(N)]), + + emit(Fd, " if (oe_env->_received != ~p) {\n", [length(InTypeAttrArgs)]), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, BAD_PARAM, " + "\"Wrong number of operation parameters\");\n"), + emit_c_dec_rpt(Fd, " ", "wrong number of parameters", []), + emit_c_dec_rpt(Fd, " ", "server exec ~s\\n====\\n", [Name]), + emit(Fd, " return -1;\n", []), + emit(Fd, " }\n"), + emit(Fd, " else {\n", []), + + case InTypeAttrArgs of + [] -> + true; + _ -> + emit(Fd, " int oe_error_code = 0;\n") + end, + + %% Callback variable definition + emit_variable_defs(G, Fd, N, X, Name, RetType, TypeAttrArgs), + + %% Call to parameter decoder + emit_parameter_decoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs), + + %% Callback to user code + emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs), + + %% Call to return message encoder + case ic_forms:is_oneway(X) of + true -> + true; + false -> + emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) + end, + + %% Restore function call + emit_restore(G, Fd, N, X, Name, RetType, TypeAttrArgs), + + emit(Fd, " }\n return 0;\n}\n\n"). + +%%------------------------------------------------------------ +%% Emit parameter decoder +%%------------------------------------------------------------ + +emit_parameter_decoder(G, Fd, N, X, Name, _RetType, TypeAttrArgs) -> + %% Decoding operation specific part + InTypeAttrArgs = + lists:filter(fun({_, in, _}) -> true; + ({_, _, _}) -> false + end, TypeAttrArgs), + case InTypeAttrArgs of + [] -> + ok; + _ -> + case ic_util:mk_list(mk_par_list_for_decoder(G, N, X, + TypeAttrArgs)) of + "" -> + emit(Fd, "int ~s__dec(~s oe_obj, CORBA_Environment " + "*oe_env)\n{\n int oe_error_code;\n\n", + [Name, ic_util:to_undersc(N)]); + PLFD -> + emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment " + "*oe_env)\n{\n", + [Name, ic_util:to_undersc(N), PLFD]), + emit(Fd, " int oe_error_code;\n\n") + end, + + APars = [], % XXX Alloced parameters + foldl( + fun({{'void', _}, _, _}, _Acc) -> + ok; + ({T1, A1, N1}, Acc) -> + emit_one_decoding(G, N, Fd, T1, A1, N1, Acc) + end, APars, InTypeAttrArgs), + + emit(Fd, " return 0;\n}\n\n") + end. + +%%------------------------------------------------------------ +%% Emit one decoding +%%------------------------------------------------------------ + +emit_one_decoding(G, N, Fd, T1, A1, N1, AllocedPars) -> + IndOp = mk_ind_op(A1), + case ic_cbe:is_variable_size(G, N, T1) of + false -> + %% The last parameter "oe_outindex" is not used in + %% the static case but must be there anyhow. + emit_decoding_stmt(G, N, Fd, T1, + N1, "", "oe_env->_inbuf", 1, "&oe_outindex", + caller, AllocedPars), + ic_codegen:nl(Fd), + AllocedPars; + true -> + emit_encoding_comment(G, N, Fd, "Decode", IndOp, T1, N1), + emit(Fd, " {\n"), + emit(Fd, " int oe_size_count_index = oe_env->_iin;\n"), + emit(Fd, " int oe_malloc_size = 0;\n"), + emit(Fd, " void *oe_first = NULL;\n"), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, T1, + "oe_env->_inbuf", 1, caller), + %% This is the only malloc call in this file + emit(Fd, + " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" + " if ((*~s = oe_first = " + "malloc(oe_malloc_size)) == NULL) {\n", [N1]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit(Fd, + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "NO_MEMORY, \"Cannot malloc\");\n" + " return -1;\n" + " }\n"), + ParName = "*" ++ N1, % XXX Why not IndOp? + NAllocedPars = [ParName| AllocedPars], + case ictype:isArray(G, N, T1) of + true -> + emit_decoding_stmt(G, N, Fd, T1, + "(*" ++ IndOp ++ N1 ++ ")", "", + "oe_env->_inbuf", 1, "&oe_outindex", + array_dyn, NAllocedPars); + false -> + emit_decoding_stmt(G, N, Fd, T1, + "(*" ++ IndOp ++ N1 ++ ")", "", + "oe_env->_inbuf", 1, "&oe_outindex", + caller_dyn, NAllocedPars) + end, + emit(Fd, " }\n\n"), + NAllocedPars + end. + +%%------------------------------------------------------------ +%% Emit message encoder +%%------------------------------------------------------------ + +emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> + case ic_forms:is_oneway(X) of + false -> + %% Encoding operation specific part + emit(Fd, + "\nint ~s__enc(~s oe_obj", + [Name, ic_util:to_undersc(N)]), + RType = mk_c_ret_type(G, N, RetType), + ParList = mk_par_list_for_encoder(G, N, X, TypeAttrArgs), + case ic_util:mk_list(ParList) of + "" -> + case RType of + "void" -> + emit(Fd, ", CORBA_Environment *oe_env)\n{"); + _ -> + emit(Fd, ", ~s oe_return, CORBA_Environment " + "*oe_env)\n{", [RType]) + end; + PLFD -> + case RType of + "void" -> + emit(Fd, ", ~s, CORBA_Environment " + "*oe_env)\n{", [PLFD]); + _ -> + emit(Fd, ", ~s oe_return~s, CORBA_Environment " + "*oe_env)\n{", [RType, ", " ++ PLFD]) + end + end, + + + emit(Fd, "\n"), + emit(Fd, " int oe_error_code;\n\n"), + UserProto = get_user_proto(G, oe), + emit(Fd, " ~s_prepare_reply_encoding(oe_env);\n", [UserProto]), + + OutTypeAttrArgs = + lists:filter(fun({_, out, _}) -> true; + ({_, _, _}) -> false + end, TypeAttrArgs), + + OutLength = length(OutTypeAttrArgs), + case OutLength > 0 of + false -> + ic_codegen:nl(Fd); + true -> + emit(Fd, " oe_ei_encode_tuple_header(oe_env, ~p);\n\n", + [OutLength+1]) + + end, + + emit_encoding_comment(G, N, Fd, "Encode", "", RetType, + "oe_return"), + emit_encoding_stmt(G, N, X, Fd, RetType, "oe_return"), + + foreach(fun({T1, _A1, N1}) -> + case T1 of + {'void', _} -> + ok; + _ -> + emit_encoding_comment(G, N, Fd, "Encode", + "", T1, N1), + emit_encoding_stmt(G, N, X, Fd, T1, N1) + end + end, OutTypeAttrArgs), + emit(Fd, " return 0;\n}\n\n"); + _ -> + %% Oneway + ok + end. + +%%------------------------------------------------------------ +%% Emit message encoder call +%%------------------------------------------------------------ + +emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> + emit(Fd, " /* Encoding reply message */\n"), + RType = mk_c_ret_type(G, N, RetType), + case ic_util:mk_list(mk_enc_par_list(G, N, X, TypeAttrArgs)) of + "" -> + case RType of + "void" -> + emit(Fd, " ~s(oe_obj, oe_env);\n", + [Name ++ "__enc"]); + "erlang_pid*" -> + emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", + [Name ++ "__enc"]); + "erlang_port*" -> + emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", + [Name ++ "__enc"]); + "erlang_ref*" -> + emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", + [Name ++ "__enc"]); + _ -> + emit(Fd, " ~s(oe_obj, oe_return, oe_env);\n", + [Name ++ "__enc"]) + end; + + PLFE -> + case RType of + "void" -> + emit(Fd, " ~s(oe_obj, ~s, oe_env);\n", + [Name ++ "__enc", PLFE]); + "erlang_pid*" -> + emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", + [Name ++ "__enc", PLFE]); + "erlang_port*" -> + emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", + [Name ++ "__enc", PLFE]); + "erlang_ref*" -> + emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", + [Name ++ "__enc", PLFE]); + _ -> + emit(Fd, " ~s(oe_obj, oe_return, ~s, oe_env);\n", + [Name ++ "__enc", PLFE]) + end + end, + ic_codegen:nl(Fd). + +%%------------------------------------------------------------ +%% Emit parameter decoding call +%%------------------------------------------------------------ + +emit_parameter_decoder_call(G, Fd, N, X, Name, _R, TypeAttrArgs) -> + case ic_util:mk_list(mk_dec_par_list(G, N, X, TypeAttrArgs)) of + "" -> %% No parameters ! skip it ! + ok; + PLFDC -> + ParDecName = Name ++ "__dec", + emit(Fd, + " /* Decode parameters */\n" + " if((oe_error_code = ~s(oe_obj, ~s, oe_env)) < 0) {\n", + [ParDecName, PLFDC]), + emit_c_dec_rpt(Fd, " ", "parmeters", []), + emit(Fd, + " if(oe_env->_major == CORBA_NO_EXCEPTION)\n" + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad parameter on decode\");\n" + " return oe_error_code;\n }\n\n") + end. + +%%------------------------------------------------------------ +%% Emit call-back +%%------------------------------------------------------------ + +emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> + CallBackName = Name ++ "__cb", + emit(Fd, " /* Callback function call */\n"), + PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), + case ic_forms:is_oneway(X) of + true -> + case PL of + "" -> + emit(Fd, " oe_restore = ~s(oe_obj, oe_env);\n\n", + [CallBackName]); + _ -> + emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);\n\n", + [CallBackName, PL]) + end; + false -> + CBPL = case PL of + "" -> + ""; + _PL -> + ", " ++ PL + end, + case mk_c_ret_type(G, N, RetType) of + "void" -> + case PL of + "" -> + emit(Fd, " oe_restore = ~s(oe_obj, oe_env);" + "\n\n", [CallBackName]); + _ -> + emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);" + "\n\n", [CallBackName, PL]) + end; + _ -> + case ictype:isArray(G, N, RetType) of + true -> + emit(Fd, + " oe_restore = ~s(oe_obj, oe_return~s, " + " oe_env);\n\n", [CallBackName, CBPL]); + false -> + emit(Fd, " oe_restore = ~s(oe_obj, " + "&oe_return~s, oe_env);\n\n", + [CallBackName, CBPL]) + end + end + end. + +%%------------------------------------------------------------ +%% Emit restore +%%------------------------------------------------------------ + +emit_restore(G, Fd, N, X, _Name, RetType, TypeAttrArgs) -> + emit(Fd, " /* Restore function call */\n"), + emit(Fd, " if (oe_restore != NULL)\n"), + PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), + case ic_forms:is_oneway(X) of + true -> + case PL of + "" -> + emit(Fd, " (*oe_restore)(oe_obj, oe_env);\n\n"); + _ -> + emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);\n\n", + [PL]) + end; + false -> + RPL = case PL of + "" -> + ""; + _PL -> + ", " ++ PL + end, + case mk_c_ret_type(G, N, RetType) of + "void" -> + case PL of + "" -> + emit(Fd, " (*oe_restore)(oe_obj, oe_env);" + "\n\n"); + _ -> + emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);" + "\n\n", [PL]) + end; + _ -> + case ictype:isArray(G, N, RetType) of + true -> + emit(Fd, + " (*oe_restore)(oe_obj, oe_return~s, " + " oe_env);\n\n", [RPL]); + false -> + emit(Fd, " (*oe_restore)(oe_obj, " + "&oe_return~s, oe_env);\n\n", [RPL]) + end + end + end. + +%%------------------------------------------------------------ +%% Emit variable defs +%%------------------------------------------------------------ + +emit_variable_defs(G, Fd, N, X, _Name, RetType, TypeAttrArgs) -> + {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), + emit(Fd, " ~s__rs* oe_restore = NULL;\n", [ScopedName]), + RestVars = mk_var_list(mk_var_decl_list(G, N, X, TypeAttrArgs)), + case ic_forms:is_oneway(X) of + true -> + emit(Fd, "~s\n\n", [RestVars]); + false -> + RType = mk_c_ret_type(G, N, RetType), + case RType of + "void" -> + emit(Fd, "~s\n\n", [RestVars]); + "CORBA_unsigned_long" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_unsigned_long_long" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_unsigned_short" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_short" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_long" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_long_long" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_float" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_double" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_char" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_wchar" -> %% WCHAR + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_boolean" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + "CORBA_octet" -> + emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); + _ -> + case ic_cbe:is_variable_size(G, N, RetType) of + true -> + emit(Fd, "~s ~s oe_return;\n\n", + [RestVars, RType]); + false -> + TK = ic_forms:get_tk(X), + case TK of + {tk_enum, _, _, _List} -> + emit(Fd, "~s ~s oe_return;\n\n", + [RestVars, RType]); + _ -> + case RType of + "erlang_binary*" -> + emit(Fd, "~s erlang_binary " + "oe_return;\n\n", [RestVars]); + "erlang_pid*" -> + emit(Fd, "~s erlang_pid " + "oe_return;\n\n", [RestVars]); + "erlang_port*" -> + emit(Fd, "~s erlang_port " + "oe_return;\n\n", [RestVars]); + "erlang_ref*" -> + emit(Fd, "~s erlang_ref " + "oe_return;\n\n", [RestVars]); + _ -> + %% Structures are + %% initiated by memset + emit(Fd, "~s ~s " + "oe_return;\n\n", + [RestVars, RType]) + end, + emit(Fd, " memset(&oe_return, 0, " + "sizeof(oe_return));\n\n") + end + end + end + end. + +%%------------------------------------------------------------ +%% Make variable list +%%------------------------------------------------------------ + +%% XXX Modify +mk_var_list([]) -> + ""; +mk_var_list([Arg| Args]) -> + " " ++ Arg ++ ";\n" ++ mk_var_list(Args). + +%%------------------------------------------------------------ +%% Make return type +%%------------------------------------------------------------ + +mk_c_ret_type(G, N, Type) -> + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "*"; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> %% WSTRING + "*"; + Ctype == "CORBA_wchar *" -> %% WSTRING + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" + end + end; + false -> + if + Ctype == "erlang_pid" -> + "*"; + Ctype == "erlang_port" -> + "*"; + Ctype == "erlang_ref" -> + "*"; + true -> + "" + end + end, + Ctype ++ Dyn. + +%%------------------------------------------------------------ +%% Make call-back parameter list +%%------------------------------------------------------------ + +mk_cb_par_list(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], TypeAttrArgs0), + lists:map( + fun({Type, Attr, Arg}) -> + case ic_cbe:is_variable_size(G, N, Type) of + true -> + case Attr of + in -> + Arg; + out -> + case ictype:isArray(G, N, Type) of + true -> + Arg; + _ -> + "&" ++ Arg + end + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + Arg; + _ -> + "&" ++ Arg + end + end + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make decoder parameter list +%%------------------------------------------------------------ + +mk_dec_par_list(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], + TypeAttrArgs0), + lists:map( + fun({Type, _Attr, Arg}) -> + Ctype = mk_c_type(G, N, Type), + case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "&" ++ Arg; + Ctype == "CORBA_char *" -> + Arg; + is_record(Type, wstring) -> + "&" ++ Arg; + Ctype == "CORBA_wchar *" -> + Arg; + true -> + "&" ++ Arg + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + Arg; + _ -> + "&" ++ Arg + end + end + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make encoder parameter list +%%------------------------------------------------------------ + +mk_enc_par_list(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], + TypeAttrArgs0), + lists:map( + fun({Type, _Attr, Arg}) -> + Ctype = mk_c_type(G, N, Type), + case Ctype of + "erlang_pid" -> + "&" ++ Arg; + "erlang_port" -> + "&" ++ Arg; + "erlang_ref" -> + "&" ++ Arg; + _ -> + Arg + end + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make type argument list +%%------------------------------------------------------------ + +mk_type_attr_arg_list(Types, Args) -> + filterzip( + fun(Type, {Attr, Arg}) -> + {true, {Type, Attr, Arg}} + end, Types, Args). + +%%------------------------------------------------------------ +%% Filter type argument list +%%------------------------------------------------------------ + +filter_type_attr_arg_list(G, X, InOrOut, TypeAttrArgs) -> + lists:filter( + + fun({_Type, inout, Arg}) -> + ic_error:error(G, {inout_spec_for_c, X, Arg}), + false; + ({_Type, Attr, _Arg}) -> + lists:member(Attr, InOrOut) + end, TypeAttrArgs). + +%%------------------------------------------------------------ +%% Make indirection operator +%%------------------------------------------------------------ + +mk_ind_op(in) -> + ""; +mk_ind_op(inout) -> + error; +mk_ind_op(_) -> + "*". + +%%------------------------------------------------------------ +%% Make parameter list for decoder +%%------------------------------------------------------------ + +mk_par_list_for_decoder(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), + lists:map( + fun({Type, Attr, Arg}) -> + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "**"; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> %% WSTRING + "**"; + Ctype == "CORBA_wchar *" -> %% WSTRING + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + slice(Attr) ++ "*"; + _ -> + "**" + end + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" + end + end, + Ctype ++ Dyn ++ " " ++ Arg + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make parameter list for encoder +%%------------------------------------------------------------ + +mk_par_list_for_encoder(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), + lists:map( + fun({Type, _Attr, Arg}) -> + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "*"; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> %% WSTRING + "*"; + Ctype == "CORBA_wchar *" -> %% WSTRING + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" + end + end; + false -> + if + Ctype == "erlang_pid" -> + "*"; + Ctype == "erlang_port" -> + "*"; + Ctype == "erlang_ref" -> + "*"; + true -> + "" + end + end, + Ctype ++ " " ++ Dyn ++ Arg + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make parameter list for decoder prototypes +%%------------------------------------------------------------ + +mk_par_list_for_decoder_prototypes(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), + lists:map( + fun({Type, Attr, _Arg}) -> + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "**"; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> %% WSTRING + "**"; + Ctype == "CORBA_wchar *" -> %% WSTRING + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + slice(Attr) ++ "*"; + _ -> + "**" + end + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" + end + end, + Ctype ++ Dyn + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make parameter list for encoder prototypes +%%------------------------------------------------------------ + +mk_par_list_for_encoder_prototypes(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), + lists:map( + fun({Type, _Attr, _Arg}) -> + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "*"; + Ctype == "CORBA_char *" -> + ""; + is_record(Type, wstring) -> %% WSTRING + "*"; + Ctype == "CORBA_wchar *" -> %% WSTRING + ""; + true -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" + end + end; + false -> + if + Ctype == "erlang_pid" -> + "*"; + Ctype == "erlang_port" -> + "*"; + Ctype == "erlang_ref" -> + "*"; + true -> + "" + end + end, + Ctype ++ Dyn + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make parameter list for call-back prototypes +%%------------------------------------------------------------ + +mk_par_list_for_callback_prototypes(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], + TypeAttrArgs0), + lists:map( + fun({Type, Attr, _Arg}) -> + IndOp = mk_ind_op(Attr), + Ctype = mk_c_type(G, N, Type), + Dyn = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + "*" ++ IndOp; + Ctype == "CORBA_char *" -> + "" ++ IndOp; + is_record(Type, wstring) -> %% WSTRING + "*" ++ IndOp; + Ctype == "CORBA_wchar *" -> %% WSTRING + "" ++ IndOp; + true -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + "*" ++ IndOp + end + end; + false -> + case ictype:isArray(G, N, Type) of + true -> + ""; + _ -> + case Attr of %% Should just be IndOp + in -> + "*" ++ IndOp; + out -> + IndOp + end + end + end, + Ctype ++ Dyn + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Make variable declaration list +%%------------------------------------------------------------ + +mk_var_decl_list(G, N, X, TypeAttrArgs0) -> + TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], + TypeAttrArgs0), + lists:map( + fun({Type, Attr, Arg}) -> + Ctype = mk_c_type(G, N, Type), + VarDecl = case ic_cbe:is_variable_size(G, N, Type) of + true -> + if + is_record(Type, string) -> + Ctype ++ "* " ++ Arg ++ " = NULL"; + Ctype == "CORBA_char *" -> + Ctype ++ " " ++ Arg ++ " = NULL"; + is_record(Type, wstring) -> %% WSTRING + Ctype ++ "* " ++ Arg ++ " = NULL"; + Ctype == "CORBA_wchar *" -> %% WSTRING + Ctype ++ " " ++ Arg ++ " = NULL"; + true -> + case ictype:isArray(G, N, Type) of + true -> + Ctype ++ slice(Attr) ++ " " ++ + Arg; + _ -> + Ctype ++ "* " ++ Arg + end + end; + false -> + Ctype ++ " " ++ Arg + end, + + VarDecl + end, TypeAttrArgs1). + +%%------------------------------------------------------------ +%% Slice +%%------------------------------------------------------------ + +slice(in) -> + "_slice*"; +slice(_) -> + "". + +%%------------------------------------------------------------ +%% Special comment functions +%%------------------------------------------------------------ + +emit_encoding_comment(G, N, F, String, RefOrVal, Type, Name) -> + emit(F, [io_lib:format(" /* ~s parameter: ~s~s ~s */\n", + [String, mk_c_type(G, N, Type), + RefOrVal, Name])]). + + +%%------------------------------------------------------------ +%% Make C type +%%------------------------------------------------------------ + +%% +%% Warning this is NOT identical to mk_c_type in ic_cbe.erl +%% +mk_c_type(G, N, S) -> + mk_c_type(G, N, S, evaluate). + +mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + {enum, Type} -> + mk_c_type(G, N, Type, evaluate); + Type -> + mk_c_type(G, N, Type, evaluate) + end; +mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + Type -> + Type + end; +mk_c_type(_G, _N, S, _) when is_list(S) -> + S; +mk_c_type(_G, _N, S, _) when is_record(S, string) -> + "CORBA_char"; +mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> %% WSTRING + "CORBA_wchar"; +mk_c_type(_G, _N, {boolean, _}, _) -> + "CORBA_boolean"; +mk_c_type(_G, _N, {octet, _}, _) -> + "CORBA_octet"; +mk_c_type(_G, _N, {void, _}, _) -> + "void"; +mk_c_type(_G, _N, {unsigned, U}, _) -> + case U of + {short, _} -> + "CORBA_unsigned_short"; + {long, _} -> + "CORBA_unsigned_long"; + {'long long', _} -> + "CORBA_unsigned_long_long" + end; +mk_c_type(_G, _N, {'long long', _}, _) -> + "CORBA_long_long"; +mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type + "CORBA_long"; +mk_c_type(_G, _N, {T, _}, _) -> + "CORBA_" ++ atom_to_list(T). + +%%------------------------------------------------------------ +%% Emit encoding statement +%%------------------------------------------------------------ + +%% emit_encoding_stmt(G, N, X, Fd, T, LName) +%% +%% +emit_encoding_stmt(G, N, X, Fd, T, LName) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", + [LName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", + [LName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", + [LName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", + [LName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName); + FSN -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName) + end; +emit_encoding_stmt(G, N, X, Fd, T, LName) when is_list(T) -> + %% Already a fullscoped name + case get_param_tk(LName, X) of + error -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]); + ParamTK -> + case ic_cbe:is_variable_size(ParamTK) of + true -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0)" + " {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");" + "\n"), + ?emit_c_enc_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n }\n\n"); + false -> + if is_atom(ParamTK) -> + case ParamTK of + tk_ushort -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulong(oe_env, " + "(unsigned long) ~s)) < 0) {\n", + [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "ushort", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_ulong -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulong(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "ulong", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_ulonglong -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulonglong(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_short -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, " + "(long) ~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "short", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_long -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "long", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_longlong -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_longlong(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "longlong", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_float -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_double(oe_env, " + "(double) ~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "float", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_double -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_double(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "double", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_boolean -> + emit(Fd, " switch(~s) {\n", [LName]), + emit(Fd, " case 0 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"false\")) < 0) {\n"), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " return " + "oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"true\")) < 0) {\n"), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " return " + "oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default :\n"), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n\n"); + tk_char -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_char(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "char", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_wchar -> %% WCHAR + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_wchar(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "wchar", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_octet -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_char(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "octet", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + tk_any -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, " + "~s)) < 0) {\n", [LName]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "any", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"); + _ -> + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + ?emit_c_enc_rpt(Fd, " ", "tk_unknown", []), + emit(Fd, " return " + "oe_error_code;\n }\n\n"), + ok + end; + true -> + case element(1, ParamTK) of + tk_enum -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "enum", []); + tk_array -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "array", []); + _ -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, &~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "", []) + end, + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation " + "parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n") + end + end + end; +emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, string) -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_string(oe_env, (const char*) ~s)) < 0) {\n", + [LName]), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Cannot encode string\");\n"), + ?emit_c_enc_rpt(Fd, " ", "string", []), + emit(Fd, " return oe_error_code;\n }\n\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, wstring) -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "wstring", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Cannot encode string\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName) -> + case T of + {unsigned, {short, _}} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulong(oe_env, (unsigned long) ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "ushort", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {unsigned, {long, _}} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulong(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "ulong", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {unsigned, {'long long', _}} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ulonglong(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {short, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, (long) ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "short", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {long, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "long", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {'long long', _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_longlong(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "longlong", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {float, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_double(oe_env, (double) ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "float", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {double, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_double(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "double", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {boolean, _} -> + emit(Fd, " switch(~s) {\n", [LName]), + emit(Fd, " case 0 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default :\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n\n"); + {char, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "char", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {wchar, _} -> %% WCHAR + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_wchar(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "wchar", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {octet, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "octet", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {void, _} -> + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, \"void\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "void", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {sequence, _, _} -> + ?emit_c_enc_rpt(Fd, " ", "sequence", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + {any, _} -> %% Fix for any type + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "any", []), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "BAD_PARAM, \"Bad operation parameter on encode\");\n"), + emit(Fd, " return oe_error_code;\n }\n\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%%------------------------------------------------------------ +%% Get type kind parameter +%%------------------------------------------------------------ + +%% Useful functions +get_param_tk("oe_return", Op) -> + ic_forms:get_tk(Op); +get_param_tk(Name, Op) -> + case get_param(Name, Op) of + error -> + error; + Param -> + ic_forms:get_tk(Param) + end. + +%%------------------------------------------------------------ +%% Get parameter (for what? XXX) +%%------------------------------------------------------------ + +get_param(Name, Op) when is_record(Op, op) -> + get_param_loop(Name, Op#op.params); +get_param(_Name, _Op) -> + error. + +get_param_loop(_Name, []) -> + error; +get_param_loop(Name, [Param| Params]) -> + case ic_forms:get_id2(Param) of + Name -> + Param; + _ -> + get_param_loop(Name, Params) + end. + +%%------------------------------------------------------------ +%% Emit decoding statement +%%------------------------------------------------------------ + +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, + DecType, AllocedPars) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n\n"); + "erlang_port" -> + emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n\n"); + "erlang_ref" -> + emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n\n"); + "ETERM*" -> + emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " + "&oe_env->_iin, (void**)~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n\n"); + {enum, FSN} -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, + InBuffer, Align, NextPos, DecType, AllocedPars); + FSN -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, + InBuffer, Align, NextPos, DecType, AllocedPars) + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, + DecType, AllocedPars) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G, T), + case ictype:isBasicType(Type) of + true -> + emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + false -> + emit(Fd, " {\n"), + case DecType of + caller -> %% No malloc used, define oe_first anyhow. + emit(Fd, " void *oe_first = NULL;\n"), + emit(Fd, " int oe_outindex = 0;\n\n"); + array_dyn -> %% Malloc used + emit(Fd, " int oe_outindex = 0;\n\n"); + %% [ic_util:mk_align(io_lib:format("sizeof(~s)", [T]))]); + caller_dyn -> %% Malloc used + emit(Fd, " int oe_outindex = 0;\n\n") + end, + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " + "~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n") + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + _DecType, AllocedPars) when is_record(T, string) -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + _DecType, AllocedPars) when is_record(T, wstring) -> + %% WSTRING + emit(Fd, " if ((oe_error_code = " + "oe_ei_decode_wstring(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, " }\n"); +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + _DecType, AllocedPars) -> + case ic_cbe:normalize_type(T) of + {basic, Type} -> + emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + _ -> + case T of + {void, _} -> + emit(Fd, + " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, 0)) < 0) {\n", + [InBuffer]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + {sequence, _, _} -> + %% XXX XXX Why? + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n\n"); + {any, _} -> %% Fix for any type + emit(Fd, + " if ((oe_error_code = ei_decode_long(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "", []), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, " }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end + end. + +emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, + LName, AllocedPars) -> + Fmt = + " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " + "~s~s)) < 0) {\n", + Ret = + " return oe_error_code;\n" + "}\n", + + {Pre, DecType} = + case Type of + ushort -> {"", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"oe_", "ulonglong"}; + short -> {"", "long"}; + long -> {"", "long"}; + longlong -> {"oe_", "longlong"}; + float -> {"", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"oe_", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} + end, + case Type of + ushort -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " + "&oe_env->_iin, &oe_ulong)) < 0) {\n", [InBuffer]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit_c_dec_rpt(Fd, " ", "ushort", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *~s = (unsigned short) oe_ulong;\n", [LName]), + emit(Fd, " }\n\n"); + short -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " + "&oe_env->_iin, &oe_long)) < 0) {\n", [InBuffer]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit_c_dec_rpt(Fd, " ", "short", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *~s = (short) oe_long;\n", [LName]), + emit(Fd, " }\n\n"); + float -> + emit(Fd, " {\n"), + emit(Fd, " double oe_double;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " + "&oe_env->_iin, &oe_double)) < 0) {\n", [InBuffer]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit_c_dec_rpt(Fd, " ", "float", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *~s = (float) oe_double;\n", [LName]), + emit(Fd, " }\n\n"); + boolean -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, oe_bool)) < 0) {\n", [InBuffer]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit_c_dec_rpt(Fd, " ", "boolean", []), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " *(~s) = 0;\n", [LName]), + emit(Fd, " }\n"), + emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), + emit(Fd, " *(~s) = 1;\n", [LName]), + emit(Fd, " } else {\n"), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit_c_dec_rpt(Fd, " ", "boolean", []), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n\n"); + _ -> + emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), + ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), + emit(Fd, Ret) + end. + + +%%------------------------------------------------------------ +%% Prefix for generic functions +%%------------------------------------------------------------ +get_user_proto(G, Default) -> + case ic_options:get_opt(G, user_protocol) of + false -> + Default; + Pfx -> + Pfx + end. + +%%------------------------------------------------------------ +%% Timeout. Returns a string (or Default). +%%------------------------------------------------------------ +get_c_timeout(G, Default) -> + case ic_options:get_opt(G, c_timeout) of + Tmo when is_integer(Tmo) -> + TmoStr = integer_to_list(Tmo), + {TmoStr, TmoStr}; + {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> + {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; + false -> + Default + end. + +%%------------------------------------------------------------ +%% ZIPPERS (merging of successive elements of two lists). +%%------------------------------------------------------------ + +%% zip([H1| T1], [H2| T2]) -> +%% [{H1, H2}| zip(T1, T2)]; +%% zip([], []) -> +%% []. + +filterzip(F, [H1| T1], [H2| T2]) -> + case F(H1, H2) of + false -> + filterzip(F, T1, T2); + {true, Val} -> + [Val| filterzip(F, T1, T2)] + end; +filterzip(_, [], []) -> + []. + + diff --git a/lib/ic/src/ic_debug.hrl b/lib/ic/src/ic_debug.hrl new file mode 100644 index 0000000000..c0490b4c13 --- /dev/null +++ b/lib/ic/src/ic_debug.hrl @@ -0,0 +1,37 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%---------------------------------------------------------------------- +%% Debug macro +%%---------------------------------------------------------------------- +-ifndef(ic_debug_hrl). +-define(ic_debug_hrl, true). + +-ifdef(debug). + -define(PRINTDEBUG(Msg), + io:format("~p :~p ~p~n", [Msg, ?FILE, ?LINE])). + -define(PRINTDEBUG2(F, A), + io:format(F ++ ":~p ~p~n", A ++ [?FILE, ?LINE])). +-else. + -define(PRINTDEBUG(Msg), ok). + -define(PRINTDEBUG2(F, A), ok). +-endif. + +-endif. diff --git a/lib/ic/src/ic_enum_java.erl b/lib/ic/src/ic_enum_java.erl new file mode 100644 index 0000000000..5978c3468e --- /dev/null +++ b/lib/ic/src/ic_enum_java.erl @@ -0,0 +1,312 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_enum_java). + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([gen/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: gen/3 +%%----------------------------------------------------------------- +gen(G, N, X) when is_record(X, enum) -> + %%?PRINTDEBUG2("enum: ~p", [X]), + EnumName = ic_forms:get_java_id(X), + N2 = ["_" ++ EnumName |N], + ic_jbe:gen(G, N2, ic_forms:get_body(X)), + + emit_enum_class(G, N, X, EnumName), + emit_holder_class(G, N, X, EnumName), + emit_helper_class(G, N, X, EnumName); +gen(_G, _N, _X) -> + ok. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: emit_enum_class/4 +%%----------------------------------------------------------------- +emit_enum_class(G, N, X, EnumName) -> + {Fd, _} = ic_file:open_java_file(G, N, EnumName), + + EList = enum_member_name_list(G, N, X), + %%?PRINTDEBUG2("EList: ~p", [EList]), + ic_codegen:emit(Fd, ["final public class ",EnumName," {\n\n" + + " // instance variables\n"]), + + emit_enum_member_int_values_initialization(G, N, X, Fd, EList), + emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList), + + ic_codegen:emit(Fd, [" private int _value;\n\n" + + " // constructors\n" + " private ",EnumName,"(int __value) {\n" + " _value = __value;\n" + " }\n\n" + + " // methods\n" + " public int value() {\n" + " return _value;\n" + " }\n"]), + + emit_enum_from_int_function(G, N, X, Fd, EnumName, EList), + + ic_codegen:emit(Fd, "\n}\n"), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_holder_class/4 +%%----------------------------------------------------------------- +emit_holder_class(G, N, _X, EnumName) -> + EName = string:concat(EnumName, "Holder"), + {Fd, _} = ic_file:open_java_file(G, N, EName), + + ic_codegen:emit(Fd, ["final public class ",EnumName,"Holder {\n\n" + + " // instance variables\n" + " public ",EnumName," value;\n\n" + + " // constructors\n" + " public ",EnumName,"Holder() {}\n\n" + + " public ",EnumName,"Holder(",EnumName," initial) {\n" + " value = initial;\n" + " }\n\n" + + " // methods\n" + " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" + " ",EnumName,"Helper.marshal(out, value);\n" + " }\n\n" + + " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" + " value = ",EnumName,"Helper.unmarshal(in);\n" + " }\n\n" + "}\n"]), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_helper_class/4 +%%----------------------------------------------------------------- +emit_helper_class(G, N, X, EnumName) -> + EName = string:concat(EnumName, "Helper"), + WEList = enum_member_atom_list(G, N, X), + {Fd, _} = ic_file:open_java_file(G, N, EName), + + ic_codegen:emit(Fd, ["public class ",EnumName,"Helper {\n\n" + + " // constructors\n" + " private ",EnumName,"Helper() {}\n\n" + + " // methods\n" + + " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",EnumName," _value)\n" + " throws java.lang.Exception {\n\n"]), + + emit_enum_write_function(G, N, X, Fd, EnumName), + + ic_codegen:emit(Fd, [" }\n\n" + + " public static ",EnumName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" + " throws java.lang.Exception {\n\n"]), + + emit_enum_read_function(G, N, X, Fd, EnumName), + + ic_codegen:emit(Fd, "\n }\n\n"), + + emit_enum_private_member_variables(Fd, WEList), + + ic_codegen:emit(Fd, ["\n // Get integer value of enum from string\n" + " private static int _getIntFromName(String name) throws java.lang.Exception {\n" + " for(int i = 0; i < _memberCount; i++) {\n" + " if (name.equals(_members[i]))\n" + " return i;\n" + " }\n" + " throw new java.lang.Exception(\"\");\n" + " }\n\n" + + " public static String id() {\n" + " return \"",ictk:get_IR_ID(G, N, X),"\";\n" + " }\n\n" + + " public static String name() {\n" + " return \"",EnumName,"\";\n" + " }\n\n"]), + + ic_jbe:emit_type_function(G, N, X, Fd), + + ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",EnumName," _this)\n" + " throws java.lang.Exception {\n\n" + + " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" + " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" + + " _any.type(type());\n" + " marshal(_os, _this);\n" + " _any.insert_Streamable(_os);\n" + " }\n\n" + + " public static ",EnumName," extract(",?ICPACKAGE,"Any _any)\n" + " throws java.lang.Exception {\n\n" + + " return unmarshal(_any.extract_Streamable());\n" + " }\n\n" + + "}\n"]), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_enum_public_instance_variables/6 +%%----------------------------------------------------------------- +emit_enum_public_instance_variables(_G, _N, _X, _Fd, _EnumName, []) -> + ok; +emit_enum_public_instance_variables(G, N, X, Fd, EnumName, [Enumerator |EList]) -> + ic_codegen:emit(Fd, [" public static final ",EnumName," ",Enumerator," = new ",EnumName,"(_",Enumerator,");\n"]), + emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList). + +%%----------------------------------------------------------------- +%% Func: emit_enum_member_int_values_initialization/5 +%%----------------------------------------------------------------- +emit_enum_member_int_values_initialization(G, N, X, Fd, EList) -> + InitString = emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, 0), + ic_codegen:emit(Fd, [" public static final int ",InitString,";\n"]). + + +%%----------------------------------------------------------------- +%% Func: emit_enum_member_int_values_initialization_1/6 +%%----------------------------------------------------------------- +emit_enum_member_int_values_initialization_1(_G, _N, _X, _Fd, [Enumerator], Num) -> + " _" ++ Enumerator ++ " = " ++ ic_util:to_list(Num); +emit_enum_member_int_values_initialization_1(G, N, X, Fd, [Enumerator |EList], Num) -> + Spaces = if + Num == 0 -> + ""; + true -> + " " + end, + Spaces ++ "_" ++ Enumerator ++ " = " ++ ic_util:to_list(Num) ++ ",\n" ++ + emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, Num + 1). + +%%----------------------------------------------------------------- +%% Func: emit_enum_from_int_function/6 +%%----------------------------------------------------------------- +emit_enum_from_int_function(_G, _N, _X, Fd, EnumName, EList) -> + ic_codegen:emit(Fd, + [" public static final ",EnumName," from_int(int __value) throws java.lang.Exception {\n" + " switch (__value) {\n"]), + emit_enum_from_int_function_switchbody(Fd, EList), + ic_codegen:emit(Fd, [" }\n" + " }\n"]). + +%%----------------------------------------------------------------- +%% Func: emit_enum_from_int_function_switchbody/2 +%%----------------------------------------------------------------- +emit_enum_from_int_function_switchbody(Fd, []) -> + ic_codegen:emit(Fd, [" default:\n" + " throw new java.lang.Exception(\"\");\n"]); +emit_enum_from_int_function_switchbody(Fd, [Enumerator |EList]) -> + ic_codegen:emit(Fd, [" case _",Enumerator,":\n" + " return ",Enumerator,";\n"]), + emit_enum_from_int_function_switchbody(Fd, EList). + +%%----------------------------------------------------------------- +%% Func: emit_enum_private_member_variables/2 +%%----------------------------------------------------------------- +emit_enum_private_member_variables(Fd, EList) -> + ic_codegen:emit(Fd, [" private static final int _memberCount = ",integer_to_list(length(EList)),";\n" + " private static String[] _members = {\n"]), + emit_enum_private_member_variables_1(Fd, EList), + ic_codegen:emit(Fd, " };\n"). + +%%----------------------------------------------------------------- +%% Func: emit_enum_private_member_variables_1/2 +%%----------------------------------------------------------------- +emit_enum_private_member_variables_1(Fd, [Enumerator]) -> + ic_codegen:emit(Fd, [" \"",Enumerator,"\"\n"]); +emit_enum_private_member_variables_1(Fd, [Enumerator |EList]) -> + ic_codegen:emit(Fd, [" \"",Enumerator,"\",\n"]), + emit_enum_private_member_variables_1(Fd, EList). + +%%----------------------------------------------------------------- +%% Func: emit_enum_read_function/5 +%%----------------------------------------------------------------- +emit_enum_read_function(_G, _N, _X, Fd, EnumName) -> + ic_codegen:emit(Fd, [" return ",EnumName,".from_int(_getIntFromName(_in.read_atom()));"]). + +%%----------------------------------------------------------------- +%% Func: emit_enum_write_function/5 +%%----------------------------------------------------------------- +emit_enum_write_function(_G, _N, _X, Fd, _EnumName) -> + ic_codegen:emit(Fd, " _out.write_atom(_members[_value.value()]);\n"). + + +%%----------------------------------------------------------------- +%% Func: enum_member_name_list/3 +%% +%% Note: The names generated are checked for name coalition +%% with java keywords. If so the name is always prefixed +%% by "_" +%%----------------------------------------------------------------- +enum_member_name_list(_G, _N, X) -> + lists:map( + fun(Enumerator) -> + ic_forms:get_java_id(Enumerator) + end, + ic_forms:get_body(X)). + +%%----------------------------------------------------------------- +%% Func: enum_member_atom_list/3 +%% +%% Note : Similar to the emit_member_list/3 but does not +%% solves name coalitions with java keywords. +%% Used for wire encoding only +%%----------------------------------------------------------------- +enum_member_atom_list(_G, _N, X) -> + lists:map( + fun(Enumerator) -> + ic_forms:get_id2(Enumerator) + end, + ic_forms:get_body(X)). + + + + + + + + diff --git a/lib/ic/src/ic_erl_template.erl b/lib/ic/src/ic_erl_template.erl new file mode 100644 index 0000000000..f5983a53bd --- /dev/null +++ b/lib/ic/src/ic_erl_template.erl @@ -0,0 +1,639 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_erl_template). + + +-export([do_gen/3, emit_header/3]). + +-import(ic_codegen, [emit/2, emit/3, nl/1]). + +-include("icforms.hrl"). +-include("ic.hrl"). + +-include_lib("stdlib/include/erl_compile.hrl"). + +-define(TAB, " "). +-define(TAB2, "% "). + +-define(TEMPLATE_1_A, + "%%----------------------------------------------------------------------\n" + "%% <LICENSE>\n" + "%% \n" + "%% $Id$\n" + "%%\n" + "%%----------------------------------------------------------------------\n" + "%% Module : ~s.erl\n" + "%% \n" + "%% Source : ~s\n" + "%% \n" + "%% Description : \n" + "%% \n" + "%% Creation date: ~s\n" + "%%\n" + "%%----------------------------------------------------------------------\n" + "-module(~p).\n\n"). + +-define(TEMPLATE_1_B, + "%%----------------------------------------------------------------------\n" + "%% Internal Exports\n" + "%%----------------------------------------------------------------------\n" + "-export([init/1,\n" + " terminate/2,\n" + " code_change/3,\n" + " handle_info/2]).\n\n" + "%%----------------------------------------------------------------------\n" + "%% Include Files\n" + "%%----------------------------------------------------------------------\n" + "\n\n" + "%%----------------------------------------------------------------------\n" + "%% Macros\n" + "%%----------------------------------------------------------------------\n" + "\n\n" + "%%----------------------------------------------------------------------\n" + "%% Records\n" + "%%----------------------------------------------------------------------\n" + "-record(state, {}).\n\n" + "%%======================================================================\n" + "%% API Functions\n" + "%%======================================================================\n"). + +-define(TEMPLATE_1_C, + "%%======================================================================\n" + "%% Internal Functions\n" + "%%======================================================================\n" + "%%----------------------------------------------------------------------\n" + "%% Function : init/1\n" + "%% Arguments : Env = term()\n" + "%% Returns : {ok, State} |\n" + "%% {ok, State, Timeout} |\n" + "%% ignore |\n" + "%% {stop, Reason}\n" + "%% Raises : -\n" + "%% Description: Initiates the server\n" + "%%----------------------------------------------------------------------\n" + "init(_Env) ->\n" + "\t{ok, #state{}}.\n\n\n" + "%%----------------------------------------------------------------------\n" + "%% Function : terminate/2\n" + "%% Arguments : Reason = normal | shutdown | term()\n" + "%% State = term()\n" + "%% Returns : ok\n" + "%% Raises : -\n" + "%% Description: Invoked when the object is terminating.\n" + "%%----------------------------------------------------------------------\n" + "terminate(_Reason, _State) ->\n" + "\tok.\n\n\n" + "%%----------------------------------------------------------------------\n" + "%% Function : code_change/3\n" + "%% Arguments : OldVsn = undefined | term()\n" + "%% State = NewState = term()\n" + "%% Extra = term()\n" + "%% Returns : {ok, NewState}\n" + "%% Raises : -\n" + "%% Description: Invoked when the object should update its internal state\n" + "%% due to code replacement.\n" + "%%----------------------------------------------------------------------\n" + "code_change(_OldVsn, State, _Extra) ->\n" + "\t{ok, State}.\n\n\n" + "%%----------------------------------------------------------------------\n" + "%% Function : handle_info/2\n" + "%% Arguments : Info = normal | shutdown | term()\n" + "%% State = NewState = term()\n" + "%% Returns : {noreply, NewState} |\n" + "%% {noreply, NewState, Timeout} |\n" + "%% {stop, Reason, NewState}\n" + "%% Raises : -\n" + "%% Description: Invoked when, for example, the server traps exits.\n" + "%%----------------------------------------------------------------------\n" + "handle_info(_Info, State) ->\n" + "\t{noreply, State}.\n\n\n"). + +-define(TEMPLATE_2_A, + "%%% #0. BASIC INFORMATION\n" + "%%% ----------------------------------------------------------------------\n" + "%%% %CCaseFile : ~s.erl %\n" + "%%% Author : \n" + "%%% Description : \n" + "%%%\n" + "%%% Modules used: \n" + "%%%\n" + "%%%\n" + "%%% ----------------------------------------------------------------------\n" + "-module(~p).\n" + "-author('unknown').\n" + "-id('').\n" + "-vsn('').\n" + "-date('~s').\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% Template Id: <ID>\n" + "%%%\n" + "%%% #Copyright (C) 2004\n" + "%%% by <COMPANY>\n" + "%%% <ADDRESS>\n" + "%%% <OTHER INFORMATION>\n" + "%%% \n" + "%%% <LICENSE>\n" + "%%% \n" + "%%% \n" + "%%% ----------------------------------------------------------------------\n" + "%%% #1. REVISION LOG\n" + "%%% ----------------------------------------------------------------------\n" + "%%% Rev Date Name What\n" + "%%% ----- ------- -------- --------------------------\n" + "%%% \n" + "%%% ----------------------------------------------------------------------\n" + "%%%\n" + "%%% \n" + "%%% #2. EXPORT LISTS\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #2.1 EXPORTED INTERFACE FUNCTIONS\n" + "%%% ----------------------------------------------------------------------\n"). + +-define(TEMPLATE_2_B, + "%%% ----------------------------------------------------------------------\n" + "%%% #2.2 EXPORTED INTERNAL FUNCTIONS\n" + "%%% ----------------------------------------------------------------------\n" + "-export([init/1,\n" + " terminate/2,\n" + " code_change/3,\n" + " handle_info/2]).\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #2.3 INCLUDE FILES\n" + "%%% ----------------------------------------------------------------------\n" + "\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #2.4 MACROS\n" + "%%% ----------------------------------------------------------------------\n" + "\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #2.5 RECORDS\n" + "%%% ----------------------------------------------------------------------\n" + "-record(state, {}).\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #3. CODE\n" + "%%% #---------------------------------------------------------------------\n" + "%%% #3.1 CODE FOR EXPORTED INTERFACE FUNCTIONS\n" + "%%% #---------------------------------------------------------------------\n"). + +-define(TEMPLATE_2_C, + "%%% ----------------------------------------------------------------------\n" + "%%% #3.3 CODE FOR INTERNAL FUNCTIONS\n" + "%%% ----------------------------------------------------------------------\n" + "%%% ----------------------------------------------------------------------\n" + "%%% # init/1\n" + "%%% Input : Env = term()\n" + "%%% Output : {ok, State} |\n" + "%%% {ok, State, Timeout} |\n" + "%%% ignore |\n" + "%%% {stop, Reason}\n" + "%%% Exceptions : -\n" + "%%% Description: Initiates the server\n" + "%%% ----------------------------------------------------------------------\n" + "init(_Env) ->\n" + "\t{ok, #state{}}.\n\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% # terminate/2\n" + "%%% Input : Reason = normal | shutdown | term()\n" + "%%% State = term()\n" + "%%% Output : ok\n" + "%%% Exceptions : -\n" + "%%% Description: Invoked when the object is terminating.\n" + "%%% ----------------------------------------------------------------------\n" + "terminate(_Reason, _State) ->\n" + "\tok.\n\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% # code_change/3\n" + "%%% Input : OldVsn = undefined | term()\n" + "%%% State = NewState = term()\n" + "%%% Extra = term()\n" + "%%% Output : {ok, NewState}\n" + "%%% Exceptions : -\n" + "%%% Description: Invoked when the object should update its internal state\n" + "%%% due to code replacement.\n" + "%%% ----------------------------------------------------------------------\n" + "code_change(_OldVsn, State, _Extra) ->\n" + "\t{ok, State}.\n\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% # handle_info/2\n" + "%%% Input : Info = normal | shutdown | term()\n" + "%%% State = NewState = term()\n" + "%%% Output : {noreply, NewState} |\n" + "%%% {noreply, NewState, Timeout} |\n" + "%%% {stop, Reason, NewState}\n" + "%%% Exceptions : -\n" + "%%% Description: Invoked when, for example, the server traps exits.\n" + "%%% ----------------------------------------------------------------------\n" + "handle_info(_Info, State) ->\n" + "\t{noreply, State}.\n\n\n" + "%%% ----------------------------------------------------------------------\n" + "%%% #4 CODE FOR TEMPORARY CORRECTIONS\n" + "%%% ----------------------------------------------------------------------\n\n"). + + +%%------------------------------------------------------------ +%% +%% Generate the client side Erlang stubs. +%% +%% Each module is generated to a separate file. +%% +%% Export declarations for all interface functions must be +%% generated. Each function then needs to generate a function head and +%% a body. IDL parameters must be converted into Erlang parameters +%% (variables, capitalised) and a type signature list must be +%% generated (for later encode/decode). +%% +%%------------------------------------------------------------ +do_gen(G, _File, Form) -> + gen_head(G, [], Form), + gen(G, [], Form). + + +gen(G, N, [X|Xs]) when is_record(X, preproc) -> + NewG = ic:handle_preproc(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); +gen(G, N, [X|Xs]) when is_record(X, module) -> + G2 = ic_file:filename_push(G, N, X, erlang_template_no_gen), + N2 = [ic_forms:get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, ic_forms:get_body(X)), + G3 = ic_file:filename_pop(G2, erlang_template_no_gen), + gen(G3, N, Xs); +gen(G, N, [X|Xs]) when is_record(X, interface) -> + G2 = ic_file:filename_push(G, N, X, erlang_template), + N2 = [ic_forms:get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, ic_forms:get_body(X)), + lists:foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, + X#interface.inherit_body), + Fd = ic_genobj:stubfiled(G2), + case get_template_version(G2) of + ?IC_FLAG_TEMPLATE_2 -> + emit(Fd, ?TEMPLATE_2_C, []); + _ -> + emit(Fd, ?TEMPLATE_1_C, []) + end, + G3 = ic_file:filename_pop(G2, erlang_template), + gen(G3, N, Xs); +gen(G, N, [X|Xs]) when is_record(X, op) -> + {Name, InArgNames, OutArgNames, Reply} = extract_info(X), + emit_function(G, N, X, ic_genobj:is_stubfile_open(G), + ic_forms:is_oneway(X), Name, InArgNames, OutArgNames, Reply), + gen(G, N, Xs); +gen(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, ic_genobj:is_stubfile_open(G), fun emit_function/9), + gen(G, N, Xs); +gen(G, N, [_X|Xs]) -> + gen(G, N, Xs); +gen(_G, _N, []) -> + ok. + +%% Module Header +emit_header(G, Fd, Name) -> + Date = get_date(), + case get_template_version(G) of + ?IC_FLAG_TEMPLATE_2 -> + emit(Fd, ?TEMPLATE_2_A, [Name, list_to_atom(Name), Date]); + _ -> + IDLFile = ic_genobj:idlfile(G), + emit(Fd, ?TEMPLATE_1_A, [Name, IDLFile, Date, list_to_atom(Name)]) + end. + + +emit_attr(G, N, X, Open, F) -> + XX = #id_of{type=X}, + lists:foreach(fun(Id) -> + X2 = XX#id_of{id=Id}, + IsOneWay = ic_forms:is_oneway(X2), + {Get, Set} = mk_attr_func_names(N, ic_forms:get_id(Id)), + F(G, N, X2, Open, IsOneWay, Get, [], [], + [{ic_util:mk_var(ic_forms:get_id(Id)), + ic_forms:get_tk(X)}]), + case X#attr.readonly of + {readonly, _} -> + ok; + _ -> + F(G, N, X2, Open, IsOneWay, Set, + [{ic_util:mk_var(ic_forms:get_id(Id)), + ic_forms:get_tk(X)}], [], ["ok"]) + end + end, ic_forms:get_idlist(X)). + + +%% The automaticly generated get and set operation names for an +%% attribute. +mk_attr_func_names(_Scope, Name) -> + {"_get_" ++ Name, "_set_" ++ Name}. + + +extract_info(X) when is_record(X, op) -> + Name = ic_forms:get_id2(X), + InArgs = ic:filter_params([in,inout], X#op.params), + OutArgs = ic:filter_params([out,inout], X#op.params), + Reply = case ic_forms:get_tk(X) of + tk_void -> + ["ok"]; + Type -> + [{"OE_Reply", Type}] + end, + InArgsTypeList = + [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)), + ic_forms:get_tk(InArg)} || InArg <- InArgs ], + OutArgsTypeList = + [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)), + ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], + {Name, InArgsTypeList, OutArgsTypeList, Reply}. + +get_template_version(G) -> + case ic_options:get_opt(G, flags) of + Flags when is_integer(Flags) -> + case ?IC_FLAG_TEST(Flags, ?IC_FLAG_TEMPLATE_2) of + true -> + ?IC_FLAG_TEMPLATE_2; + false -> + ?IC_FLAG_TEMPLATE_1 + end; + _ -> + ?IC_FLAG_TEMPLATE_1 + end. + + +get_date() -> + {{Y,M,D}, _} = calendar:now_to_datetime(now()), + if + M < 10, D < 10 -> + lists:concat([Y, "-0", M, "-0",D]); + M < 10 -> + lists:concat([Y, "-0", M, "-", D]); + D < 10 -> + lists:concat([Y, "-", M, "-0", D]); + true -> + lists:concat([Y, "-", M, "-", D]) + end. + + +%%------------------------------------------------------------ +%% +%% Export stuff +%% +%% Gathering of all names that should be exported from a stub +%% file. +%% + + +gen_head_special(G, N, X) when is_record(X, interface) -> + Fd = ic_genobj:stubfiled(G), + lists:foreach(fun({_Name, Body}) -> + ic_codegen:export(Fd, exp_top(G, N, Body, [])) + end, X#interface.inherit_body), + nl(Fd), + ok; +gen_head_special(_G, _N, _X) -> + ok. + + +%% Generate all export declarations +gen_head(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:export(Fd, exp_top(G, N, X, [])), + gen_head_special(G, N, X), + case get_template_version(G) of + ?IC_FLAG_TEMPLATE_2 -> + emit(Fd, ?TEMPLATE_2_B, []); + _ -> + emit(Fd, ?TEMPLATE_1_B, []) + end; + false -> + ok + end. + +exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> + Acc; +exp_top(G, N, L, Acc) when is_list(L) -> + exp_list(G, N, L, Acc); +exp_top(G, N, M, Acc) when is_record(M, module) -> + exp_list(G, N, ic_forms:get_body(M), Acc); +exp_top(G, N, I, Acc) when is_record(I, interface) -> + exp_list(G, N, ic_forms:get_body(I), Acc); +exp_top(G, N, X, Acc) -> + exp3(G, N, X, Acc). + +exp3(G, N, Op, Acc) when is_record(Op, op) -> + FuncName = ic_forms:get_id(Op#op.id), + Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1 + + count_extras(G, N, Op), + [{FuncName, Arity} | Acc]; +exp3(G, N, A, Acc) when is_record(A, attr) -> + Extra = count_extras(G, N, A), + lists:foldr(fun(Id, Acc2) -> + {Get, Set} = mk_attr_func_names([], ic_forms:get_id(Id)), + case A#attr.readonly of + {readonly, _} -> + [{Get, 1 + Extra} | Acc2]; + _ -> + [{Get, 1 + Extra}, {Set, 2 + Extra} | Acc2] + end + end, Acc, ic_forms:get_idlist(A)); +exp3(_G, _N, _X, Acc) -> + Acc. + +exp_list(G, N, L, OrigAcc) -> + lists:foldr(fun(X, Acc) -> + exp3(G, N, X, Acc) + end, OrigAcc, L). + +count_extras(G, N, Op) -> + case {use_this(G, N, Op), use_from(G, N, Op)} of + {[], []} -> + 0; + {[], _} -> + 1; + {_, []} -> + 1; + _ -> + 2 + end. + +%%------------------------------------------------------------ +%% +%% Emit stuff +%% +%% Low level generation primitives +%% + +emit_function(_G, _N, _X, false, _, _, _, _, _) -> + ok; +emit_function(G, N, X, true, false, Name, InArgs, OutArgs, Reply) -> + Fd = ic_genobj:stubfiled(G), + This = use_this(G, N, Name), + From = use_from(G, N, Name), + State = ["State"], + Vers = get_template_version(G), + case OutArgs of + [] -> + ReplyString = create_string(Reply), + emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), + InArgs, length(InArgs), OutArgs, Reply, + ReplyString, Vers), + emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", + [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), + ReplyString]); + _ -> + ReplyString = "{" ++ create_string(Reply ++ OutArgs) ++ "}", + emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), + InArgs, length(InArgs), OutArgs, Reply, + ReplyString, Vers), + emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", + [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), + ReplyString]) + end; +emit_function(G, N, X, true, true, Name, InArgs, _OutArgs, _Reply) -> + Fd = ic_genobj:stubfiled(G), + This = use_this(G, N, Name), + State = ["State"], + Vers = get_template_version(G), + emit_function_header(G, Fd, X, N, Name, create_extra(This, [], Vers), + InArgs, length(InArgs), "", "", "", Vers), + emit(Fd, "~p(~s) ->\n\t{noreply, State}.\n\n", + [ic_util:to_atom(Name), create_string(This ++ State ++ InArgs)]). + +create_string([]) -> + ""; +create_string([{Name, _Type}|T]) -> + Name ++ create_string2(T); +create_string([Name|T]) -> + Name ++ create_string2(T). + +create_string2([{Name, _Type}|T]) -> + ", " ++ Name ++ create_string2(T); +create_string2([Name|T]) -> + ", " ++ Name ++ create_string2(T); +create_string2([]) -> + "". + +create_extra([], [], _Vers) -> + {"State - term()", 1}; +create_extra([], _From, ?IC_FLAG_TEMPLATE_2) -> + {"OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 2}; +create_extra([], _From, _Vers) -> + {"OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 2}; +create_extra(_This, [], ?IC_FLAG_TEMPLATE_2) -> + {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ "State - term()", 2}; +create_extra(_This, [], _Vers) -> + {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ "State - term()", 2}; +create_extra(_This, _From, ?IC_FLAG_TEMPLATE_2) -> + {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ + "OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 3}; +create_extra(_This, _From, _Vers) -> + {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ + "OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 3}. + +use_this(G, N, OpName) -> + FullOp = ic_util:to_colon([OpName|N]), + FullIntf = ic_util:to_colon(N), + case {ic_options:get_opt(G, {this, FullIntf}), + ic_options:get_opt(G, {this, FullOp}), + ic_options:get_opt(G, {this, true})} of + {_, force_false, _} -> + []; + {force_false, false, _} -> + []; + {false, false, false} -> + []; + _ -> + ["OE_This"] + end. + +use_from(G, N, OpName) -> + FullOp = ic_util:to_colon([OpName|N]), + FullIntf = ic_util:to_colon(N), + case {ic_options:get_opt(G, {from, FullIntf}), + ic_options:get_opt(G, {from, FullOp}), + ic_options:get_opt(G, {from, true})} of + {_, force_false, _} -> + []; + {force_false, false, _} -> + []; + {false, false, false} -> + []; + _ -> + ["OE_From"] + end. + + +emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, + Reply, ReplyString, ?IC_FLAG_TEMPLATE_2) -> + emit(Fd, + "%%% ----------------------------------------------------------------------\n" + "%%% # ~p/~p\n" + "%%% Input : ~s\n", + [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), + ic_code:type_expand_all(G, N, X, Fd, ?TAB2, InP), + case Reply of + ["ok"] -> + emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]); + _ -> + emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]), + ic_code:type_expand_all(G, N, X, Fd, "% ", Reply) + end, + ic_code:type_expand_all(G, N, X, Fd, ?TAB2, OutP), + emit(Fd, + "%%% Exceptions : ~s\n" + "%%% Description: \n" + "%%% ----------------------------------------------------------------------\n", + [get_raises(X, ?IC_FLAG_TEMPLATE_2)]); +emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, + Reply, ReplyString, Vers) -> + emit(Fd, + "%%----------------------------------------------------------------------\n" + "%% Function : ~p/~p\n" + "%% Arguments : ~s\n", + [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), + ic_code:type_expand_all(G, N, X, Fd, ?TAB, InP), + case Reply of + ["ok"] -> + emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]); + _ -> + emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]), + ic_code:type_expand_all(G, N, X, Fd, " ", Reply) + end, + ic_code:type_expand_all(G, N, X, Fd, ?TAB, OutP), + emit(Fd, + "%% Raises : ~s\n" + "%% Description: \n" + "%%----------------------------------------------------------------------\n", + [get_raises(X, Vers)]). + +get_raises(#op{raises = []}, _Vers) -> + ""; +get_raises(#op{raises = ExcList}, Vers) -> + get_raises2(ExcList, [], Vers); +get_raises(_X, _Vers) -> + []. + +get_raises2([H], Acc, _Vers) -> + lists:flatten(lists:reverse([ic_util:to_colon(H)|Acc])); +get_raises2([H|T], Acc, ?IC_FLAG_TEMPLATE_2) -> + get_raises2(T, ["\n%%% ", ic_util:to_colon(H) |Acc], + ?IC_FLAG_TEMPLATE_2); +get_raises2([H|T], Acc, _Vers) -> + get_raises2(T, ["\n%% ", ic_util:to_colon(H) |Acc], _Vers). + diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl new file mode 100644 index 0000000000..75c87929db --- /dev/null +++ b/lib/ic/src/ic_erlbe.erl @@ -0,0 +1,1141 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_erlbe). + + +-export([do_gen/3]). +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-export([unfold/1, mk_attr_func_names/2]). + + +-import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). +-import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). +-import(ic_codegen, [emit/2, emit/3, nl/1]). +-import(ic_options, [get_opt/2]). + +-import(lists, [foreach/2, foldr/3, map/2]). + + +-include("icforms.hrl"). +-include("ic.hrl"). + +-include_lib("stdlib/include/erl_compile.hrl"). + + +%%------------------------------------------------------------ +%% +%% Generate the client side Erlang stubs. +%% +%% Each module is generated to a separate file. +%% +%% Export declarations for all interface functions must be +%% generated. Each function then needs to generate a function head and +%% a body. IDL parameters must be converted into Erlang parameters +%% (variables, capitalised) and a type signature list must be +%% generated (for later encode/decode). +%% +%%------------------------------------------------------------ +do_gen(G, File, Form) -> + GT = get_opt(G, be), + G2 = ic_file:filename_push(G, [], mk_oe_name(G, + ic_file:remove_ext(to_list(File))), + erlang), + Light = ic_options:get_opt(G, light_ifr), + R = if + GT == erl_corba, Light == false -> + case ic_genobj:is_stubfile_open(G2) of + true -> + emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", + [?ORBNAME, ?IFRTYPESHRL]); + false -> ok + end, + gen_head(G2, [], Form), + ic_codegen:export(ic_genobj:stubfiled(G2), + [{ictk:register_name(G2), 0}, + {ictk:unregister_name(G2), 0}, + {oe_get_module,5}, + {oe_dependency,0}]), + R0= gen(G2, [], Form), + ictk:reg_gen(G2, [], Form), + ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 + genDependency(G2), % creates code for dependency list + R0; + GT == erl_corba, Light == true -> + case ic_genobj:is_stubfile_open(G2) of + true -> + emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", + [?ORBNAME, ?IFRTYPESHRL]); + false -> ok + end, + gen_head(G2, [], Form), + ic_codegen:export(ic_genobj:stubfiled(G2), + [{ictk:register_name(G2), 0}, + {ictk:register_name(G2), 1}, + {ictk:unregister_name(G2), 0}, + {ictk:unregister_name(G2), 1}]), + R0= gen(G2, [], Form), + ictk:reg_gen(G2, [], Form), + ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 + R0; + true -> + gen_head(G2, [], Form), + gen(G2, [], Form) + end, + ic_file:filename_pop(G2, erlang), + R. + + +gen(G, N, [X|Xs]) when is_record(X, preproc) -> + NewG = ic:handle_preproc(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, module) -> + CD = ic_code:codeDirective(G,X), + G2 = ic_file:filename_push(G, N, X, CD), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + G3 = ic_file:filename_pop(G2, CD), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, interface) -> + G2 = ic_file:filename_push(G, N, X, erlang), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, + X#interface.inherit_body), + gen_serv(G2, N, X), + G3 = ic_file:filename_pop(G2, erlang), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, const) -> +% N2 = [get_id2(X) | N], + emit_constant_func(G, X#const.id, X#const.val), + gen(G, N, Xs); %% N2 or N? + +gen(G, N, [X|Xs]) when is_record(X, op) -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs, + is_oneway(X), get_opt(G, be)), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, fun emit_stub_func/9), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, except) -> + icstruct:except_gen(G, N, X, erlang), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) -> + case may_contain_structs(X) of + true -> icstruct:struct_gen(G, N, X, erlang); + false -> ok + end, + gen(G, N, Xs); + +gen(_G, _N, []) -> ok. + + +may_contain_structs(X) when is_record(X, typedef) -> true; +may_contain_structs(X) when is_record(X, struct) -> true; +may_contain_structs(X) when is_record(X, union) -> true; +may_contain_structs(_X) -> false. + + + +%%-------------------------------------------------------------------- +%% +%% Generate the server side (handle_call and handle_cast) +%% + +gen_serv(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + GT = get_opt(G, be), + gen_oe_is_a(G, N, X, GT), + N2 = [get_id2(X) | N], + gen_oe_tc(G, N2, X, GT), + + emit_serv_std(GT, G, N, X), + + gen_calls(G, N2, get_body(X)), + lists:foreach(fun({_Name, Body}) -> + gen_calls(G, N2, Body) end, + X#interface.inherit_body), + gen_end_of_call(GT, G), + + gen_casts(G, N2, get_body(X)), + lists:foreach(fun({_Name, Body}) -> + gen_casts(G, N2, Body) end, + X#interface.inherit_body), + gen_end_of_cast(GT, G), + emit_skel_footer(GT, G, N, X); % Note N instead of N2 + false -> + ok + end. + +gen_oe_is_a(G, N, X, erl_corba) when is_record(X, interface) -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:mcomment(Fd, ["Inherited Interfaces"]), + emit(Fd, "oe_is_a(~p) -> true;\n", [ictk:get_IR_ID(G, N, X)]), + lists:foreach(fun(ScopedName) -> + emit(Fd, "oe_is_a(~p) -> true;\n", + [ic_pragma:scope2id(G, ScopedName)]) + end, X#interface.inherit), + emit(Fd, "oe_is_a(_) -> false.\n"), + nl(Fd), + ok; +gen_oe_is_a(_G, _N, _X, _BE) -> ok. + + +%% Generates the oe_tc function +gen_oe_tc(G, N, X, erl_corba) -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:mcomment(Fd, ["Interface TypeCode"]), + LocalInterface = gen_oe_tc2(G, N, get_body(X), Fd, []), + CompleteInterface = + lists:foldl(fun({Name, Body}, FunAcc) -> + AName = ic_util:to_atom(ic_util:to_undersc(Name)), + gen_oe_tc3(G, AName, Body, Fd, FunAcc) + end, LocalInterface, X#interface.inherit_body), + emit(Fd, "oe_tc(_) -> undefined.\n"), + nl(Fd), + emit(Fd, "oe_get_interface() -> \n\t["), + emit_oe_get_interface(Fd, CompleteInterface), + nl(Fd), + ok; +gen_oe_tc(_, _, _, _) -> + ok. + +emit_oe_get_interface(Fd, []) -> + emit(Fd, "].\n"); +emit_oe_get_interface(Fd, [Item]) -> + emit(Fd, "~s].\n", [lists:flatten(Item)]); +emit_oe_get_interface(Fd, [H|T]) -> + emit(Fd, "~s,\n\t", [lists:flatten(H)]), + emit_oe_get_interface(Fd, T). + +gen_oe_tc2(_,_,[],_, Acc) -> + Acc; +gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> + R = ic_forms:get_tk(X), + IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, + ic:filter_params([in, inout], X#op.params)), + OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, + ic:filter_params([out, inout], X#op.params)), + Function = get_id2(X), + FunctionAtom = ic_util:to_atom(Function), + emit(Fd, "oe_tc(~p) -> \n\t~p;\n",[FunctionAtom, {R, IN, OUT}]), + GI = io_lib:format("{~p, oe_tc(~p)}",[Function, FunctionAtom]), + gen_oe_tc2(G, N, Rest, Fd, [GI|Acc]); + +gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> + {GetT, SetT} = mk_attr_func_types([], X), + NewAcc = + lists:foldl(fun(Id, FunAcc) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + GetAttrAtom = ic_util:to_atom(Get), + emit(Fd, "oe_tc(~p) -> \n\t~p;\n", + [GetAttrAtom, GetT]), + case X#attr.readonly of + {readonly, _} -> + GI = io_lib:format("{~p, oe_tc(~p)}", + [Get, GetAttrAtom]), + [GI|FunAcc]; + _ -> + SetAttrAtom = ic_util:to_atom(Set), + + emit(Fd, "oe_tc(~p) -> \n\t~p;\n", + [SetAttrAtom, SetT]), + GetGI = io_lib:format("{~p, oe_tc(~p)}", + [Get, GetAttrAtom]), + SetGI = io_lib:format("{~p, oe_tc(~p)}", + [Set, SetAttrAtom]), + [GetGI, SetGI|FunAcc] + end + end, Acc, ic_forms:get_idlist(X)), + gen_oe_tc2(G, N, Rest, Fd, NewAcc); + +gen_oe_tc2(G,N,[_X|Rest], Fd, Acc) -> + gen_oe_tc2(G,N,Rest, Fd, Acc). + + +gen_oe_tc3(_,_,[],_, Acc) -> + Acc; +gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> + Function = get_id2(X), + FunctionAtom = ic_util:to_atom(get_id2(X)), + GI = io_lib:format("{~p, ~p:oe_tc(~p)}",[Function, N, FunctionAtom]), + emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", + [FunctionAtom, N, FunctionAtom]), + gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]); + +gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> + NewAcc = lists:foldl(fun(Id, FunAcc) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + GetAttrAtom = ic_util:to_atom(Get), + emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", + [GetAttrAtom, N, GetAttrAtom]), + case X#attr.readonly of + {readonly, _} -> + [io_lib:format("{~p, ~p:oe_tc(~p)}", + [Get, N, GetAttrAtom])|FunAcc]; + _ -> + SetAttrAtom = ic_util:to_atom(Set), + emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", + [SetAttrAtom, N, SetAttrAtom]), + [io_lib:format("{~p, ~p:oe_tc(~p)}", + [Get, N, GetAttrAtom]), + io_lib:format("{~p, ~p:oe_tc(~p)}", + [Set, N, SetAttrAtom])|FunAcc] + end + end, Acc, ic_forms:get_idlist(X)), + gen_oe_tc3(G, N, Rest, Fd, NewAcc); + +gen_oe_tc3(G,N,[_X|Rest], Fd, Acc) -> + gen_oe_tc3(G,N,Rest, Fd, Acc). + +gen_calls(G, N, [X|Xs]) when is_record(X, op) -> + case is_oneway(X) of + false -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, false, + get_opt(G, be)), + gen_calls(G, N, Xs); + true -> + gen_calls(G, N, Xs) + end; + +gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, fun emit_skel_func/9), + gen_calls(G, N, Xs); + +gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); +gen_calls(_G, _N, []) -> ok. + +gen_casts(G, N, [X|Xs]) when is_record(X, op) -> + case is_oneway(X) of + true -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, true, + get_opt(G, be)), + gen_casts(G, N, Xs); + false -> + gen_casts(G, N, Xs) + end; + +gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); +gen_casts(_G, _N, []) -> ok. + +emit_attr(G, N, X, F) -> + XX = #id_of{type=X}, + BE = get_opt(G, be), + {GetType, SetType} = mk_attr_func_types(N, X), + lists:foreach(fun(Id) -> + X2 = XX#id_of{id=Id}, + {Get, Set} = mk_attr_func_names(N, get_id(Id)), + F(G, N, X2, Get, [], GetType, [], + is_oneway(X2), BE), + case X#attr.readonly of + {readonly, _} -> ok; + _ -> + F(G, N, X2, Set, [mk_name(G, "Value")], + SetType, [], + is_oneway(X2), BE) + end end, ic_forms:get_idlist(X)). + + +extract_info(G, _N, X) when is_record(X, op) -> + Name = get_id2(X), + InArgs = ic:filter_params([in,inout], X#op.params), + OutArgs = ic:filter_params([out,inout], X#op.params), + ArgNames = mk_erl_vars(G, InArgs), + TypeList = {ic_forms:get_tk(X), + map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), + map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) + }, + {Name, ArgNames, TypeList, OutArgs}. + + + +%% This function generates the standard functions of an object +%% gen_server +emit_serv_std(erl_corba, G, N, X) -> + Fd = ic_genobj:stubfiled(G), + Impl = ic_genobj:impl(G), + TypeID = ictk:get_IR_ID(G, N, X), + + nl(Fd), nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Object server implementation."]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), + nl(Fd), + emit(Fd, "typeID() ->\n"), + emit(Fd, " \"~s\".\n", [TypeID]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Object creation functions."]), + nl(Fd), + emit(Fd, "oe_create() ->\n"), + emit(Fd, " corba:create(?MODULE, \"~s\").\n", [TypeID]), + nl(Fd), + emit(Fd, "oe_create_link() ->\n"), + emit(Fd, " corba:create_link(?MODULE, \"~s\").\n", [TypeID]), + nl(Fd), + emit(Fd, "oe_create(Env) ->\n"), + emit(Fd, " corba:create(?MODULE, \"~s\", Env).\n", [TypeID]), + nl(Fd), + emit(Fd, "oe_create_link(Env) ->\n"), + emit(Fd, " corba:create_link(?MODULE, \"~s\", Env).\n", [TypeID]), + nl(Fd), + emit(Fd, "oe_create(Env, RegName) ->\n"), + emit(Fd, " corba:create(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), + nl(Fd), + emit(Fd, "oe_create_link(Env, RegName) ->\n"), + emit(Fd, " corba:create_link(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), + nl(Fd), + ic_codegen:mcomment(Fd, ["Init & terminate functions."]), + nl(Fd), + emit(Fd, "init(Env) ->\n"), + ic_codegen:comment(Fd, "Call to implementation init"), + emit(Fd, " corba:handle_init(~p, Env).\n", [to_atom(Impl)]), + nl(Fd), + emit(Fd, "terminate(Reason, State) ->\n"), + emit(Fd, " corba:handle_terminate(~p, Reason, State).\n", + [to_atom(Impl)]), + nl(Fd), nl(Fd), + Fd; +emit_serv_std(erl_genserv, G, N, X) -> + Fd = ic_genobj:stubfiled(G), + Impl = ic_genobj:impl(G), + TypeID = ictk:get_IR_ID(G, N, X), + + nl(Fd), nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Server implementation."]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), + nl(Fd), + emit(Fd, "typeID() ->\n"), + emit(Fd, " \"~s\".\n", [TypeID]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Server creation functions."]), + nl(Fd), + emit(Fd, "oe_create() ->\n"), + emit(Fd, " start([], []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link() ->\n"), + emit(Fd, " start_link([], []).\n", []), + nl(Fd), + emit(Fd, "oe_create(Env) ->\n"), + emit(Fd, " start(Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link(Env) ->\n"), + emit(Fd, " start_link(Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create(Env, RegName) ->\n"), + emit(Fd, " start(RegName, Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link(Env, RegName) ->\n"), + emit(Fd, " start_link(RegName, Env, []).\n", []), + nl(Fd), + ic_codegen:mcomment(Fd, ["Start functions."]), + nl(Fd), + emit(Fd, "start(Env, Opt) ->\n"), + emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start_link(Env, Opt) ->\n"), + emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start(RegName, Env, Opt) ->\n"), + emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start_link(RegName, Env, Opt) ->\n"), + emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), + nl(Fd), + ic_codegen:comment(Fd, "Standard gen_server termination"), + emit(Fd, "stop(OE_THIS) ->\n"), + emit(Fd, " gen_server:cast(OE_THIS,stop).\n"), + nl(Fd), + ic_codegen:comment(Fd, "Call to implementation init"), + emit(Fd, "init(Env) ->\n"), + emit(Fd, " ~p:~p(Env).\n", [to_atom(Impl), init]), + nl(Fd), + emit(Fd, "terminate(Reason, State) ->\n"), + emit(Fd, " ~p:~p(Reason, State).\n", + [to_atom(Impl), terminate]), + nl(Fd), nl(Fd), + Fd. + +gen_end_of_call(erl_corba, G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), + emit(Fd, "handle_call(stop, _, State) ->\n"), + emit(Fd, " {stop, normal, ok, State}"), + case get_opt(G, serv_last_call) of + exception -> + emit(Fd, ";\n"), + nl(Fd), + emit(Fd, "handle_call(_, _, State) ->\n"), + emit(Fd, " {reply, catch corba:raise(#'BAD_OPERATION'{minor=1163001857, completion_status='COMPLETED_NO'}), State}.\n"); + exit -> + emit(Fd, ".\n"), + nl(Fd), + nl(Fd) + end, + ok; +gen_end_of_call(erl_genserv, G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), + emit(Fd, "handle_call(stop, _, State) ->\n"), + emit(Fd, " {stop, normal, ok, State}"), + emit(Fd, ".\n"), + nl(Fd), nl(Fd), + ok. + +gen_end_of_cast(erl_corba, G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), + emit(Fd, "handle_cast(stop, State) ->\n"), + emit(Fd, " {stop, normal, State}"), + case get_opt(G, serv_last_call) of + exception -> + emit(Fd, ";\n"), + nl(Fd), + emit(Fd, "handle_cast(_, State) ->\n"), + emit(Fd, " {noreply, State}.\n"); + exit -> + emit(Fd, ".\n"), + nl(Fd), nl(Fd) + end, + ok; +gen_end_of_cast(erl_genserv, G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), + emit(Fd, "handle_cast(stop, State) ->\n"), + emit(Fd, " {stop, normal, State}"), + emit(Fd, ".\n"), + nl(Fd), nl(Fd), + ok. + +emit_skel_footer(erl_corba, G, N, X) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), + case use_impl_handle_info(G, N, X) of + true -> + emit(Fd, "handle_info(Info, State) ->\n"), + emit(Fd, " corba:handle_info(~p, Info, State).\n\n", + [list_to_atom(ic_genobj:impl(G))]); + false -> + emit(Fd, "handle_info(_, State) ->\n"), + emit(Fd, " {noreply, State}.\n\n") + end, + nl(Fd), + case get_opt(G, no_codechange) of + false -> + emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), + emit(Fd, " corba:handle_code_change(~p, OldVsn, State, Extra).\n\n", + [list_to_atom(ic_genobj:impl(G))]); + true -> + emit(Fd, "code_change(_, State, _) ->\n"), + emit(Fd, " {ok, State}.\n\n") + end, + ok; +emit_skel_footer(erl_genserv, G, N, X) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), + case use_impl_handle_info(G, N, X) of + true -> + emit(Fd, "handle_info(Info, State) ->\n"), + emit(Fd, " ~p:handle_info(Info, State).\n\n", + [list_to_atom(ic_genobj:impl(G))]); + false -> + emit(Fd, "handle_info(_, State) ->\n"), + emit(Fd, " {noreply, State}.\n\n") + end, + nl(Fd), nl(Fd), + case get_opt(G, no_codechange) of + false -> + emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), + emit(Fd, " ~p:code_change(OldVsn, State, Extra).\n\n", + [list_to_atom(ic_genobj:impl(G))]); + true -> + emit(Fd, "code_change(_, State, _) ->\n"), + emit(Fd, " {ok, State}.\n\n") + end, + ok. + + +use_impl_handle_info(G, N, X) -> + FullName = ic_util:to_colon([get_id2(X) | N]), + case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of + {_, force_false} -> false; + {false, false} -> false; + _ -> true + end. + +use_timeout(G, N, _X) -> + FullName = ic_util:to_colon(N), + case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of + {_, force_false} -> false; + {false, false} -> false; + _ -> true + end. + +use_precond(G, N, X) -> + FullName = ic_util:to_colon([get_id2(X) | N]), + case get_opt(G, {precond, FullName}) of + false -> + InterfaceName = ic_util:to_colon(N), + case get_opt(G, {precond, InterfaceName}) of + false -> + case get_opt(G, precond) of + false -> false; + V2 -> V2 + end; + V2 -> V2 + end; + V1 -> V1 + end. + +use_postcond(G, N, X) -> + FullName = ic_util:to_colon([get_id2(X) | N]), + case get_opt(G, {postcond, FullName}) of + false -> + InterfaceName = ic_util:to_colon(N), + case get_opt(G, {postcond, InterfaceName}) of + false -> + case get_opt(G, postcond) of + false -> false; + V3 -> V3 + end; + V2 -> V2 + end; + V1 -> V1 + end. + + +%%------------------------------------------------------------ +%% +%% Export stuff +%% +%% Gathering of all names that should be exported from a stub +%% file. +%% + + +gen_head_special(G, N, X) when is_record(X, interface) -> + Fd = ic_genobj:stubfiled(G), + + foreach(fun({Name, Body}) -> + ic_codegen:comment(Fd, "Exports from ~p", + [ic_util:to_colon(Name)]), + ic_codegen:export(Fd, exp_top(G, N, Body, [], get_opt(G, be))), + nl(Fd) + end, X#interface.inherit_body), + + ic_codegen:comment(Fd, "Type identification function"), + ic_codegen:export(Fd, [{typeID, 0}]), + nl(Fd), + ic_codegen:comment(Fd, "Used to start server"), + ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, {oe_create_link, 1}, + {oe_create, 2}, {oe_create_link, 2}]), + nl(Fd), + case get_opt(G, be) of + erl_corba -> + ic_codegen:comment(Fd, "TypeCode Functions and inheritance"), + ic_codegen:export(Fd, [{oe_tc, 1}, {oe_is_a, 1}, {oe_get_interface, 0}]); + _ -> + ic_codegen:export(Fd, [{start, 2}, {start_link, 3}]) + end, + nl(Fd), + ic_codegen:comment(Fd, "gen server export stuff"), + emit(Fd, "-behaviour(gen_server).\n"), + + case get_opt(G, be) of + erl_genserv -> %% stop/1 is only for erl_genserv backend + ic_codegen:export(Fd, [{stop, 1}, {init, 1}, {terminate, 2}, {handle_call, 3}, + {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]); + _ -> + ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, + {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]) + end, + + case get_opt(G, be) of + erl_corba -> + nl(Fd), + emit(Fd, "-include_lib(\"~s/include/~s\").\n", [?ORBNAME, ?CORBAHRL]); + _ -> + ok + end, + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Object interface functions."]), + nl(Fd), nl(Fd), nl(Fd), + Fd; +gen_head_special(_G, _N, _X) -> ok. + + + +%% Shall generate all export declarations +gen_head(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + F = ic_genobj:stubfiled(G), + ic_codegen:comment(F, "Interface functions"), + ic_codegen:export(F, exp_top(G, N, X, [], get_opt(G, be))), + nl(F), + gen_head_special(G, N, X); + false -> ok + end. + +exp_top(_G, _N, X, Acc, _) when element(1, X) == preproc -> + Acc; +exp_top(G, N, L, Acc, BE) when is_list(L) -> + exp_list(G, N, L, Acc, BE); +exp_top(G, N, M, Acc, BE) when is_record(M, module) -> + exp_list(G, N, get_body(M), Acc, BE); +exp_top(G, N, I, Acc, BE) when is_record(I, interface) -> + exp_list(G, N, get_body(I), Acc, BE); +exp_top(G, N, X, Acc, BE) -> + exp3(G, N, X, Acc, BE). + +exp3(_G, _N, C, Acc, _BE) when is_record(C, const) -> + [{get_id(C#const.id), 0} | Acc]; +exp3(_G, _N, Op, Acc, erl_corba) when is_record(Op, op) -> + FuncName = get_id(Op#op.id), + Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1, + [{FuncName, Arity}, {FuncName, Arity+1} | Acc]; +exp3(G, N, Op, Acc, _BE) when is_record(Op, op) -> + FuncName = get_id(Op#op.id), + Arity = + case use_timeout(G,N,Op) of + true -> + %% NO TimeOut on ONEWAYS here !!!! + case is_oneway(Op) of + true -> + length(ic:filter_params([in, inout], Op#op.params)) + 1; + false -> + length(ic:filter_params([in, inout], Op#op.params)) + 2 + end; + false -> + length(ic:filter_params([in, inout], Op#op.params)) + 1 + end, + [{FuncName, Arity} | Acc]; + +exp3(_G, _N, A, Acc, erl_corba) when is_record(A, attr) -> + lists:foldr(fun(Id, Acc2) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + case A#attr.readonly of + {readonly, _} -> [{Get, 1}, {Get, 2} | Acc2]; + _ -> [{Get, 1}, {Get, 2}, + {Set, 2}, {Set, 3} | Acc2] + end end, Acc, ic_forms:get_idlist(A)); +exp3(_G, _N, A, Acc, _BE) when is_record(A, attr) -> + lists:foldr(fun(Id, Acc2) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + case A#attr.readonly of + {readonly, _} -> [{Get, 1} | Acc2]; + _ -> [{Get, 1}, {Set, 2} | Acc2] + end end, Acc, ic_forms:get_idlist(A)); + +exp3(_G, _N, _X, Acc, _BE) -> Acc. + +exp_list(G, N, L, OrigAcc, BE) -> + lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc, BE) end, OrigAcc, L). + + + + +%%------------------------------------------------------------ +%% +%% Emit stuff +%% +%% Low level generation primitives +%% + +emit_stub_func(G, N, X, Name, ArgNames, _TypeList, OutArgs, Oneway, Backend) -> + case ic_genobj:is_stubfile_open(G) of + false -> + ok; + true -> + Fd = ic_genobj:stubfiled(G), + StubName = list_to_atom(Name), + UsingTimeout = use_timeout(G, N, X), + Timeout = case UsingTimeout of + true -> + mk_name(G, "Timeout"); + false -> + "infinity" + end, + Options = mk_name(G, "Options"), + This = mk_name(G, "THIS"), + CallOrCast = + case is_oneway(X) of + true -> ?CAST; + _ -> ?CALL + end, + emit_op_comment(G, Fd, X, StubName, ArgNames, OutArgs), + case Backend of + erl_corba -> + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This | ArgNames])]), + emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE).\n\n", + [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames)]), + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This, Options| ArgNames])]), + emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE, ~s).\n\n", + [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames), + Options]); + _ -> + FunName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + list_to_atom(ic_util:to_undersc([Name | N])); + false -> + StubName + end, + %% NO TimeOut on ONEWAYS here !!!! + case Oneway of + true -> + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This | ArgNames])]); + false -> + case UsingTimeout of + true -> + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This, Timeout| ArgNames])]); + false -> + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This | ArgNames])]) + end + end, + + %% NO TimeOut on ONEWAYS here !!!! + if + length(ArgNames) == 0 -> + case is_oneway(X) of + true -> + emit(Fd, " ~s:~s(~s, ~p).\n\n", + [?GENSERVMOD, CallOrCast, This, FunName]); + false -> + emit(Fd, " ~s:~s(~s, ~p, ~s).\n\n", + [?GENSERVMOD, CallOrCast, This, FunName, Timeout]) + end; + true -> + case is_oneway(X) of + true -> + emit(Fd, " ~s:~s(~s, {~p, ~s}).\n\n", + [?GENSERVMOD, CallOrCast, This, FunName, + mk_list(ArgNames)]); + false -> + emit(Fd, " ~s:~s(~s, {~p, ~s}, ~s).\n\n", + [?GENSERVMOD, CallOrCast, This, FunName, + mk_list(ArgNames), Timeout]) + end + end + end + end. + +emit_skel_func(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) -> + case ic_genobj:is_stubfile_open(G) of + false -> + ok; + true -> + emit_skel_func_helper(G, N, X, OpName, ArgNames, TypeList, OutArgs, + Oneway, Backend) + end. + +emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, + erl_corba) -> + Fd = ic_genobj:stubfiled(G), + Name = list_to_atom(OpName), + ImplF = Name, + ImplM = list_to_atom(ic_genobj:impl(G)), + ThisStr = mk_name(G, "THIS"), + FromStr = mk_name(G, "From"), + State = mk_name(G, "State"), + Context = mk_name(G, "Context"), + + {UseFrom, From} = + case Oneway of + false -> + case use_from(G, N, OpName) of + true -> + {FromStr, FromStr}; + false -> + {"false", "_"} + end; + true -> + {"false", "_"} + end, + {UseThis, This} = + case use_this(G, N, OpName) of + true -> + {ThisStr, ThisStr}; + false -> + {"false", "_"} + end, + %% Create argument list string + CallArgs = mk_list(ArgNames), + emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), + + %% Check if pre and post conditions are specified for this operation + Precond = use_precond(G, N, X), + Postcond = use_postcond(G, N, X), + + case Oneway of + true -> + emit(Fd, "handle_cast({~s, ~s, ~p, [~s]}, ~s) ->\n", + [This, Context, Name, CallArgs, State]), + case {Precond, Postcond} of + {false, false} -> + emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s);\n\n", + [ImplM, ImplF, CallArgs, State, Context, UseThis]); + _ -> + emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", + [ImplM, ImplF, CallArgs, State, Context, UseThis, + Precond, Precond]) + end; + false -> + emit(Fd, "handle_call({~s, ~s, ~p, [~s]}, ~s, ~s) ->\n", + [This, Context, Name, CallArgs, From, State]), + case {Precond, Postcond} of + {false, false} -> + emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s);\n\n", + [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom]); + _-> + emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", + [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom, + Precond, Postcond]) + end + end; +emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, + _Backend) -> + Fd = ic_genobj:stubfiled(G), + Name = list_to_atom(OpName), + ImplF = Name, + ImplM = list_to_atom(ic_genobj:impl(G)), + FromStr = mk_name(G, "From"), + State = mk_name(G, "State"), + + %% Create argument list + CallArgs1 = [State | ArgNames], + {CallArgs2, From} = + case is_oneway(X) of + false -> + case use_from(G, N, OpName) of + true -> + {[FromStr | CallArgs1], FromStr}; + false -> + {CallArgs1, "_"} + end; + true -> + {CallArgs1, "_"} + end, + %% Create argument list string + CallArgs = mk_list(CallArgs2), + emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), + FunName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + list_to_atom(ic_util:to_undersc([OpName | N])); + false -> + list_to_atom(OpName) + end, + case Oneway of + true -> + if + length(ArgNames) == 0 -> + emit(Fd, "handle_cast(~p, ~s) ->\n", [FunName, State]); + true -> + emit(Fd, "handle_cast({~p, ~s}, ~s) ->\n", + [FunName, mk_list(ArgNames), State]) + end, + emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]); + false -> + if + length(ArgNames) == 0 -> + emit(Fd, "handle_call(~p, ~s, ~s) ->\n", + [FunName, From, State]); + true -> + emit(Fd, "handle_call({~p, ~s}, ~s, ~s) ->\n", + [FunName, mk_list(ArgNames), From, State]) + end, + emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]) + end. + +use_this(G, N, OpName) -> + FullOp = ic_util:to_colon([OpName|N]), + FullIntf = ic_util:to_colon(N), + case {get_opt(G, {this, FullIntf}), get_opt(G, {this, FullOp}), + get_opt(G, {this, true})} of + {_, force_false, _} -> false; + {force_false, false, _} -> false; + {false, false, false} -> false; + _ -> true + end. + +use_from(G, N, OpName) -> + FullOp = ic_util:to_colon([OpName|N]), + FullIntf = ic_util:to_colon(N), + case {get_opt(G, {from, FullIntf}), get_opt(G, {from, FullOp}), + get_opt(G, {from, true})} of + {_, force_false, _} -> false; + {force_false, false, _} -> false; + {false, false, false} -> false; + _ -> true + end. + + +emit_constant_func(G, Id, Val) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + N = list_to_atom(get_id(Id)), + emit_const_comment(G, Fd, Id, N), + emit(Fd, "~p() -> ~p.\n\n", [N, Val]) + end. + + + +emit_const_comment(_G, F, _X, Name) -> + ic_codegen:mcomment_light(F, + [io_lib:format("Constant: ~p", [Name])]). + + +emit_op_comment(G, F, X, Name, InP, OutP) -> + ic_codegen:mcomment_light(F, + [io_lib:format("~s: ~p", [get_title(X), Name]), + "", + get_returns(G, X, InP, OutP) | + get_raises(X)]). + +get_title(X) when is_record(X, attr) -> "Attribute Operation"; +get_title(_X) -> "Operation". + +get_raises(X) when is_record(X, op) -> + if X#op.raises == [] -> []; + true -> + [" Raises: " ++ + mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, + X#op.raises))] + end; +get_raises(_X) -> []. + +get_returns(_G, _X, _InP, []) -> + " Returns: RetVal"; +get_returns(G, _X, _InP, OutP) -> + " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). + + + + +%%------------------------------------------------------------ +%% +%% Utilities +%% +%% Convenient little go-get functions +%% +%%------------------------------------------------------------ + +%% The automaticly generated get and set operation names for an +%% attribute. +mk_attr_func_names(_Scope, Name) -> + {"_get_" ++ Name, "_set_" ++ Name}. +%% {scoped_name(Scope, "_get_"++Name), scoped_name(Scope, "_set_"++Name)}. + +%% Returns TK of the Get and Set attribute functions. +mk_attr_func_types(_N, X) -> + TK = ic_forms:get_tk(X), + {{TK, [], []}, {tk_void, [TK], []}}. + + + +%%------------------------------------------------------------ +%% +%% Generation utilities and common stuff +%% +%% Convenient stuff for generation +%% +%%------------------------------------------------------------ + + +%% Input is a list of parameters (in parse form) and output is a list +%% of capitalised variable names. mk_var is in icgen +mk_erl_vars(_G, Params) -> + map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). + + +%% mk_list produces a nice comma separated string of variable names +mk_list([]) -> []; +mk_list([Arg | Args]) -> + Arg ++ mk_list2(Args). +mk_list2([Arg | Args]) -> + ", " ++ Arg ++ mk_list2(Args); +mk_list2([]) -> []. + + +%%------------------------------------------------------------ +%% +%% Parser utilities +%% +%% Called from the yecc parser. Expands the identifier list of an +%% attribute so that the attribute generator never has to handle +%% lists. +%% +%%------------------------------------------------------------ + + +%% Unfold identifier lists or nested lists. Note that many records +%% contain an entry named id that is a list before unfold and a single +%% id afterwards. +unfold(L) when is_list(L) -> + lists:flatten(map(fun(X) -> unfold2(X) end, L)); +unfold(X) -> unfold2(X). + +unfold2(A) when is_record(A, attr) -> + map(fun(Id) -> A#attr{id=Id} end, A#attr.id); +unfold2(M) when is_record(M, member) -> + map(fun(Id) -> M#member{id=Id} end, M#member.id); +unfold2(M) when is_record(M, case_dcl) -> + map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); +unfold2(T) when is_record(T, typedef) -> + map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id). + + + + +%% Code produce for dependency function +genDependency(G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd),nl(Fd), + ic_codegen:comment(Fd, "Idl file dependency list function"), + emit(Fd, "oe_dependency() ->\n\n", []), + emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). diff --git a/lib/ic/src/ic_error.erl b/lib/ic/src/ic_error.erl new file mode 100644 index 0000000000..f41e78a8be --- /dev/null +++ b/lib/ic/src/ic_error.erl @@ -0,0 +1,375 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_error). + +-include_lib("ic/src/ic.hrl"). +-include_lib("ic/src/ic_debug.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([error/2, + fatal_error/2, + init_errors/1, + return/1, + warn/2, + get_error_count/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% +%% Error and warning utilities. +%% +%% Note that errors are somewhat brutal and that warnings are kept in +%% a list for the user to extract at a later stage. The handling of +%% warnings is entirely up to the user while handling of errors is +%% never left to the user. +%% +%%-------------------------------------------------------------------- + +return(G) -> + case ic_options:get_opt(G, silent2) of + true -> + case get_error_count(G) of + 0 -> {ok, get_list(G, warn_list)}; + _X -> {error, get_list(G, warn_list), get_list(G, error_list)} + end; + false -> + case get_error_count(G) of + 0 -> ok; + X -> print_error(G, {error, g, ic_genobj:idlfile(G), {error_count, X}}), + error + end + end. + + +get_list(G, ListName) -> + ?lookup(G#genobj.options, ListName). + + +%% Public function for reporting an error +error(G, Err) -> + Error = {error, g, ic_genobj:idlfile(G), Err}, + case insert_in_list(G, Error, error_list) of + new -> + print_error(G, Error), + MaxErrs = ic_options:get_opt(G, maxerrs), + case incr_counter(G, error_count) of + X when X >= MaxErrs -> + fatal_error(G, {error_count_exceeded, X}); + _ -> Error + end; + old -> + Error + end. + +%% Public function for reporting an error. NOTE: also stops execution +fatal_error(G, Err) -> + Error = {error, g, ic_genobj:idlfile(G), Err}, + insert_in_list(G, Error, error_list), + incr_counter(G, error_count), + print_error(G, Error), + throw(Error). + + +%% Public function for reporting a warning +warn(G, Warn) -> + Warning = {warn, g, ic_genobj:idlfile(G), Warn}, + case insert_in_list(G, Warning, warn_list) of + new -> + print_warn(G, Warning), + MaxErrs = ic_options:get_opt(G, maxwarns), + case incr_counter(G, warn_count) of + X when X >= MaxErrs -> + fatal_error(G, {warn_count_exceeded, X}); + _ -> ok + end; + old -> ok +end. + + +%% Initialisation of all counters and lists associated with errors and +%% warnings. +init_errors(G) -> + reset_counter(G, error_count), + reset_counter(G, warn_count), + reset_list(G, error_list), + reset_list(G, warn_list), + ok. + + + +%%-------------------------------------------------------------------- +%% Counter and list (warn and error) handling +%% + +incr_counter(G, Counter) -> + Num = ?lookup(G#genobj.options, Counter) + 1, + ?insert(G#genobj.options, Counter, Num), + Num. + +reset_counter(G, Counter) -> + ?insert(G#genobj.options, Counter, 0). + +get_error_count(G) -> + ?lookup(G#genobj.options, error_count). + +reset_list(G, ListName) -> + ?insert(G#genobj.options, ListName, []). + +insert_in_list(G, Item, ListName) -> + List = ?lookup(G#genobj.options, ListName), + case lists:member(Item, List) of + true -> old; + false -> + ?insert(G#genobj.options, ListName, [Item| List]), + new + end. + + +%%-------------------------------------------------------------------- +%% +%% Nice printouts of errors and warnings +%% + + +%% Errors + +print_error(G, Error) -> + case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of + {true, _} -> ok; + {_, true} -> ok; + _ -> format_error(Error) + end, + error. + +format_error({error, _, File, {parse_error, Line, Args}}) -> + Fmt = lists:foldl(fun(_, Acc) -> [$~, $s | Acc] end, [], Args), + display(File, Line, Fmt, Args); +format_error({error, _, File, {error_count, X}}) -> + display(File, "~p errors found", [X]); +format_error({error, _, File, {error_count_exceeded, X}}) -> + display(File, "too many errors found (~p)", [X]); +format_error({error, _, File, {warn_count_exceeded, X}}) -> + display(File, "too many warnings found (~p)", [X]); +format_error({error, _, File, {inherit_name_collision, + {Orig, Item}, {Base, NewItem}}}) -> + display(File, ic_forms:get_line(Item), "~s collides with ~s", + [pp([ic_forms:get_id2(Item) | Orig]), pp([ic_forms:get_id2(NewItem) | Base])]); +format_error({error, _, File, {unsupported_op, {'~', Line}}}) -> + display(File, Line, "unsupported unary operation ~~", []); +format_error({error, _, File, {multiply_defined, X}}) -> + display(File, ic_forms:get_line(X), "multiple defined identifier ~p", [ic_forms:get_id2(X)]); +format_error({error, _, File, {illegal_spelling, X}}) -> + display(File, ic_forms:get_line(X), +% "illegal spelling of identifier ~s (capitalisation?)", + "identifier ~p multiply declared - differs in case only", + [ic_forms:get_id2(X)]); +format_error({error, _, File, {illegal_enumerant_value, X}}) -> + display(File, ic_forms:get_line(X), + "Enumerant ~s's value collide by name with other type", + [ic_forms:get_id2(X)]); +format_error({error, _, File, {illegal_forward, X}}) -> + display(File, ic_forms:get_line(X), + "cannot inherit from forwarded interface ~s", [ic_forms:get_id2(X)]); +format_error({error, _, File, {illegal_const_t, X, Type}}) -> + display(File, ic_forms:get_line(X), + "Illegal constant type ~s of ~s", [pp(Type), ic_forms:get_id2(X)]); +format_error({error, _, File, {multiple_cases, X}}) -> + display(File, ic_forms:get_line(X), "multiple case values ~s", [pp(X)]); +format_error({error, _, File, {symtab_not_found, X}}) -> + display(File, ic_forms:get_line(X), "undeclared identifier ~s", [ic_forms:get_id2(X)]); +format_error({error, _, File, {preproc, Lines}}) -> + display(File, "preprocessor error: ~s", [hd(Lines)]); +format_error({error, _, File, {ic_pp_error, Lines}}) -> + display(File, "preprocessor error: ~s", [Lines]); +format_error({error, _, File, {illegal_float, Line}}) -> + display(File, Line, "illegal floating point number", []); +format_error({error, _, File, {bad_type_combination, E, V1, V2}}) -> + display(File, ic_forms:get_line(E), "incompatible types, ~p and ~p", [V1, V2]); +format_error({error, _, File, {bad_oneway_type, X, _TK}}) -> + display(File, ic_forms:get_line(X), "oneway operations must be declared void", []); +format_error({error, _, File, {inout_spec_for_c, X, Arg}}) -> + display(File, ic_forms:get_line(X), "inout parameter ~s specified in native c mode", + [Arg]); +format_error({error, _, File, {sequence_not_defined, X, Arg}}) -> + display(File, ic_forms:get_line(X), "sequence ~s not defined", [Arg]); +format_error({error, _, File, {illegal_typecode_for_c, Arg}}) -> + display(File, not_specified, "illegal typecode ~s used in native c mode", + [Arg]); +format_error({error, _, File, {name_not_found, N}}) -> + display(File, not_specified, "name ~s not found", [N]); +format_error({error, _, File, {illegal_typecode_for_c, Arg, N}}) -> + display(File, not_specified, "illegal typecode ~p used for ~p in native c mode", [Arg, N]); +format_error({error, _, File, {oneway_outparams, X}}) -> + display(File, ic_forms:get_line(X), + "oneway operations may not have out or inout parameters", []); +format_error({error, _, File, {oneway_raises, X}}) -> + display(File, ic_forms:get_line(X), "oneway operations may not raise exceptions", + []); +format_error({error, _, File, {bad_tk_match, T, TK, V}}) -> + display(File, ic_forms:get_line(T), + "value ~p does not match declared type ~s", [V, pp(TK)]); +format_error({error, _, File, {bad_scope_enum_case, ScopedId}}) -> + display(File, ic_forms:get_line(ScopedId), + "scoped enum identifiers not allowed as case (~s)", + [pp(ScopedId)]); +format_error({error, _, File, {bad_type, Expr, Op, _TypeList, V}}) -> + display(File, ic_forms:get_line(Expr), + "parameter value ~p to ~s is of illegal type", [V, pp(Op)]); +format_error({error, _, File, {bad_case_type, TK, X, Val}}) -> + display(File, ic_forms:get_line(X), + "case value ~s does not match discriminator type ~s", + [case_pp(X, Val), pp(TK)]); +format_error({error, _, File, {tk_not_found, X}}) -> + display(File, ic_forms:get_line(X), "undeclared identifier ~s", [pp(X)]); +%%% New format_errors +format_error({error, _, File, {bad_fixed, Format, Args, Line}}) -> + display(File, Line, Format, Args); +format_error({error, _, File, {illegal_switch_t, Arg, _N}}) -> + display(File, ic_forms:get_line(Arg), "illegal switch", []); +format_error({error, _, File, {inherit_resolve, Arg, N}}) -> + display(File, ic_forms:get_line(Arg), "cannot resolve ~s", [N]); +format_error({error, _, File, {bad_escape_character, Line, Char}}) -> + display(File, Line, "bad escape character \"~c\"", [Char]); +format_error({error, _, File, {pragma_code_opt_bad_option_list, Line}}) -> + display(File, Line, "bad option list on pragma \"CODEOPT\"", []); +format_error({error, _, File, {bad_string, Line}}) -> + display(File, Line, "bad string", []); +format_error({error, _, File, {create_dir, Path, Reason}}) -> + display(File, not_specified, "couldn't create directory ~p due to ~p", [Path, Reason]); +format_error({error, _, File, {open_file, Path, Reason}}) -> + display(File, not_specified, "couldn't open ~p due to ~p", [Path, Reason]); +format_error({error, _, File, {plain_error_string, ErrString}}) -> + display(File, not_specified, "~s", [ErrString]); +format_error({error, _, File, {plain_error_string, T, ErrString}}) -> + display(File, ic_forms:get_line(T), "~s", [ErrString]); +format_error({error, _, File, {ErrString, Line}}) -> + display(File, Line, ErrString, []). + + +%% Warnings +print_warn(G, Warn) -> + case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of + {true, _} -> ok; + {_, true} -> ok; + _ -> format_warn(Warn) + end. + +format_warn({warn, _, File, {ic_pp_warning, Lines}}) -> + display(File, "preprocessor warning: ~s", [Lines]); +format_warn({warn, _, _File, {cfg_open, _Reason, File}}) -> + display(File, "warning: could not open file: ~p", [File]); +format_warn({warn, _, _File, {cfg_read, File}}) -> + display(File, "warning: syntax error in configuration file", []); +format_warn({warn, _, File, {multi_modules, Id}}) -> + display(File, ic_forms:get_line(Id), "warning: multiple modules in file", []); +format_warn({warn, _, File, {illegal_opt, Opt}}) -> + display(File, "warning: unrecognised option: ~p", [Opt]); +format_warn({warn, _, File, {nested_mod, Id}}) -> + display(File, ic_forms:get_line(Id), "warning: nested module: ~s", [ic_forms:get_id(Id)]); +format_warn({warn, _, File, {inherit_name_shadow, {Orig, Item}, + {Base, NewItem}}}) -> + display(File, ic_forms:get_line(Item), + "warning: ~s shadows ~s", [pp([ic_forms:get_id2(Item) | Orig]), + pp([ic_forms:get_id2(NewItem) | Base])]); +format_warn({warn, _, File, {internal_307, X, Y}}) -> + %% If global Scope variable is not [] at top level constant + display(File, ic_forms:get_line(X), "warning: internal 307: ~p ~p", [X, Y]); +format_warn({warn, _, File, {WarnString, Line}}) -> + display(File, Line, WarnString, []). + +%% Display an error or warning +display(File, not_specified, F, A) -> + io:format("~p : ~s~n", [File, io_lib:format(F, A)]); +display(File, Line, F, A) -> + io:format("~p on line ~p: ~s~n", [File, Line, io_lib:format(F, A)]). +display(File, F, A) -> + io:format("~p: ~s~n", [File, io_lib:format(F, A)]). + + + +%%format_warn2(G, WarnStr) -> +%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), +%% ic_options:get_opt(G, nowarn)} of +%% {false, false, false} -> +%% io:format("~p: warning: ~s~n", [ic_genobj:idlfile(G), WarnStr]); +%% _ -> ok +%% end. + +%%format_warn2(G, Line, WarnStr) -> +%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), +%% ic_options:get_opt(G, nowarn)} of +%% {false, false, false} -> +%% io:format("~p on line ~p: warning: ~s~n", +%% [ic_genobj:idlfile(G), Line, WarnStr]); +%% _ -> ok +%% end. + + + + +%% pretty print various stuff + +pp({tk_string, _}) -> "string"; +pp({tk_wstring, _}) -> "wstring"; +pp(tk_long) -> "long"; +pp(tk_short) -> "short"; +pp(tk_ushort) -> "unsigned short"; +pp(tk_ulong) -> "unsigned long"; +pp(tk_float) -> "float"; +pp(tk_double) -> "double"; +pp(tk_boolean) -> "boolean"; +pp(tk_char) -> "char"; +pp(tk_wchar) -> "wchar"; +pp(tk_octet) -> "octet"; +pp(tk_null) -> "null"; +pp(tk_void) -> "void"; +pp(tk_any) -> "any"; +pp({tk_fixed, _, _}) -> "fixed"; +pp({tk_objref, _, _}) -> "object reference"; +pp(rshift) -> ">>"; +pp(lshift) -> "<<"; +pp(X) when element(1, X) == tk_enum -> "enum"; +pp(X) when is_record(X, scoped_id) -> ic_util:to_colon(X); +pp(X) when element(1, X) == '<identifier>' -> ic_forms:get_id(X); +pp(X) when is_list(X) andalso is_list(hd(X)) -> ic_util:to_colon(X); +pp({_, Num, Beef}) when is_integer(Num) -> Beef; +pp({Beef, Num}) when is_integer(Num) -> ic_util:to_list(Beef); +pp(X) -> ic_util:to_list(X). + +%% special treatment of case label names +case_pp(X, _Val) when is_record(X, scoped_id) -> pp(X); +case_pp(_X, Val) -> pp(Val). + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_fetch.erl b/lib/ic/src/ic_fetch.erl new file mode 100644 index 0000000000..c1b140ef11 --- /dev/null +++ b/lib/ic/src/ic_fetch.erl @@ -0,0 +1,388 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_fetch). + +-include("icforms.hrl"). + +-export([member2type/3]). + +-export([fetchTk/3, isArray/3, isBasicType/1, isBasicType/2, + isBasicType/3, isBasicTypeOrEterm/3, isEterm/3, isString/3, + isStruct/3, isUnion/3, name2type/2, searchIncludedTk/2, + searchInsideTks/2, searchTk/2, searchTk/3]). + +name2type(G, Name) -> + S = ic_genobj:tktab(G), + ScopedName = lists:reverse(string:tokens(Name,"_")), + InfoList = ets:lookup( S, ScopedName ), + filter( InfoList ). + + + +%% This is en overloaded function, +%% differs in input on unions +member2type(_G, X, I) when is_record(X, union)-> + Name = ic_forms:get_id2(I), + case lists:keysearch(Name,2,element(6,X#union.tk)) of + false -> + error; + {value,Rec} -> + fetchType(element(3,Rec)) + end; +member2type( G, SName, MName ) -> + + S = ic_genobj:tktab( G ), + SNList = lists:reverse(string:tokens(SName,"_")), + ScopedName = [MName | SNList], + InfoList = ets:lookup( S, ScopedName ), + + case filter( InfoList ) of + error -> + %% Try a little harder, seeking inside tktab + case lookup_member_type_in_tktab(S, ScopedName, MName) of + error -> + %% Check if this is the "return to return1" case + case MName of + "return1" -> + %% Do it all over again ! + ScopedName2 = ["return" | SNList], + InfoList2 = ets:lookup( S, ScopedName2 ), + case filter( InfoList2 ) of + error -> + %% Last resort: seek in pragma table + lookup_type_in_pragmatab(G, SName); + + Other -> + Other + end; + _ -> + %% Last resort: seek in pragma table + lookup_type_in_pragmatab(G, SName) + end; + Other -> + Other + end; + Other -> + Other + end. + + +lookup_member_type_in_tktab(S, ScopedName, MName) -> + case ets:match_object(S, {'_',member,{MName,'_'},nil}) of + [] -> + error; + [{_FullScopedName,member,{MName,TKInfo},nil}]-> + fetchType( TKInfo ); + List -> + lookup_member_type_in_tktab(List,ScopedName) + end. + +lookup_member_type_in_tktab([],_ScopedName) -> + error; +lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> + case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of + ScopedName -> + fetchType(TKInfo); + _ -> + lookup_member_type_in_tktab(Rest,ScopedName) + end. + + +lookup_type_in_pragmatab(G, SName) -> + S = ic_genobj:pragmatab(G), + + %% Look locally first + case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of + [] -> + %% No match, seek included + case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of + + [] -> + error; + [[Type]] -> + io:format("1 Found(~p) : ~p~n",[SName,Type]), + Type + end; + + [[Type]] -> + io:format("2 Found(~p) : ~p~n",[SName,Type]), + Type + end. + + + + +filter( [] ) -> + error; +filter( [I | Is ] ) -> + case I of + { _, member, { _, TKINFO }, _ } -> + fetchType( TKINFO ); + + { _, struct, _, _ } -> + struct; + + { _, typedef, TKINFO, _ } -> + fetchType( TKINFO ); + + { _, module, _, _ } -> + module; + + { _, interface, _, _ } -> + interface; + + { _, op, _, _ } -> + op; + + { _,enum, _, _ } -> + enum; + + { _, spellcheck } -> + filter( Is ); + + _ -> + error + end. + + +fetchType( { tk_sequence, _, _ } ) -> + sequence; +fetchType( { tk_array, _, _ } ) -> + array; +fetchType( { tk_struct, _, _, _} ) -> + struct; +fetchType( { tk_string, _} ) -> + string; +fetchType( tk_short ) -> + short; +fetchType( tk_long ) -> + long; +fetchType( tk_ushort ) -> + ushort; +fetchType( tk_ulong ) -> + ulong; +fetchType( tk_float ) -> + float; +fetchType( tk_double ) -> + double; +fetchType( tk_boolean ) -> + boolean; +fetchType( tk_char ) -> + char; +fetchType( tk_octet ) -> + octet; +fetchType( { tk_enum, _, _, _ } ) -> + enum; +fetchType( { tk_union, _, _, _, _, _ } ) -> + union; +fetchType( tk_any ) -> + any; +fetchType( _ ) -> + error. + +isBasicTypeOrEterm(G, N, S) -> + case isBasicType(G, N, S) of + true -> + true; + false -> + isEterm(G, N, S) + end. + + +isEterm(G, N, S) when element(1, S) == scoped_id -> + {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of + "erlang_term" -> + true; + "ETERM*" -> + true; + _X -> + false + end; +isEterm(_G, _Ni, _X) -> + false. + +isBasicType(G, N, S) when element(1, S) == scoped_id -> + {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + isBasicType(fetchType(TK)); +isBasicType(_G, _N, {string, _} ) -> + false; +isBasicType(_G, _N, {Type, _} ) -> + isBasicType(Type). + + +isBasicType(G, Name) -> + isBasicType(name2type(G, Name )). + + +isBasicType(Type) -> + lists:member(Type, + [tk_short,short, + tk_long,long, + tk_ushort,ushort, + tk_ulong,ulong, + tk_float,float, + tk_double,double, + tk_boolean,boolean, + tk_char,char, + tk_octet,octet]). + + + +isString(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_string',_}, _} -> + true; + _ -> + false + end; +isString(_G, _N, T) when is_record(T, string) -> + true; +isString(_G, _N, _Other) -> + false. + + +isArray(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_array', _, _}, _} -> + true; + _ -> + false + end; +isArray(_G, _N, T) when is_record(T, array) -> + true; +isArray(_G, _N, _Other) -> + false. + + + +isStruct(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> + true; + _ -> + false + end; +isStruct(_G, _N, T) when is_record(T, struct) -> + true; +isStruct(_G, _N, _Other) -> + false. + + + +isUnion(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> + true; + _Other -> + false + end; +isUnion(_G, _N, T) when is_record(T, union) -> + true; +isUnion(_G, _N, _Other) -> + false. + + + +%%------------------------------------------------------------ +%% +%% Always fetchs TK of a record. +%% +%%------------------------------------------------------------ +fetchTk(G,N,X) -> + case ic_forms:get_tk(X) of + undefined -> + searchTk(G,ictk:get_IR_ID(G, N, X)); + TK -> + TK + end. + + +%%------------------------------------------------------------ +%% +%% seek type code when not accessible by get_tk/1 +%% +%%------------------------------------------------------------ +searchTk(G,IR_ID) -> + S = ic_genobj:tktab(G), + case catch searchTk(S,IR_ID,typedef) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch searchTk(S,IR_ID,struct) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch searchTk(S,IR_ID,union) of + {value,TK} -> + TK; + _ -> + undefined + end + end + end. + + +searchTk(S,IR_ID,Type) -> + L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), + case lists:keysearch(IR_ID,2,L) of + {value,TK} -> + {value,TK}; + false -> + searchInsideTks(L,IR_ID) + end. + + +searchInsideTks([],_IR_ID) -> + false; +searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> + case searchIncludedTk(TK,IR_ID) of + {value,TK} -> + {value,TK}; + false -> + searchInsideTks(Xs,IR_ID) + end. + + +searchIncludedTk({tk_array,TK,_},IR_ID) -> + searchIncludedTk(TK,IR_ID); +searchIncludedTk({tk_sequence,TK,_},IR_ID) -> + searchIncludedTk(TK,IR_ID); +searchIncludedTk(TK,_IR_ID) when is_atom(TK) -> + false; +searchIncludedTk(TK,IR_ID) -> + case element(2,TK) == IR_ID of + true -> + {value,TK}; + false -> + false + end. + + + + + + + + + + + diff --git a/lib/ic/src/ic_file.erl b/lib/ic/src/ic_file.erl new file mode 100644 index 0000000000..6a99d6cfde --- /dev/null +++ b/lib/ic/src/ic_file.erl @@ -0,0 +1,447 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_file). + +-include_lib("ic/src/ic.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([filename_push/4, filename_pop/2, open/2, close/1, remove_ext/1, join/2, + add_dot_erl/1, add_dot_hrl/1, add_dot_c/1, add_dot_h/1, add_dot_java/1, + add_dot_idl/1, javaInterfaceFilePush/3, javaInterfaceFilePop/1, + createDirectory/2, createJavaDirectory/2, open_java_file/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: filename_push +%% +%% Pushes a file name, can also push ignore in which case means that +%% no files should ever be opened at this scope. Note that empty in +%% the file descriptor entries means that the file just isn't open +%% yet. +%%----------------------------------------------------------------- +filename_push(G, _N, ignore, _) -> + G#genobj{stubfile=[ignore | G#genobj.stubfile], + stubfiled=[ignore | G#genobj.stubfiled], + skelfile=[ignore | G#genobj.skelfile], + skelfiled=[ignore | G#genobj.skelfiled], + includefile=[ignore | G#genobj.includefile], + includefiled=[ignore | G#genobj.includefiled]}; + +filename_push(G, N, X, Lang) -> + Fullname = [ic_forms:get_id2(X) | N], + EName0 = ic_util:to_undersc(Fullname), + + DoGen = ic_genobj:do_gen(G), + + ImplName = find_impl_name(G, Fullname), + + {StubName, EName} = + case Lang of + erlang -> + {join(ic_options:get_opt(G, stubdir), add_dot_erl(EName0)), + EName0}; + erlang_template -> + {join(ic_options:get_opt(G, stubdir), add_dot_erl(ImplName)), + ImplName}; + c -> + {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0)), + EName0}; + c_server -> + {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0++"__s")), + EName0}; + erlang_template_no_gen -> + {undefined, EName0}; + erlang_no_stub -> + {undefined, EName0}; + c_no_stub -> + {undefined, EName0}; + c_server_no_stub -> + {undefined, EName0} + end, + Stub = if DoGen==true -> + case StubName of + undefined -> + ignore; + _ -> + ic_codegen:emit_stub_head(G, open(empty, StubName), EName, Lang) + end; + true -> ignore end, + + HrlName = case Lang of + erlang_template -> + ignore; + erlang_template_no_gen -> + ignore; + erlang -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), + ignore); + c -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), + ignore); + c_server -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), + add_dot_h(EName++"__s")), + ignore); + erlang_no_stub -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), + ignore); + c_no_stub -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), + ignore); + c_server_no_stub -> + ?ifopt2(G, gen_hrl, + join(ic_options:get_opt(G, stubdir), + add_dot_h(EName++"__s")), + ignore) + end, + Hrl = if DoGen==true -> + case Lang of + erlang_template -> + ignore; + erlang_template_no_gen -> + ignore; + erlang_no_stub -> + ic_codegen:emit_hrl_head(G, open(empty, HrlName), + EName, erlang); + c_no_stub -> + ic_codegen:emit_hrl_head(G, open(empty, HrlName), + EName, c); + c_server_no_stub -> + ic_codegen:emit_hrl_head(G, open(empty, HrlName), + EName, c_server); + _ -> + ic_codegen:emit_hrl_head(G, open(empty, HrlName), + EName, Lang) + end; + true -> ignore end, + + G#genobj{impl=ImplName, + stubfile=[StubName | G#genobj.stubfile], + stubfiled=[Stub | G#genobj.stubfiled], + includefile=[HrlName | G#genobj.includefile], + includefiled=[Hrl | G#genobj.includefiled]}. + +%%----------------------------------------------------------------- +%% Func: join/2 +%% +%% Special version of filename join. +%%----------------------------------------------------------------- +join([], File) -> + File; +join(Path, File) -> + filename:join(Path, File). + + +%%----------------------------------------------------------------- +%% Func: filename_pop/2 +%%----------------------------------------------------------------- +filename_pop(G, Lang) -> +%% io:format("Popped file names: ~p~n", [hd(G#genobj.stubfile)]), +%% case is_skelfile_open(G) of +%% true -> emit_skel_footer(G); +%% false -> ok end, +%% close(hd(G#genobj.skelfiled)), + close(hd(G#genobj.stubfiled)), + ic_codegen:emit_hrl_foot(G, Lang), + close(hd(G#genobj.includefiled)), + G#genobj{stubfile=tl(G#genobj.stubfile), + stubfiled=tl(G#genobj.stubfiled), +%% skelfile=tl(G#genobj.skelfile), +%% skelfiled=tl(G#genobj.skelfiled), + includefile=tl(G#genobj.includefile), + includefiled=tl(G#genobj.includefiled)}. + + + +%%----------------------------------------------------------------- +%% Func: javaInterfaceFilePush/3 +%%----------------------------------------------------------------- +javaInterfaceFilePush(G, N, X) -> + Name = ic_forms:get_java_id(X), + {InterfaceFd, InterfaceFileName} = open_java_file(G, N, Name), + + StubClassName = "_" ++ Name ++ "Stub", + {StubFd, StubFileName} = open_java_file(G, N, StubClassName), + + SkelClassName = "_" ++ Name ++ "ImplBase", + {SkelFd, SkelFileName} = open_java_file(G, N, SkelClassName), + + HelperClassName = Name ++ "Helper", + {HelperFd, HelperFileName} = open_java_file(G, N, HelperClassName), + + HolderClassName = Name ++ "Holder", + {HolderFd, HolderFileName} = open_java_file(G, N, HolderClassName), + + G#genobj{ + interfacefile=[InterfaceFileName | G#genobj.interfacefile], + interfacefiled=[InterfaceFd | G#genobj.interfacefiled], + stubfile=[StubFileName | G#genobj.stubfile], + stubfiled=[StubFd | G#genobj.stubfiled], + skelfile=[SkelFileName | G#genobj.skelfile], + skelfiled=[SkelFd | G#genobj.skelfiled], + helperfile=[HelperFileName | G#genobj.helperfile], + helperfiled=[HelperFd | G#genobj.helperfiled], + holderfile=[HolderFileName | G#genobj.holderfile], + holderfiled=[HolderFd | G#genobj.holderfiled]}. + + + + + +%%----------------------------------------------------------------- +%% Func: javaInterfaceFilePop/1 +%%----------------------------------------------------------------- +javaInterfaceFilePop(G) -> + close(hd(G#genobj.interfacefiled)), + close(hd(G#genobj.stubfiled)), + close(hd(G#genobj.skelfiled)), + close(hd(G#genobj.helperfiled)), + close(hd(G#genobj.holderfiled)), + G#genobj{ + interfacefile=tl(G#genobj.interfacefile), + interfacefiled=tl(G#genobj.interfacefiled), + stubfile=tl(G#genobj.stubfile), + stubfiled=tl(G#genobj.stubfiled), + skelfile=tl(G#genobj.skelfile), + skelfiled=tl(G#genobj.skelfiled), + helperfile=tl(G#genobj.helperfile), + helperfiled=tl(G#genobj.helperfiled), + holderfile=tl(G#genobj.holderfile), + holderfiled=tl(G#genobj.holderfiled)}. + +%%----------------------------------------------------------------- +%% Func: createDirectory/2 +%%----------------------------------------------------------------- +createDirectory(_G, []) -> + ok; +createDirectory(G, Scope) -> + Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(Scope)), + case file:make_dir(Path) of + ok -> + ok; + {error, eexist} -> + ok; + {error, Reason} -> + ic_error:fatal_error(G, {create_dir, Path, Reason}) + end. + + +%%----------------------------------------------------------------- +%% Func: createJavaDirectory/2 +%%----------------------------------------------------------------- +createJavaDirectory(_G, []) -> + ok; +createJavaDirectory(G, Scope) -> + JavaScope = ic_util:adjustScopeToJava(G,Scope), + Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(JavaScope)), + case file:make_dir(Path) of + ok -> + ok; + {error, eexist} -> + ok; + {error, Reason} -> + ic_error:fatal_error(G, {create_dir, Path, Reason}) + end. + + + + +%%----------------------------------------------------------------- +%% Func: createJavaFileName/3 +%%----------------------------------------------------------------- +createJavaFileName(G, Scope, FName) -> + JavaScope = ic_util:adjustScopeToJava(G,Scope), + join(ic_options:get_opt(G, stubdir), + ic_pragma:slashify([FName++".java"|JavaScope])). + +%%----------------------------------------------------------------- +%% Func: close/2 (used to be file_close) +%%----------------------------------------------------------------- +close(empty) -> ok; +close(ignore) -> ok; +close(Fd) -> + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: remove_ext/1 +%%----------------------------------------------------------------- +remove_ext(File) -> + filename:rootname(filename:basename(File)). + +%%----------------------------------------------------------------- +%% Func: open/2 (used to be file_open) +%%----------------------------------------------------------------- +open(_, ignore) -> ignore; +open(empty, Name) -> + case file:open(Name, [raw, binary, write]) of + {ok, Fd} -> + Fd; + {error, Reason} -> + exit({error, Reason}) +%% ic_error:fatal_error(G, {open_file, Name, Reason}) + end. + +%%----------------------------------------------------------------- +%% Func: open_java_file/3 +%%----------------------------------------------------------------- +open_java_file(G, N, Name) -> + createJavaDirectory(G, N), + FName = createJavaFileName(G, N, Name), + case file:open(FName, [raw, binary, write]) of + {ok, Fd} -> + ic_codegen:emit_stub_head(G, Fd, Name, java), + emit_package(G, N, Fd), + {Fd, FName}; + {error, Reason} -> + ic_error:fatal_error(G, {open_file, FName, Reason}) + end. + +%%----------------------------------------------------------------- +%% Func: emit_package/3 +%%----------------------------------------------------------------- +emit_package(_G, [], _Fd) -> + ok; +emit_package(G, N, Fd) -> + ic_codegen:emit(Fd, "package ~s;\n", [ic_util:to_dot(G,N)]), + ic_codegen:nl(Fd). + +%%----------------------------------------------------------------- +%% Func: add_dot_erl/1 +%%----------------------------------------------------------------- +add_dot_erl(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$l, $r, $e, $. | _Rest] -> + File; + _ -> + File ++ ".erl" + end. + +%%----------------------------------------------------------------- +%% Func: add_dot_hrl/1 +%%----------------------------------------------------------------- +add_dot_hrl(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$l, $r, $h, $. | _Rest] -> + File; + _ -> + File ++ ".hrl" + end. + +%%----------------------------------------------------------------- +%% Func: add_dot_c/1 +%%----------------------------------------------------------------- +add_dot_c(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$c, $. | _Rest] -> + File; + _ -> + File ++ ".c" + end. + +%%----------------------------------------------------------------- +%% Func: add_dot_h/1 +%%----------------------------------------------------------------- +add_dot_h(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$h, $. | _Rest] -> + File; + _ -> + File ++ ".h" + end. + +%%----------------------------------------------------------------- +%% Func: add_dot_java/1 +%%----------------------------------------------------------------- +add_dot_java(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$a, $v, $a, $j, $. | _Rest] -> + File; + _ -> + File ++ ".java" + end. + +%%----------------------------------------------------------------- +%% Func: add_dot_idl/1 +%%----------------------------------------------------------------- +add_dot_idl(F) -> + File = ic_util:to_list(F), + F2 = lists:reverse(File), + case F2 of + [$l, $d, $i, $. | _Rest] -> + File; + _ -> + File ++ ".idl" + end. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% +%% File handling stuff +%% +%% +%% Shall open a file for writing. Also sets up the generator with +%% usefull bits of information +%% +%%-------------------------------------------------------------------- +find_impl_name(G, Name) -> + N1 = ic_util:to_colon(Name), + N2 = ic_util:to_undersc(Name), + case {ic_options:get_opt(G, {impl, N1}), + ic_options:get_opt(G, {impl, N2})} of + {false, false} -> + case {ic_options:get_opt(G, {impl, "::"++N1}), + ic_options:get_opt(G, {impl, N2})} of + {false, false} -> N2 ++ "_impl"; + {X, _Y} when X /= false -> ic_util:to_list(X); + {_X, Y} when Y /= false -> ic_util:to_list(Y) + end; + {X, _Y} when X /= false -> ic_util:to_list(X); + {_X, Y} when Y /= false -> ic_util:to_list(Y) + end. diff --git a/lib/ic/src/ic_forms.erl b/lib/ic/src/ic_forms.erl new file mode 100644 index 0000000000..7409ddeb7b --- /dev/null +++ b/lib/ic/src/ic_forms.erl @@ -0,0 +1,437 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_forms). + +-include_lib("ic/src/ic.hrl"). +-include_lib("ic/src/icforms.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([get_id/1, get_id2/1, get_java_id/1, get_line/1]). +-export([get_type_code/3, search_tk/2, clean_up_scope/1]). +-export([get_body/1, get_dimension/1, get_idlist/1, get_type/1, get_tk/1, is_oneway/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% +%% Generation go-get utilities +%% +%% Feeble attempt at virtual funtions. +%% +%%-------------------------------------------------------------------- + +get_dimension(X) when is_record(X, array) -> + [element(3, L) || L <- X#array.size]. + +%% Should find the name hidden in constructs +get_id( [{'<identifier>', _LineNo, Id}] ) -> Id; +get_id( {'<identifier>', _LineNo, Id} ) -> Id; +get_id(Id) when is_list(Id) andalso is_integer(hd(Id)) -> Id; +get_id(X) when is_record(X, scoped_id) -> X#scoped_id.id; +get_id(X) when is_record(X, array) -> get_id(X#array.id); +get_id( {'<string_literal>', _LineNo, Id} ) -> Id; +get_id( {'<wstring_literal>', _LineNo, Id} ) -> Id. + +get_line([{'<identifier>', LineNo, _Id}]) -> LineNo; +get_line({'<identifier>', LineNo, _Id}) -> LineNo; +get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line; +get_line(X) when is_record(X, module) -> get_line(X#module.id); +get_line(X) when is_record(X, interface) -> get_line(X#interface.id); +get_line(X) when is_record(X, forward) -> get_line(X#forward.id); +get_line(X) when is_record(X, const) -> get_line(X#const.id); +get_line(X) when is_record(X, typedef) -> get_line(X#typedef.id); +get_line(X) when is_record(X, struct) -> get_line(X#struct.id); +get_line(X) when is_record(X, member) -> get_line(X#member.id); +get_line(X) when is_record(X, union) -> get_line(X#union.id); +get_line(X) when is_record(X, case_dcl) -> get_line(X#case_dcl.id); +get_line(X) when is_record(X, enum) -> get_line(X#enum.id); +get_line(X) when is_record(X, enumerator) -> get_line(X#enumerator.id); +get_line(X) when is_record(X, array) -> get_line(X#array.id); +get_line(X) when is_record(X, attr) -> get_line(X#attr.id); +get_line(X) when is_record(X, except) -> get_line(X#except.id); +get_line(X) when is_record(X, op) -> get_line(X#op.id); +get_line(X) when is_record(X, param) -> get_line(X#param.id); +get_line(X) when is_record(X, id_of) -> get_line(X#id_of.id); + +get_line({'or', T1, _T2}) -> get_line(T1); +get_line({'xor', T1, _T2}) -> get_line(T1); +get_line({'and', T1, _T2}) -> get_line(T1); +get_line({'rshift', T1, _T2}) ->get_line(T1); +get_line({'lshift', T1, _T2}) ->get_line(T1); +get_line({'+', T1, _T2}) -> get_line(T1); +get_line({'-', T1, _T2}) -> get_line(T1); +get_line({'*', T1, _T2}) -> get_line(T1); +get_line({'/', T1, _T2}) -> get_line(T1); +get_line({'%', T1, _T2}) -> get_line(T1); +get_line({{'-', _Line}, T}) -> get_line(T); +get_line({{'+', _Line}, T}) -> get_line(T); +get_line({{'~', _Line}, T}) -> get_line(T); +get_line({_, X, _}) when is_integer(X) -> X; +get_line({_A, N}) when is_integer(N) -> N; +get_line(_) -> -1. + + +%%-------------------------------------------------------------------- +%% +%% High level get functions. +%% +%% These are highly polymorphic functions that will get the id, +%% body and type of a record (those records output from the +%% parser). +%% +%% NOTE: The typedef node (the alias) is special, because the type +%% field is a type definition and therefore considered a body, +%% and the type of a typedef is its name. +%% + +get_id2(X) when is_record(X, module) -> get_id(X#module.id); +get_id2(X) when is_record(X, interface) -> get_id(X#interface.id); +get_id2(X) when is_record(X, forward) -> get_id(X#forward.id); +get_id2(X) when is_record(X, const) -> get_id(X#const.id); +get_id2(X) when is_record(X, typedef) -> get_id(hd(X#typedef.id)); +get_id2(X) when is_record(X, struct) -> get_id(X#struct.id); +get_id2(X) when is_record(X, member) -> get_id(hd(X#member.id)); +get_id2(X) when is_record(X, union) -> get_id(X#union.id); +get_id2(X) when is_record(X, case_dcl) -> get_id(X#case_dcl.id); +get_id2(X) when is_record(X, enum) -> get_id(X#enum.id); +get_id2(X) when is_record(X, enumerator) -> get_id(X#enumerator.id); +get_id2(X) when is_record(X, array) -> get_id(X#array.id); +get_id2(X) when is_record(X, attr) -> get_id(X#attr.id); +get_id2(X) when is_record(X, except) -> get_id(X#except.id); +get_id2(X) when is_record(X, op) -> get_id(X#op.id); +get_id2(X) when is_record(X, param) -> get_id(X#param.id); +get_id2(X) when is_record(X, type_dcl) -> get_id2(X#type_dcl.type); +get_id2(X) when is_record(X, scoped_id) -> ic_symtab:scoped_id_strip(X); +get_id2(X) when is_record(X, preproc) -> get_id(X#preproc.id); +get_id2(X) when is_record(X, id_of) -> get_id2(X#id_of.id); +get_id2(X) -> get_id(X). + +get_body(X) when is_record(X, module) -> X#module.body; +get_body(X) when is_record(X, interface) -> X#interface.body; +get_body(X) when is_record(X, struct) -> X#struct.body; +get_body(X) when is_record(X, union) -> X#union.body; +get_body(X) when is_record(X, enum) -> X#enum.body; +get_body(X) when is_record(X, typedef) -> X#typedef.type; % See Note +get_body(X) when is_record(X, except) -> X#except.body. + +get_type(X) when is_record(X, const) -> X#const.type; +get_type(X) when is_record(X, type_dcl) -> X#type_dcl.type; +get_type(X) when is_record(X, typedef) -> X#typedef.id; % See Note +get_type(X) when is_record(X, member) -> X#member.type; +get_type(X) when is_record(X, union) -> X#union.type; +get_type(X) when is_record(X, case_dcl) -> X#case_dcl.type; +get_type(X) when is_record(X, sequence) -> X#sequence.type; +get_type(X) when is_record(X, attr) -> X#attr.type; +get_type(X) when is_record(X, op) -> X#op.type; +get_type(X) when is_record(X, param) -> X#param.type. +%%get_type(X) when record(X, id_of) -> get_type(X#id_of.type). + +%% Temporary place +get_tk(X) when is_record(X, interface) -> X#interface.tk; +get_tk(X) when is_record(X, forward) -> X#forward.tk; +get_tk(X) when is_record(X, const) -> X#const.tk; +get_tk(X) when is_record(X, type_dcl) -> X#type_dcl.tk; +get_tk(X) when is_record(X, typedef) -> X#typedef.tk; +get_tk(X) when is_record(X, struct) -> X#struct.tk; +get_tk(X) when is_record(X, union) -> X#union.tk; +get_tk(X) when is_record(X, enum) -> X#enum.tk; +get_tk(X) when is_record(X, attr) -> X#attr.tk; +get_tk(X) when is_record(X, except) -> X#except.tk; +get_tk(X) when is_record(X, op) -> X#op.tk; +get_tk(X) when is_record(X, id_of) -> X#id_of.tk; +get_tk(X) when is_record(X, param) -> X#param.tk. + + +%% Get idlist returns the list of identifiers found in typedefs, case +%% dcls etc. +get_idlist(X) when is_record(X, typedef) -> X#typedef.id; +get_idlist(X) when is_record(X, member) -> X#member.id; +get_idlist(X) when is_record(X, case_dcl) -> X#case_dcl.label; +get_idlist(X) when is_record(X, attr) -> X#attr.id. + + +is_oneway(X) when is_record(X, op) -> + case X#op.oneway of + {oneway, _} -> true; + _ -> false + end; +is_oneway(_X) -> false. + + + + + +%%------------------------------------------------------------ +%% +%% Analyze the record and seek the correct type code. +%% +%% NOT equal to get_tk, this will always succed ! +%% +%%------------------------------------------------------------ +get_type_code(G, N, X) -> + case get_type_code2(G, N, X) of + undefined -> + %% Remove "Package" suffix from scope + N2 = clean_up_scope(N), + search_tk(G,ictk:get_IR_ID(G, N2, X)); + TC -> + TC + end. + +clean_up_scope(N) -> + clean_up_scope(N,[]). + +clean_up_scope([],N) -> + lists:reverse(N); +clean_up_scope([N|Ns],Found) -> + case lists:suffix("Package",N) of + true -> + Len = length(N), + case Len > 7 of + true -> + N2 = string:substr(N,1,Len-7), + clean_up_scope(Ns,[N2|Found]); + false -> + clean_up_scope(Ns,[N|Found]) + end; + false -> + clean_up_scope(Ns,[N|Found]) + end. + + +get_type_code2(_, _, X) when is_record(X, interface) -> X#interface.tk; +get_type_code2(_, _, X) when is_record(X, forward) -> X#forward.tk; +get_type_code2(_, _, X) when is_record(X, const) -> X#const.tk; +get_type_code2(_, _, X) when is_record(X, type_dcl) -> X#type_dcl.tk; +get_type_code2(_, _, X) when is_record(X, typedef) -> + Id = X#typedef.id, + ET = X#typedef.tk, + if is_list(Id) -> + Head = hd(Id), + if is_tuple(Head) -> + case element(1,Head) of + array -> + get_array_tc(ET, element(3,Head)); + _ -> + ET + end; + true -> + ET + end; + true -> + ET + end; + +get_type_code2(_, _, X) when is_record(X, struct) -> X#struct.tk; +get_type_code2(_, _, X) when is_record(X, union) -> X#union.tk; +get_type_code2(_, _, X) when is_record(X, enum) -> X#enum.tk; +get_type_code2(_, _, X) when is_record(X, attr) -> X#attr.tk; +get_type_code2(_, _, X) when is_record(X, except) -> X#except.tk; +get_type_code2(_, _, X) when is_record(X, op) -> X#op.tk; +get_type_code2(_, _, X) when is_record(X, id_of) -> X#id_of.tk; +get_type_code2(_, _, X) when is_record(X, param) -> X#param.tk; + +get_type_code2(G, N, X) when is_record(X, member) -> + ET = get_type_code(G, N, element(2,X)), + Id = element(3,X), + + if is_list(Id) -> + Head = hd(Id), + if is_tuple(Head) -> + case element(1,Head) of + array -> + get_array_tc(ET, element(3,Head)); + _ -> + ET + end; + true -> + ET + end; + true -> + ET + end; + +get_type_code2(G, N, X) when is_record(X, scoped_id) -> + element(3,ic_symtab:get_full_scoped_name(G, N, X)); + +get_type_code2(G, N, X) when is_record(X, sequence) -> + if is_tuple(X#sequence.length) -> + {tk_sequence, + get_type_code(G, N, X#sequence.type), + list_to_integer(element(3,X#sequence.length))}; + true -> + {tk_sequence, + get_type_code(G, N, X#sequence.type), + X#sequence.length} + end; + +get_type_code2(_G, _N, {unsigned,{short,_}}) -> tk_ushort; + +get_type_code2(_G, _N, {unsigned,{long,_}}) -> tk_ulong; + +get_type_code2(_G, _N, {unsigned,{'long long',_}}) -> tk_ulonglong; + +get_type_code2(_G, _N, X) when is_record(X, fixed) -> + {tk_fixed, X#fixed.digits, X#fixed.scale}; + +get_type_code2(G, N, {X,_}) -> + get_type_code2(G, N, X); + +get_type_code2(_, _, short) -> tk_short; +get_type_code2(_, _, long) -> tk_long; +get_type_code2(_, _, 'long long') -> tk_longlong; +get_type_code2(_, _, float) -> tk_float; +get_type_code2(_, _, double) -> tk_double; +get_type_code2(_, _, boolean) -> tk_boolean; +get_type_code2(_, _, char) -> tk_char; +get_type_code2(_, _, wchar) -> tk_wchar; +get_type_code2(_, _, octet) -> tk_octet; +get_type_code2(_, _, string) -> tk_string; +get_type_code2(_, _, wstring) -> tk_wstring; +get_type_code2(_, _, any) -> tk_any. + + +get_array_tc(ET, []) -> + ET; +get_array_tc(ET, [L|Ls]) -> + {tk_array, + get_array_tc(ET,Ls), + list_to_integer(element(3,L))}. + + + + +%%------------------------------------------------------------ +%% +%% seek type code when not accessible by ic_forms:get_tk/1 ( should be +%% a part of "do_gen" related functions later ) +%% +%%------------------------------------------------------------ +search_tk(G, IR_ID) -> + S = ic_genobj:tktab(G), + case catch search_tk(S,IR_ID,typedef) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch search_tk(S,IR_ID,struct) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch search_tk(S,IR_ID,union) of + {value,TK} -> + TK; + _ -> + undefined + end + end + end. + + +search_tk(S, IR_ID, Type) -> + L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), + case lists:keysearch(IR_ID,2,L) of + {value,TK} -> + {value,TK}; + false -> + search_inside_tks(L,IR_ID) + end. + + +search_inside_tks([],_IR_ID) -> + false; +search_inside_tks([{tk_array,TK,_}|Xs],IR_ID) -> + case search_included_tk(TK,IR_ID) of + {value,TK} -> + {value,TK}; + false -> + search_inside_tks(Xs,IR_ID) + end. + + +search_included_tk({tk_array,TK,_}, IR_ID) -> + search_included_tk(TK,IR_ID); +search_included_tk({tk_sequence,TK,_}, IR_ID) -> + search_included_tk(TK,IR_ID); +search_included_tk(TK, _IR_ID) when is_atom(TK) -> + false; +search_included_tk(TK, IR_ID) -> + case element(2,TK) == IR_ID of + true -> + {value,TK}; + false -> + false + end. + + + + +%% This is similar to get_id2 but in everything else +%% than a module it will generate an id prefixed +get_java_id(Id) when is_list(Id) -> + case java_keyword_coalition(Id) of + true -> + "_" ++ Id; + false -> + Id + end; +get_java_id(Id_atom) when is_atom(Id_atom) -> + Id = atom_to_list(Id_atom), + case java_keyword_coalition(Id) of + true -> + "_" ++ Id; + false -> + Id + end; +get_java_id(X) -> + Id = get_id2(X), + case java_keyword_coalition(Id) of + true -> + "_" ++ Id; + false -> + Id + end. + +java_keyword_coalition(Id) -> + lists:member(list_to_atom(Id), + [abstract, default, 'if', private, throw, boolean, + do, implements, protected, throws, break, + double, import, public, transient, byte, + else, instanceof, return, 'try', 'case', extends, + int, short, void, 'catch', final, interface, static, + volatile, char, finally, long, super, while, class, + float, native, switch, const, for, new, synchronized, + continue, goto, package, this, true, false]). + + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_genobj.erl b/lib/ic/src/ic_genobj.erl new file mode 100644 index 0000000000..afb00eeb19 --- /dev/null +++ b/lib/ic/src/ic_genobj.erl @@ -0,0 +1,244 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_genobj). + + +-include_lib("ic/src/ic.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([new/1, free_table_space/1, process_space/0]). +-export([skelfiled/1, stubfiled/1, hrlfiled/1, includefiled/1]). +-export([interfacefiled/1, helperfiled/1, holderfiled/1]). +-export([is_skelfile_open/1, is_stubfile_open/1, is_hrlfile_open/1]). +-export([include_file/1, include_file_stack/1]). +-export([push_file/2, pop_file/2, sys_file/2]). + +-export([skelscope/1, stubscope/1, impl/1, do_gen/1]). +-export([symtab/1, auxtab/1, tktab/1, pragmatab/1, optiontab/1, typedeftab/1]). +-export([idlfile/1, module/1, set_idlfile/2, set_module/2]). + + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% +%% Initialisation stuff +%% +%% +%% +%%-------------------------------------------------------------------- + + +new(Opts) -> + OptDB = ets:new(options, [set, public]), + Warns = ets:new(warnings, [set, public]), + Aux = ets:new(aux, [set, public]), + Tk = ets:new(tktab, [set, public]), + PragmaTab = ets:new(pragmatab, [bag, public]), + TypeDefTab = ets:new(c_typedeftab, [set, public]), + G = #genobj{options=OptDB, + warnings=Warns, + symtab=ic_symtab:new(), + auxtab=Aux, + tktab=Tk, + pragmatab=PragmaTab, + c_typedeftab=TypeDefTab}, + ic_error:init_errors(G), + ic_options:add_opt(G, default_opts, true), + ic_options:read_cfg(G, Opts), % Read any config files + ic_options:add_opt(G, Opts, true), + ic_symtab:symtab_add_faked_included_types(G), % Add CORBA::<Types> that as if they + % were defined in an included file + case ic_options:get_opt(G, be) of + false -> + DefBE = ic_options:defaultBe(), + case ic_options:get_opt(G, multiple_be) of + false -> + ic_options:add_opt(G, be, DefBE), + G; + List -> + case lists:member(DefBE, List) of + true -> + %% Delete the default be from the list to avoid + %% generating it twice. + NewList = lists:delete(DefBE, List), + ic_options:add_opt(G, multiple_be, NewList), + ic_options:add_opt(G, be, DefBE), + G; + false -> + G + end + end; + _ -> + G + end. + + +%%-------------------------------------------------------------------- +%% +%% Table removal +%% +%% +%% +%%-------------------------------------------------------------------- + + +free_table_space(G) -> + %% Free ets tables + ets:delete(G#genobj.options), + ets:delete(G#genobj.symtab), + ets:delete(G#genobj.warnings), + ets:delete(G#genobj.auxtab), + ets:delete(G#genobj.tktab), + ets:delete(G#genobj.pragmatab), + ets:delete(G#genobj.c_typedeftab), + %% Close file descriptors + close_fd(G#genobj.skelfiled), + close_fd(G#genobj.stubfiled), + close_fd(G#genobj.interfacefiled), + close_fd(G#genobj.helperfiled), + close_fd(G#genobj.holderfiled), + close_fd(G#genobj.includefiled). + +close_fd([]) -> + ok; +close_fd([Fd|Fds]) -> + file_close(Fd), + close_fd(Fds). + +file_close(empty) -> ok; +file_close(ignore) -> ok; +file_close(Fd) -> + file:close(Fd). + + +%%-------------------------------------------------------------------- +%% +%% Process memory usage +%% +%% +%% +%%-------------------------------------------------------------------- + +process_space() -> + Pheap=4*element(2,element(2,lists:keysearch(heap_size,1,process_info(self())))), + Pstack=4*element(2,element(2,lists:keysearch(stack_size,1,process_info(self())))), + io:format("Process current heap = ~p bytes\n",[Pheap]), + io:format("Symbol current stack = ~p bytes\n",[Pstack]), + io:format("-----------------------------------------------\n"), + io:format("Totally used ~p bytes\n\n",[Pheap+Pstack]). + + + + + + +skelfiled(G) -> hd(G#genobj.skelfiled). +stubfiled(G) -> hd(G#genobj.stubfiled). +includefiled(G) -> hd(G#genobj.includefiled). +hrlfiled(G) -> hd(G#genobj.includefiled). +interfacefiled(G) -> hd(G#genobj.interfacefiled). +helperfiled(G) -> hd(G#genobj.helperfiled). +holderfiled(G) -> hd(G#genobj.holderfiled). + +include_file(G) -> hd(G#genobj.includefile). +include_file_stack(G) -> G#genobj.includefile. + +is_skelfile_open(G) -> + if hd(G#genobj.skelfiled) /= empty, hd(G#genobj.skelfiled) /= ignore + -> true; + true -> false + end. +is_stubfile_open(G) -> + if hd(G#genobj.stubfiled) /= empty, hd(G#genobj.stubfiled) /= ignore + -> true; + true -> false + end. + +is_hrlfile_open(G) -> + if hd(G#genobj.includefiled) /= empty, hd(G#genobj.includefiled) /= ignore + -> true; + true -> false + end. + +%%-------------------------------------------------------------------- +%% +%% Handling of pre processor file commands +%% +%%-------------------------------------------------------------------- + +push_file(G, Id) -> + New = G#genobj.filestack+1, + set_idlfile(G, Id), + G#genobj{filestack=New, do_gen=true_or_not(New)}. +pop_file(G, Id) -> + New = G#genobj.filestack-1, + set_idlfile(G, Id), + G#genobj{filestack=New, do_gen=true_or_not(New)}. +sys_file(G, _Id) -> G#genobj{sysfile=true}. + + +do_gen(G) -> G#genobj.do_gen. + +%%-------------------------------------------------------------------- +%% +%% Storage routines +%%i +%% The generator object G is used to store many usefull bits of +%% information so that the information doesn't need to get passed +%% around everywhere. +%% +%%-------------------------------------------------------------------- + + +skelscope(G) -> G#genobj.skelscope. +stubscope(G) -> G#genobj.stubscope. +symtab(G) -> G#genobj.symtab. +auxtab(G) -> G#genobj.auxtab. +tktab(G) -> G#genobj.tktab. +impl(G) -> G#genobj.impl. +pragmatab(G) -> G#genobj.pragmatab. +optiontab(G) -> G#genobj.options. +typedeftab(G) -> G#genobj.c_typedeftab. + +idlfile(G) -> ?lookup(G#genobj.options, idlfile). +module(G) -> ?lookup(G#genobj.options, module). + +set_idlfile(G, X) -> ?insert(G#genobj.options, idlfile, X). +set_module(G, X) -> ?insert(G#genobj.options, module, ic_forms:get_id(X)). + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +true_or_not(X) when X < 2 -> + true; +true_or_not(_) -> + false. diff --git a/lib/ic/src/ic_java_type.erl b/lib/ic/src/ic_java_type.erl new file mode 100644 index 0000000000..b8979b6dbe --- /dev/null +++ b/lib/ic/src/ic_java_type.erl @@ -0,0 +1,1213 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_java_type). + + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([getType/3, getHolderType/3, + getParamType/4, inlinedTypes/2, + marshalFun/4, unMarshalFun/4, getFullType/4, + getFullType/3, getMarshalType/4, getUnmarshalType/4, + getdim/1]). +-export([isBasicType/3, isBasicType/1]). +-export([isIntegerType/3, isIntegerType/1]). +-export([isTermType/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Func: getType/3 +%%----------------------------------------------------------------- +getType(G, N, T) when is_record(T, scoped_id) -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + case BT of + "erlang.pid" -> + ?ICPACKAGE ++ "Pid"; + "erlang.port" -> + ?ICPACKAGE ++ "Port"; + "erlang.ref" -> + ?ICPACKAGE ++ "Ref"; + "erlang.term" -> + ?ICPACKAGE ++ "Term"; + {enum, Type} -> + getType(G, N, Type); + Type -> + case TK of + {tk_array,_,_} -> + tk2type(G,N,T,TK); + {tk_sequence,_,_} -> + tk2type(G,N,T,TK); + tk_any -> + ?ICPACKAGE ++ "Any"; + _ -> + case isBasicType(G,N,TK) of + true -> + tk2type(G,N,T,TK); + false -> + Type %% Other types + end + end + end; + +getType(_G, _N, S) when is_list(S) -> + S; + +getType(_G, _N, T) when is_record(T, string) -> + "java.lang.String"; + +getType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING + "java.lang.String"; + +getType(G, N, T) when is_record(T, struct) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); + +getType(G, N, T) when is_record(T, union) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); + +getType(G, N, T) when is_record(T, sequence) -> + getType(G, N, ic_forms:get_type(T)) ++ "[]"; + +getType(G, N, T) when is_record(T, enum) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); + +%% NOTE i am using the new isJavaElementaryType +%% to avoid members declared as keywords (except +%% all java elementary types) to be used as a +%% class +getType(G, N, T) when is_record(T, member) -> + Type = tk2type(G,N,T,ic_forms:get_type_code(G, N, T)), + case isJavaElementaryType(list_to_atom(Type)) of + true -> + Type; + false -> + Prefix = list_to_atom(lists:flatten(string:tokens(Type,"[]"))), + case isJavaElementaryType(Prefix) of %% Checks if Type is an array + %% of elementary java types + true -> + Type; + false -> + ic_forms:get_java_id(getType(G,N,ic_forms:get_type(T))) ++ + if is_record(hd(T#member.id),array) -> + arrayEmptyDim(hd(T#member.id)); + true -> + "" + end + end + end; + +getType(_G, _N, {boolean, _}) -> + "boolean"; + +getType(_G, _N, {octet, _}) -> + "byte"; + +getType(_G, _N, {void, _}) -> + "void"; + +getType(_G, _N, {unsigned, U}) -> + case U of + {short,_} -> + "short"; + {long,_} -> + "int"; + {'long long',_} -> + "long" + end; + +getType(_G, _N, {char, _}) -> + "char"; + +getType(_G, _N, {wchar, _}) -> %% WCHAR + "char"; + +getType(_G, _N, {short, _}) -> + "short"; + +getType(_G, _N, {long, _}) -> + "int"; + +getType(_G, _N, {'long long', _}) -> + "long"; + +getType(_G, _N, {float, _}) -> + "float"; + +getType(_G, _N, {double, _}) -> + "double"; + +getType(_G, _N, {any, _}) -> + ?ICPACKAGE ++ "Any". + + + + + + +%%----------------------------------------------------------------- +%% Func: getHolderType/3 +%%----------------------------------------------------------------- +getHolderType(G, N, T) when element(1, T) == scoped_id -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + case BT of + "erlang.pid" -> + ?ICPACKAGE ++ "PidHolder"; + "erlang.port" -> + ?ICPACKAGE ++ "PortHolder"; + "erlang.ref" -> + ?ICPACKAGE ++ "RefHolder"; + "erlang.term" -> + ?ICPACKAGE ++ "TermHolder"; + {enum, Type} -> + getHolderType(G, N, Type); + + Type -> + case TK of + {'tk_struct', _, _, _} -> + Type ++ "Holder"; + + {'tk_union', _, _, _, _, _} -> + Type ++ "Holder"; + + {'tk_array', _ , _} -> + Type ++ "Holder"; + + {'tk_sequence', _ , _} -> + Type ++ "Holder"; + + {'tk_string', _} -> + ?ICPACKAGE ++ "StringHolder"; + + {'tk_wstring', _} -> %% WSTRING + ?ICPACKAGE ++ "StringHolder"; + + {'tk_enum', _, _, _} -> + Type ++ "Holder"; + + 'tk_boolean' -> + ?ICPACKAGE ++ "BooleanHolder"; + + 'tk_octet' -> + ?ICPACKAGE ++ "ByteHolder"; + + 'tk_ushort' -> + ?ICPACKAGE ++ "ShortHolder"; + + 'tk_ulong' -> + ?ICPACKAGE ++ "IntHolder"; + + 'tk_ulonglong' -> %% ULLONG + ?ICPACKAGE ++ "LongHolder"; + + 'tk_short' -> + ?ICPACKAGE ++ "ShortHolder"; + + 'tk_long' -> + ?ICPACKAGE ++ "IntHolder"; + + 'tk_longlong' -> + ?ICPACKAGE ++ "LongHolder"; %% LLONG + + 'tk_float' -> + ?ICPACKAGE ++ "FloatHolder"; + + 'tk_double' -> + ?ICPACKAGE ++ "DoubleHolder"; + + 'tk_char' -> + ?ICPACKAGE ++ "CharHolder"; + + 'tk_wchar' -> %% WCHAR + ?ICPACKAGE ++ "CharHolder"; + + 'tk_any' -> + ?ICPACKAGE ++ "AnyHolder"; + + _ -> + case isBasicType(G,N,TK) of + true -> + %% Faked the type ! + getHolderType(G, N, {list_to_atom(tk2type(G,N,T,TK)), -1}); + false -> + %%io:format("TK = ~p, Type = ~p\n",[TK,Type]), + ic_util:to_dot(G,FullScopedName) ++ "Holder" + end + end + end; + +getHolderType(G, N, S) when is_list(S) -> + ic_util:to_dot(G,[S|N]) ++ "Holder"; + +getHolderType(_G, _N, T) when is_record(T, string) -> + ?ICPACKAGE ++"StringHolder"; + +getHolderType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING + ?ICPACKAGE ++"StringHolder"; + +getHolderType(G, N, T) when is_record(T, struct) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; + +getHolderType(G, N, T) when is_record(T, union) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; + +getHolderType(G, N, T) when is_record(T, array) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; + +getHolderType(G, N, T) when is_record(T, sequence) -> + getType(G, N, ic_forms:get_type(T)) ++ "Holder[]"; + +getHolderType(G, N, T) when is_record(T, enum) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; + +getHolderType(_G, _N, {boolean, _}) -> + ?ICPACKAGE ++"BooleanHolder"; + +getHolderType(_G, _N, {octet, _}) -> + ?ICPACKAGE ++"ByteHolder"; + +getHolderType(_G, _N, {void, _}) -> + "void"; + +getHolderType(_G, _N, {unsigned, U}) -> + case U of + {short,_} -> + ?ICPACKAGE ++"ShortHolder"; + {long,_} -> + ?ICPACKAGE ++"IntHolder"; + {'long long',_} -> + ?ICPACKAGE ++"LongHolder" + end; + +getHolderType(_G, _N, {char, _}) -> + ?ICPACKAGE ++"CharHolder"; + +getHolderType(_G, _N, {wchar, _}) -> %% WCHAR + ?ICPACKAGE ++"CharHolder"; + +getHolderType(_G, _N, {short, _}) -> + ?ICPACKAGE ++"ShortHolder"; + +getHolderType(_G, _N, {long, _}) -> + ?ICPACKAGE ++"IntHolder"; + +getHolderType(_G, _N, {'long long', _}) -> + ?ICPACKAGE ++"LongHolder"; + +getHolderType(_G, _N, {float, _}) -> + ?ICPACKAGE ++"FloatHolder"; + +getHolderType(_G, _N, {double, _}) -> + ?ICPACKAGE ++"DoubleHolder"; + +getHolderType(_G, _N, {any,_}) -> + ?ICPACKAGE ++ "AnyHolder". + + +%%----------------------------------------------------------------- +%% Func: getParamType/4 +%%----------------------------------------------------------------- +getParamType(G, N, S, in) -> + getType(G, N, S); +getParamType(G, N, S, ret) -> + getType(G, N, S); +getParamType(G, N, S, out) -> + getHolderType(G, N, S); +getParamType(G, N, S, inout) -> + getHolderType(G, N, S). + + +%%----------------------------------------------------------------- +%% Func: getUnmarshalType/4 +%%----------------------------------------------------------------- +getUnmarshalType(G, N, X, T) when element(1, T) == scoped_id -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + case BT of + "erlang.pid" -> + ?ICPACKAGE ++ "PidHelper"; + "erlang.port" -> + ?ICPACKAGE ++ "PortHelper"; + "erlang.ref" -> + ?ICPACKAGE ++ "RefHelper"; + "erlang.term" -> + ?ICPACKAGE ++ "TermHelper"; + {enum, Type} -> + getUnmarshalType(G, N, X, Type); + Type -> + case TK of + {'tk_struct', _, _, _} -> + Type ++ "Helper"; + + {'tk_union', _, _, _, _, _} -> + Type ++ "Helper"; + + {'tk_sequence', _ , _} -> + Type ++ "Helper"; + + {'tk_array', _ , _} -> + Type ++ "Helper"; + + {'tk_enum', _, _, _} -> + Type ++ "Helper"; + + {'tk_string',_} -> + ?ERLANGPACKAGE ++ "OtpErlangString"; + + {'tk_wstring',_} -> %% WSTRING + ?ERLANGPACKAGE ++ "OtpErlangString"; + + 'tk_char' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_wchar' -> %% WCHAR + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_octet' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_ushort' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_ulong' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_ulonglong' -> %% ULLONG + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_short' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_long' -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_longlong' -> %% LLONG + ?ERLANGPACKAGE ++ "OtpErlangLong"; + + 'tk_float' -> + ?ERLANGPACKAGE ++ "OtpErlangDouble"; + + 'tk_double' -> + ?ERLANGPACKAGE ++ "OtpErlangDouble"; + + 'tk_boolean' -> + ?ERLANGPACKAGE ++ "OtpErlangAtom"; + + 'tk_void' -> + ?ERLANGPACKAGE ++ "OtpErlangAtom"; + + 'tk_any' -> + ?ICPACKAGE ++ "AnyHelper"; + + _ -> + case isBasicType(G,N,TK) of + true -> + %% Faked the type ! + getUnmarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); + false -> + ic_util:to_dot(G,FullScopedName) ++ "Helper" + end + end + end; + +getUnmarshalType(_G, _N, _X, S) when is_list(S) -> + S ++ "Helper"; + +getUnmarshalType(_G, _N, _X, T) when is_record(T, string) -> + ?ERLANGPACKAGE ++ "OtpErlangString"; + +getUnmarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING + ?ERLANGPACKAGE ++ "OtpErlangString"; + +getUnmarshalType(G, N, _X, T) when is_record(T, struct) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; + +getUnmarshalType(G, N, _X, T) when is_record(T, union) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; + +getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso + is_record(X, member) -> + ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; + +getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso + is_record(X, case_dcl) -> + ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; + +getUnmarshalType(G, N, X, T) when is_record(T, sequence) -> + getUnmarshalType(G, N, X, ic_forms:get_type(T)) ++ "Helper"; + +getUnmarshalType(G, N, X, T) when is_record(T, array) andalso + is_record(X, case_dcl) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; + +getUnmarshalType(G, N, _X, T) when is_record(T, enum) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ + "Helper"; + +getUnmarshalType(_G, _N, _X, {boolean, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangAtom"; + +getUnmarshalType(_G, _N, _X, {octet, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {void, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangAtom"; + +getUnmarshalType(_G, _N, _X, {unsigned, U}) -> + case U of + {short,_} -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + {long,_} -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + {'long long',_} -> + ?ERLANGPACKAGE ++ "OtpErlangLong" + end; + +getUnmarshalType(_G, _N, _X, {char, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {short, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {long, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {'long long', _}) -> + ?ERLANGPACKAGE ++ "OtpErlangLong"; + +getUnmarshalType(_G, _N, _X, {float, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangDouble"; + +getUnmarshalType(_G, _N, _X, {double, _}) -> + ?ERLANGPACKAGE ++ "OtpErlangDouble"; + +getUnmarshalType(_G, _N, _X, {any, _}) -> + ?ICPACKAGE ++ "AnyHelper". + +%%----------------------------------------------------------------- +%% Func: getMarshalType/4 +%%----------------------------------------------------------------- +getMarshalType(G, N, X, T) when element(1, T) == scoped_id -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + case BT of + "erlang.pid" -> + ?ICPACKAGE ++ "PidHelper"; + "erlang.port" -> + ?ICPACKAGE ++ "PortHelper"; + "erlang.ref" -> + ?ICPACKAGE ++ "RefHelper"; + "erlang.term" -> + ?ICPACKAGE ++ "TermHelper"; + {enum, Type} -> + getMarshalType(G, N, X, Type); + Type -> + case TK of + {'tk_struct', _, _, _} -> + Type ++ "Helper"; + + {'tk_union', _, _, _, _, _} -> + Type ++ "Helper"; + + {'tk_array', _ , _} -> + Type ++ "Helper"; + + {'tk_sequence', _ , _} -> + Type ++ "Helper"; + + {'tk_enum', _, _, _} -> + Type ++ "Helper"; + + {'tk_string',_} -> + "string"; + + {'tk_wstring',_} -> %% WSTRING + "string"; + + 'tk_char' -> + "char"; + + 'tk_wchar' -> %% WCHAR + "char"; + + 'tk_octet' -> + "byte"; + + 'tk_ushort' -> + "ushort"; + + 'tk_ulong' -> + "uint"; + + 'tk_ulonglong' -> %% ULLONG + "ulong"; + + 'tk_short' -> + "short"; + + 'tk_long' -> + "int"; + + 'tk_longlong' -> %% LLONG + "long"; + + 'tk_float' -> + "float"; + + 'tk_double' -> + "double"; + + 'tk_boolean' -> + "boolean"; + + 'tk_void' -> + "atom"; + + 'tk_any' -> + ?ICPACKAGE ++ "AnyHelper"; + + _ -> + case isBasicType(G,N,TK) of + true -> + %% Faked the type ! + getMarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); + false -> + ic_util:to_dot(G,FullScopedName) ++ "Helper" + end + end + end; + +getMarshalType(_G, _N, _X, S) when is_list(S) -> + S ++ "Helper"; + +getMarshalType(_G, _N, _X, T) when is_record(T, string) -> + "string"; + +getMarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING + "string"; + +getMarshalType(G, N, _X, T) when is_record(T, struct) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ + "Helper"; + +getMarshalType(G, N, _X, T) when is_record(T, union) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ + "Helper"; + +getMarshalType(G, N, X, T) when is_record(T, array) andalso + is_record(X, case_dcl) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ + "Helper"; + +getMarshalType(G, N, X, T) when is_record(T, sequence) andalso + is_record(X, member) -> + ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ + "Helper"; + +getMarshalType(G, N, _X, T) when is_record(T, sequence) -> + getType(G, N, ic_forms:get_type(T)) ++ + "Helper"; + +getMarshalType(G, N, _X, T) when is_record(T, enum) -> + ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ + "Helper"; + +getMarshalType(_G, _N, _X, {boolean, _}) -> + "boolean"; + +getMarshalType(_G, _N, _X, {octet, _}) -> + "byte"; + +getMarshalType(_G, _N, _X, {void, _}) -> + ""; % <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +getMarshalType(_G, _N, _X, {unsigned, U}) -> + case U of + {short,_} -> + "ushort"; + {long,_} -> + "uint"; + {'long long',_} -> + "ulong" + end; + +getMarshalType(_G, _N, _X, {short, _}) -> + "short"; +getMarshalType(_G, _N, _X, {long, _}) -> + "int"; +getMarshalType(_G, _N, _X, {'long long', _}) -> + "long"; +getMarshalType(_G, _N, _X, {float, _}) -> + "float"; +getMarshalType(_G, _N, _X, {double, _}) -> + "double"; +getMarshalType(_G, _N, _X, {char, _}) -> + "char"; +getMarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR + "char"; +getMarshalType(_G, _N, _X, {any, _}) -> + ?ICPACKAGE ++ "AnyHelper". + + + + +%%----------------------------------------------------------------- +%% Func: unMarshalFun/4 +%%----------------------------------------------------------------- +unMarshalFun(G, N, X, T) when element(1, T) == scoped_id -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + case BT of + "erlang.pid" -> + ".read_pid()"; + "erlang.port" -> + ".read_port()"; + "erlang.ref" -> + ".read_ref()"; + "erlang.term" -> + ".read_term()"; + {enum, Type} -> + unMarshalFun(G, N, X, Type); + _Type -> + case isBasicType(G,N,TK) of + true -> + case TK of + {'tk_string',_} -> + ".read_string()"; + + {'tk_wstring',_} -> %% WSTRING + ".read_string()"; + + 'tk_boolean' -> + ".read_boolean()"; + + 'tk_octet' -> + ".read_byte()"; + + 'tk_ushort' -> + ".read_ushort()"; + + 'tk_ulong' -> + ".read_uint()"; + + 'tk_ulonglong' -> %% ULLONG + ".read_ulong()"; + + 'tk_short' -> + ".read_short()"; + + 'tk_long' -> + ".read_int()"; + + 'tk_longlong' -> %% LLONG + ".read_long()"; + + 'tk_float' -> + ".read_float()"; + + 'tk_double' -> + ".read_double()"; + + 'tk_char' -> + ".read_char()"; + + 'tk_wchar' -> %% WCHAR + ".read_char()"; + + _ -> + %% Faked the type ! + unMarshalFun(G, N, X, {list_to_atom(tk2type(G,N,X,TK)), -1}) + end; + false -> + ".unmarshal()" + end + end; + +unMarshalFun(_G, _N, _X, S) when is_list(S) -> + ".unmarshal()"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, string) -> + ".read_string()"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING + ".read_string()"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, struct) -> + ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, union) -> + ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, sequence) -> + ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlanglist)"; + +unMarshalFun(_G, _N, _X, T) when is_record(T, enum) -> + ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangAtom)"; + +unMarshalFun(_G, _N, _X, {boolean, _}) -> + ".read_boolean()"; + +unMarshalFun(_G, _N, _X, {octet, _}) -> + ".read_byte()"; + +unMarshalFun(_G, _N, _X, {void, _}) -> + ""; + +unMarshalFun(_G, _N, _X, {unsigned, U}) -> + case U of + {short,_} -> + ".read_ushort()"; + {long,_} -> + ".read_uint()"; + {'long long',_} -> + ".read_ulong()" + end; + +unMarshalFun(_G, _N, _X, {short, _}) -> + ".read_short()"; +unMarshalFun(_G, _N, _X, {long, _}) -> + ".read_int()"; +unMarshalFun(_G, _N, _X, {'long long', _}) -> + ".read_long()"; +unMarshalFun(_G, _N, _X, {float, _}) -> + ".read_float()"; +unMarshalFun(_G, _N, _X, {double, _}) -> + ".read_double()"; +unMarshalFun(_G, _N, _X, {char, _}) -> + ".read_char()"; +unMarshalFun(_G, _N, _X, {wchar, _}) -> %% WCHAR + ".read_char()". + + + + + +%%----------------------------------------------------------------- +%% Func: getFullType/4 - /3 +%% +%% Note : Similar to the getType/3 with the major difference +%% thet on arrays and sequences it will also declare +%% their sizes. Used for "new" declarations +%% +%%----------------------------------------------------------------- + + +getFullType(G, N, X, T) when is_record(X, typedef) andalso is_record(T, array) -> + FullDim = + tk2FullType(G,N,X,ic_forms:get_tk(X)) ++ + getFullDim(G,N,T#array.size), + fixArrayDims(FullDim); + +getFullType(G, N, X, T) when is_record(X, member) andalso is_record(T, array) -> + FullDim = + getFullType(G, N, ic_forms:get_type(X)) ++ + getFullDim(G,N,T#array.size), + fixArrayDims(FullDim); + +getFullType(G, N, X, T) when is_record(X, case_dcl) andalso is_record(T, array) -> + FullDim = + getFullType(G, N, ic_forms:get_type(X)) ++ + getFullDim(G,N,T#array.size), + fixArrayDims(FullDim); + +getFullType(G, N, _X, T) -> + getFullType(G, N, T). + + + +getFullType(G, N, T) when is_record(T, scoped_id) -> + {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), + case TK of + {tk_array,_,_} -> + tk2FullType(G,N,T,TK); + {tk_sequence,_,_} -> + tk2FullType(G,N,T,TK); + _ -> + case isBasicType(G,N,TK) of + true -> + tk2FullType(G,N,T,TK); + false -> + %% Other types + ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)) + end + end; + +getFullType(G, N, T) when is_record(T, sequence) -> + fixSeqDims(getType(G,N,T),"_length"); + +getFullType(G, N, T) -> + getType(G, N, T). + + + +%% In order to make a legal declaration +%% of an assignable array, the dimensions +%% of empty array sequences are swifted to +%% the end of the type +fixArrayDims(Cs) -> + fixArrayDims(Cs,[],[]). + +fixArrayDims([],Fulls,Emptys) -> + lists:reverse(Fulls) ++ Emptys; +fixArrayDims([91,93|Rest],Fulls,Emptys) -> + fixArrayDims(Rest,Fulls,[91,93|Emptys]); +fixArrayDims([C|Rest],Fulls,Emptys) -> + fixArrayDims(Rest,[C|Fulls],Emptys). + + +%% In order to make a legal declaration +%% of an assignable array, the dimensions +%% of empty array of sequences are swifted +%% to the end of the type +fixSeqDims(Cs,Length) -> + fixSeqDims(Cs,Length,[]). + +fixSeqDims([],_Length,Found) -> + lists:reverse(Found); +fixSeqDims([91,93|Rest],Length,Found) when is_list(Length) -> + lists:reverse([93|lists:reverse(Length)] ++ + [91|Found]) ++ Rest; +fixSeqDims([C|Rest],Length,Found) -> + fixSeqDims(Rest,Length,[C|Found]). + + + +%%----------------------------------------------------------------- +%% Func: inlinedTypes/2 +%%----------------------------------------------------------------- +inlinedTypes(PkgName, Type) when is_record(Type, struct) -> + "_" ++ PkgName ++ "."; +inlinedTypes(PkgName, Type) when is_record(Type, union) -> + "_" ++ PkgName ++ "."; +inlinedTypes(PkgName, Type) when is_record(Type, enum) -> + "_" ++ PkgName ++ "."; +inlinedTypes(_, _) -> + "". + +%%----------------------------------------------------------------- +%% Func: marshalFun/4 +%%----------------------------------------------------------------- +marshalFun(G, N, X, Type) -> + case isBasicType(G, N, Type) of + true -> + ".write_" ++ getMarshalType(G, N, X, Type); + _ -> + getMarshalType(G, N, X, Type) ++ ".marshal" + end. + + +%%----------------------------------------------------------------- +%% Func: isBasicType/3 +%%----------------------------------------------------------------- +isBasicType(G, N, S) when element(1, S) == scoped_id -> + {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + isBasicType(ictype:fetchType(TK)); + +isBasicType(G, N, X) when is_record(X, member) -> + if is_record(hd(element(3,X)), array) -> + false; + true -> + isBasicType(G, N, element(2,X)) + end; + +isBasicType(_G, _N, {unsigned, {long, _}} ) -> + true; + +isBasicType(_G, _N, {unsigned, {short, _}} ) -> + true; + +isBasicType(_G, _N, {unsigned, {'long long', _}} ) -> + true; + +isBasicType(_G, _N, {'long long', _} ) -> + true; + +isBasicType(_G, _N, {Type, _} ) -> + isBasicType(Type); + +isBasicType(_G, _N, Type) -> + isBasicType(Type). + + +%%----------------------------------------------------------------- +%% Func: isBasicType/1 +%%----------------------------------------------------------------- + +isBasicType( Type ) -> + lists:member(Type, + [tk_short,short, + tk_long,long, + tk_longlong,longlong, %% LLONG + tk_ushort,ushort, + tk_ulong,ulong, + tk_ulonglong,ulonglong, %% ULLONG + tk_float,float, + tk_double,double, + tk_boolean,boolean, + tk_char,char, + tk_wchar,wchar, %% WCHAR + tk_octet,octet, + tk_wstring,wstring, %% WSTRING + tk_string,string]). + +%% returns true if the Type is a java elementary type +isJavaElementaryType( Type ) -> + lists:member(Type, + [byte, char, wchar, boolean, + int, short, long, 'long long', float, double]). + +%%----------------------------------------------------------------- +%% Func: isIntegerType/3 +%%----------------------------------------------------------------- +isIntegerType(G, N, S) when element(1, S) == scoped_id -> + {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + isIntegerType(ictype:fetchType(TK)); +isIntegerType(_G, _N, {unsigned, {long, _}} ) -> + true; +isIntegerType(_G, _N, {unsigned, {short, _}} ) -> + true; +isIntegerType(_G, _N, {unsigned, {'long long', _}} ) -> + true; +isIntegerType(_G, _N, {'long long', _} ) -> + true; +isIntegerType(_G, _N, {Type, _} ) -> + isIntegerType(Type); +isIntegerType(_G, _N, Type) -> + isIntegerType(Type). + +%%----------------------------------------------------------------- +%% Func: isIntegerType/1 +%%----------------------------------------------------------------- + +isIntegerType( Type ) -> + lists:member(Type, + [tk_short,short, + tk_long,long, + tk_longlong,longlong, %% LLONG + tk_ushort,ushort, + tk_ulong,ulong, + tk_ulonglong,ulonglong, %% ULLONG + tk_char,char, + tk_wchar,wchar, %% WCHAR + tk_octet,octet]). + + + +%%----------------------------------------------------------------- +%% Func: isTerm/3 +%%----------------------------------------------------------------- +isTermType(G, N, T) -> + case getType(G,N,T) of + "com.ericsson.otp.ic.Term" -> + true; + _ -> + false + end. + + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + + +%% Changes the typecode to the +%% corresponding "basic" type +tk2type(_G,_N,_X,{'tk_struct', _IFRId, "port", _ElementList}) -> + ?ICPACKAGE ++ "Port"; +tk2type(_G,_N,_X,{'tk_struct', _IFRId, "pid", _ElementList}) -> + ?ICPACKAGE ++ "Pid"; +tk2type(_G,_N,_X,{'tk_struct', _IFRId, "ref", _ElementList}) -> + ?ICPACKAGE ++ "Ref"; +tk2type(_G,_N,_X,{'tk_struct', _IFRId, "term", _ElementList}) -> + ?ICPACKAGE ++ "Term"; +tk2type(_G,_N,_X,{'tk_string', _}) -> + "java.lang.String"; +tk2type(_G,_N,_X,{'tk_wstring', _}) -> %% WSTRING + "java.lang.String"; +tk2type(G,N,X,{'tk_array', ElemTC, Dim}) -> + tkarr2decl(G,N,X,{'tk_array', ElemTC, Dim}); +tk2type(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> + tkseq2decl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); +tk2type(G,N,_X,{'tk_struct', IFRId, Name, _ElementList}) -> + ScopedId= + lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), + + case ic_forms:clean_up_scope([Name|N]) of + ScopedId -> + %% Right path, use N instead + ic_util:to_dot(G,[Name|N]); + _ -> + %% Ugly work arround + ic_util:to_dot(G,ScopedId) + end; +tk2type(G,N,_X,{'tk_union', IFRId, Name, _, _, _ElementList}) -> + ScopedId= + lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), + + case ic_forms:clean_up_scope([Name|N]) of + ScopedId -> + %% Right path, use N instead + ic_util:to_dot(G,[Name|N]); + _ -> + %% Ugly work arround + ic_util:to_dot(G,ScopedId) + end; +tk2type(_G,_N,_X,{'tk_enum', _Id, Name, _ElementList}) -> + Name; +tk2type(_G,_N,_X,tk_void) -> + "void"; +tk2type(_G,_N,_X,tk_long) -> + "int"; +tk2type(_G,_N,_X,tk_longlong) -> %% LLONG + "long"; +tk2type(_G,_N,_X,tk_short) -> + "short"; +tk2type(_G,_N,_X,tk_ulong) -> + "int"; +tk2type(_G,_N,_X,tk_ulonglong) -> %% ULLONG + "long"; +tk2type(_G,_N,_X,tk_ushort) -> + "short"; +tk2type(_G,_N,_X,tk_float) -> + "float"; +tk2type(_G,_N,_X,tk_double) -> + "double"; +tk2type(_G,_N,_X,tk_boolean) -> + "boolean"; +tk2type(_G,_N,_X,tk_char) -> + "char"; +tk2type(_G,_N,_X,tk_wchar) -> %% WCHAR + "char"; +tk2type(_G,_N,_X,tk_octet) -> + "byte"; +tk2type(_G,_N,_X,tk_string) -> + "java.lang.String"; +tk2type(_G,_N,_X,tk_wstring) -> %% WSTRING + "java.lang.String"; +tk2type(_G,_N,_X,tk_any) -> + ?ICPACKAGE ++ "Any"; +tk2type(_G,_N,_X,tk_term) -> %% Term + ?ICPACKAGE ++ "Term". + +%% Changes the sequence typecode to the +%% corresponding "basic" structure +tkseq2decl(G,N,X,TKSeq) -> + tkseq2decl2(G,N,X,TKSeq,[],[]). + +tkseq2decl2(G,N,X,{tk_sequence,E,D},[],Ds) -> + tkseq2decl2(G,N,X,E,[],[D|Ds]); +tkseq2decl2(G,N,X,TkEl,[],Ds) -> + ElName = tk2type(G,N,X,TkEl), + ElName ++ getdim(Ds). + +%% Changes the array typecode to the +%% corresponding "basic" structure +tkarr2decl(G,N,X,TKArr) -> + tkarr2decl2(G,N,X,TKArr,[],[]). + +tkarr2decl2(G,N,X,{tk_array,E,D},[],Ds) -> + tkarr2decl2(G,N,X,E,[],[D|Ds]); +tkarr2decl2(G,N,X,TkEl,[],Ds) -> + ElName = tk2type(G,N,X,TkEl), + ElName ++ getdim(Ds). + +getdim([]) -> + ""; +getdim([_D|Ds]) -> + getdim(Ds) ++ "[]". + + + +%% Changes the typecode to the corresponding "basic" type +%% used for variable declarations where arrays and sequences +%% are declared with there full dimensions +tk2FullType(G,N,X,{'tk_array', ElemTC, Dim}) -> + tkarr2FullDecl(G,N,X,{'tk_array', ElemTC, Dim}); +tk2FullType(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> + tkseq2FullDecl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); +tk2FullType(G,N,X,TK) -> + tk2type(G,N,X,TK). + + +%% Changes the sequence typecode to the +%% corresponding "basic" structure here +%% arrays and sequences are declared with +%% their full dimensions +tkseq2FullDecl(G,N,X,TKSeq) -> + tkseq2FullDecl2(G,N,X,TKSeq,[],[]). + +tkseq2FullDecl2(G,N,X,{tk_sequence,E,D},[],Ds) -> + tkseq2FullDecl2(G,N,X,E,[],[D|Ds]); +tkseq2FullDecl2(G,N,X,TkEl,[],Ds) -> + ElName = tk2FullType(G,N,X,TkEl), + ElName ++ getdim(Ds). + +%% Changes the array typecode to the +%% corresponding "basic" structure +tkarr2FullDecl(G,N,X,TKArr) -> + tkarr2FullDecl2(G,N,X,TKArr,[],[]). + +tkarr2FullDecl2(G,N,X,{tk_array,E,D},[],Ds) -> + tkarr2FullDecl2(G,N,X,E,[],[D|Ds]); +tkarr2FullDecl2(G,N,X,TkEl,[],Ds) -> + ElName = tk2FullType(G,N,X,TkEl), + ElName ++ getFullDim(G,N,Ds). + +getFullDim(_G,_N,[]) -> + ""; +getFullDim(G,N,[D|Ds]) when is_record(D,scoped_id) -> + {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), + "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ getFullDim(G,N,Ds); +getFullDim(G,N,[D|Ds]) when is_integer(D) -> + "[" ++ integer_to_list(D) ++ "]" ++ getFullDim(G,N,Ds); +getFullDim(G,N,[D|Ds]) when is_tuple(D) -> + "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ getFullDim(G,N,Ds). + + + +%% Constructs an array empty dimension string +%% used for array variable declaration +arrayEmptyDim(X) -> + arrayEmptyDim2(X#array.size). + +arrayEmptyDim2([_D]) -> + "[]"; +arrayEmptyDim2([_D |Ds]) -> + "[]" ++ arrayEmptyDim2(Ds). + + + diff --git a/lib/ic/src/ic_jbe.erl b/lib/ic/src/ic_jbe.erl new file mode 100644 index 0000000000..81798d0429 --- /dev/null +++ b/lib/ic/src/ic_jbe.erl @@ -0,0 +1,1487 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + + +-module(ic_jbe). + + +-export([do_gen/3, gen/3, emit_type_function/4]). + + + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +-include_lib("stdlib/include/erl_compile.hrl"). + + + +%%------------------------------------------------------------ +%% +%% Entry point +%% +%%------------------------------------------------------------ + +do_gen(G, _File, Form) -> + gen(G, [], Form). + + +%%------------------------------------------------------------ +%% +%% Generate the client side C stubs. +%% +%% Each module is generated to a separate file. +%% +%% Each function needs to generate a function head and +%% a body. IDL parameters must be converted into C parameters. +%% +%%------------------------------------------------------------ + +gen(G, N, [X|Xs]) when is_record(X, preproc) -> + NewG = handle_preproc(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, module) -> + gen_module(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, interface) -> + gen_interface(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, const) -> + ic_constant_java:gen(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, op) -> + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, attr) -> + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, except) -> + gen_exception(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, enum) -> + ic_enum_java:gen(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, struct) -> + ic_struct_java:gen(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, union) -> + ic_union_java:gen(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, typedef) -> + gen_typedef(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, member) -> + %%?PRINTDEBUG2("gen member: ~p\n",[ic_forms:get_type(X)]), + gen_member(G, N, X), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, case_dcl) -> + %%?PRINTDEBUG2("gen case decl: ~p\n",[ic_forms:get_type(X)]), + gen(G, N, [ic_forms:get_type(X)]), + gen(G, N, Xs); + +gen(G, N, [_|Xs]) -> + gen(G, N, Xs); + +gen(_G, _N, []) -> + ok. + + +%%%-------------------------------------------- +%%% +%%% Just generates the directory to host +%%% the module files +%%% +%%%-------------------------------------------- + +gen_module(G, N, X) -> + case ic_genobj:do_gen(G) of + + true -> %% Generate & register + N1 = [ic_forms:get_id2(X) | N], + %% Create directory + ic_file:createJavaDirectory(G, N1), + gen(G, N1, ic_forms:get_body(X)); + + false -> %% Register only + N1 = [ic_forms:get_id2(X) | N], + reg(G, N1, ic_forms:get_body(X)) + end. + +reg(G, N, [X|_Xs]) when is_record(X, module) -> + reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); + +reg(G, N, [X|_Xs]) when is_record(X, interface) -> + reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); + +reg(G, N, [X|Xs]) when is_record(X, typedef) -> + Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), + case X#typedef.type of + {scoped_id,_,_,_} -> + {FullScopedName, _, _, _} = + ic_symtab:get_full_scoped_name(G, N, X#typedef.type), + Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + ic_code:insert_typedef(G, Name, Type); + _ -> + ok + end, + reg(G, N, Xs); + +reg(G, N, [_|Xs]) -> + reg(G, N, Xs); + +reg(_G, _N, []) -> + ok. + + + + +%%%---------------------------------------------- +%%% +%%% Generates the interface code +%%% +%%%---------------------------------------------- + +gen_interface(G, N, X) -> + case ic_genobj:do_gen(G) of + true -> + G1 = ic_file:javaInterfaceFilePush(G, N, X), + + %% Generate Interface file + InterfaceFd = ic_genobj:interfacefiled(G1), + emit_interface(G1, N, X, InterfaceFd), + + %% Generate Helper file + HelperFd = ic_genobj:helperfiled(G1), + emit_helper(G1, N, X, HelperFd), + + %% Generate Holder file + HolderFd = ic_genobj:holderfiled(G1), + emit_holder(G1, N, X, HolderFd), + + %% Generate Stub file + StubFd = ic_genobj:stubfiled(G1), + emit_stub(G1,N,X,StubFd), %<--------------------------------------------------- 1 + + %% Generate Skeleton file + SkelFd = ic_genobj:skelfiled(G1), + emit_skel(G1, N, X, SkelFd), + + ic_file:javaInterfaceFilePop(G1); + false -> + ok + end. + + + + +%%%-------------------------------------------- +%%% +%%% Typedef redirection +%%% +%%%-------------------------------------------- + +gen_typedef(G, N, X) -> + Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), + case X#typedef.type of + {scoped_id,_,_,_} -> + {FullScopedName, _, _, _} = + ic_symtab:get_full_scoped_name(G, N, X#typedef.type), + Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), + ic_code:insert_typedef(G, Name, Type); + _ -> + ok + end, + gen_typedef_1(G, N, X, ic_forms:get_body(X)). + +gen_typedef_1(G, N, X, Type) when is_record(Type, sequence) -> + ic_sequence_java:gen(G, N, Type, ic_forms:get_java_id(X)); +gen_typedef_1(G, N, X, Type) when is_record(Type, array) -> + ic_array_java:gen(G, N, X, Type); +gen_typedef_1(G, N, X, _Type) -> + gen_typedef_2(G, N, X, X#typedef.id), + ok. + +gen_typedef_2(G, N, X, Type) when is_record(Type, array) -> + gen_typedef_1(G, N, X, Type); +gen_typedef_2(G, N, X, Type) when is_list(Type) -> + case Type of + [] -> + ok; + _ -> + gen_typedef_2(G, N, X, hd(Type)), + gen_typedef_2(G, N, X, tl(Type)) + end; +%gen_typedef_2(G, N, X, Type) -> %% Generating Helpers for typedef +% %% Stoped due to compatibility problems +% %% with erl_genserv backend +% case ic_java_type:isBasicType(G,N,X#typedef.type) of +% true -> +% ok; +% false -> +% case ic_forms:get_type_code(G,N,X#typedef.type) of +% {'tk_struct', _, _, _} -> +% ic_struct_java:gen(G, N, X); +% {'tk_sequence',_,_} -> +% ic_sequence_java:gen(G, N, X, ic_forms:get_java_id(X)), +% ok; +% _ -> +% ok +% end +% end; +gen_typedef_2(_G, _N, _X, _Type) -> + ok. + + + +%%%-------------------------------------------- +%%% +%%% Member redirection +%%% +%%%-------------------------------------------- + +gen_member(G, N, X) -> + gen_member_1(G, N, X, [X#member.type]), + gen_member_2(G, N, X, X#member.id). + + +gen_member_1(_G, _N, _X, []) -> + ok; + +gen_member_1(G, N, X, [T|Ts]) when is_record(T, sequence) -> + ic_sequence_java:gen(G, N, T, ic_forms:get_java_id(X)), + gen_member_1(G, N, X, Ts); + +gen_member_1(G, N, X, [T|Ts]) -> + gen(G,N,[T]), + gen_member_1(G,N,X,Ts). + + +gen_member_2(_G, _N, _X, []) -> + ok; + +gen_member_2(G, N, X, [T|Ts]) when is_record(T, array) -> %% BUG ! + ic_array_java:gen(G, N, X, T), + gen_member_2(G, N, X, Ts); + +gen_member_2(G, N, X, [_T|Ts]) -> + gen_member_2(G, N, X, Ts). + + + +gen_exception(_G, N, X) -> + io:format("Warning : Exceptions not supported for java mapping, ~p ignored\n", + [ic_util:to_colon([ic_forms:get_java_id(X)|N])]), + ok. + + + +%%%----------------------------------------------------- +%%% +%%% Interface file generation +%%% +%%%----------------------------------------------------- + +emit_interface(G, N, X, Fd) -> + Interface = ic_forms:get_java_id(X), %% Java Interface Name + IFCName = ic_forms:get_id2(X), %% Internal Interface Name + + ic_codegen:emit(Fd, "public interface ~s {\n\n",[Interface]), + Body = ic_forms:get_body(X), + + %% Generate type declarations inside interface + gen(G, [IFCName |N], Body), + + lists:foreach(fun({_Name, Body1}) -> + emit_interface_prototypes(G, [IFCName|N], Body1, Fd) end, + [{x, Body} | X#interface.inherit_body]), + + ic_codegen:emit(Fd, "}\n\n"). + + +emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, op) -> + + {_, ArgNames, TypeList} = extract_info(G, N, X), + {R, ParameterTypes, _} = TypeList, + + OpName = ic_forms:get_java_id(X), + RT = ic_java_type:getParamType(G,N,R,ret), + PL = ic_util:mk_list(gen_par_list(G, N, X, ParameterTypes,ArgNames)), + + ic_codegen:emit(Fd, "/*\n"), + ic_codegen:emit(Fd, " * Operation ~p interface functions \n", [ic_util:to_colon([OpName|N])]), + ic_codegen:emit(Fd, " */\n\n"), + + ic_codegen:emit(Fd, "~s ~s(~s)\n",[RT, OpName, PL]), + ic_codegen:emit(Fd, " throws java.lang.Exception;\n\n\n"), + + emit_interface_prototypes(G, N, Xs, Fd); +emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, attr) -> + ic_attribute_java:emit_attribute_prototype(G, N, X, Fd), + emit_interface_prototypes(G, N, Xs, Fd); +emit_interface_prototypes(G, N, [_X|Xs], Fd) -> + emit_interface_prototypes(G, N, Xs, Fd); +emit_interface_prototypes(_G, _N, [], _Fd) -> ok. + + + + +%%%----------------------------------------------------- +%%% +%%% Holder file generation +%%% +%%%----------------------------------------------------- + +emit_holder(_G, N, X, Fd) -> + InterfaceName = ic_forms:get_java_id(X), + FullInterfaceName = ic_util:to_dot([InterfaceName|N]), + + ic_codegen:emit(Fd, "public final class ~sHolder {\n\n",[InterfaceName]), + + ic_codegen:emit(Fd, " // Instance variable\n"), + ic_codegen:emit(Fd, " public ~s value;\n\n",[FullInterfaceName]), + + ic_codegen:emit(Fd, " // Constructors\n"), + ic_codegen:emit(Fd, " public ~sHolder() {\n",[InterfaceName]), + ic_codegen:emit(Fd, " this(null);\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public ~sHolder(~s _arg) {\n",[InterfaceName, FullInterfaceName]), + ic_codegen:emit(Fd, " value = _arg;\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public void _marshal() {\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public void _unmarshal() {\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, "}\n\n"). + + + + +%%%----------------------------------------------------- +%%% +%%% Helper file generation +%%% +%%%----------------------------------------------------- +emit_helper(G, N, X, Fd) -> + InterfaceName = ic_forms:get_java_id(X), + FullInterfaceName = ic_util:to_dot([InterfaceName|N]), + + ic_codegen:emit(Fd, "public final class ~sHelper {\n\n",[InterfaceName]), + + ic_codegen:emit(Fd, " // Constructor\n"), + ic_codegen:emit(Fd, " public ~sHelper() {\n",[InterfaceName]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static void _marshal() {\n"), + ic_codegen:emit(Fd, " // Writing the object to the message\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static ~s _unmarshal() {\n",[FullInterfaceName]), + ic_codegen:emit(Fd, " // Reading the object from the message\n"), + ic_codegen:emit(Fd, " return null;\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static java.lang.String id() {\n"), + ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, "}\n\n"). + + + + +%%%----------------------------------------------------- +%%% +%%% Stub file generation +%%% +%%%----------------------------------------------------- + +emit_stub(G, N, X, Fd) -> + InterfaceName = ic_forms:get_java_id(X), %% Java Interface Name + IFCName = ic_forms:get_id2(X), %% Internal Interface Name + + FullInterfaceName = ic_util:to_dot([InterfaceName|N]), + Body = ic_forms:get_body(X), + + ic_codegen:emit(Fd, "public class _~sStub implements ~s {\n\n", + [InterfaceName,FullInterfaceName]), + + ic_codegen:emit(Fd, " // Client data\n"), + ic_codegen:emit(Fd, " public ~sEnvironment _env;\n\n",[?ICPACKAGE]), + + ic_codegen:emit(Fd, " // Constructors\n"), + ic_codegen:emit(Fd, " public _~sStub(~sOtpSelf _self,\n",[InterfaceName,?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " ~sOtpPeer _peer,\n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " _env =\n"), + ic_codegen:emit(Fd, " new ~sEnvironment(_self, _peer, _server);\n",[?ICPACKAGE]), + ic_codegen:emit(Fd, " _env.connect();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public _~sStub(java.lang.String _selfN,\n",[InterfaceName]), + ic_codegen:emit(Fd, " java.lang.String _peerN,\n"), + ic_codegen:emit(Fd, " java.lang.String _cookie,\n"), + ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), + ic_codegen:emit(Fd, " _env =\n"), + ic_codegen:emit(Fd, " new ~sEnvironment(_selfN, _peerN, _cookie, _server);\n",[?ICPACKAGE]), + ic_codegen:emit(Fd, " _env.connect();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public _~sStub(~sOtpConnection _connection,\n",[InterfaceName, ?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), + ic_codegen:emit(Fd, " _env =\n"), + ic_codegen:emit(Fd, " new ~sEnvironment(_connection, _server);\n",[?ICPACKAGE]), + ic_codegen:emit(Fd, " _env.connect();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + emit_message_reference_extraction(Fd), + + emit_servers_object_access(Fd), + + emit_client_connection_close(Fd), + + emit_client_connection_reconnect(Fd), + + emit_client_destroy(Fd), + + lists:foreach(fun({_Name, Body1}) -> + emit_op_implementation(G, [IFCName|N], Body1, Fd) end, + [{x, Body} | X#interface.inherit_body]), + + ic_codegen:emit(Fd, "}\n\n"). + + +emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, op) -> + + WireOpName = ic_forms:get_id2(X), + OpName = ic_forms:get_java_id(WireOpName), + {_, ArgNames, TypeList} = extract_info(G, N, X), + {R, ParamTypes, _} = TypeList, + + RT = ic_java_type:getParamType(G,N,R,ret), + PL = ic_util:mk_list(gen_par_list(G, N, X, ParamTypes, ArgNames)), + CMCPL = ic_util:mk_list(gen_client_marshal_call_par_list(ArgNames)), + + ic_codegen:emit(Fd, " // Operation ~p implementation\n", [ic_util:to_colon([WireOpName|N])]), + ic_codegen:emit(Fd, " public ~s ~s(~s)\n", [RT, OpName, PL]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + %% Function marshal call + ic_codegen:emit(Fd, " // Calling the marshal function\n"), + + case CMCPL of + "" -> + ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n",[OpName]); + _ -> + ic_codegen:emit(Fd, " _~s_marshal(_env, ~s);\n\n",[OpName, CMCPL]) + end, + + %% Sending call + ic_codegen:emit(Fd, " // Message send\n"), + ic_codegen:emit(Fd, " _env.send();\n\n"), + + case ic_forms:is_oneway(X) of + true -> + ok; + false -> + %% Receiving return values + ic_codegen:emit(Fd, " // Message receive\n"), + ic_codegen:emit(Fd, " _env.receive();\n\n"), + + %% Function unmarshal call + case RT of + "void" -> + case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of + "" -> + ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), + ic_codegen:emit(Fd, " _~s_unmarshal(_env);\n", + [OpName]); + UMCPL -> + ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), + ic_codegen:emit(Fd, " _~s_unmarshal(_env, ~s);\n", + [OpName,UMCPL]) + end; + _ -> + ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), + case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of + "" -> + ic_codegen:emit(Fd, " return _~s_unmarshal(_env);\n", + [OpName]); + UMCPL -> + ic_codegen:emit(Fd, " return _~s_unmarshal(_env, ~s);\n", + [OpName,UMCPL]) + end + end + end, + ic_codegen:emit(Fd, " }\n\n"), + + %% Marshalling + emit_op_marshal(G, N, X, Fd), + + %% UnMarshalling + emit_op_unmarshal(G, N, X, Fd), + ic_codegen:emit(Fd, "\n"), + + emit_op_implementation(G, N, Xs, Fd); +emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, attr) -> + ic_attribute_java:emit_attribute_stub_code(G, N, X, Fd), + emit_op_implementation(G, N, Xs, Fd); +emit_op_implementation(G, N, [_X|Xs], Fd) -> + emit_op_implementation(G, N, Xs, Fd); +emit_op_implementation(_G, _N, [], _Fd) -> ok. + + + + + +%%--------------------------------------- +%% +%% Marshal operation generation +%% +%%--------------------------------------- + +emit_op_marshal(G, N, X, Fd) -> + WireOpName = ic_forms:get_id2(X), + OpName = ic_forms:get_java_id(WireOpName), + {_, ArgNames, TypeList} = extract_info(G, N, X), + {_R, ParamTypes, _} = TypeList, + + PL = ic_util:mk_list(gen_marshal_par_list(G, N, X, ParamTypes, ArgNames)), + + ic_codegen:emit(Fd, " // Marshal operation for ~p\n", [OpName]), + case PL of + "" -> + ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", + [OpName, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"); + _ -> + ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s)\n", + [OpName, ?ICPACKAGE, PL]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n") + end, + %% Message encoding + emit_op_encode(G, N, X, OpName, WireOpName, ParamTypes, ArgNames, Fd), + + ic_codegen:emit(Fd, " }\n\n"). + + +emit_op_encode(G, N, X, _OpN, WOpN, ParamTypes, ArgNames, Fd) -> + + OpCallName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ic_util:to_undersc([WOpN|N]); + false -> + WOpN + end, + + SendParamNr = count_client_send(ArgNames), + + ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n", + [?ERLANGPACKAGE]), + + case ic_forms:is_oneway(X) of + true -> + %% Initiating call tuple + ic_codegen:emit(Fd, " // Message header assembly\n"), + ic_codegen:emit(Fd, " __os.reset();\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"$gen_cast\");\n\n"); + false -> + %% Initiating call tuple + ic_codegen:emit(Fd, " // Message header assembly\n"), + ic_codegen:emit(Fd, " __os.reset();\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), + + %% Initiating call identity tuple + ic_codegen:emit(Fd, " // Message identity part creation\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __env.write_client_pid();\n"), + ic_codegen:emit(Fd, " __env.write_client_ref();\n\n") + end, + + %% Operation part initializations + case SendParamNr > 0 of + true -> + ic_codegen:emit(Fd, " // Operation attribute creation\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n", [SendParamNr+1]), + ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]), + emit_op_encode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); + false -> %% No in/inout paramaters + ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]) + end. + + + +emit_op_encode_loop(_,_,_,_,[],_,_Fd) -> + ok; +emit_op_encode_loop(G, N, X, [_Type|Types],[{out, _Arg}|Args], Counter, Fd) -> + emit_op_encode_loop(G, N, X, Types, Args, Counter, Fd); +emit_op_encode_loop(G, N, X, [Type|Types], [{inout, Arg}|Args], Counter, Fd) -> + case ic_java_type:isBasicType(G, N, Type) of + true -> + ic_codegen:emit(Fd, " __os~s(~s.value);\n", + [ic_java_type:marshalFun(G, N, X, Type),Arg]); + false -> + ic_codegen:emit(Fd, " ~s(__os, ~s.value);\n", + [ic_java_type:marshalFun(G, N, X, Type),Arg]) + end, + emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd); +emit_op_encode_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> + case ic_java_type:isBasicType(G, N, Type) of + true -> + ic_codegen:emit(Fd, " __os~s(~s);\n", + [ic_java_type:marshalFun(G, N, X, Type),Arg]); + false -> + ic_codegen:emit(Fd, " ~s(__os, ~s);\n", + [ic_java_type:marshalFun(G, N, X, Type),Arg]) + end, + emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd). + + + + + + +%%------------------------------------- +%% +%% UnMarshal operation generation +%% +%%------------------------------------- + +emit_op_unmarshal(G, N, X, Fd) -> + case ic_forms:is_oneway(X) of + true -> + ok; + false -> + OpName = ic_forms:get_java_id(X), + {_, ArgNames, TypeList} = extract_info(G, N, X), + {R, ParamTypes, _} = TypeList, + + RT = ic_java_type:getParamType(G,N,R,ret), + PL = ic_util:mk_list(gen_unmarshal_par_list(G, N, X, ParamTypes, ArgNames)), + + case PL of + "" -> + case RT of + "void" -> + ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), + ic_codegen:emit(Fd, " public static void _~s_unmarshal(~sEnvironment __env)\n", + [OpName, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + ic_codegen:emit(Fd, " __env.getIs().read_atom();\n"), + ic_codegen:emit(Fd, " }\n\n"); + _ -> + ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), + ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env)\n", + [RT, OpName, ?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Get input stream\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", + [?ERLANGPACKAGE]), + + emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), + ic_codegen:emit(Fd, " }\n\n") + end; + _ -> + ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), + ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env, ~s)\n", + [RT, OpName, ?ICPACKAGE, PL]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Get input stream\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", + [?ERLANGPACKAGE]), + + emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), + ic_codegen:emit(Fd, " }\n\n") + end + end. + + +emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd) -> + ReceiveNr = count_client_receive(ArgNames), + + case RT of + "void" -> + case ReceiveNr > 0 of + true -> + ic_codegen:emit(Fd, " // Extracting output values\n"), + ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), + ic_codegen:emit(Fd, " __is.read_atom();\n"), + emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); + false -> + ic_codegen:emit(Fd, " __is.read_atom();\n") + end; + _ -> + case ReceiveNr > 0 of + true -> + ic_codegen:emit(Fd, " // Extracting return/output values\n"), + ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), + case ic_java_type:isBasicType(G,N,R) of + true -> + ic_codegen:emit(Fd, " ~s _result = __is~s;\n", + [RT,ic_java_type:unMarshalFun(G, N, X, R)]); + false -> + ic_codegen:emit(Fd, " ~s _result = ~s.unmarshal(__is);\n", + [RT, ic_java_type:getUnmarshalType(G,N,X,R)]) + end, + emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd), + + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, " return _result;\n"); + false -> + ic_codegen:emit(Fd, " // Extracting return value\n"), + case ic_java_type:isBasicType(G,N,R) of + true -> + ic_codegen:emit(Fd, " return __is~s;\n", + [ic_java_type:unMarshalFun(G, N, X, R)]); + false -> + ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", + [ic_java_type:getUnmarshalType(G,N,X,R)]) + end + end + end. + +emit_op_decode_loop(_,_,_,_,[],_,_Fd) -> + ok; +emit_op_decode_loop(G, N, X, [_Type|Types], [{in, _Arg}|Args], Counter, Fd) -> + emit_op_decode_loop(G, N, X, Types, Args, Counter, Fd); +emit_op_decode_loop(G, N, X, [Type|Types], [{_, Arg}|Args], Counter, Fd) -> + case ic_java_type:isBasicType(G,N,Type) of + true -> + ic_codegen:emit(Fd, " ~s.value = __is~s;\n", + [Arg, + ic_java_type:unMarshalFun(G, N, X, Type)]); + false -> + ic_codegen:emit(Fd, " ~s.value = ~s.unmarshal(__is);\n", + [Arg, + ic_java_type:getUnmarshalType(G, N, X, Type)]) + end, + emit_op_decode_loop(G, N, X, Types, Args, Counter+1, Fd). + + + +emit_message_reference_extraction(Fd) -> + ic_codegen:emit(Fd, " // Returns call reference\n"), + ic_codegen:emit(Fd, " public ~sOtpErlangRef __getRef()\n", + [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + ic_codegen:emit(Fd, " return _env.received_ref();\n"), + ic_codegen:emit(Fd, " }\n\n"). + +emit_servers_object_access(Fd) -> + ic_codegen:emit(Fd, " // Returns the server\n"), + ic_codegen:emit(Fd, " public java.lang.Object __server() {\n"), + ic_codegen:emit(Fd, " return _env.server();\n"), + ic_codegen:emit(Fd, " }\n\n"). + +emit_client_connection_close(Fd) -> + ic_codegen:emit(Fd, " // Closes connection\n"), + ic_codegen:emit(Fd, " public void __disconnect() {\n"), + ic_codegen:emit(Fd, " _env.disconnect();\n"), + ic_codegen:emit(Fd, " }\n\n"). + +emit_client_connection_reconnect(Fd) -> + ic_codegen:emit(Fd, " // Reconnects client\n"), + ic_codegen:emit(Fd, " public void __reconnect()\n"), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + ic_codegen:emit(Fd, " _env.reconnect();\n"), + ic_codegen:emit(Fd, " }\n\n"). + +emit_client_destroy(Fd) -> + ic_codegen:emit(Fd, " // Destroy server\n"), + ic_codegen:emit(Fd, " public void __stop()\n"), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + ic_codegen:emit(Fd, " _env.client_stop_server();\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + +%%%---------------------------------------------------- +%%% +%%% Generates the server code +%%% +%%%---------------------------------------------------- + +emit_skel(G, N, X, Fd) -> + InterfaceName = ic_forms:get_java_id(X), + FullInterfaceName = ic_util:to_dot([InterfaceName|N]), + + ic_codegen:emit(Fd, "public abstract class _~sImplBase implements ~s {\n\n", + [InterfaceName,FullInterfaceName]), + + ic_codegen:emit(Fd, " // Server data\n"), + ic_codegen:emit(Fd, " protected ~sEnvironment _env = null;\n\n",[?ICPACKAGE]), + + ic_codegen:emit(Fd, " // Constructors\n"), + ic_codegen:emit(Fd, " public _~sImplBase() {\n",[InterfaceName]), + ic_codegen:emit(Fd, " }\n\n"), + + emit_caller_pid(G, N, X, Fd), + + %% Emit operation dictionary + emit_dictionary(G, N, X, Fd), + + %% Emit server switch + emit_server_switch(G, N, X, Fd), + + ic_codegen:emit(Fd, "}\n"). + + +emit_server_switch(G, N, X, Fd) -> + + IFCName = ic_forms:get_id2(X), %% Internal Interface Name + Body = ic_forms:get_body(X), + Counter = 0, + + ic_codegen:emit(Fd, " // Operation invokation\n"), + ic_codegen:emit(Fd, " public ~sOtpOutputStream invoke(~sOtpInputStream _in)\n", + [?ERLANGPACKAGE,?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Create a new environment if needed\n"), + ic_codegen:emit(Fd, " if (_env == null)\n"), + ic_codegen:emit(Fd, " _env = new com.ericsson.otp.ic.Environment();\n\n"), + + ic_codegen:emit(Fd, " // Unmarshal head\n"), + ic_codegen:emit(Fd, " _env.uHead(_in);\n\n"), + + ic_codegen:emit(Fd, " // Switch over operation\n"), + ic_codegen:emit(Fd, " return __switch(_env);\n"), + + ic_codegen:emit(Fd, " }\n\n"), + + + ic_codegen:emit(Fd, " // Operation switch\n"), + ic_codegen:emit(Fd, " public ~sOtpOutputStream __switch(~sEnvironment __env)\n", [?ERLANGPACKAGE,?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " // Setup streams and operation label\n"), + ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " __os.reset();\n"), + ic_codegen:emit(Fd, " int __label = __env.uLabel(__operations);\n\n"), + + ic_codegen:emit(Fd, " // Switch over operation\n"), + ic_codegen:emit(Fd, " switch(__label) {\n\n"), + + OpNr = emit_server_op_switch_loop(G, + [IFCName|N], + [{x, Body} | X#interface.inherit_body], + Counter, + Fd), + + ic_codegen:emit(Fd, " case ~p: { // Standard stop operation\n\n",[OpNr]), + ic_codegen:emit(Fd, " __env.server_stop_server();\n\n"), + ic_codegen:emit(Fd, " } break;\n\n"), + + ic_codegen:emit(Fd, " default: // It will never come down here \n"), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"BAD OPERATION\");\n\n", []), + + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " if(__os.count() > 0)\n"), + ic_codegen:emit(Fd, " return __os;\n\n"), + + ic_codegen:emit(Fd, " return null;\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + +emit_server_op_switch_loop(_G, _N, [], C, _Fd) -> + C; +emit_server_op_switch_loop(G, N, [{_,X}|Xs], C, Fd) -> + C1 = emit_server_op_switch(G, N, X, C, Fd), + emit_server_op_switch_loop(G, N, Xs, C1, Fd). + + +emit_server_op_switch(G, N, [X|Xs], C, Fd) when is_record(X, op) -> + + OpName = ic_forms:get_java_id(X), + + ic_codegen:emit(Fd, " case ~p: { // Operation ~s\n\n",[C,ic_util:to_dot([OpName|N])]), + + emit_invoke(G, N, X, Fd), + + ic_codegen:emit(Fd, " } break;\n\n"), + + emit_server_op_switch(G, N, Xs, C+1, Fd); +emit_server_op_switch(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> + C1 = ic_attribute_java:emit_attribute_switch_case(G,N,X,Fd,C), + emit_server_op_switch(G, N, Xs, C1, Fd); +emit_server_op_switch(G, N, [_X|Xs], C, Fd) -> + emit_server_op_switch(G, N, Xs, C, Fd); +emit_server_op_switch(_G, _N, [], C, _Fd) -> + C. + + +emit_caller_pid(_G, _N, _X, Fd) -> + ic_codegen:emit(Fd, " // Extracts caller identity\n"), + ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid() {\n", [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " return _env.getScaller();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid(~sEnvironment __env) {\n", + [?ERLANGPACKAGE, ?ICPACKAGE]), + ic_codegen:emit(Fd, " return __env.getScaller();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public boolean __isStopped() {\n"), + ic_codegen:emit(Fd, " return _env.isStopped();\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public boolean __isStopped(~sEnvironment __env) {\n", + [?ICPACKAGE]), + ic_codegen:emit(Fd, " return __env.isStopped();\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + +%% Creates an operation dictionary +emit_dictionary(G, N, X, Fd) -> + + Counter = 0, + Body = ic_forms:get_body(X), + + ic_codegen:emit(Fd, " // Operation dictionary\n"), + ic_codegen:emit(Fd, " private static java.util.Dictionary __operations = new java.util.Hashtable();\n"), + ic_codegen:emit(Fd, " static {\n"), + + emit_dictionary_loop(G, + [ic_forms:get_id2(X)|N], + [{x, Body} | X#interface.inherit_body], + Counter, + Fd), + + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " // Operation dictionary access\n"), + ic_codegen:emit(Fd, " public static java.util.Dictionary __operations() {\n"), + ic_codegen:emit(Fd, " return __operations;\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + + +emit_dictionary_loop(_G, _N, [], C, Fd) -> + ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", + ["stop",C]); +emit_dictionary_loop(G, N, [{_,X}|Xs], C, Fd) -> + C1 = emit_dictionary(G, N, X, C, Fd), + emit_dictionary_loop(G, N, Xs, C1, Fd). + + +emit_dictionary(G, N, [X|Xs], C, Fd) when is_record(X, op) -> + + OpName = case ic_options:get_opt(G, scoped_op_calls) of + true -> + ic_util:to_undersc([ic_forms:get_id2(X)|N]); + false -> + ic_forms:get_id2(X) + end, + + ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", + [OpName,C]), + emit_dictionary(G, N, Xs, C+1, Fd); + +emit_dictionary(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> + C1 = ic_attribute_java:emit_atrribute_on_dictionary(G, N, X, Fd, C), + emit_dictionary(G, N, Xs, C1, Fd); + +emit_dictionary(G, N, [_X|Xs], C, Fd) -> + emit_dictionary(G, N, Xs, C, Fd); + +emit_dictionary(_G, _N, [], C, _Fd) -> + C. + + + +emit_invoke(G, N, X, Fd) -> + + {_, ArgNames, TypeList} = extract_info(G, N, X), + {R, ParamTypes, _} = TypeList, + OpName = ic_forms:get_java_id(X), + RT = ic_java_type:getParamType(G,N,R,ret), + PL = ic_util:mk_list(gen_cb_arg_list(ArgNames)), + OutParamNr = count_server_send(ArgNames), + + case count_server_receive(ArgNames) of + 0 -> + ok; + _C -> + ic_codegen:emit(Fd, " // Preparing input\n"), + ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n", + [?ERLANGPACKAGE]), + emit_server_unmarshal_loop(G, N, X, ParamTypes, ArgNames, 1, Fd) + end, + + ic_codegen:emit(Fd, " // Calling implementation function\n"), + case RT of + "void" -> + ic_codegen:emit(Fd, " this.~s(~s);\n\n", + [OpName,PL]); + _ -> + ic_codegen:emit(Fd, " ~s _result = this.~s(~s);\n\n", + [RT, OpName, PL]) + end, + + case ic_forms:is_oneway(X) of + true -> + ok; + false -> + ic_codegen:emit(Fd, " // Marshaling output\n"), + ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), + + case RT of + "void" -> + case OutParamNr > 0 of + true -> + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), + ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n"), + emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); + false -> + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), + ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n") + end; + _ -> + case OutParamNr > 0 of + true -> + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), + ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), + + case ic_java_type:isBasicType(G,N,R) of + true -> + ic_codegen:emit(Fd, " __os~s(_result); // Return value\n", + [ic_java_type:marshalFun(G,N,X,R)]); + false -> + ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n", + [ic_java_type:marshalFun(G,N,X,R)]) + end, + emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); + false -> + ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), + ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), + + case ic_java_type:isBasicType(G,N,R) of + true -> + ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", + [ic_java_type:marshalFun(G,N,X,R)]); + false -> + ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", + [ic_java_type:marshalFun(G,N,X,R)]) + end + end + end, + ic_codegen:nl(Fd) + end. + + +emit_server_unmarshal_loop(_,_,_,_,[],_,Fd) -> + ic_codegen:nl(Fd); +emit_server_unmarshal_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> + case ic_java_type:isBasicType(G,N,Type) of + true -> + ic_codegen:emit(Fd, " ~s ~s = __is~s; // In value\n", + [ic_java_type:getType(G,N,Type), + Arg, + ic_java_type:unMarshalFun(G,N,X,Type)]); + false -> + ic_codegen:emit(Fd, " ~s ~s = ~s.unmarshal(__is); // In value\n", + [ic_java_type:getType(G,N,Type), + Arg, + ic_java_type:getUnmarshalType(G,N,X,Type)]) + end, + emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); +emit_server_unmarshal_loop(G, N, X, [Type|Types],[{inout, Arg}|Args], Counter, Fd) -> + Holder = ic_java_type:getHolderType(G,N,Type), + case ic_java_type:isBasicType(G,N,Type) of + true -> +% OtpEncVar = ic_java_type:getUnmarshalType(G,N,X,Type), + ic_codegen:emit(Fd, " ~s _~s = __is~s;\n", + [ic_java_type:getType(G,N,Type), + Arg, + ic_java_type:unMarshalFun(G,N,X,Type)]), + ic_codegen:emit(Fd, " ~s ~s = new ~s(_~s); // InOut value\n", + [Holder, + Arg, + Holder, + Arg]); + false -> + ic_codegen:emit(Fd, " ~s ~s = new ~s(); // InOut value\n", + [Holder, + Arg, + Holder]), + ic_codegen:emit(Fd, " ~s._unmarshal(__is);\n", + [Arg]) + end, + emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); +emit_server_unmarshal_loop(G, N, X, [Type|Types],[{out, Arg}|Args], Counter, Fd) -> + Holder = ic_java_type:getHolderType(G,N,Type), + ic_codegen:emit(Fd, " ~s ~s = new ~s(); // Out value\n", [Holder, Arg, Holder]), + emit_server_unmarshal_loop(G, N, X, Types, Args, Counter, Fd). + + +emit_server_marshal_loop(_,_,_,_,[],_,_Fd) -> + ok; +emit_server_marshal_loop(G, N, X, [_Type|Types],[{in, _Arg}|Args], Counter, Fd) -> + emit_server_marshal_loop(G, N, X, Types, Args, Counter, Fd); +emit_server_marshal_loop(G, N, X, [Type|Types],[{_, Arg}|Args], Counter, Fd) -> +% Holder = ic_java_type:getHolderType(G,N,Type), + case ic_java_type:isBasicType(G,N,Type) of + true -> + ic_codegen:emit(Fd, " __os~s(~s.value); // Out/InOut value\n", + [ic_java_type:marshalFun(G,N,X,Type),Arg]); + false -> + ic_codegen:emit(Fd, " ~s._marshal(__os); // Out/InOut value\n", + [Arg]) + end, + emit_server_marshal_loop(G, N, X, Types, Args, Counter+1, Fd). + + + + + +%%%---------------------------------------------------- +%%% +%%% Utilities +%%% +%%%---------------------------------------------------- + +extract_info(_G, N, X) when is_record(X, op) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + Args = X#op.params, + ArgNames = mk_c_vars(Args), + TypeList = {ic_forms:get_type(X), + lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), + [] + }, + {Name, ArgNames, TypeList}; +extract_info(_G, N, X) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + {Name, [], []}. + +%% Input is a list of parameters (in parse form) and output is a list +%% of parameter attribute and variable names. +mk_c_vars(Params) -> + lists:map(fun(P) -> {A, _} = P#param.inout, + {A, ic_forms:get_id(P#param.id)} + end, + Params). + +%% +handle_preproc(G, _N, line_nr, X) -> + Id = ic_forms:get_java_id(X), + Flags = X#preproc.aux, + case Flags of + [] -> ic_genobj:push_file(G, Id); + _ -> + lists:foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id); + ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); + ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, + G, Flags) + end; +handle_preproc(G, _N, _Other, _X) -> + G. + + +%% +gen_par_list(_, _, _, [], []) -> + []; +gen_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> + JType = ic_java_type:getParamType(G, N, Type, Attr), + [JType ++ " " ++ Arg | + gen_par_list(G, N, X, Types, Args)]. + + +gen_marshal_par_list(_, _, _, [], []) -> + []; +gen_marshal_par_list(G, N, X, [_Type |Types], [{out, _Arg}|Args]) -> + gen_marshal_par_list(G, N, X, Types, Args); +gen_marshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> + JType = ic_java_type:getParamType(G, N, Type, Attr), + [JType ++ " " ++ Arg | + gen_marshal_par_list(G, N, X, Types, Args)]. + + +gen_unmarshal_par_list(_, _, _, [], []) -> + []; +gen_unmarshal_par_list(G, N, X, [_Type |Types], [{in, _Arg}|Args]) -> + gen_unmarshal_par_list(G, N, X, Types, Args); +gen_unmarshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> + JType = ic_java_type:getParamType(G, N, Type, Attr), + [JType ++ " " ++ Arg | + gen_unmarshal_par_list(G, N, X, Types, Args)]. + + +%% +gen_client_marshal_call_par_list([]) -> + []; +gen_client_marshal_call_par_list([{out, _Arg}|Args]) -> + gen_client_marshal_call_par_list(Args); +gen_client_marshal_call_par_list([{_Attr, Arg}|Args]) -> + [Arg | gen_client_marshal_call_par_list(Args)]. + + +gen_client_unmarshal_call_par_list([]) -> + []; +gen_client_unmarshal_call_par_list([{in, _Arg}|Args]) -> + gen_client_unmarshal_call_par_list(Args); +gen_client_unmarshal_call_par_list([{_Attr, Arg}|Args]) -> + [Arg | gen_client_unmarshal_call_par_list(Args)]. + + + +count_client_receive(ArgNames) -> + count_client_receive(ArgNames,0). + +count_client_receive([],C) -> + C; +count_client_receive([{in, _Arg}|Args],C) -> + count_client_receive(Args,C); +count_client_receive([_|Args],C) -> + count_client_receive(Args,C+1). + + + +count_client_send(ArgNames) -> + count_client_send(ArgNames,0). + +count_client_send([],C) -> + C; +count_client_send([{out, _Arg}|Args],C) -> + count_client_send(Args,C); +count_client_send([_|Args],C) -> + count_client_send(Args,C+1). + + +gen_cb_arg_list([]) -> + []; +gen_cb_arg_list([{_Attr, Arg}|Args]) -> + [Arg | gen_cb_arg_list(Args)]. + + +count_server_receive(ArgNames) -> + count_server_receive(ArgNames,0). + +count_server_receive([],C) -> + C; +count_server_receive([_|Args],C) -> + count_server_receive(Args,C+1). + + +count_server_send(ArgNames) -> + count_server_send(ArgNames,0). + +count_server_send([],C) -> + C; +count_server_send([{in, _Arg}|Args],C) -> + count_server_send(Args,C); +count_server_send([_|Args],C) -> + count_server_send(Args,C+1). + + + + + +%%%------------------------------------------------------- + + +emit_type_function(G, N, X, Fd) -> + + TC = ic_forms:get_type_code(G, N, X), + + %%io:format("X = ~p\nTC = ~p\n",[X,TC]), + + ic_codegen:emit(Fd, " private static ~sTypeCode _tc;\n",[?ICPACKAGE]), + ic_codegen:emit(Fd, " synchronized public static ~sTypeCode type() {\n\n",[?ICPACKAGE]), + + ic_codegen:emit(Fd, " if (_tc != null)\n"), + ic_codegen:emit(Fd, " return _tc;\n\n"), + + emit_type_function(TC, 0, Fd), + + ic_codegen:emit(Fd, "\n _tc = _tc0;\n"), + + ic_codegen:emit(Fd, "\n return _tc0;\n"), + ic_codegen:emit(Fd, " }\n\n"). + + + +emit_type_function({tk_struct, ID, Name, ML}, C, Fd) -> %% struct + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_struct);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), + ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), + ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(ML)]), + emit_struct_members(ML, C, C+1, 0, Fd); + +emit_type_function({tk_enum, ID, Name, MNames}, C, Fd) -> %% enum + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_enum);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), + ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), + ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(MNames)]), + emit_enum_members(MNames, C, 0, Fd), + C+1; + +emit_type_function({tk_array, ET, L}, C, Fd) -> %% array + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_array);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), + ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), + C1 = C+1, + C2 = emit_type_function(ET, C1, Fd), + ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), + C2; + +emit_type_function({tk_sequence, ET, L}, C, Fd) -> %% sequence + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_sequence);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), + ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), + C1 = C+1, + C2 = emit_type_function(ET, C1, Fd), + ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), + C2; + +emit_type_function({tk_string, L}, C, Fd) -> %% string + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_string);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), + C+1; + +emit_type_function({tk_union, ID, Name, DT, DI, LL}, C, Fd) -> %% union + + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_union);\n", [C,?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), + ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), + + C1 = C+1, + C2 = emit_type_function(DT, C1, Fd), + + ic_codegen:emit(Fd, " _tc~p.discriminator_type(_tc~p);\n", [C,C1]), + ic_codegen:emit(Fd, " _tc~p.default_index(~p);\n", [C,DI]), + ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(LL)]), + + emit_union_labels(LL, C, DT, C2, 0, Fd); + +emit_type_function(tk_term, C, Fd) -> %% term, must change it to tk_any + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_any);\n", [C,?ICPACKAGE]), + C+1; + +emit_type_function(TC, C, Fd) -> %% other + ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), + ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), + ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.~p);\n", [C,?ICPACKAGE,TC]), + C+1. + + + +emit_struct_members([], _, TCtr, _, _Fd) -> + TCtr; +emit_struct_members([{Name,MT}|Rest], BTCtr, TCtr, I, Fd) -> + ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), + TCtr2 = emit_type_function(MT, TCtr, Fd), + ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr]), + emit_struct_members(Rest, BTCtr, TCtr2, I+1, Fd). + +emit_enum_members([], _, _, _Fd) -> + ok; +emit_enum_members([Name|Names], BTCtr, I, Fd) -> + ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), + emit_enum_members(Names, BTCtr, I+1, Fd). + + +emit_union_labels([], _, _, TCtr, _, _) -> + TCtr; +emit_union_labels([{L, LN, LT}|Rest], BTCtr, DT, TCtr, I, Fd) -> + ic_codegen:emit(Fd, " ~sAny _any~p =\n",[?ICPACKAGE,TCtr]), + ic_codegen:emit(Fd, " new ~sAny();\n", [?ICPACKAGE]), + TCtr1 = TCtr+1, + TCtr2 = emit_type_function(LT, TCtr1,Fd), + ic_codegen:emit(Fd, " _any~p.type(_tc~p);\n",[TCtr,TCtr1]), + + case L of + default -> + ic_codegen:emit(Fd, " _any~p.insert_atom(\"default\");\n", [TCtr]); + _ -> + case DT of + tk_boolean -> + ic_codegen:emit(Fd, " _any~p.insert_boolean(~p);\n",[TCtr,L]); + tk_char -> + Default = if is_integer(L) -> + [L]; + true -> + L + end, + ic_codegen:emit(Fd, " _any~p.insert_char('~s');\n",[TCtr,Default]); + tk_ushort -> + ic_codegen:emit(Fd, " _any~p.insert_ushort(~p);\n",[TCtr,L]); + tk_ulong -> + ic_codegen:emit(Fd, " _any~p.insert_ulong(~p);\n",[TCtr,L]); + tk_short -> + ic_codegen:emit(Fd, " _any~p.insert_short(~p);\n",[TCtr,L]); + tk_long -> + ic_codegen:emit(Fd, " _any~p.insert_long(~p);\n",[TCtr,L]); + _ -> + ic_codegen:emit(Fd, " _any~p.insert_string(~p);\n", [TCtr,L]) + end + end, + ic_codegen:emit(Fd, " _tc~p.member_label(~p,_any~p);\n", [BTCtr,I,TCtr]), + ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,LN]), + TCtr3 = emit_type_function(LT, TCtr2, Fd), + ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr2]), + emit_union_labels(Rest, BTCtr, DT, TCtr3, I+1, Fd). + + + + + + + + diff --git a/lib/ic/src/ic_noc.erl b/lib/ic/src/ic_noc.erl new file mode 100644 index 0000000000..d43d550a52 --- /dev/null +++ b/lib/ic/src/ic_noc.erl @@ -0,0 +1,1113 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_noc). + + +-export([do_gen/3]). +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-export([unfold/1, mk_attr_func_names/2]). + + +-import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). +-import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). +-import(ic_codegen, [emit/2, emit/3, nl/1]). +-import(ic_options, [get_opt/2]). + + +-import(lists, [foreach/2, foldr/3, map/2]). + + +-include("icforms.hrl"). +-include("ic.hrl"). + + + + +%%------------------------------------------------------------ +%% +%% Generate the client side Erlang stubs. +%% +%% Each module is generated to a separate file. +%% +%% Export declarations for all interface functions must be +%% generated. Each function then needs to generate a function head and +%% a body. IDL parameters must be converted into Erlang parameters +%% (variables, capitalised) and a type signature list must be +%% generated (for later encode/decode). +%% +%%------------------------------------------------------------ + + +do_gen(G, File, Form) -> + G2 = ic_file:filename_push(G, [], mk_oe_name(G, + ic_file:remove_ext(to_list(File))), + erlang), + gen_head(G2, [], Form), + exportDependency(G2), + %% Loop through form and adds inheritence data + ic_pragma:preproc(G2, [], Form), + gen(G2, [], Form), + genDependency(G2), + ic_file:filename_pop(G2, erlang), + ok. + + +gen(G, N, [X|Xs]) when is_record(X, preproc) -> + NewG = ic:handle_preproc(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, module) -> + CD = ic_code:codeDirective(G,X), + G2 = ic_file:filename_push(G, N, X, CD), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + G3 = ic_file:filename_pop(G2, CD), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, interface) -> + G2 = ic_file:filename_push(G, N, X, erlang), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, + X#interface.inherit_body), + gen_serv(G2, N, X), + G3 = ic_file:filename_pop(G2, erlang), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, const) -> +% N2 = [get_id2(X) | N], + emit_constant_func(G, X#const.id, X#const.val), + gen(G, N, Xs); %% N2 or N? + +gen(G, N, [X|Xs]) when is_record(X, op) -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + + case getNocType(G,X,N) of + transparent -> + emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); + multiple -> + mark_not_transparent(G,N), + emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); + _XTuple -> + mark_not_transparent(G,N), + emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs) + end, + + gen(G, N, Xs); + + +gen(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, fun emit_stub_func/7), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, except) -> + icstruct:except_gen(G, N, X, erlang), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) -> + case may_contain_structs(X) of + true -> icstruct:struct_gen(G, N, X, erlang); + false -> ok + end, + gen(G, N, Xs); + +gen(_G, _N, []) -> ok. + + +may_contain_structs(X) when is_record(X, typedef) -> true; +may_contain_structs(X) when is_record(X, struct) -> true; +may_contain_structs(X) when is_record(X, union) -> true; +may_contain_structs(_X) -> false. + + + +%%-------------------------------------------------------------------- +%% +%% Generate the server side (handle_call and handle_cast) +%% + +gen_serv(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + emit_serv_std(G, N, X), + N2 = [get_id2(X) | N], + gen_calls(G, N2, get_body(X)), + lists:foreach(fun({_Name, Body}) -> + gen_calls(G, N2, Body) end, + X#interface.inherit_body), + get_if_gen(G, N2, X), + gen_end_of_call(G, N, X), % Note N instead of N2 + + gen_casts(G, N2, get_body(X)), + lists:foreach(fun({_Name, Body}) -> + gen_casts(G, N2, Body) end, + X#interface.inherit_body), + gen_end_of_cast(G, N, X), % Note N instead of N2 + emit_skel_footer(G, N, X); % Note N instead of N2 + false -> + ok + end. + +gen_calls(G, N, [X|Xs]) when is_record(X, op) -> + case is_oneway(X) of + false -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), + gen_calls(G, N, Xs); + true -> + gen_calls(G, N, Xs) + end; + +gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, fun emit_skel_func/7), + gen_calls(G, N, Xs); + +gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); +gen_calls(_G, _N, []) -> ok. + +gen_casts(G, N, [X|Xs]) when is_record(X, op) -> + case is_oneway(X) of + true -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), + gen_casts(G, N, Xs); + false -> + gen_casts(G, N, Xs) + end; + +gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); +gen_casts(_G, _N, []) -> ok. + +emit_attr(G, N, X, F) -> + XX = #id_of{type=X}, + {GetType, SetType} = mk_attr_func_types(N, X), + lists:foreach(fun(Id) -> + X2 = XX#id_of{id=Id}, + {Get, Set} = mk_attr_func_names(N, get_id(Id)), + F(G, N, X2, Get, [], GetType, []), + case X#attr.readonly of + {readonly, _} -> ok; + _ -> + F(G, N, X2, Set, [mk_name(G, "Value")], + SetType, []) + end end, ic_forms:get_idlist(X)). + + +extract_info(G, _N, X) when is_record(X, op) -> + Name = get_id2(X), + InArgs = ic:filter_params([in,inout], X#op.params), + OutArgs = ic:filter_params([out,inout], X#op.params), + ArgNames = mk_erl_vars(G, InArgs), + TypeList = {ic_forms:get_tk(X), + map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), + map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) + }, + {Name, ArgNames, TypeList, OutArgs}. + + + + +emit_serv_std(G, N, X) -> + Fd = ic_genobj:stubfiled(G), + case transparent(G) of + true -> + true; + _XTupleORMultiple -> + Impl = getImplMod(G,X,[get_id2(X)|N]), + TypeID = ictk:get_IR_ID(G, N, X), + + nl(Fd), nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Server implementation."]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), + nl(Fd), + emit(Fd, "typeID() ->\n"), + emit(Fd, " \"~s\".\n", [TypeID]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Server creation functions."]), + nl(Fd), + emit(Fd, "oe_create() ->\n"), + emit(Fd, " start([], []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link() ->\n"), + emit(Fd, " start_link([], []).\n", []), + nl(Fd), + emit(Fd, "oe_create(Env) ->\n"), + emit(Fd, " start(Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link(Env) ->\n"), + emit(Fd, " start_link(Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create(Env, RegName) ->\n"), + emit(Fd, " start(RegName, Env, []).\n", []), + nl(Fd), + emit(Fd, "oe_create_link(Env, RegName) ->\n"), + emit(Fd, " start_link(RegName, Env, []).\n", []), + nl(Fd), + ic_codegen:mcomment(Fd, ["Start functions."]), + nl(Fd), + emit(Fd, "start(Env, Opt) ->\n"), + emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start_link(Env, Opt) ->\n"), + emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start(RegName, Env, Opt) ->\n"), + emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), + nl(Fd), + emit(Fd, "start_link(RegName, Env, Opt) ->\n"), + emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), + nl(Fd), + ic_codegen:comment(Fd, "Call to implementation init"), + emit(Fd, "init(Env) ->\n"), + emit(Fd, " ~p:~p(Env).\n", [Impl, init]), + nl(Fd), + emit(Fd, "terminate(Reason, State) ->\n"), + emit(Fd, " ~p:~p(Reason, State).\n", + [Impl, terminate]), + nl(Fd), nl(Fd) + end, + Fd. + + + + +gen_end_of_call(G, _N, _X) -> + case transparent(G) of + true -> + true; + _XTuple -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), + emit(Fd, "handle_call(stop, From, State) ->\n"), + emit(Fd, " {stop, normal, ok, State}"), + case get_opt(G, serv_last_call) of + exception -> + emit(Fd, ";\n"), + nl(Fd), + emit(Fd, "handle_call(Req, From, State) ->\n"), + emit(Fd, " {reply, ~p, State}.\n",[getCallErr()]); + exit -> + emit(Fd, ".\n"), + nl(Fd), + nl(Fd) + end + end, + ok. + + +gen_end_of_cast(G, _N, _X) -> + case transparent(G) of + true -> + true; + _XTuple -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), + emit(Fd, "handle_cast(stop, State) ->\n"), + emit(Fd, " {stop, normal, State}"), + case get_opt(G, serv_last_call) of + exception -> + emit(Fd, ";\n"), + nl(Fd), + emit(Fd, "handle_cast(Req, State) ->\n"), + emit(Fd, " {reply, ~p, State}.\n",[getCastErr()]); + exit -> + emit(Fd, ".\n"), + nl(Fd), nl(Fd) + end + end, + ok. + + +emit_skel_footer(G, N, X) -> + case transparent(G) of + true -> + true; + _XTuple -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), + emit(Fd, "handle_info(X, State) ->\n"), + case use_impl_handle_info(G, N, X) of + true -> + emit(Fd, " ~p:handle_info(X, State).\n\n", + [list_to_atom(ic_genobj:impl(G))]); + false -> + emit(Fd, " {reply, ~p, State}.\n\n",[getInfoErr()]) + end + end, + ok. + + +use_impl_handle_info(G, N, X) -> + FullName = ic_util:to_colon([get_id2(X) | N]), + case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of + {_, force_false} -> false; + {false, false} -> false; + _ -> true + end. + + +use_timeout(G, N, _X) -> + FullName = ic_util:to_colon(N), + case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of + {_, force_false} -> false; + {false, false} -> false; + _ -> true + end. + + +get_if_name(G) -> mk_oe_name(G, "get_interface"). + + +%% Generates the get_interface function (for Lars) +get_if_gen(G, N, X) -> + case transparent(G) of + true -> + ok; + _XTuple -> + case ic_genobj:is_stubfile_open(G) of + true -> + IFC_TKS = tk_interface_data(G,N,X), + Fd = ic_genobj:stubfiled(G), + Name = to_atom(get_if_name(G)), + + ic_codegen:mcomment_light(Fd, + [io_lib:format("Standard Operation: ~p", + [Name])]), + + emit(Fd, "handle_call({~s, ~p, []}, From, State) ->~n", + [mk_name(G, "Ref"), Name]), + + emit(Fd, " {reply, ~p, State};~n", [IFC_TKS]), + nl(Fd), + ok; + + false -> ok + end + end. + + +get_if(G,N,[X|Rest]) when is_record(X, op) -> + R = ic_forms:get_tk(X), + IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, + ic:filter_params([in, inout], X#op.params)), + OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, + ic:filter_params([out, inout], X#op.params)), + case print_tk(G,N,X) of + true -> + [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)]; + false -> + get_if(G,N,Rest) + end; + +get_if(G,N,[X|Rest]) when is_record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<< + {GetT, SetT} = mk_attr_func_types([], X), + AList = lists:map(fun(Id) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + case X#attr.readonly of + {readonly, _} -> + {Get, GetT}; + _ -> + [{Set, SetT}, {Get, GetT}] + end end, ic_forms:get_idlist(X)), + lists:flatten(AList) ++ get_if(G,N,Rest); + +get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest); +get_if(_,_,[]) -> []. + + + + +%%------------------------------------------------------------ +%% +%% Export stuff +%% +%% Gathering of all names that should be exported from a stub +%% file. +%% + + +gen_head_special(G, N, X) when is_record(X, interface) -> + Fd = ic_genobj:stubfiled(G), + NocType = getNocType(G,X,N), + + foreach(fun({Name, Body}) -> + ic_codegen:comment(Fd, "Exports from ~p", + [ic_util:to_colon(Name)]), + ic_codegen:export(Fd, exp_top(G, N, Body, NocType, [])), + nl(Fd) + end, X#interface.inherit_body), + + case transparent(G) of + true -> + nl(Fd), nl(Fd); + _XTuple -> + ic_codegen:comment(Fd, "Type identification function"), + ic_codegen:export(Fd, [{typeID, 0}]), + nl(Fd), + ic_codegen:comment(Fd, "Used to start server"), + ic_codegen:export(Fd, [{start, 2},{start_link, 3}]), + ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, + {oe_create_link, 1},{oe_create, 2}, {oe_create_link, 2}]), + nl(Fd), + ic_codegen:comment(Fd, "gen server export stuff"), + emit(Fd, "-behaviour(gen_server).\n"), + ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, + {handle_cast, 2}, {handle_info, 2}]), + nl(Fd), nl(Fd), + ic_codegen:mcomment(Fd, ["Object interface functions."]), + nl(Fd), nl(Fd), nl(Fd) + end, + Fd; + + +gen_head_special(_G, _N, _X) -> ok. + + + +%% Shall generate all export declarations +gen_head(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + F = ic_genobj:stubfiled(G), + ic_codegen:comment(F, "Interface functions"), + ic_codegen:export(F, exp_top(G, N, X, getNocType(G,X,N), [])), + nl(F), + gen_head_special(G, N, X); + false -> ok + end. + +exp_top(_G, _N, X, _NT, Acc) when element(1, X) == preproc -> + Acc; +exp_top(G, N, L, NT, Acc) when is_list(L) -> + exp_list(G, N, L, NT, Acc); +exp_top(G, N, M, NT, Acc) when is_record(M, module) -> + exp_list(G, N, get_body(M), NT, Acc); +exp_top(G, N, I, NT, Acc) when is_record(I, interface) -> + exp_list(G, N, get_body(I), NT, Acc); +exp_top(G, N, X, NT, Acc) -> + exp3(G, N, X, NT, Acc). + +exp3(_G, _N, C, _NT, Acc) when is_record(C, const) -> + [{get_id(C#const.id), 0} | Acc]; + +exp3(G, N, Op, NocType, Acc) when is_record(Op, op) -> + FuncName = get_id(Op#op.id), + + TA = case use_timeout(G,N,Op) of + true -> + 1; + false -> + 0 + end, + + case NocType of + transparent -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc]; + multiple -> + case getModType(G, Op, N) of + dt -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc]; + do -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc]; + spt -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc]; + spo -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc] + end; + _ -> + Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, + [{FuncName, Arity} | Acc] + end; +exp3(_G, _N, A, _NT, Acc) when is_record(A, attr) -> + lists:foldr(fun(Id, Acc2) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + case A#attr.readonly of + {readonly, _} -> [{Get, 1} | Acc2]; + _ -> [{Get, 1}, {Set, 2} | Acc2] + end end, Acc, ic_forms:get_idlist(A)); + +exp3(_G, _N, _X, _NT, Acc) -> Acc. + +exp_list(G, N, L, NT, OrigAcc) -> + lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L). + + + + +%%------------------------------------------------------------ +%% +%% Emit stuff +%% +%% Low level generation primitives +%% + +emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + StubName = list_to_atom(Name), + This = mk_name(G, "Ref"), + XTuple = getNocType(G,X,N), + CallOrCast = + case is_oneway(X) of + true -> ?CAST; + _ -> ?CALL + end, + + %% Type expand operation on comments + ic_code:type_expand_op(G,N,X,Fd), + + case use_timeout(G,N,X) of + true -> + Timeout = mk_name(G,"Timeout"), + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This, Timeout| ArgNames])]), + emit(Fd, " ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n", + [getImplMod(G,X,N), + CallOrCast, + This, + Timeout, + XTuple, + StubName, + mk_list(ArgNames), + tk_operation_data(G, N, X, TypeList)]); + false -> + emit(Fd, "~p(~s) ->\n", + [StubName, mk_list([This | ArgNames])]), + + emit(Fd, " ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n", + [getImplMod(G,X,N), + CallOrCast, + This, + XTuple, + StubName, + mk_list(ArgNames), + tk_operation_data(G, N, X, TypeList)]) + end + end. + + +emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + OpName = list_to_atom(Name), + + ArgList = case use_timeout(G,N,X) of + true -> + mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]); + false -> + mk_list([mk_name(G,"Ref")|ArgNames]) + end, + + %% Type expand operation on comments + ic_code:type_expand_op(G,N,X,Fd), + + emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), + emit(Fd, " ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList]) + end. + + + + + + +emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) -> + case getNocType(G,X,N) of + transparent -> + true; + multiple -> + true; + XTuple -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + Name = list_to_atom(OpName), + This = mk_name(G, "Ref"), + From = mk_name(G, "From"), + State = mk_name(G, "State"), + + %% Type expand handle operation on comments + ic_code:type_expand_handle_op(G,N,X,Fd), + + case is_oneway(X) of + true -> + emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n", + [This, XTuple, Name, mk_list(ArgNames), State]), + emit(Fd, " ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n", + [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]); + false -> + emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n", + [This, XTuple, Name, mk_list(ArgNames), From, State]), + emit(Fd, " ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n", + [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State]) + end + end + end. + + + +emit_constant_func(G, Id, Val) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + N = list_to_atom(get_id(Id)), + emit_const_comment(G, Fd, Id, N), + emit(Fd, "~p() -> ~p.\n\n", [N, Val]) + end. + + +emit_const_comment(_G, F, _X, Name) -> + ic_codegen:mcomment_light(F, + [io_lib:format("Constant: ~p", [Name])]). + +%%------------------------------------------------------------ +%% +%% Utilities +%% +%% Convenient little go-get functions +%% +%%------------------------------------------------------------ + +%% The automaticly generated get and set operation names for an +%% attribute. +mk_attr_func_names(_Scope, Name) -> + {"_get_" ++ Name, "_set_" ++ Name}. + +%% Returns TK of the Get and Set attribute functions. +mk_attr_func_types(_N, X) -> + TK = ic_forms:get_tk(X), + {{TK, [], []}, {tk_void, [TK], []}}. + + + +%%------------------------------------------------------------ +%% +%% Generation utilities and common stuff +%% +%% Convenient stuff for generation +%% +%%------------------------------------------------------------ + + +%% Input is a list of parameters (in parse form) and output is a list +%% of capitalised variable names. mk_var is in icgen +mk_erl_vars(_G, Params) -> + map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). + + +%% mk_list produces a nice comma separated string of variable names +mk_list([]) -> []; +mk_list([Arg | Args]) -> + Arg ++ mk_list2(Args). +mk_list2([Arg | Args]) -> + ", " ++ Arg ++ mk_list2(Args); +mk_list2([]) -> []. + + +%%------------------------------------------------------------ +%% +%% Parser utilities +%% +%% Called from the yecc parser. Expands the identifier list of an +%% attribute so that the attribute generator never has to handle +%% lists. +%% +%%------------------------------------------------------------ + + +%% Unfold identifier lists or nested lists. Note that many records +%% contain an entry named id that is a list before unfold and a single +%% id afterwards. +unfold(L) when is_list(L) -> + lists:flatten(map(fun(X) -> unfold2(X) end, L)); +unfold(X) -> unfold2(X). + +unfold2(A) when is_record(A, attr) -> + map(fun(Id) -> A#attr{id=Id} end, A#attr.id); +unfold2(M) when is_record(M, member) -> + map(fun(Id) -> M#member{id=Id} end, M#member.id); +unfold2(M) when is_record(M, case_dcl) -> + map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); +unfold2(T) when is_record(T, typedef) -> + map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id ). + + + + + + +%% Export code produce for dependency function +exportDependency(G) -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:export(Fd, [{oe_dependency, 0}]), + nl(Fd). + +%% Code produce for dependency function +genDependency(G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd),nl(Fd), + ic_codegen:comment(Fd, "Idl file dependency list function"), + emit(Fd, "oe_dependency() ->\n", []), + emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). + + + + + +%%%%%% + + +getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName + + %% Get actual pragma appliance scope + SpecScope = getActualScope(G,X,Scope), + + %% The "broker" option is passed + %% only by pragmas, seek for module. + case ic_pragma:getBrokerData(G,X,SpecScope) of + {Module,_Type} -> + Module; + _List -> + element(1,ic_pragma:defaultBrokerData(G)) + end. + + +getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified + OpList = getAllOperationScopes(G,Scope), + getNocType2(G,X,OpList); +getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} + getNocType3(G,X,Scope). + +getNocType2(G,X,List) -> + getNocType2(G,X,List,[]). + +getNocType2(_,_,[],Found) -> + selectTypeFromList(Found); +getNocType2(G,X,[OpScope|OpScopes],Found) -> + getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]). + +getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} + + %% Get actual pragma appliance scope + SpecScope = getActualScope(G,X,Scope), + + %% The "broker" option is passed + %% only by pragmas, seek for type. + case ic_pragma:getBrokerData(G,X,SpecScope) of + {_Module,Type} -> + Type; + List -> + selectTypeFromList(List) %%transparent/multiple + end. + + +getModType(G,X,Scope) -> %% default | specified + + %% Get actual pragma appliance scope + SpecScope = getActualScope(G,X,Scope), + + %% The "broker" option is passed + %% only by pragmas, seek for brokerdata. + case ic_pragma:getBrokerData(G,X,SpecScope) of + {Module,Type} -> + case Module == ic_genobj:impl(G) of + true -> + case Type of + transparent -> + dt; %% default + transparent + _ -> + do %% default + opaque + end; + false -> + case Type of + transparent -> + spt; %% specified + transparent + _ -> + spo %% specified + opaque + end + end; + _List -> + dt + end. + + + +%%%% +%% +%% Returns a list of ALL operation full +%% scoped names local and inherited +%% from other interfaces +%% + +getAllOperationScopes(G,Scope) -> + getOperationScopes(G,Scope) ++ + getInhOperationScopes(G,Scope). + + +getOperationScopes(G,Scope) -> + getOpScopes(G, + Scope, + ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}), + []). + +getOpScopes(_,_,[],OpScopes) -> + OpScopes; +getOpScopes(G,Scope,[[Name]|Names],Found) -> + getOpScopes(G,Scope,Names,[[Name|Scope]|Found]). + + +getInhOperationScopes(G,Scope) -> + getInhOpScopes1(G, + Scope, + ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}), + []). + +getInhOpScopes1(G,_Scope,[],OpScopes) -> + getInhOpScopes2(G,OpScopes); +getInhOpScopes1(G,Scope,[[SC]|SCs],Found) -> + getInhOpScopes1(G,Scope,SCs,[SC|Found]). + + +getInhOpScopes2(G,Scopes) -> + getInhOpScopes2(G,Scopes,[]). + +getInhOpScopes2(_G,[],Found) -> + Found; +getInhOpScopes2(G,[SC|SCs],Found) -> + getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found). + +%% +%% +%%%% + + + +%%%% +%% +%% +%% Seek the actual operation scope : +%% +%% * if the operation is inherited, get the real scope for it +%% +%% * if the operation has a specific pragma, apply the real +%% scope, otherwise return the including scope +%% +getActualScope(G, X, Scope) when is_record(X, op) -> + OpScope = getRealOpScope(G,X,Scope), + case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of + [[]] -> + OpScope; + _ -> + Scope + end; +getActualScope(_G, _X, N) -> + N. + +%% +%% Just seek and return the scope for the operation +%% where it were originaly defined +%% +getRealOpScope(G,X,N) when is_record(X, op) -> + Ptab = ic_genobj:pragmatab(G), + Id = get_id2(X), + + case ets:match(Ptab,{op,Id,N,'_','_'}) of + [[]] -> + [Id|N]; + _ -> + getRealOpScope(G, Ptab, X, N, Id, ets:match(Ptab,{inherits,N,'$1'})) + end; +getRealOpScope(_G,_X,N) -> + N. + +getRealOpScope(_G, _S, _X, N, Id, []) -> + [Id|N]; +getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) -> + case ets:match(S,{op,Id,OS,'_','_'}) of + [[]] -> + [Id|OS]; + _ -> + getRealOpScope(G, S, X, N, Id, OSs) + end. + +selectTypeFromList([]) -> + transparent; +selectTypeFromList([{_,transparent}|Rest]) -> + selectTypeFromList(Rest); +selectTypeFromList([transparent|Rest]) -> + selectTypeFromList(Rest); +selectTypeFromList([_|_Rest]) -> + multiple. + + + +getCallErr() -> + {'ERROR' ,"Bad Operation -- handle call"}. + +getCastErr() -> + {'ERROR' ,"Bad Operation -- handle cast"}. + +getInfoErr() -> + {'ERROR' ,"Bad Operation -- handle info"}. + + + + + + +%% +%% Type code access utilities +%% + +tk_operation_data(G, N, X, TL) -> + case print_tk(G,N,X) of + true -> + TL; + false -> + no_tk + end. + +tk_interface_data(G, N, X) -> + InfoList = + foldr(fun({_Name, Body}, Acc) -> + get_if(G,N,Body)++Acc end, + get_if(G,N,get_body(X)), + X#interface.inherit_body), + case InfoList of + [] -> + no_tk; %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning ! + _ -> + InfoList + end. + + +print_tk(G, N, X) when is_record(X, op)-> %% operation + case getNocType(G,X,N) of + transparent -> + false; + multiple -> + false; + _XTuple -> %%check if there are any USETK pragmas + operation_usetk(G,N,X) + end; +print_tk(_G, _N, _X) -> %% error + false. + + +operation_usetk(G,N,X) -> + PTab = ic_genobj:pragmatab(G), + OTab = ic_genobj:optiontab(G), + OpName = get_id2(X), +% SID = ic_util:to_colon(N), + Res = case use_tk(OTab,[N]) of + {ok,N} -> + true; + false -> + %% Look if there is an operation with that name + %% which can be found in an included file. + case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of + [] -> + false; + ScopeList -> + case use_tk(OTab,ScopeList) of + %% There is an operation with that name, + %% look if it is inherited by interface "N" + {ok,FoundScope} -> + ic_pragma:is_inherited_by(FoundScope,N,PTab); + false -> + false + end + end + end, + Res. + + +use_tk(_,[]) -> + false; +use_tk(OTab,[[Scope]|Scopes]) -> + SID = ic_util:to_colon(Scope), + case ets:match(OTab,{{option,{use_tk,SID}},true}) of + [] -> + case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of + [] -> + use_tk(OTab,Scopes); + _ -> + {ok,Scope} + end; + _ -> + {ok,Scope} + end; +use_tk(OTab,[Scope|Scopes]) -> + SID = ic_util:to_colon(Scope), + case ets:match(OTab,{{option,{use_tk,SID}},true}) of + [] -> + case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of + [] -> + use_tk(OTab,Scopes); + _ -> + {ok,Scope} + end; + _ -> + {ok,Scope} + end. + + + + + +mark_not_transparent(G,N) -> + + %% Mark that there are multiple + %% functions in interface + S = ic_genobj:pragmatab(G), + ets:insert(S,{no_transparent,N}). + + +transparent(G) -> + + S = ic_genobj:pragmatab(G), + case ets:match_object(S,{no_transparent,'$0'}) of + [] -> + true; + _ -> + false + end. + diff --git a/lib/ic/src/ic_options.erl b/lib/ic/src/ic_options.erl new file mode 100644 index 0000000000..8d17fc1753 --- /dev/null +++ b/lib/ic/src/ic_options.erl @@ -0,0 +1,363 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_options). + +-include_lib("ic/src/ic.hrl"). +-include_lib("kernel/include/file.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([defaultBe/0, float_to_version/1, get_opt/2, add_opt/3, + read_cfg/2, which_opts/1, allowed_opt/2]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% +%% Option handling +%% +%% Valid options are: (those with * is NotYetImpl) +%% +%% pedantic - makes the compiler really nitty-gritty about its input +%% +%% Wall - those warning options that we feel an IDL programmer should +%% care about. Not as picky as pedantic +%% +%% warn_multi_mod - warn if several modules are declared in the same +%% IDL file +%% +%% warn_nested_mod - warn if there are nested modules. This is not a +%% problem but it breakes the rule that modules are put into one file +%% each. +%% +%% warn_name_shadow - warn if identifiers are shadow through inherited +%% interfaces. Default is true. +%% +%% warn_quoted_atom - warn if atoms needs quote, this makes Erlang +%% code less nice but is certainly no error. +%% +%% nowarn - suppress all warning messages. Will still output warnings +%% if silent2 option is used +%% +%% always_outargs - force object server implementation return the +%% tuple {RetVal, OutArgs, NewState} even if there are no OutArgs. If +%% this option is not set then such an operation implementation is +%% assumed to return {RetVal, NewState} +%% +%% use_proc_dict - use the process dictionary in the client +%% stubs. This means that client stubs return RetVal instead of {ok, +%% RetVal, OutArgs} and that corba:get_outargs() returns OutArgs. The +%% out arguments are stored with the key '$corba_outargs'. +%% +%% module_group - use the top module as file name for both skeletons +%% and stubs. Default value is false which means that each interface +%% is put in a separate file. +%% +%% skel_module_group - group all interfaces in a module in one +%% skeleton file as opposed to one skeleton file for each +%% interface. Defaults to false. +%% +%% stub_module_group - group all interface stubs from a module in one +%% stub file as opposed to one stub file for each interface. Default +%% is false. +%% +%% *help - prints a small summary of the compiler usage +%% +%% silent - suppresses all messages from the compiler +%% +%% silent2 - suppresses all messages from the compiler and returns all +%% warnings or errors as lists. Returns {ok, WarnList} or {error, +%% WarnList, ErrList} +%% +%% *noexec - runs the compiler but does not open files or write to +%% files. +%% +%% {serv, <ModName>} - sets the name of the implementation skeleton +%% file. This defaults to ModName_skel. +%% +%% {impl, <ModName>} - sets the name of the interface server +%% implementation module name. This defaults to InterfaceName_impl +%% +%% {outdir, Dir} - use Dir as the directory to put all generated +%% files. +%% +%% {servdir, Dir} - put all generated skel files in the directory Dir. +%% +%% {stubdir, Dir} - put all generated stub files in the directory Dir. +%% +%% {this, InterfaceOrOpName} - puts the OE_THIS parameter into the +%% impl. call. This option can be used both on whole interfaces an on +%% distinct operations. Fullscoped names must be used (as in {this, +%% "M1::I1::Op"}). The option can be given in 3 ways: {this, Name} +%% means this will be added to all matching Name or as {{this, Name}, +%% true} or this can explicitly be asked to be left out as in {{this, +%% Name}, false} which enables OE_THIS to be passed to all ops of an +%% interface except those set by the false flag. +%% +%% cfgfile - sets the name of the config file that is read at +%% startup. The order of the different ways to set options is: default +%% setting, configuration file, options given when generator is +%% called. Default name for this file is .ic_config +%% +%% serv_last_call - tells what the last handle_call clause should +%% do. It can have the values exception, which makes the last clause +%% return a CORBA exception and exit which does not generate a last clause +%% (which will make the server crash on an unknown call) +%% +%% +%% -- UNDOCUMENTED -- +%% +%% debug - prints debug information +%% +%% tokens - prints the tokens from the tokenizer and then exit +%% +%% form - prints the form from the parser and then exit +%% +%% tform - form returned from type check +%% +%% time - if true then time is measured during compilation +%% +%% +%%-------------------------------------------------------------------- +allowed_opt(default_opts, _V) -> true; +allowed_opt(debug, V) -> is_bool(V); +allowed_opt(tokens, V) -> is_bool(V); +allowed_opt(form, V) -> is_bool(V); +allowed_opt(tform, V) -> is_bool(V); +allowed_opt(time, V) -> is_bool(V); +allowed_opt(maxerrs, V) -> is_intorinfinity(V); +allowed_opt(maxwarns, V) -> is_intorinfinity(V); +allowed_opt(nowarn, V) -> is_bool(V); +allowed_opt(show_opts, V) -> is_bool(V); + +allowed_opt(help, V) -> is_bool(V); +allowed_opt('Wall', V) -> is_bool(V); +allowed_opt(warn_multi_mod, V) -> is_bool(V); +allowed_opt(warn_quoted_atom, V) -> is_bool(V); +allowed_opt(warn_nested_mod, V) -> is_bool(V); +allowed_opt(warn_name_shadow, V) -> is_bool(V); +allowed_opt(module_group, V) -> is_bool(V); +allowed_opt(skel_module_group, V) -> is_bool(V); +allowed_opt(stub_module_group, V) -> is_bool(V); +allowed_opt(always_outargs, V) -> is_bool(V); +allowed_opt(pedantic, V) -> is_bool(V); +%%allowed_opt(gen_serv, V) -> is_bool(V); +%%allowed_opt(gen_stub, V) -> is_bool(V); +allowed_opt(gen_hrl, V) -> is_bool(V); +allowed_opt(serv_last_call, exception) -> true; +allowed_opt(serv_last_call, exit) -> true; +allowed_opt(silent, V) -> is_bool(V); +allowed_opt(silent2, V) -> is_bool(V); +allowed_opt({serv, _}, _V) -> true; +allowed_opt({impl, _}, _V) -> true; +allowed_opt(outdir, _V) -> true; +allowed_opt(servdir, _V) -> true; +allowed_opt(stubdir, _V) -> true; +allowed_opt(cfgfile, _V) -> true; +allowed_opt(use_preproc, V) -> is_bool(V); +allowed_opt(preproc_cmd, _V) -> true; +allowed_opt(preproc_flags, _V) -> true; +allowed_opt(this, _V) -> true; +allowed_opt({this, _}, V) -> is_bool(V); +allowed_opt(from, _V) -> true; +allowed_opt({from, _}, V) -> is_bool(V); +allowed_opt(handle_info, _V) -> true; +allowed_opt({handle_info, _}, V) -> is_bool(V); +allowed_opt(timeout, _V) -> true; +allowed_opt({timeout, _}, V) -> is_bool(V); +allowed_opt(c_timeout, {V1, V2}) -> is_int(V1) and is_int(V2); +allowed_opt(c_timeout, V) -> is_int(V); +allowed_opt(c_report, V) -> is_bool(V); +allowed_opt(scoped_op_calls, V) -> is_bool(V); +% Compatibility option (semantic check limitation) +allowed_opt(scl, V) -> is_bool(V); +% Added switches for non corba generation +allowed_opt(flags, V) -> is_int(V); +allowed_opt(be, erl_corba) -> true; +allowed_opt(be, erl_template) -> true; +allowed_opt(be, erl_genserv) -> true; +allowed_opt(be, c_genserv) -> true; +allowed_opt(be, erl_plain) -> true; +allowed_opt(be, c_server) -> true; +allowed_opt(be, c_client) -> true; +allowed_opt(be, java) -> true; +% Noc backend +allowed_opt(be, noc) -> true; +allowed_opt({broker,_},{_,transparent}) -> true; +allowed_opt({broker,_},{_,Term}) -> is_term(Term); +allowed_opt({use_tk,_},V) -> is_bool(V); +% +% Multiple be +allowed_opt(multiple_be, _List) -> true; +% +allowed_opt(precond, {_M, _F}) -> true; +allowed_opt({precond, _}, {_M, _F}) -> true; +allowed_opt(postcond, {_M, _F}) -> true; +allowed_opt({postcond, _}, {_M, _F}) -> true; +allowed_opt(no_codechange, V) -> is_bool(V); +allowed_opt(user_protocol, _V) -> true; +allowed_opt(light_ifr, V) -> is_bool(V); +allowed_opt(_, _) -> false. + + +-define(DEFAULTCFGFILE, ".ic_config"). + +which_opts(G) -> + ets:match(G#genobj.options, {{option, '$1'}, '$2'}). + +add_opt(G, KList, Val) when is_list(KList) -> + lists:foreach(fun({K, V}) -> add_opt(G, K, V); + (K) -> add_opt(G, K, Val) end, + KList); + +add_opt(G, servdir, V) -> + do_add_opt(G, servdir, assure_directory(G, ic_util:to_list(V))); +add_opt(G, stubdir, V) -> + do_add_opt(G, stubdir, assure_directory(G, ic_util:to_list(V))); +add_opt(G, K, V) -> + do_add_opt(G, K, V). + + +assure_directory(_G, Dir) -> + Dirs = filename:split(Dir), + check_dirs(Dirs, [], filename:pathtype(Dir)). + +check_dirs([X | Xs], SoFar, Type) -> + New = if SoFar == [], Type /= absolute -> + X; + true -> + filename:join(SoFar, X) + end, + assert_dir(New), + check_dirs(Xs, New, Type); +check_dirs([], SoFar, _Type) -> + SoFar. + +assert_dir(D) -> + case file:read_file_info(D) of + {ok, X} when X#file_info.type == directory -> ok; + _ -> case file:make_dir(D) of + ok -> ok; + _ -> exit({could_not_create, D}) + end + end. + +do_add_opt(G, handle_info, V) -> + ?insert(G#genobj.options, {option, {handle_info, V}}, true); +do_add_opt(G, {handle_info, V}, false) -> + ?insert(G#genobj.options, {option, {handle_info, V}}, force_false); +do_add_opt(G, timeout, V) -> + ?insert(G#genobj.options, {option, {timeout, V}}, true); +do_add_opt(G, {timeout, V}, false) -> + ?insert(G#genobj.options, {option, {timeout, V}}, force_false); +do_add_opt(G, this, V) -> + ?insert(G#genobj.options, {option, {this, V}}, true); +do_add_opt(G, {this, V}, false) -> + ?insert(G#genobj.options, {option, {this, V}}, force_false); +do_add_opt(G, from, V) -> + ?insert(G#genobj.options, {option, {from, V}}, true); +do_add_opt(G, {from, V}, false) -> + ?insert(G#genobj.options, {option, {from, V}}, force_false); +do_add_opt(G, scoped_op_calls, V) when V /= true, V /= false -> + ?insert(G#genobj.options, {option, {scoped_op_calls, V}}, false); +do_add_opt(G, K, V) -> + case allowed_opt(K, V) of + true -> + case expand_opt(K) of + L when is_list(L) -> + add_opt(G, L, V); + _ -> + %%io:format("Add opt: ~p ~p~n", [K, V]), + ?insert(G#genobj.options, {option, K}, V) + end; + _ -> + ic_error:warn(G, {illegal_opt, K}) + end. + +get_opt(G, K) -> + case ets:lookup(G#genobj.options, {option, K}) of + [] -> false; + [{{_, K}, V}] -> V + end. + +expand_opt(pedantic) -> [warn_multi_mod, warn_quoted_atom, always_outargs]; +expand_opt(module_group) -> [skel_module_group, stub_module_group]; +expand_opt('Wall') -> [warn_multi_mod, warn_nested_mod, warn_name_shadow]; +expand_opt(outdir) -> [servdir, stubdir]; +expand_opt(default_opts) -> + ['Wall', gen_hrl, {serv_last_call, exception}, + {outdir, []}, use_preproc, {preproc_cmd, "erl"}, + {preproc_flags, ""}, {maxerrs, 10}, {maxwarns, infinity}]; +%% gcc preproc command {preproc_cmd, "gcc -x c++ -E"} +expand_opt(Opt) -> Opt. + + +%% Use this if user not provide +%% a backend. +defaultBe() -> erl_corba. + + +%% +%% Read any config file +read_cfg(G, Opts) -> + Name = case lists:keysearch(cfgfile, 1, Opts) of + {value, {_, N}} -> ic_util:to_list(N); + _ -> ?DEFAULTCFGFILE + end, + case file:consult(Name) of + {ok, OptList} -> + add_opt(G, OptList, true); + _X when Name == ?DEFAULTCFGFILE -> ok; +%% {error, X} -> +%% ic_error:warn(G, {cfg_open, X, Name}); + X -> ic_error:warn(G, {cfg_open, X, Name}) + end. + + +float_to_version({_,_,Str}) -> Str. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +is_bool(true) -> true; +is_bool(false) -> true; +is_bool(_) -> false. + +is_int(V) when is_integer(V) -> true; +is_int(_) -> false. + +is_intorinfinity(X) when is_integer(X) -> true; +is_intorinfinity(infinity) -> true; +is_intorinfinity(_X) -> false. + + +is_term(Term) when is_tuple(Term) -> true; +is_term(_NoTerm) -> false. + diff --git a/lib/ic/src/ic_plainbe.erl b/lib/ic/src/ic_plainbe.erl new file mode 100644 index 0000000000..7b3e3dc859 --- /dev/null +++ b/lib/ic/src/ic_plainbe.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_plainbe). + + +-export([do_gen/3]). +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ + +-import(ic_util, [mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). +-import(ic_forms, [get_id/1, get_id2/1, get_body/1]). +-import(ic_codegen, [emit/3, nl/1]). + +-import(lists, [foreach/2, map/2]). + +-include("icforms.hrl"). +-include("ic.hrl"). + +%%------------------------------------------------------------ +%% +%% Generate the client side Erlang stubs. +%% +%% Each module is generated to a separate file. +%% +%% Export declarations for all interface functions must be +%% generated. Each function then needs to generate a function head and +%% a body. IDL parameters must be converted into Erlang parameters +%% (variables, capitalised) and a type signature list must be +%% generated (for later encode/decode). +%% +%%------------------------------------------------------------ + + +do_gen(G, File, Form) -> + G2 = ic_file:filename_push(G, [], mk_oe_name(G, + ic_file:remove_ext(to_list(File))), + erlang), + gen_head(G2, [], Form), + exportDependency(G2), + gen(G2, [], Form), + genDependency(G2), + ic_file:filename_pop(G2, erlang), + ok. + + +gen(G, N, [X|Xs]) when is_record(X, preproc) -> + NewG = ic:handle_preproc(G, N, X#preproc.cat, X), + gen(NewG, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, module) -> + CD = ic_code:codeDirective(G,X), + G2 = ic_file:filename_push(G, N, X, CD), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + G3 = ic_file:filename_pop(G2, CD), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, interface) -> + %% Add inheritence data to pragmatab + ic_pragma:add_inh_data(G,N,X), + G2 = ic_file:filename_push(G, N, X, erlang), + N2 = [get_id2(X) | N], + gen_head(G2, N2, X), + gen(G2, N2, get_body(X)), + foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, + X#interface.inherit_body), + G3 = ic_file:filename_pop(G2, erlang), + gen(G3, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, const) -> +% N2 = [get_id2(X) | N], + emit_constant_func(G, X#const.id, X#const.val), + gen(G, N, Xs); %% N or N2? + +gen(G, N, [X|Xs]) when is_record(X, op) -> + {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), + emit_func(G, N, X, Name, ArgNames, TypeList, OutArgs), + gen(G, N, Xs); + + +gen(G, N, [X|Xs]) when is_record(X, attr) -> + emit_attr(G, N, X, fun emit_func/7), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) when is_record(X, except) -> + icstruct:except_gen(G, N, X, erlang), + gen(G, N, Xs); + +gen(G, N, [X|Xs]) -> + case may_contain_structs(X) of + true -> icstruct:struct_gen(G, N, X, erlang); + false -> ok + end, + gen(G, N, Xs); + +gen(_G, _N, []) -> ok. + + +may_contain_structs(X) when is_record(X, typedef) -> true; +may_contain_structs(X) when is_record(X, struct) -> true; +may_contain_structs(X) when is_record(X, union) -> true; +may_contain_structs(_X) -> false. + + +%%------------------------------------------------------------ +%% +%% Export stuff +%% +%% Gathering of all names that should be exported from a stub +%% file. +%% + + +gen_head_special(G, N, X) when is_record(X, interface) -> + Fd = ic_genobj:stubfiled(G), + + foreach(fun({Name, Body}) -> + ic_codegen:comment(Fd, "Exports from ~p", + [ic_util:to_colon(Name)]), + ic_codegen:export(Fd, exp_top(G, N, Body, [])), + nl(Fd) + end, X#interface.inherit_body), + Fd; +gen_head_special(_G, _N, _X) -> ok. + + + +%% Shall generate all export declarations +gen_head(G, N, X) -> + case ic_genobj:is_stubfile_open(G) of + true -> + F = ic_genobj:stubfiled(G), + ic_codegen:comment(F, "Interface functions"), + ic_codegen:export(F, exp_top(G, N, X, [])), + nl(F), + gen_head_special(G, N, X); + false -> ok + end. + +exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> + Acc; +exp_top(G, N, L, Acc) when is_list(L) -> + exp_list(G, N, L, Acc); +exp_top(G, N, M, Acc) when is_record(M, module) -> + exp_list(G, N, get_body(M), Acc); +exp_top(G, N, I, Acc) when is_record(I, interface) -> + exp_list(G, N, get_body(I), Acc); +exp_top(G, N, X, Acc) -> + exp3(G, N, X, Acc). + +exp3(_G, _N, C, Acc) when is_record(C, const) -> + [{get_id(C#const.id), 0} | Acc]; + +exp3(_G, _N, Op, Acc) when is_record(Op, op) -> + FuncName = get_id(Op#op.id), + Arity = length(ic:filter_params([in, inout], Op#op.params)), + [{FuncName, Arity} | Acc]; + +exp3(_G, _N, A, Acc) when is_record(A, attr) -> + lists:foldr(fun(Id, Acc2) -> + {Get, Set} = mk_attr_func_names([], get_id(Id)), + case A#attr.readonly of + {readonly, _} -> [{Get, 1} | Acc2]; + _ -> [{Get, 1}, {Set, 2} | Acc2] + end end, Acc, ic_forms:get_idlist(A)); + +exp3(_G, _N, _X, Acc) -> Acc. + +exp_list(G, N, L, OrigAcc) -> + lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc) end, OrigAcc, L). + + + + +%%------------------------------------------------------------ +%% +%% Emit stuff +%% +%% Low level generation primitives +%% + + +emit_func(G, _N, X, Name, ArgNames, _TypeList, OutArgs) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + OpName = list_to_atom(Name), + ArgList = mk_list(ArgNames), + emit_op_comment(G, Fd, X, OpName, ArgNames, OutArgs), + emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), + emit(Fd, " ~p:~p(~s).\n\n", [to_atom(ic_genobj:impl(G)), OpName, ArgList]) + end. + +emit_attr(G, N, X, F) -> + XX = #id_of{type=X}, + {GetType, SetType} = mk_attr_func_types(N, X), + lists:foreach(fun(Id) -> + X2 = XX#id_of{id=Id}, + {Get, Set} = mk_attr_func_names(N, get_id(Id)), + F(G, N, X2, Get, [], GetType, []), + case X#attr.readonly of + {readonly, _} -> ok; + _ -> + F(G, N, X2, Set, [ic_util:mk_name(G, "Value")], + SetType, []) + end end, ic_forms:get_idlist(X)). + +emit_constant_func(G, Id, Val) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + N = list_to_atom(get_id(Id)), + emit_const_comment(G, Fd, Id, N), + emit(Fd, "~p() -> ~p.\n\n", [N, Val]) + end. + + +emit_const_comment(_G, F, _X, Name) -> + ic_codegen:mcomment_light(F, + [io_lib:format("Constant: ~p", [Name])]). + + +emit_op_comment(G, F, X, Name, InP, OutP) -> + ic_codegen:mcomment_light(F, + [io_lib:format("~s: ~p", [get_title(X), Name]), + "", + get_returns(G, X, InP, OutP) | + get_raises(X)]). + +get_title(X) when is_record(X, attr) -> "Attribute Operation"; +get_title(_X) -> "Operation". + +get_raises(X) when is_record(X, op) -> + if X#op.raises == [] -> []; + true -> + [" Raises: " ++ + mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, X#op.raises))] + end; +get_raises(_X) -> []. + +get_returns(_G, _X, _InP, []) -> + " Returns: RetVal"; +get_returns(G, _X, _InP, OutP) -> + " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). + + + + +%%------------------------------------------------------------ +%% +%% Utilities +%% +%% Convenient little go-get functions +%% +%%------------------------------------------------------------ + +%% The automaticly generated get and set operation names for an +%% attribute. +mk_attr_func_names(_Scope, Name) -> + {"_get_" ++ Name, "_set_" ++ Name}. + +%% Returns TK of the Get and Set attribute functions. +mk_attr_func_types(_N, X) -> + TK = ic_forms:get_tk(X), + {{TK, [], []}, {tk_void, [TK], []}}. + + + +%%------------------------------------------------------------ +%% +%% Generation utilities and common stuff +%% +%% Convenient stuff for generation +%% +%%------------------------------------------------------------ + + +%% Input is a list of parameters (in parse form) and output is a list +%% of capitalised variable names. mk_var is in icgen +mk_erl_vars(_G, Params) -> + map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). + + +%% mk_list produces a nice comma separated string of variable names +mk_list([]) -> []; +mk_list([Arg | Args]) -> + Arg ++ mk_list2(Args). +mk_list2([Arg | Args]) -> + ", " ++ Arg ++ mk_list2(Args); +mk_list2([]) -> []. + + +%%------------------------------------------------------------ +%% +%% Parser utilities +%% +%% Called from the yecc parser. Expands the identifier list of an +%% attribute so that the attribute generator never has to handle +%% lists. +%% +%%------------------------------------------------------------ + + + + +%% Export code produce for dependency function +exportDependency(G) -> + Fd = ic_genobj:stubfiled(G), + ic_codegen:export(Fd, [{oe_dependency, 0}]), + nl(Fd). + +%% Code produce for dependency function +genDependency(G) -> + Fd = ic_genobj:stubfiled(G), + nl(Fd),nl(Fd), + ic_codegen:comment(Fd, "Idl file dependency list function"), + emit(Fd, "oe_dependency() ->\n", []), + emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). + + + + +extract_info(G, _N, X) when is_record(X, op) -> + Name = get_id2(X), + InArgs = ic:filter_params([in,inout], X#op.params), + OutArgs = ic:filter_params([out,inout], X#op.params), + ArgNames = mk_erl_vars(G, InArgs), + TypeList = {ic_forms:get_tk(X), + map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), + map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) + }, + {Name, ArgNames, TypeList, OutArgs}. diff --git a/lib/ic/src/ic_pp.erl b/lib/ic/src/ic_pp.erl new file mode 100644 index 0000000000..db06118d32 --- /dev/null +++ b/lib/ic/src/ic_pp.erl @@ -0,0 +1,2139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_pp). + +-export([run/2]). + +-define(is_number(X), X >= $0, X =< $9). +-define(is_upper(X), X >= $A, X =< $Z). +-define(is_lower(X), X >= $a, X =< $z). +-define(is_underline(X), X == $_). +-define(is_tab(X), X == 9). +-define(is_space(X), X == 32). +-define(tab, 9). +-define(space, 32). + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% Preprocessor +%% +%% This preprocessor is equivalent to the gcc-preprocessor. It takes a file name and +%% a list of preprocessor flags as an input and returns a processed text file. +%% +%% The processing is done in two phases. +%% In the first phase the input file is tokenised into a list where all comments are +%% replaced by a space and all "backslash-newline" sequences are removed. +%% +%% In the second phase all macros are expanded. + +%% %% %% NOTE: #if, #else, and #elif are not yet implemented. +%% Only '#if 0' is implemented to be possible to keep old code as a comment for +%% future refence by putting '#if 0' before it and '#endif' after it. +%% +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== + + +%%====================================================================================== +%% Variables which are used throughout the program: +%% ------------------------------------------------ +%% +%% Command A preprocessor command +%% Current Temporary variable used when tokenising the file +%% Defs The currently valid macro definitions +%% Err The current list of errors = [{file, line number, error text}, ...] +%% File The tokenised file (or what remains of it when expanding the macros) +%% Flags The preprocessor flags +%% FN or FileName Tbe name of the current file +%% IfCou Used for ifdef/ifndef/endif values: check_all | {endif, Endif, IfLine} +%% Endif = number of matching endif's yet to be found +%% Ifline = the line number for the the first found ifdef/ifndef +%% IncDir Directories to be searched for included files +%% IncFile Stack of included files +%% IncLine The line numer of an include +%% L The current line number +%% Name Name of a macro +%% Nl Number of encountered newlines +%% No_of_para Numer of parameters of the currently expanded macro +%% Out The result of the second step +%% Parameters The parameters of the currently expanded macro +%% PrevFile The name of the "parent" file which includes the currently expanded file +%% Rem Remaining of the file currently being expanded +%% Removed The tokens removed, used when removing tokens to the end of a line +%% Result The current result of something +%% SelfRef List of variables which shoud not be expanded at the rescan to avoid +%% endless loops due to self referencing +%% Str Temporary string +%% Text A variable used for string handling, e.g at error handling +%% Tokens Temoprary list when tokenising +%% War The current list of warnings = [{file, line number, warning text}, ...] +%% X Temporary variable used when the value is not important +%% Y Temporary variable used when the value is not important +%% +%%====================================================================================== + + + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% The main entry for the preprocessor +%% +%% +%% Output {ok, Out, War} | {error, Err} +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +run(FileName, Flags) when is_atom(FileName) -> + run(atom_to_list(FileName), Flags); + +run(FileName, Flags) -> + IncDir = include_dir(Flags), + + case catch file:read_file(FileName) of + {ok, Bin} -> + FileList = binary_to_list(Bin), + run(FileList, FileName, IncDir, Flags); + {error, _} -> + Text = "No such file or directory", + {error, [FileName ++ ": " ++ Text]} + end. + + +run(FileList, FileName, IncDir, Flags) -> + %%---------------------------------------------------------- + %% Run the first phase, i.e tokenise the file + %%---------------------------------------------------------- + File = tokenise(FileList, FileName), + + %%---------------------------------------------------------- + %% Run the second phase, i.e expand macros + %%---------------------------------------------------------- + {Out, Err, War, _Defs, IfCou} = expand(File, FileName, IncDir, Flags), + + %%---------------------------------------------------------- + %% Check if all #if #ifdef #ifndef have a matching #endif + %%---------------------------------------------------------- + IfError = case IfCou of + {endif, Endif, IfLine} when Endif > 0 -> + [{FileName, IfLine, "unterminated `#if' conditional"}]; + _ -> + [] + end, + + Err2 = Err++IfError, + + case Err2 of + [] -> + {ok, lists:flatten(lists:reverse(Out)), lists:reverse(War)}; + _ -> + {error, lists:reverse(Err2)} + end. + +%%====================================================================================== +%% The entry for all included files +%% +%% +%% Output {Out, Defs, Err, War} +%%====================================================================================== +run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir) -> + + %%---------------------------------------------------------- + %% Run the first phase, i.e tokenise the file + %%---------------------------------------------------------- + [PrevFile | _T] = IncFile, + {File, FileInfoStart, FileInfoEnd} = + tokenise(FileList, FileName, IncLine, PrevFile), + + %%---------------------------------------------------------- + %% Run the second phase, i.e expand macros + %%---------------------------------------------------------- + + %% Try first pass without file info start/end + {OutT, ErrT, WarT, DefsT, IfCouT} = + expand(File, Defs, Err, War, [FileName|IncFile], IncDir), + + {Out2, Err2, War2, Defs2, IfCou2} = + case only_nls(OutT) of + true -> %% The file is defined before + {["\n"], ErrT, WarT, DefsT, IfCouT}; + false -> %% The file is not defined before, try second pass + expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War, [FileName|IncFile], IncDir) + end, + + %%---------------------------------------------------------- + %% Check if all #if #ifdef #ifndef have a matching #endif + %%---------------------------------------------------------- + IfError = case IfCou2 of + {endif, Endif, IfLine} when Endif > 0 -> + [{FileName, IfLine, "unterminated `#if' conditional"}]; + _ -> + [] + end, + + {Out2, Defs2, Err2++IfError, War2}. + + + +%% Return true if there is no data +%% other than new lines +only_nls([]) -> + true; +only_nls(["\n"|Rem]) -> + only_nls(Rem); +only_nls(["\r","\n"|Rem]) -> + only_nls(Rem); +only_nls([_|_Rem]) -> + false. + + + + + + + + + + +%%=================================================================================== +%%=================================================================================== +%%=================================================================================== +%% Tokenise the file +%% +%% +%% Output: File +%% +%% Description: +%% The input file is tokenised into a list where all comments are replaced +%% by a space and all "backslash-newline" sequences are removed. +%% +%% A file information is added at start and end of an included file to set the +%% current file name and line number. +%% +%% +%% A token consists of: +%% -------------------- +%% +%% {char, Char} special characters like ()[]{},!%& etc +%% {command,Command} a macro command +%% {expanded,Str} an expanded variable, used to prevent infinite loops +%% at self reference +%% {file_info,FI} start and end information of a file +%% FI is a string of the following format: +%% "# Line FileName Int" were Int is +%% 1 if start of an included file, +%% 2 when returning to "parent" file +%% {nl, L} newline +%% {number,Num) variable, a string starting with a number +%% {self_ref,Var} to allow reference to a variable again, used when expanding +%% self refering macros +%% space a space +%% space_exp a space, special notation to prevent not wanted concatination +%% {string, Str} a (tail of a) string constant +%% {string_part, Str} a head of a string constant defined on several consecutive lines +%% {sys_head, Str} (tail of) the file name of included system file +%% {sys_head_part , Str} the file name of included system file +%% {var,Var} variable, a string starting with minuscular or capital letter or +%% an underline +%% +%% Note, comments are not removed within a character or string constant +%% or inside an include-definition where the file name is delimited with < > +%%=================================================================================== +%%=================================================================================== +%%=================================================================================== + +tokenise(File, FileName) -> + {Result, _L} = token(File, 2, [], not_set, 0), + FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 ~p~n",[FileName]))), + FileInfoStart = {file_info, FI_start}, + [FileInfoStart | Result]. + +tokenise(File, FileName, IncLine, PrevFile) -> + {Result, _L} = token(File, 2, [], not_set, 0), + FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 ~p 1~n",[FileName]))), + FileInfoStart = {file_info, FI_start}, + FI_end = lists:reverse(lists:flatten(io_lib:format("# ~p ~p 2~n~n",[IncLine-1,PrevFile]))), + FileInfoEnd = [{file_info, FI_end}], + {Result, FileInfoStart, FileInfoEnd}. +% [FileInfoStart | Result] ++ FileInfoEnd. + + +%%=================================================================================== +%% token(InputFile, L, Result, Gen) +%% Gen information of the first token on the line, default = not_set +%% +%% Output: File +%%=================================================================================== + +%%================================================================== +%% Normal line +%%================================================================== +%%--------------------------------------- +%% All file tokenised +%%--------------------------------------- +token([], L, [{nl,NL}|Result], _Gen, _BsNl) when L == NL+1-> + {lists:reverse([{nl,NL}|Result]), L}; +token([], L, Result, _Gen, _BsNl) -> + {lists:reverse([{nl,L-1}|Result]), L}; + +%%--------------------------------------- +%% String +%%--------------------------------------- +token(File, L, Result, string, BsNl) -> + case token_string(File, []) of + {Rem, Str, nl} -> + Result1 = [{nl, L}, {string,Str} | Result], + token(Rem, L+1, Result1, string, BsNl); + {Rem, Str} -> + token(Rem, L, [{string,Str}|Result], not_set, BsNl) + end; + +token([$"|File], L, Result, Gen, BsNl) -> + case token_string(File, []) of + {Rem, Str, nl} -> + Result1 = [{nl, L}, {string_part,Str} | Result], + token(Rem, L+1, Result1, string, BsNl); + {Rem, Str} -> + token(Rem, L, [{string,Str}|Result], Gen, BsNl) + end; + +%%--------------------------------------- +%% Include with < > +%%--------------------------------------- +token(File, L, Result, include, BsNl) -> + case token_include(File, []) of + {Rem, Str, nl} -> + Result1 = [{nl, L}, {sys_head,Str} | Result], + token(Rem, L+1, Result1, include, BsNl); + {Rem, Str} -> + token(Rem, L, [{sys_head,Str}|Result], not_set, BsNl) + end; + +token([$<|File], L, [space,{command,"include"}|Result], Gen, BsNl) -> + case token_include(File, []) of + {Rem, Str, nl} -> + Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], + token(Rem, L+1,Result1, include, BsNl); + {Rem, Str} -> + Result1 = [{sys_head,Str}, space, {command,"include"} |Result], + token(Rem, L, Result1, Gen, BsNl) + end; +token([$<|File], L, [{command,"include"}|Result], Gen, BsNl) -> + case token_include(File, []) of + {Rem, Str, nl} -> + Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], + token(Rem, L+1,Result1, include, BsNl); + {Rem, Str} -> + Result1 = [{sys_head,Str}, space, {command,"include"} |Result], + token(Rem, L, Result1, Gen, BsNl) + end; + + + + +%%--------------------------------------- +%% CR (just remove these) +%%--------------------------------------- +token([$\r|File], L, Result, Gen, BsNl) -> +% Bs = lists:duplicate(BsNl+1,{nl,L}), + token(File, L, Result, Gen, BsNl); %% Bs or BsNl? + +%%--------------------------------------- +%% Newline +%%--------------------------------------- +token([$\n|File], L, Result, _Gen, BsNl) -> + Bs = lists:duplicate(BsNl+1,{nl,L}), + token(File, L+1, Bs++Result, not_set, 0); + +token([$\\,$\n|File], L, Result, Gen, BsNl) -> + token(File, L, Result, Gen, BsNl+1); + +%%--------------------------------------- +%% Comments +%%--------------------------------------- +token([$/,$/|File], L, Result, not_set, BsNl) -> + Rem = skip_to_nl(File), + token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); +token([$/,$/|File], L, Result, _Gen, BsNl) -> + Rem = skip_to_nl(File), + token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); + +token([$/,$*|File], L, Result, not_set, BsNl) -> + case token_comment(File) of + {Rem, nl} -> + token(Rem, L+1, [{nl, L} | Result], not_set, BsNl); + Rem -> + token(Rem, L, Result, not_set, BsNl) + end; +token([$/,$*|File], L, Result, Gen, BsNl) -> + case token_comment(File) of + {Rem, nl} -> + token(Rem, L+1, [{nl, L}, space | Result], not_set, BsNl); + Rem -> + token(Rem, L, [space|Result], Gen, BsNl) + end; + +%%--------------------------------------- +%% Variable +%%--------------------------------------- +token([X|File], L, Result, Gen, BsNl) when ?is_upper(X) -> + GenNew = case Gen of not_set -> var; _ -> Gen end, + {Rem, Var} = tok_var(File, [X]), + token(Rem, L, [{var,Var}|Result], GenNew, BsNl); +token([X|File], L, Result, Gen, BsNl) when ?is_lower(X) -> + GenNew = case Gen of not_set -> var; _ -> Gen end, + {Rem, Var} = tok_var(File, [X]), + token(Rem, L, [{var,Var}|Result], GenNew, BsNl); +token([X|File], L, Result, Gen, BsNl) when ?is_underline(X) -> + GenNew = case Gen of not_set -> var; _ -> Gen end, + {Rem, Var} = tok_var(File, [X]), + token(Rem, L, [{var,Var}|Result], GenNew, BsNl); + +%%--------------------------------------- +%% Number +%%--------------------------------------- +token([X|File], L, Result, Gen, BsNl) when ?is_number(X) -> + GenNew = case Gen of not_set -> number; _ -> Gen end, + {Rem, Tokens} = tok_number(File, [X]), + token(Rem, L, [{number,Tokens}|Result], GenNew, BsNl); + +%%--------------------------------------- +%% Space +%%--------------------------------------- +token([X|File], L, [Y|Result], Gen, BsNl) when ?is_space(X) -> + case Y of + space -> + Rem = remove_leading_spaces(File), + token(Rem, L, [Y|Result], Gen, BsNl); + {nl,_,_} -> + Rem = remove_leading_spaces(File), + token(Rem, L, Result, Gen, BsNl); + _ -> + Rem = remove_leading_spaces(File), + token(Rem, L, [space, Y |Result], Gen, BsNl) + end; + +token([X|File], L, [Y|Result], Gen, BsNl) when ?is_tab(X) -> + case Y of + space -> + Rem = remove_leading_spaces(File), + token(Rem, L, [Y|Result], Gen, BsNl); + {nl,_,_} -> + Rem = remove_leading_spaces(File), + token(Rem, L, Result, Gen, BsNl); + _ -> + Rem = remove_leading_spaces(File), + token(Rem, L, [space, Y |Result], Gen, BsNl) + end; + +%%--------------------------------------- +%% Command +%%--------------------------------------- +token([$#|File], L, Result, not_set, BsNl) -> + {Rem, Command} = token_pp_com(File), + case catch list_to_integer(Command) of + {'EXIT', _} -> + token(Rem, L, [{command,Command}|Result], not_set, BsNl); + _Int -> + Result1 = [{number,Command}, {command,"line"}| Result], + token(Rem, L, Result1, not_set, BsNl) + end; + +%%--------------------------------------- +%% Char +%%--------------------------------------- +token([X|File], L, Result, Gen, BsNl) -> + GenNew = case Gen of not_set -> char; _ -> Gen end, + token(File, L, [{char,X}|Result], GenNew, BsNl). + + +%%================================================================== +%% Scan to the end of a token +%%================================================================== +%%--------------------------------------- +%% Number +%%--------------------------------------- +tok_number([], Str) -> + {[], lists:reverse(Str)}; +tok_number([X|File], Str) when ?is_upper(X) -> + tok_number(File, [X|Str]); +tok_number([X|File], Str) when ?is_lower(X) -> + tok_number(File, [X|Str]); +tok_number([X|File], Str) when ?is_underline(X) -> + tok_number(File, [X|Str]); +tok_number([X|File], Str) when ?is_number(X) -> + tok_number(File, [X|Str]); +tok_number(File, Str) -> + {File, lists:reverse(Str)}. + + +%%--------------------------------------- +%% Variable +%%--------------------------------------- +tok_var([], Str) -> + {[], lists:reverse(Str)}; +tok_var([X|File], Str) when ?is_upper(X) -> + tok_var(File, [X|Str]); +tok_var([X|File], Str) when ?is_lower(X) -> + tok_var(File, [X|Str]); +tok_var([X|File], Str) when ?is_underline(X) -> + tok_var(File, [X|Str]); +tok_var([X|File], Str) when ?is_number(X) -> + tok_var(File, [X|Str]); +tok_var(File, Str) -> + {File, lists:reverse(Str)}. + + +%%--------------------------------------- +%% Preprocessor command +%%--------------------------------------- +token_pp_com([X|File]) when ?is_upper(X) -> + tok_var(File, [X]); +token_pp_com([X|File]) when ?is_lower(X) -> + tok_var(File, [X]); +token_pp_com([X|File]) when ?is_underline(X) -> + tok_var(File, [X]); +token_pp_com([X|File]) when ?is_number(X) -> + tok_var(File, [X]); +token_pp_com(File) -> + Rem = remove_leading_spaces(File), + {Rem, "null"}. + + + +%%--------------------------------------- +%% Comment +%%--------------------------------------- +token_comment([]) -> + []; +token_comment([$*,$/|File]) -> + File; +token_comment([$\n|File]) -> + {[$/,$*|File], nl}; +token_comment([$\r,$\n|File]) -> + {[$/,$*|File], nl}; +token_comment([$\\,$\n|File]) -> + {[$/,$*|File], nl}; +%token_comment([$\\,$\n|File]) -> +% token_comment(File); +token_comment([_|File]) -> + token_comment(File). + + +%%--------------------------------------- +%% String +%%--------------------------------------- +token_string([], Str) -> + {[], lists:reverse(Str)}; +token_string([$"|File], Str) -> + {File, lists:reverse(Str)}; +token_string([$\n|File], Str) -> + {File, lists:reverse(Str), nl}; +token_string([$\r,$\n|File], Str) -> + {File, lists:reverse(Str), nl}; +token_string([$\\,$\n|File], Str) -> + token_string(File, Str); +token_string([X|File], Str) -> + token_string(File, [X|Str]). + + +%%--------------------------------------- +%% Include +%%--------------------------------------- +token_include([], Str) -> + {[], lists:reverse(Str)}; +token_include([$>|File], Str) -> + {File, lists:reverse(Str)}; +token_include([$\n|File], Str) -> + {File, lists:reverse(Str), nl}; +token_include([$\r,$\n|File], Str) -> + {File, lists:reverse(Str), nl}; +token_include([$\\,$\n|File], Str) -> + token_include(File, Str); +token_include([X|File], Str) -> + token_include(File, [X|Str]). + + + + +%%=================================================================================== +%% detokenise a list of tokens, until next newline +%% +%% Output: a string +%%=================================================================================== +detokenise(Tokens) -> + detokenise(Tokens, []). + +detokenise([], Result) -> + lists:flatten(Result); +detokenise([space], Result) -> + lists:flatten(Result); +detokenise([space_exp], Result) -> + lists:flatten(Result); +detokenise([space|Rem], Result) -> + detokenise(Rem, Result++[?space]); +detokenise([space_exp|Rem], Result) -> + detokenise(Rem, Result++[?space]); +detokenise([nl|Rem], Result) -> + detokenise(Rem, Result++[$\n]); +detokenise([{_, String}|Rem], Result) -> + detokenise(Rem, Result++[String]). + + +detokenise_pragma(Tokens) -> + detokenise_pragma(Tokens, []). + +detokenise_pragma([], Result) -> + lists:flatten(Result); +detokenise_pragma([space], Result) -> + lists:flatten(Result); +detokenise_pragma([space|Rem], Result) -> + detokenise_pragma(Rem, Result++[?space]); +detokenise_pragma([nl|Rem], Result) -> + detokenise_pragma(Rem, Result++[$\n]); +detokenise_pragma([{string, String}|Rem], Result) -> + detokenise_pragma(Rem, Result++[$"|String]++[$"]); +detokenise_pragma([{_, String}|Rem], Result) -> + detokenise_pragma(Rem, Result++[String]). + + + + + + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% Expand macros. +%% +%% +%% Output: A text file +%% +%% Description: Expands all macros. All macro definitions are logged in a list 'Defs' +%% and all found errors and warnings are logged in a list 'Err' and 'War', +%% respectively. +%% +%% When a macro name is found in a source line it is expanded according +%% to the current 'Defs'-list. The macro must agree both to the name +%% and number of parameters, otherwise an error is reported. +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== + + +expand(List, FileName, IncDir, Flags) -> + %% Get all definitions from preprocessor commnads + %% and merge them on top of the file collected. + CLDefs = get_cmd_line_defs(Flags), + expand(List, [], [], CLDefs, [FileName], IncDir, check_all, [], [], 1, FileName). + +expand(List, Defs, Err, War, [FileName|IncFile], IncDir) -> + expand(List, [], [], Defs, [FileName|IncFile], IncDir, check_all, Err, War, 1, FileName). + + +%%======================================================= +%% Main loop for the expansion +%%======================================================= +expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, IfCou, Err, War, _L, _FN) -> +% io:format("~n ===============~n"), +% io:format(" definitions ~p~n",[lists:reverse(Defs)]), +% io:format(" found warnings ~p~n",[lists:reverse(War)]), +% io:format(" found errors ~p~n",[lists:reverse(Err)]), +% io:format(" ===============~n~n~n"), + {Out, Err, War, Defs, IfCou}; + +expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +%%--------------------------------------- +%% Searching for endif, +%% i.e skip all source lines until matching +%% end if is encountered +%%--------------------------------------- +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) + when Command == "ifdef" -> + {_Removed, Rem2, _Nl} = read_to_nl(Rem), + IfCou2 = {endif, Endif+1, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + + +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) + when Command == "ifndef" -> + {_Removed, Rem2, _Nl} = read_to_nl(Rem), + IfCou2 = {endif, Endif+1, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + + +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) + when Command == "if" -> + case pp_command(Command, Rem, Defs, IncDir, Err, War, L, FN) of + {{'if', true}, Rem2, Err2, War2, Nl} -> + IfCou2 = {endif, Endif+1, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); +%% {{'if', false}, Rem2, Err2, War2, Nl} -> Not implemented yet + {{'if', error}, Rem2, Err2, War2, Nl} -> + IfCou2 = {endif, Endif, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN) + end; + +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) + when Command == "endif" -> + {_Removed, Rem2, Nl} = read_to_nl(Rem), + case Endif of + 1 -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + _ -> + IfCou2 = {endif, Endif-1, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L+Nl, FN) + end; + + +expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> + {_Removed, Rem2, _Nl} = read_to_nl(Rem), + IfCou2 = {endif, Endif, IfLine}, + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + +%% Solves a bug when spaces in front of hashmark ! +expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); + +expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); + + +expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> + {_Removed, Rem2, Nl} = read_to_nl(Rem), + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); + + + + + +%%--------------------------------------- +%% Check all tokens +%%--------------------------------------- +expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L+1, FN); + +expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L, FN) -> + case pp_command(Command, Rem, Defs, IncDir, Err, War, L, FN) of + {define, Rem2, Defs2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {undef, Rem2, Defs2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {{include, ok}, FileName, FileCont, Rem2, Nl, Err2, War2} -> + {Out3, Defs3, Err3, War3} = + run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir), + Nls = [], + Out4 = Out3++Nls++Out, + expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, check_all, Err3, War3, L+Nl, FN); + + {{include, error}, Rem2, Nl, Err2, War2} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {{ifdef, true}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + IfCou2 = {endif, 1, L}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); + {{ifdef, false}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {{ifndef, true}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + IfCou2 = {endif, 1, L}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); + {{ifndef, false}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {endif, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {{'if', true}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + IfCou2 = {endif, 1, L}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); +%% {{'if', false}, Removed, Rem2, Nl} -> Not implemented at present + {{'if', error}, Rem2, Err2, War2, Nl} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + + {'else', {_Removed, Rem2, Nl}} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + Err2 = {FN, L, "`else' command is not implemented at present"}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + + {'elif', {_Removed, Rem2, Nl}} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + Err2 = {FN, L, "`elif' command is not implemented at present"}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + + {warning, {WarningText, Rem2, Nl}} -> + [FileName|_More] = IncFile, + War2 = {FileName, L, "warning: #warning "++detokenise(WarningText)}, + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, [War2|War], L+Nl, FN); + + {error, {ErrorText, Rem2, Nl}} -> + [FileName|_More] = IncFile, + Err2 = {FileName, L, detokenise(ErrorText)}, + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + + {{line, ok}, {_Removed, Rem2, Nl}, L2, FN2, LineText} -> + Out2 = lists:duplicate(Nl,$\n)++LineText++Out, + [_X|IF] = IncFile, + IncFile2 = [FN2|IF], + expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, check_all, Err, War, L2, FN2); + {{line, error}, {_Removed, Rem2, Nl}, Err2} -> + Out2 = [lists:duplicate(Nl,$\n)|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + + hash_mark -> + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L, FN); + + {pragma, Rem2, Nl, Text} -> + Out2 = lists:duplicate(Nl,$\n)++Text++Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + + {ident, Rem2, Nl, Text} -> + Out2 = lists:duplicate(Nl,$\n)++Text++Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + + {not_recognised, {Removed, Rem2, Nl}} -> + Text = lists:reverse([$#|Command]), + RemovedS = lists:reverse([?space|detokenise(Removed)]), + Out2 = [$\n|RemovedS]++Text++Out, + case Command of + [X|_T] when ?is_upper(X) -> + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + [X|_T] when ?is_lower(X) -> + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + [X|_T] when ?is_underline(X) -> + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + _ -> + Err2 = {FN, L, "invalid preprocessing directive name"}, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN) + end; + + Else -> +% io:format(" %%%%Else%%%%%% ~p~n",[Else]), + exit(Else) + end; + + +expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + LL = io_lib:format("~p",[L]), + expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + {{Y,M,D},{_H,_Mi,_S}} = calendar:universal_time(), + Date = io_lib:format("\"~s ~p ~p\"",[month(M),D,Y]), + expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + {{_Y,_M,_D},{H,Mi,S}} = calendar:universal_time(), + HS = if H < 10 -> "0"++integer_to_list(H); + true -> integer_to_list(H) + end, + MiS = if Mi < 10 -> "0"++integer_to_list(Mi); + true -> integer_to_list(Mi) + end, + SS = if S < 10 -> "0"++integer_to_list(S); + true -> integer_to_list(S) + end, + Time = io_lib:format("\"~s:~s:~s\"",[HS,MiS,SS]), + expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + IL = io_lib:format("~p",[length(IncFile)-1]), + expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + [BF|_T] = lists:reverse(IncFile), + expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + {Out2, Err2, War2, Rem2, SelfRef2} = + source_line(Var, Rem, SelfRef, Defs, Err, War, L, FN), + expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, IfCou, Err2, War2, L, FN); + +expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + SelfRef2 = lists:delete(Str,SelfRef), + expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + +expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> + {Str2, Rem2, Nl} = expand_string_part([$"|Str], Rem), + expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L+Nl, FN). + + + + + + + + +%%======================================================================== +%% Expand a line starting as a partial string +%%======================================================================== +expand_string_part(Str, File) -> + expand_string_part(File, Str, 0). + +expand_string_part([{string, Str_part} | Rem], Str, Nl) -> + {Str++Str_part++[$"], Rem, Nl}; +expand_string_part([space | Rem], Str, Nl) -> + expand_string_part(Rem, Str, Nl); +expand_string_part([nl| Rem], Str, Nl) -> + expand_string_part(Rem, Str++[$\n], Nl); +expand_string_part([{string_part, Str_part} | Rem], Str, Nl) -> + expand_string_part(Rem, Str++Str_part, Nl). + + + + + +%%======================================================================== +%% Parse and integrate command line macro directives +%% At this momment, only -D and -U are supported (gcc like) +%%======================================================================== + + +%% Collect all command line macro definitions +get_cmd_line_defs(Flags) -> + Adjusted = parse_cmd_line(Flags,[]), + + {_Out, _Err, _War, Defs, _IfCou} = + expand(tokenise(Adjusted,""), + [], + [], + [], + [], + [], + check_all, + [], + [], + 1, + ""), + Defs. + +%% Parse command line macros +parse_cmd_line([],Found) -> + lists:flatten(lists:reverse(Found)); + +parse_cmd_line([45,68|Rest],Found) -> + {Collected,RestCmds} = collect_define(Rest,[]), + parse_cmd_line(RestCmds,[Collected|Found]); + +parse_cmd_line([45,85|Rest],Found) -> + {Collected,RestCmds} = collect_undefine(Rest,[]), + parse_cmd_line(RestCmds,[Collected|Found]); + +parse_cmd_line([_|Rest],Found) -> + parse_cmd_line(Rest,Found). + + +%% Collect defines and translate them +%% into a text format +collect_define([],Found) -> + { "#define "++lists:reverse(Found)++"\n", [] }; +collect_define([32|Rest],Found) -> + { "#define "++lists:reverse(Found)++"\n", Rest }; +collect_define([61|Rest],[]) -> + { "", Rest }; +collect_define([61|Rest],Found) -> + collect_define(Rest,[32|Found]); +collect_define([C|Rest],Found) -> + collect_define(Rest,[C|Found]). + + +%% Collect undefines and translate them +%% into a text format +collect_undefine([],Found) -> + { "#undef "++lists:reverse(Found)++"\n", [] }; +collect_undefine([32|Rest],Found) -> + { "#undef "++lists:reverse(Found)++"\n", Rest }; +collect_undefine([C|Rest],Found) -> + collect_undefine(Rest,[C|Found]). + + + + + + + + + + + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% Read a preprocessor command +%% +%% +%% Output: Depending of the command, typically = {Command, Rem, Err, War, Nl} +%% +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== + +pp_command(Command, [space|File], Defs, IncDir, Err, War, L, FN) -> + pp_command(Command, File, Defs, IncDir, Err, War, L, FN); + +pp_command(Command, File, Defs, IncDir, Err, War, L, FN) -> + + case Command of + %%---------------------------------------- + %% #define + %%---------------------------------------- + "define" -> + case define(File, Err, War, L, FN) of + {error, Rem, Err2, War2, Nl} -> + {define, Rem, Defs, Err2, War2, Nl}; + {warning, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> + case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of + {yes, Defs2} -> + {define, Rem, Defs2, Err2, War2, Nl}; + {no, Defs2} -> + Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), + {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; + {error, Text, Defs2} -> + {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} + end; + {ok, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> + case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of + {yes, Defs2} -> + {define, Rem, Defs2, Err2, War2, Nl}; + {no, Defs2} -> + Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), + {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; + {error, Text, Defs2} -> + {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} + end + end; + + %%---------------------------------------- + %% #undef + %%---------------------------------------- + "undef" -> + case undef(File, Err, War, L, FN) of + {error, Rem, Err2, War2, Nl} -> + {undef, Rem, Defs, Err2, War2, Nl}; + {ok, Rem, Name, Err2, War2, Nl} -> + Defs2 = lists:keydelete(Name, 1, Defs), + {undef, Rem, Defs2, Err2, War2, Nl} + end; + + %%---------------------------------------- + %% #include + %%---------------------------------------- + "include" -> + case include(File, IncDir) of + {error, Rem, Nl, Err2} -> + {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War}; + {error, Rem, Nl, Err2, NameNl} -> + {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War}; + {ok, FileName, FileCont, Rem, Nl} -> + {{include, ok}, FileName, FileCont, Rem, Nl, Err, War} + end; + + %%---------------------------------------- + %% #ifdef + %%---------------------------------------- + "ifdef" -> + case define(File, Err, War, L, FN) of + {error, Rem, Err2, War2, Nl} -> + {{ifdef, false}, Rem, Defs, Err2, War2, Nl}; + {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> + case is_defined_before(Name, No_of_para, Defs) of + yes -> + {{ifdef, false}, Rem, Err2, War2, Nl}; + no -> + {{ifdef, true}, Rem, Err2, War2, Nl} + end; + {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> + case is_defined_before(Name, No_of_para, Defs) of + yes -> + {{ifdef, false}, Rem, Err2, War2, Nl}; + no -> + {{ifdef, true}, Rem, Err2, War2, Nl} + end + end; + + + + %%---------------------------------------- + %% #ifndef + %%---------------------------------------- + "ifndef" -> + case define(File, Err, War, L, FN) of + {error, Rem, Err2, War2, Nl} -> + {{ifndef, false}, Rem, Defs, Err2, War2, Nl}; + {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> + case is_defined_before(Name, No_of_para, Defs) of + yes -> + {{ifndef, true}, Rem, Err2, War2, Nl}; + no -> + {{ifndef, false}, Rem, Err2, War2, Nl} + end; + {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> + case is_defined_before(Name, No_of_para, Defs) of + yes -> + {{ifndef, true}, Rem, Err2, War2, Nl}; + no -> + {{ifndef, false}, Rem, Err2, War2, Nl} + end + end; + + + %%---------------------------------------- + %% #endif + %%---------------------------------------- + "endif" -> + {Removed, Rem, Nl} = read_to_nl(File), + case Removed of + [] -> + {endif, Rem, Err, War, 1}; + _ -> + Text = "ignoring the tail of the line", + {ok, Rem, Err, [{FN, L, Text}|War], Nl} + end; + + + %%---------------------------------------- + %% #if + %%---------------------------------------- + "if" -> + case if_zero(File, Err, War, L, FN) of + {error, Rem2, _Removed, Nl} -> + Err2 = {FN, L, "only '#if 0' is implemented at present"}, + {{'if', error}, Rem2, [Err2 | Err], War, Nl}; + {ok, Rem2, 0, _Removed, Nl} -> + {{'if', true}, Rem2, Err, War, Nl}; + {ok, Rem2, _Num, _Removed, Nl} -> + Err2 = {FN, L, "only '#if 0' is implemented at present"}, + {{'if', error}, Rem2, [Err2 | Err], War, Nl} + end; + + %%---------------------------------------- + %% #else + %%---------------------------------------- + "else" -> + {'else', read_to_nl(File)}; + + %%---------------------------------------- + %% #elif + %%---------------------------------------- + "elif" -> + {'elif', read_to_nl(File)}; + + %%---------------------------------------- + %% #pragma + %%---------------------------------------- + "pragma" -> + {Removed, Rem, Nl} = read_to_nl(File), + {pragma, Rem, Nl, lists:reverse("#pragma " ++ detokenise_pragma(Removed))}; + + %%---------------------------------------- + %% #ident + %%---------------------------------------- + "ident" -> + {Removed, Rem, Nl} = read_to_nl(File), + {ident, Rem, Nl, lists:reverse("#ident " ++ detokenise_pragma(Removed))}; + + %%---------------------------------------- + %% #warning + %%---------------------------------------- + "warning" -> + {warning, read_to_nl(File)}; + + %%---------------------------------------- + %% #error + %%---------------------------------------- + "error" -> + {error, read_to_nl(File)}; + + %%---------------------------------------- + %% #line + %%---------------------------------------- + "line" -> + line(File, L, FN); + + %%---------------------------------------- + %% # + %%---------------------------------------- + "null" -> + hash_mark; + + %%---------------------------------------- + %% not recognised preprocessor commands + %%---------------------------------------- + _Else -> + {not_recognised, read_to_nl(File)} + end. + + + + +%%=============================================================== +%%=============================================================== +%%=============================================================== +%% if +%% +%% Only #if 0 is implemented at the time to be able to use if +%% to comment some code parts. +%%=============================================================== +%%=============================================================== +%%=============================================================== + +if_zero(File, _Err, _War, _L, _FN) -> + case if_zero(File) of + {ok, Remain, Num, Removed, Nl} -> + case catch list_to_integer(Num) of + {'EXIT', _} -> + {Removed2, Rem2, Nl2} = read_to_nl(File), + {error, Rem2, Removed2, Nl2}; + Int -> + {ok, Remain, Int, Removed, Nl} + end; + E -> + E + end. + +if_zero([{number,Num}]) -> + {ok, [], Num, [], 0}; +if_zero([{number,Num}, space]) -> + {ok, [], Num, [], 0}; +if_zero([{number,Num} | Rem]) -> + {Removed, Rem2, Nl} = read_to_nl(Rem), + {ok, Rem2, Num, Removed, Nl}; +%if_zero([{number,Num}, {nl,_X} | Rem]) -> +% {ok, Rem, Num, [], 1}; +if_zero(Rem) -> + {Removed, Rem2, Nl} = read_to_nl(Rem), + {error, Rem2, Removed, Nl}. + + + +%%=============================================================== +%%=============================================================== +%%=============================================================== +%% Define macro +%% +%% Check the syntax of the macro, extract the parameters if any. +%% If valid macro it is added to the Defs-list. +%% If a macro is redefined, a warning will be given, the latest +%% definition is always the valid one. +%%=============================================================== +%%=============================================================== +%%=============================================================== + +define(File, Err, War, L, FN) -> + case define_name(File) of + {ok, Rem, Name, No_of_para, Parameters, Macro, Nl} -> + {ok, Rem, Name, No_of_para, Parameters, Macro, Err, War, Nl}; + {{warning,no_space}, Rem, Name, No_of_para, Parameters, Macro, Nl} -> + Text = lists:flatten(io_lib:format("missing white space after `#define ~s'",[Name])), + {warning, Rem, Name, No_of_para, Parameters, Macro, Err, [{FN, L, Text}|War], Nl}; + {error, invalid_name, Nl} -> + Text = "invalid macro name", + {_Removed, Rem, Nl2} = read_to_nl(File), + {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; + {error, invalid_name, Name, Nl} -> + Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), + {_Removed, Rem, Nl2} = read_to_nl(File), + {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; + {error, illegal_arg} -> + {Removed, Rem, Nl} = read_to_nl(File), + RemovedS = detokenise(Removed), + Text = lists:flatten(io_lib:format("Invalid argument list ~s",[RemovedS])), + {error, Rem, [{FN, L, Text}|Err], War, Nl} + end. + + + +%%=========================================================== +%% Check if valid macro +%%=========================================================== +define_name([]) -> + {warning, no_macro}; +define_name([space]) -> + {warning, no_macro}; +%% Macro with parameters +define_name([{var,Name},{char,$(}|Rem]) -> + case read_para([{char,$(}|Rem]) of + {ok, Rem2, Para, NoOfPara} -> + {Removed, Rem3, _Nl} = read_to_nl(Rem2), + {ok, Rem3, Name, NoOfPara, Para, Removed, 1}; + Error -> + Error + end; +%% Macro without parameters +define_name([{var,Name}]) -> + {ok, [], Name, 0, [], [], 0}; +define_name([{var,Name}, space | Rem]) -> + {Removed, Rem2, Nl} = read_to_nl(Rem), + {ok, Rem2, Name, 0, [], Removed, Nl}; +define_name([{var,Name}, {nl,_X} | Rem]) -> + {ok, Rem, Name, 0, [], [], 1}; +define_name([{var,Name} | Rem]) -> + {Removed, Rem2, Nl} = read_to_nl(Rem), + {{warning,no_space}, Rem2, Name, 0, [], Removed, Nl}; +%% Invalid macro name +define_name([{number, Name} | _Rem]) -> + {error, invalid_name, Name, 0}; +define_name(_Rem) -> + {error, invalid_name, 0}. + + + + + + + +%%=============================================================== +%%=============================================================== +%%=============================================================== +%% Undefine macro +%% +%% If it is a valid undef command the macro name will be deleted +%% from the Defs-list +%%=============================================================== +%%=============================================================== +%%=============================================================== + +undef(File, Err, War, L, FN) -> + case undef(File) of + {ok, Rem, Name, Nl} -> + {ok, Rem, Name, Err, War, Nl}; + {warning, Rem, Name, Nl} -> + Text = "ignoring the tail of the line", + {ok, Rem, Name, Err, [{FN, L, Text}|War], Nl}; + {error, invalid_name} -> + Text = "invalid macro name", + {_Removed, Rem, Nl} = read_to_nl(File), + {error, Rem, [{FN, L, Text}|Err], War, Nl}; + {error, invalid_name, Name} -> + Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), + {_Removed, Rem, Nl} = read_to_nl(File), + {error, Rem, [{FN, L, Text}|Err], War, Nl} + end. + +%%------------------------------------------------- +%% Check if valid macro name +%%------------------------------------------------- +undef([]) -> + {error, invalid_name, []}; +%% Valid name +undef([{var,Name}]) -> + {ok, [], Name, 0}; +undef([{var,Name}, {nl,_X} | Rem]) -> + {ok, Rem, Name, 1}; +undef([{var,Name}, space, {nl,_X} | Rem]) -> + {ok, Rem, Name, 1}; +undef([{var,Name} | Rem]) -> + {_Removed, Rem2, Nl} = read_to_nl(Rem), + {warning, Rem2, Name, Nl}; +%% Invalid macro name +undef([{number, Name} | _Rem]) -> + {error, invalid_name, Name}; +undef(_Rem) -> + {error, invalid_name}. + + + + + + +%%=============================================================== +%%=============================================================== +%%=============================================================== +%% Include macro +%% +%% Read the included file +%%=============================================================== +%%=============================================================== +%%=============================================================== + +include(File, IncDir) -> + case include2(File) of + {ok, FileName, Rem, Nl, FileType} -> + %% The error handling is lite strange just to make it compatible to gcc + case {read_inc_file(FileName, IncDir), Nl, FileType} of + {{ok, FileList, FileNamePath}, _, _} -> + {ok, FileNamePath, FileList, Rem, Nl}; + {{error, Text}, _, own_file} -> + NameNl = count_nl(FileName,0), + Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), + {error, Rem, Nl, Error, NameNl}; + {{error, Text}, 1, sys_file} -> + NameNl = count_nl(FileName,0), + Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), + {error, Rem, Nl, Error, NameNl}; + {{error, _Text}, _, sys_file} -> + {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} + end; + + {error, {_Removed, Rem, Nl}} -> + {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} + end. + +count_nl([],Nl) -> + Nl; +count_nl([$\n|T],Nl) -> + count_nl(T,Nl+1); +count_nl([_H|T],Nl) -> + count_nl(T,Nl). + +%%================================================= +%% Extract the file name from the token list +%%================================================= +include2([space|Rem]) -> + include2(Rem); + +include2([{string, FileName}]) -> + {ok, FileName, [], 1, own_file}; +include2([{string, FileName}, space]) -> + {ok, FileName, [], 1, own_file}; +include2([{string, FileName}, {nl, _X} | Rem]) -> + {ok, FileName, Rem, 1, own_file}; +include2([{string, FileName}, space, {nl, _X} | Rem]) -> + {ok, FileName, Rem, 1, own_file}; +include2([{string, _FileName}, _No_nl | Rem]) -> + {error, read_to_nl(Rem)}; +include2([{string_part, File_part}, {nl, _X} | Rem]) -> + case include_read_string_file_name(File_part++[$\n], Rem, 1) of + {ok, FileName, Rem2, Nl} -> + {ok, FileName, Rem2, Nl, own_file}; + error -> + {error, read_to_nl([{string_part,File_part} | Rem])} + end; +include2([{sys_head, FileName}]) -> + {ok, FileName, [], 1, sys_file}; +include2([{sys_head, FileName}, space]) -> + {ok, FileName, [], 1, sys_file}; +include2([{sys_head, FileName}, {nl, _X} | Rem]) -> + {ok, FileName, Rem, 1, sys_file}; +include2([{sys_head, FileName}, space, {nl, _X} | Rem]) -> + {ok, FileName, Rem, 1, sys_file}; +include2([{sys_head, _FileName}, _No_nl | Rem]) -> + {error, read_to_nl(Rem)}; +include2([{sys_head_part ,File_part}, {nl, _X} | Rem]) -> + case include_read_sys_file_name(File_part++[$\n], Rem, 1) of + {ok, FileName, Rem2, Nl} -> + {ok, FileName, Rem2, Nl, sys_file}; + error -> + {error, read_to_nl([{sys_head_part, File_part} | Rem])} + end; +include2(Rem) -> + {error, read_to_nl(Rem)}. + + + +%%------------------------------------------------- +%% File name framed by " " +%%------------------------------------------------- +include_read_string_file_name(File, [{string, File_part}, {nl,_X} | Rem], Nl) -> + {ok, File++File_part, Rem, Nl+1}; +include_read_string_file_name(File, [{string_part, File_part}, {nl,_X} | Rem], Nl) -> + include_read_string_file_name(File++File_part++[$\n], Rem, Nl+1); +include_read_string_file_name(_File, _X, _Nl) -> + error. + +%%------------------------------------------------- +%% File name framed by < > +%%------------------------------------------------- +include_read_sys_file_name(File, [{sys_head, File_part}, {nl,_X} | Rem], Nl) -> + {ok, File++File_part, Rem, Nl+1}; +include_read_sys_file_name(File, [{sys_head_part, File_part}, {nl,_X} | Rem], Nl) -> + include_read_sys_file_name(File++File_part++[$\n], Rem, Nl+1); +include_read_sys_file_name(_File, _X, _Nl) -> + error. + + + + + + + +%%=============================================================== +%%=============================================================== +%%=============================================================== +%% Line macro +%% +%% The line macro may redefine both the current line number and +%% the current file name: #line ' new_line_nr' 'new_file_name' +%%=============================================================== +%%=============================================================== +%%=============================================================== + +line(File, L, FN) -> + line(File, L, FN, not_defined, not_defined). + + + +line([], L, FN, _Line, _File) -> + {{line, error}, {[],[],0}, {FN,L,"invalid format `#line' directive"}}; + +line([space|Rem], L, FN, Line, File) -> + line(Rem, L, FN, Line, File); + +%%------------------------------ +%% Line number expected +%%------------------------------ +line([{number,Number}|Rem], L, FN, not_defined, File) -> + case catch list_to_integer(Number) of + {'EXIT', _} -> + {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; + Int -> + line(Rem, L, FN, Int, File) + end; +line(Rem, L, FN, not_defined, _File) -> + {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; + +%%------------------------------ +%% File name or newline expected +%%------------------------------ +line([{nl, _NL}|Rem], _L, FN, Line, not_defined) -> + {{line, ok}, {[],Rem,1}, Line, FN, io_lib:format("~n~p ~p #",[FN, Line-1])}; +line([{string,NewFN}|Rem], _L, _FN, Line, not_defined) -> + {{line, ok}, read_to_nl(Rem), Line, NewFN, io_lib:format("~n~p ~p #",[NewFN, Line-1])}; +line(Rem, L, FN, _Line, _File) -> + {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}. + + + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% Source line +%% +%% +%% Output: {Str, Err, War, Rem, SelfRef} +%% +%% Description: The input source line is searched for macros. If a macro is found it +%% is expanded. The result of an expansion is rescanned for more macros. +%% To prevent infinite loops if the macro is self referring +%% an extra token is put into the Rem list. The variable SelfRef +%% contains all the macros which are inhibited to be expanded. +%% A special specae token is also inserted to prevent not wanted +%% concatinations if one of the variables to be concatinated is expanded. +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== + +source_line(Str, Rem, SelfRef, Defs, Err, War, L, FN) -> + {Rem2, Para, No_of_para} = case read_para(Rem) of + {ok, RemT, ParaT, No_of_paraT} -> + {RemT, ParaT, No_of_paraT}; + {error, illegal_arg} -> + {[], [], 0} + end, + + + %%------------------------------------------------- + %% Check if a valid macro + %%------------------------------------------------- + case lists:keysearch(Str, 1, Defs) of + %% a macro without parameters + {value, {Str, 0, _MacroPara, Macro}} -> + case lists:member(Str, SelfRef) of + true -> + {[Str], Err, War, Rem, SelfRef}; + false -> + ExpandedRes2 = sl_mark_expanded(Macro, Str), + {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem], [Str|SelfRef]} + end; + + %% a macro with parameters + {value, {Str, N, _MacroPara, Macro}} when N == No_of_para -> + case lists:member(Str, SelfRef) of + true -> + {[Str], Err, War, Rem, SelfRef}; + false -> + ExpandedRes = sl_macro_expand(Macro, Para, Defs), + ExpandedRes2 = sl_mark_expanded(ExpandedRes, Str), + {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem2], [Str|SelfRef]} + end; + + %% a variable, because it doesn't have any parameters + {value, {Str, _N, _MacroPara, _Macro}} when No_of_para == 0 -> + {Str, Err, War, Rem, SelfRef}; + + %% illegal no of parameters + {value, {Str, N, _MacroPara, _Macro}} when No_of_para < N -> + Text = io_lib:format(" macro `~s' used with just ~p arg",[Str,No_of_para]), + Err2 = {FN, L, lists:flatten(Text)}, + {Str, [Err2|Err], War, Rem, SelfRef}; + {value, {Str, _N, _MacroPara, _Macro}} -> + Text = io_lib:format(" macro `~s' used with too many (~p) args",[Str,No_of_para]), + Err2 = {FN, L, lists:flatten(Text)}, + {Str, [Err2|Err], War, Rem, SelfRef}; + + %% no macro + false -> + {Str, Err, War, Rem, SelfRef} + end. + + + + + +%%================================================= +%% Expand a macro +%%================================================= +sl_macro_expand(Macro, Para, Defs) -> + sl_macro_expand(Macro, Para, Defs, []). + + +%%................... +%% End +%%................... +sl_macro_expand([], _Para, _Defs, Res) -> + lists:reverse(Res); + +%%................... +%% Concatination +%%................... +%% para ## para +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> + Exp = sl_para_para({para, N},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% para## para +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> + Exp = sl_para_para({para, N},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% para ##para +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> + Exp = sl_para_para({para, N},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% para##para +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> + Exp = sl_para_para({para, N},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); + +%% para ## var +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {var, Var}|T], Para, Defs, Res) -> + Exp = sl_para_var({para, N}, {var, Var}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% para## var +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {var, Var} | T], Para, Defs, Res) -> + [{var, VarN}] = lists:nth(N,Para), + sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); +%% para ##var +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> + [{var, VarN}] = lists:nth(N,Para), + sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); +%% para##var +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> + [{var, VarN}] = lists:nth(N,Para), + sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); + +%% var ## para +sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> + Exp = sl_var_para({var, Var},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% var## para +sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> + Exp = sl_var_para({var, Var},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% var ##para +sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> + Exp = sl_var_para({var, Var},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); +%% var##para +sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> + Exp = sl_var_para({var, Var},{para, M}, Para), + sl_macro_expand(Exp++T, Para, Defs, [space |Res]); + +%% expanded ## para +sl_macro_expand([space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> + [{var, VarM}] = lists:nth(M,Para), + sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); +%% expanded## para +sl_macro_expand([{char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> + [{var, VarM}] = lists:nth(M,Para), + sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); +%% expanded ##para +sl_macro_expand([space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> + [{var, VarM}] = lists:nth(M,Para), + sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); +%% expanded##para +sl_macro_expand([{char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> + [{var, VarM}] = lists:nth(M,Para), + sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); + +%% para ## ? +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> + Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), + sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); +%% para## ? +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> + Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), + sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); +%% para ##? +sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> + Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), + sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); +%% para##? +sl_macro_expand([{para, N}, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> + Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), + sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); + +sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, [space|Res]) -> + sl_macro_expand(T, Para, Defs, Res); +sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, [space|Res]) -> + sl_macro_expand(T, Para, Defs, Res); +sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, Res) -> + sl_macro_expand(T, Para, Defs, Res); +sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, Res) -> + sl_macro_expand(T, Para, Defs, Res); + +%%................... +%% Stringification +%%................... +sl_macro_expand([{char,$#}, {para, N}|T], Para, Defs, Res) -> + Nth = lists:nth(N,Para), + Tokens = detokenise(Nth), + sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); +sl_macro_expand([{char,$#}, space, {para, N}|T], Para, Defs, Res) -> + Nth = lists:nth(N,Para), + Tokens = detokenise(Nth), + sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); + +%%................... +%% A parameter +%%................... +sl_macro_expand([{para, N}|T], Para, Defs, Res) -> + Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), + sl_macro_expand(T, Para, Defs, lists:flatten([Reexp|Res])); + +%%................... +%% No parameter +%%................... +sl_macro_expand([H|T], Para, Defs, Res) -> + sl_macro_expand(T, Para, Defs, [H|Res]). + + + +%%------------------------------------------------- +%% Expand parameters +%%------------------------------------------------- +sl_para_para({para, N}, {para, M}, Para) -> + case sl_para_1st(lists:nth(N,Para)) of + {ok, Para1st} -> + Para1st ++ sl_para_2nd(lists:nth(M,Para)); + {exp, Para1st} -> + Para1st ++ sl_para_2nd(lists:nth(M,Para)) ++ [space_exp]; + {space, Para1st} -> + Para1st ++ [space_exp | sl_para_2nd(lists:nth(M,Para))] + end. + + +sl_var_para(Var, {para, M}, Para) -> + [Var|sl_para_2nd(lists:nth(M,Para))]. + + +sl_para_var({para, N}, Var, Para) -> + case sl_para_1st(lists:nth(N,Para)) of + {ok, Para1st} -> + Para1st ++ [Var]; + {exp, Para1st} -> + Para1st ++ [Var | space_exp]; + {space, Para1st} -> + Para1st ++ [space_exp | Var] + end. + + +sl_para_1st([{var, Var}]) -> + {ok,[{expanded,Var}]}; +sl_para_1st([{var, Var}, space]) -> + {ok,[{expanded,Var}]}; +sl_para_1st([{var, Var}, space_exp]) -> + {exp, [{expanded,Var}]}; +sl_para_1st(L) -> + {space, L}. + +sl_para_2nd([{var, Var}]) -> + [{expanded,Var}]; +sl_para_2nd([{var, Var}, space_exp]) -> + [{expanded,Var}]; +sl_para_2nd([space, {var, Var}]) -> + [{expanded,Var}]; +sl_para_2nd([space_exp, {var, Var}]) -> + [{expanded,Var}]; +sl_para_2nd(L) -> + L++[space]. + + + +%%------------------------------------------------- +%% Check if the expansion is a valid macro, +%% do not reexpand if concatination +%%------------------------------------------------- +sl_macro_reexpand([], _Defs, Result) -> + Result; +sl_macro_reexpand([{var,Var}|Rem], Defs, Result) -> + case lists:keysearch(Var, 1, Defs) of + {value, {Var, 0, _MacroPara, Macro}} -> + Rem2 = case Rem of + [space | RemT] -> + [space_exp | RemT]; + _ -> + [space_exp | Rem] + end, + sl_macro_reexpand(Macro++Rem2, Defs, Result); + _ -> + sl_macro_reexpand(Rem, Defs, [{var,Var}|Result]) + end; +sl_macro_reexpand([H|Rem], Defs, Result) -> + sl_macro_reexpand(Rem, Defs, [H|Result]). + + + +%%------------------------------------------------- +%% Self referring macros are marked not be reexpanded +%%------------------------------------------------- +sl_mark_expanded(QQ, Str) -> + sl_mark_expanded(QQ, Str, []). + +sl_mark_expanded([], _Str, Res) -> + lists:reverse(Res); +sl_mark_expanded([H|T], Str, Res) -> + case H of + {_,Str} -> + sl_mark_expanded(T, Str, [{expanded, Str}|Res]); + _ -> + sl_mark_expanded(T, Str, [H|Res]) + end. + + + + + + + + + +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== +%% Misceleaneous functions +%%====================================================================================== +%%====================================================================================== +%%====================================================================================== + + +%%=============================================================== +%% Check the Flags for include directories +%%=============================================================== +include_dir(Flags) when is_list(Flags)-> + include_dir(Flags,[]); +include_dir(_Flags) -> + []. + +include_dir(Flags,IncDir) -> + case string:str(Flags,"-I") of + 0 -> + lists:reverse(IncDir); + X -> + Rem2 = string:sub_string(Flags, X+2), + Rem = string:strip(Rem2, left), + Y = string:str(Rem," "), + case string:str(Rem," ") of + 0 -> + lists:reverse([string:sub_string(Rem, Y+1)|IncDir]); + Y -> + include_dir(string:sub_string(Rem, Y+1), + [string:sub_string(Rem,1,Y-1)|IncDir]) + end + end. + + + +%%=============================================================== +%% Read a included file. Try current dir first then the IncDir list +%%=============================================================== + +read_inc_file(FileName, IncDir) -> + case catch file:read_file(FileName) of + {ok, Bin} -> + FileList = binary_to_list(Bin), + {ok, FileList, FileName}; + {error, _} -> + read_inc_file2(FileName, IncDir) + end. + +read_inc_file2(_FileName, []) -> + {error, "No such file or directory"}; +read_inc_file2(FileName, [D|Rem]) -> + Dir = case lists:last(D) of + $/ -> + D; + _ -> + D++"/" + end, + + case catch file:read_file(Dir++FileName) of + {ok, Bin} -> + FileList = binary_to_list(Bin), + {ok, FileList, Dir++FileName}; + {error, _} -> + read_inc_file2(FileName, Rem) + end. + + + + +%%=============================================================== +%% Read parameters of a macro or a variable in a source line +%%=============================================================== +read_para([{char,$(} | Rem]) -> + read_para(Rem, 1, [], [], 1); +read_para([space,{char,$(} | Rem]) -> + read_para(Rem, 1, [], [], 1); +read_para(_Rem) -> + {ok, [], [], 0}. + + +%% Abrupt end of the list +read_para([], _NoOfParen, _Current, _Para, _NoOfPara) -> + {error, illegal_arg}; +%% All parameters checked +read_para([{char,$)}|Rem], 1, [], Para, NoOfPara) -> + {ok, Rem, lists:reverse(Para), NoOfPara}; +read_para([{char,$)}|Rem], 1, Current, Para, NoOfPara) -> + {ok, Rem, lists:reverse([Current|Para]), NoOfPara}; + +%% Continue reading +read_para([{char,$)}|Rem], NoOfParen, Current, Para, NoOfPara) -> + read_para(Rem, NoOfParen-1, Current++[{char,$)}], Para, NoOfPara); +read_para([{char,$(}|Rem], NoOfParen, Current, Para, NoOfPara) -> + read_para(Rem, NoOfParen+1, Current++[{char,$(}], Para, NoOfPara); +read_para([{char,$,}|Rem], NoOfParen, Current, Para, NoOfPara) when NoOfParen == 1 -> + read_para(Rem, NoOfParen, [], [Current|Para], NoOfPara+1); +read_para([space|Rem], NoOfParen, [], Para, NoOfPara) -> + read_para(Rem, NoOfParen, [], Para, NoOfPara); +read_para([X|Rem], NoOfParen, Current, Para, NoOfPara) -> + read_para(Rem, NoOfParen, Current++[X], Para, NoOfPara). + + + + + + +%%=================================================================================== +%% check if a macro is already defined +%%=================================================================================== +is_define_ok(Name, No_of_para, Parameters, Macro, Defs) -> + + case lists:keysearch(Name, 1, Defs) of + {value, {Name, No_of_para, _MacroPara, Macro}} -> + {yes, Defs}; + {value, _} -> + Defs2 = lists:keydelete(Name, 1, Defs), + NewMacro = is_define_ok_check_para(Parameters, Macro, []), + case is_stringify_ok(NewMacro) of + yes -> + {no, [{Name, No_of_para, Parameters, NewMacro}|Defs2]}; + no -> + ErrorText = "`#' operator is not followed by a macro argument name", + {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs2]} + end; + false -> + NewMacro = is_define_ok_check_para(Parameters, Macro, []), + case is_stringify_ok(NewMacro) of + yes -> + {yes, [{Name, No_of_para, Parameters, NewMacro}|Defs]}; + no -> + ErrorText = "`#' operator is not followed by a macro argument name", + {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs]} + end + end. + +is_define_ok_check_para(_Para, [], Result) -> + lists:reverse(Result); + +is_define_ok_check_para(Para, [H|T], Result) -> + case define_arg_para_number(1, Para, H) of + no_para -> + is_define_ok_check_para(Para, T, [H|Result]); + N -> + is_define_ok_check_para(Para, T, [{para,N}|Result]) + end. + +define_arg_para_number(_N, [], _Current) -> + no_para; +define_arg_para_number(N, [H|_Para], Current) when H == [Current] -> + N; +define_arg_para_number(N, [_H|Para], Current) -> + define_arg_para_number(N+1, Para, Current). + + +is_stringify_ok([]) -> + yes; +is_stringify_ok([{char,$#},{char,$#}|T]) -> + is_stringify_ok(T); +is_stringify_ok([{char,$#},space,{para,_X}|T]) -> + is_stringify_ok(T); +is_stringify_ok([{char,$#},{para,_X}|T]) -> + is_stringify_ok(T); +is_stringify_ok([{char,$#},space,{var,_X}|T]) -> + is_stringify_ok(T); +is_stringify_ok([{char,$#},{var,_X}|T]) -> + is_stringify_ok(T); +is_stringify_ok([{char,$#},space,{nl,_X}|_T]) -> + no; +is_stringify_ok([{char,$#},{nl,_X}|_T]) -> + no; +is_stringify_ok([{char,$#}|_T]) -> + no; +is_stringify_ok([_H|T]) -> + is_stringify_ok(T). + +%%=================================================================================== +%% check if a macro is already defined +%%=================================================================================== +is_defined_before(Name, No_of_para, Defs) -> + case lists:keysearch(Name, 1, Defs) of + {value, {Name, No_of_para, _MacroPara, _Macro}} -> + yes; + {value, _} -> + no; + false -> + no + end. + + + + +%%=================================================================================== +%% read_to_nl(File) +%%=================================================================================== +read_to_nl([space|Rem]) -> + read_to_nl(Rem, [], 1); +read_to_nl(Rem) -> + read_to_nl(Rem, [], 1). + +read_to_nl([], Result, Nl) -> + {lists:reverse(Result), [], Nl}; +read_to_nl([{nl, _N}|Rem], [{string_part,String} | Result], Nl) -> + read_to_nl(Rem, [nl, {string_part,String}|Result], Nl+1); +read_to_nl([{nl, _N}|Rem], [{sys_head_part,String} | Result], Nl) -> + read_to_nl(Rem, [nl, {sys_head_part,String}|Result], Nl+1); +read_to_nl([{nl, _N}|Rem], Result, Nl) -> + {lists:reverse(Result), Rem, Nl}; +read_to_nl([space|Rem], Result, Nl) -> + read_to_nl(Rem, [space|Result], Nl); +read_to_nl([{X,String}|Rem], Result, Nl) -> + read_to_nl(Rem, [{X,String}|Result], Nl). + + + + +%%=========================================================== +%% Read characters until next newline +%%=========================================================== +%read_to_nl2(Str) -> read_to_nl2([],Str). + +%read_to_nl2(Line, []) -> {Line,[]}; +%read_to_nl2(Line, [$\n|Str]) -> {Line, Str}; +%read_to_nl2(Line, [X|Str]) -> read_to_nl2([X|Line], Str). + + + + +%%=========================================================== +%% Remove leading spaces from a list +%%=========================================================== +remove_leading_spaces([?space|List]) -> + remove_leading_spaces(List); +remove_leading_spaces([?tab|List]) -> + remove_leading_spaces(List); +remove_leading_spaces(List) -> + List. + + + + +%%=========================================================== +%% Skip characters until next newline +%%=========================================================== +skip_to_nl([]) -> []; +skip_to_nl([$\n | Str]) -> Str; +skip_to_nl([$\\,$\n | Str]) -> [$/,$/|Str]; +skip_to_nl([_|Str]) -> skip_to_nl(Str). + + + + +month(1) -> "Jan"; +month(2) -> "Feb"; +month(3) -> "Mar"; +month(4) -> "Apr"; +month(5) -> "May"; +month(6) -> "Jun"; +month(7) -> "Jul"; +month(8) -> "Aug"; +month(9) -> "Sep"; +month(10) -> "Oct"; +month(11) -> "Nov"; +month(12) -> "Dec". + + + + diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl new file mode 100644 index 0000000000..9165e3b03b --- /dev/null +++ b/lib/ic/src/ic_pragma.erl @@ -0,0 +1,1957 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ic_pragma). + + +-export([pragma_reg/2,pragma_cover/3]). +-export([pragma_prefix/3,pragma_version/3,pragma_id/3]). +-export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]). +-export([mk_ref/3,get_incl_refs/1,get_local_refs/1]). +-export([get_dependencies/1, add_inh_data/3, preproc/3]). +-export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]). +-export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]). +-export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]). +-export([is_local/2]). + +%% Debug +-export([print_tab/1,slashify/1,is_short/1]). + +-import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]). +-import(string,[tokens/2]). +-import(ets,[insert/2,lookup/2]). + +-import(ic_forms, [get_id2/1, get_body/1, get_line/1]). +-import(ic_util, [to_atom/1]). +-import(ic_genobj, [idlfile/1]). +-import(ic_options, [get_opt/2]). + +-include("icforms.hrl"). +-include("ic.hrl"). + + + + +%% Initialization of the pragma table and +%% start of pragma registration. +%% NOTE : this pragma registration is build +%% as a separate stage under compilation. +%% If it is to be optimised, it should be +%% embodied in one of other compiling stages. +pragma_reg(G,X) -> + S = ic_genobj:pragmatab(G), + init_idlfile(G,S), + init_pragma_status(S), + registerOptions(G,S), + pragma_reg_all(G, S, [], X), + denote_specific_code_opts(G), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + case get_pragma_compilation_status(S) of + true -> + %% Remove ugly pragmas from form + PragmaCleanForm = cleanup(X), + {ok,PragmaCleanForm}; + false -> + ErrorNr = get_pragma_error_nr(S), + %% Just print the number of errors found + case ErrorNr > 1 of + true -> + io:format("There were ~p errors found on file ~p~n", + [ErrorNr,get_idlfile(S)]), + error; + false -> + io:format("There were ~p error found on file ~p~n", + [ErrorNr,get_idlfile(S)]), + error + end + end. + + + +registerOptions(G,S) -> + OptList = ets:tab2list(ic_genobj:optiontab(G)), + registerOptions(G,S,OptList). + + +registerOptions(_G,_S,[]) -> + true; +registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) -> + insert(S, + {codeopt, + reverse(tokens(Scope,":")), + {broker,{Mod,Type}}, + -1, + nil, + nil}), + registerOptions(G,S,Rest); +registerOptions(G,S,[_|Rest]) -> + registerOptions(G,S,Rest). + + +%% Decide if to apply pragmas +%% by checking backend switch +applyPragmasInBe(G) -> + case get_opt(G, be) of + erl_plain -> + false; + _ -> + true + end. + + +%% Decide if the code option directive +%% is allowed to change backend +applyCodeOpt(G) -> + case get_opt(G, be) of + erl_corba -> %% Does not support codeopt + false; + erl_plain -> %% Does not support codeopt + false; + c_native -> %% Does not support codeopt + false; + _ -> + true + end. + + + +%% This removes all pragma records from the form. +%% When debugged, it can be enbodied in pragma_reg_all. +cleanup([],C) -> C; +cleanup([X|Xs],CSF) -> + cleanup(Xs, CSF++cleanup(X)). + +cleanup(X) when is_list(X) -> cleanup(X,[]); +cleanup(X) when is_record(X, preproc) -> [X]; +cleanup(X) when is_record(X, pragma) -> []; +cleanup(X) when is_record(X, op) -> % Clean inside operation parameters + [ X#op{params = cleanup(X#op.params,[])}]; + +cleanup(X) when is_record(X, module) -> % Clean inside module body + [ X#module{body = cleanup(X#module.body,[])}]; + +cleanup(X) when is_record(X, interface) -> % Clean inside interface body + [ X#interface{body = cleanup(X#interface.body,[])}]; + +cleanup(X) when is_record(X, except) -> % Clean inside exception body + [ X#except{body = cleanup(X#except.body,[])}]; + +cleanup(X) when is_record(X, struct) -> % Clean inside struct body + [ X#struct{body = cleanup(X#struct.body,[])}]; + +cleanup(X) when is_record(X, case_dcl) -> % Clean inside union body + [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}]; + +cleanup(X) when is_record(X, union) -> % Clean inside union body + [ X#union{body = cleanup(X#union.body,[])}]; + +cleanup(X) when is_record(X, enum) -> % Clean inside enum body + [ X#enum{body = cleanup(X#enum.body,[])}]; + +cleanup(X) -> [X]. + + + + +%% pragma_reg_all is top level registration for pragmas +pragma_reg_all(_G, _S, _N, []) -> ok; +pragma_reg_all(G, S, N, [X|Xs]) -> + pragma_reg(G, S, N, X), + pragma_reg_all(G, S, N, Xs). + + +%% pragma_reg is top level registration for pragmas +pragma_reg(G, S, N, X) when is_list(X) -> pragma_reg_list(G, S, N, X); +pragma_reg(_G, S, _N, X) when element(1, X) == preproc -> + case X#preproc.aux of + [{_, _, "1"}] -> + IncludeEntryLNr = get_line(X#preproc.id), + IncludeFileName = element(3,element(3,X)), + insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr}); + _Other -> + ok + end, + set_idlfile(S,element(3,element(3,X))); +pragma_reg(G, S, N, X) when element(1, X) == pragma -> + case applyPragmasInBe(G) of + + %% Pragmas are allowed to be + %% applied in this this backend. + true -> + + File = get_idlfile(S), % The current file or an included one. + Type = case idlfile(G) of % Local/Included flag + File -> + local; + _ -> + included + end, + + %% Register pragmas into pragmatab. + case X of + {pragma,{_,LineNr,"prefix"}, _To, _Apply} -> + insert(S,{prefix,X,LineNr,N,File,Type}); + + {pragma,{_,_,"ID"},_,_} -> + pragma_reg_ID(G, S, N, X); + + {pragma,{_,_,"version"},_,_} -> + pragma_reg_version(G, S, N, X ); + + {pragma,{_,_,"CODEOPT"},_,_} -> + pragma_reg_codeOpt(G,S,N,X); + + {pragma,{_,LineNr,BadPragma}, _To, _Apply} -> + io:format("Warning : on file ~p :~n",[get_idlfile(S)]), + io:format(" Unknown pragma directive ~p on line ~p, ignored.~n", + [BadPragma,LineNr]) + end; + + %% Pragmas are not to be applied in + %% this backend, ignore all pragmas. + false -> + true + end, + ok; + +pragma_reg(G, S, N, X) when is_record(X, module) -> + mk_ref(G,[get_id2(X) | N],mod_ref), + mk_file_data(G,X,N,module), + pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); + +pragma_reg(G, S, N, X) when is_record(X, interface) -> + mk_ref(G,[get_id2(X) | N],ifc_ref), + mk_file_data(G,X,N,interface), + pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); + +pragma_reg(G, S, N, X) when is_record(X, op) -> + %% Add operation in table + insert(S,{op, + get_id2(X), + N, + get_idlfile(S), + get_filepath(S)}), + mk_file_data(G,X,N,op), + pragma_reg_all(G, S, N, X#op.params); + +pragma_reg(G, S, N, X) when is_record(X, except) -> + mk_ref(G,[get_id2(X) | N],except_ref), + mk_file_data(G,X,N,except), + pragma_reg_all(G, S, N, X#except.body); + +pragma_reg(G, _S, N, X) when is_record(X, const) -> + mk_ref(G,[get_id2(X) | N],const_ref), + mk_file_data(G,X,N,const); + +pragma_reg(G, _S, N, X) when is_record(X, typedef) -> + XX = #id_of{type=X}, + lists:foreach(fun(Id) -> + mk_ref(G,[get_id2(Id) | N],typedef_ref), + mk_file_data(G,XX#id_of{id=Id},N,typedef) + end, + ic_forms:get_idlist(X)); + +pragma_reg(G, S, N, X) when is_record(X, enum) -> + mk_ref(G,[get_id2(X) | N],enum_ref), + mk_file_data(G,X,N,enum), + pragma_reg_all(G, S, N, X#enum.body); + +pragma_reg(G, S, N, X) when is_record(X, union) -> + mk_ref(G,[get_id2(X) | N],union_ref), + mk_file_data(G,X,N,union), + pragma_reg_all(G, S, N, X#union.body); + +pragma_reg(G, S, N, X) when is_record(X, struct) -> + mk_ref(G,[get_id2(X) | N],struct_ref), + mk_file_data(G,X,N,struct), + pragma_reg_all(G, S, N, X#struct.body); + +pragma_reg(G, _S, N, X) when is_record(X, attr) -> + XX = #id_of{type=X}, + lists:foreach(fun(Id) -> + mk_ref(G,[get_id2(Id) | N],attr_ref), + mk_file_data(G,XX#id_of{id=Id},N,attr) + end, + ic_forms:get_idlist(X)); + +pragma_reg(_G, _S, _N, _X) -> ok. + + + + +pragma_reg_list(_G, _S, _N, []) -> ok; +pragma_reg_list(G, S, N, List ) -> + CurrentFileName = get_idlfile(S), + pragma_reg_list(G, S, N, CurrentFileName, List). + +pragma_reg_list(_G, _S, _N, _CFN, []) -> ok; +pragma_reg_list(G, S, N, CFN, [X | Xs]) -> + case X of + {preproc,_,{_,_,FileName},_} -> + set_idlfile(S,FileName), + pragma_reg(G, S, N, X), + pragma_reg_list(G, S, N, FileName, Xs); + _ -> + pragma_reg(G, S, N, X), + pragma_reg_list(G, S, N, CFN, Xs) + end. + + + + + +pragma_reg_ID(G, S, N, X) -> + {pragma,{_,LineNr,"ID"}, _To, Apply} = X, + + + File = get_idlfile(S), % The current file or an included one. + Type = case idlfile(G) of % Local/Included flag + File -> + local; + _ -> + included + end, + + %% Check if ID is one of the allowed types : + %% * OMG IDL + %% * DCE UUID + %% * LOCAL + case tokens(element(3,Apply),":") of + ["IDL",_,_] -> + insert(S,{id,X,LineNr,N,File,Type}); + ["DCE",_,VSN] -> + case is_short(VSN) of + true -> + insert(S,{id,X,LineNr,N,File,Type}); + false -> + set_compilation_failure(S), + io:format("Error on file ~p :~n",[get_idlfile(S)]), + io:format(" Bad pragma ID ~p on line ~p,~n", + [element(3,Apply),LineNr]), + io:format(" the version part of ID is not a short integer.~n") + end; + ["LOCAL"|_] -> + insert(S,{id,X,LineNr,N,File,Type}); + _ -> + set_compilation_failure(S), + io:format("Error on file ~p :~n",[get_idlfile(S)]), + io:format(" Bad pragma ID ~p on line ~p.~n", + [element(3,Apply),LineNr]) + end. + + + +pragma_reg_version(G, S, N, X) -> + {pragma,{_,LineNr,"version"}, _To, Apply} = X, + + File = get_idlfile(S), % The current file or an included one. + Type = case idlfile(G) of % Local/Included flag + File -> + local; + _ -> + included + end, + + case tokens(Apply,".") of + [Major,Minor] -> + case is_short(Major) and is_short(Minor) of + true -> + insert(S,{version,X,LineNr,N,File,Type}); + false -> + set_compilation_failure(S), + io:format("Error on file ~p :~n",[get_idlfile(S)]), + io:format(" Bad pragma version ~p on line ~p,~n", + [Apply,LineNr]), + io:format(" the version is not valid.~n") + end; + _ -> + set_compilation_failure(S), + io:format("Error on file ~p :~n",[get_idlfile(S)]), + io:format(" Bad pragma version ~p on line ~p,~n", + [Apply,LineNr]), + io:format(" the version is not valid.~n") + end. + + +pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )-> + case applyCodeOpt(G) of + true -> + {_,_,OptionList_str} = Apply, + case list_to_term(OptionList_str) of + error -> + ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr}); + OptionList -> + case lists:keysearch(be,1,OptionList) of + false -> + %% Add the terms of the option list + %% to the compiler option list + applyCodeOpts(G,S,LineNr,OptionList); + {value, {be,Type}} -> + %% If backend is set from user, + %% let the same backend be otherwize + %% set backend by codeOpt directive + case get_opt(G, be) of + false -> + %% Add the terms of the option list + %% to the compiler option list + applyCodeOpts(G,S,LineNr,OptionList); + _ -> + %% Add all the terms of the option list + %% to the compiler option list but the + %% backend option + applyCodeOpts(G, + S, + LineNr, + lists:delete({be,Type},OptionList)) + end + end + end; + false -> + true + end. + + + +applyCodeOpts(_,_,_,[]) -> + true; +applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) -> + ScopedId = reverse(tokens(Scope,":")), + case ets:match(S, + {codeopt,ScopedId, + '$1','$2','_','_'}) of + [] -> + %% Add pragma in table + insert(S, + {codeopt, + ScopedId, + {broker,{M,T}}, + LNr, + get_idlfile(S), + get_filepath(S)}), + %% Continue + applyCodeOpts(G,S,LNr,Xs); + _ -> + %% Use the code option + %% from user and continue + applyCodeOpts(G,S,LNr,Xs) + end; +applyCodeOpts(G,S,LNr,[X|Xs]) -> + case is_allowed_opt(X) of + true -> + %% Add that term of the option list + %% to the compiler option list + ic_options:add_opt(G, [X], true), + %% Continue + applyCodeOpts(G,S,LNr,Xs); + false -> + %% Print warning and continue + io:format("Warning on file ~p :~n",[get_idlfile(S)]), + io:format(" Bad option in pragma : ~p, ignored !~n",[X]), + applyCodeOpts(G,S,LNr,Xs) + end. + + +is_allowed_opt({X,Y}) -> + ic_options:allowed_opt(X,Y); +is_allowed_opt(_X) -> + false. + + + +%% Returns a tuple { PFX, VSN, ID }, that is the +%% pragma prefix, version and id coverages of +%% the scope SCOPE. This is done by use of the +%% function pragma_cover/4. +pragma_cover(G,Scope,Object) -> + pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). + +%% Returns a tuple { PFX, VSN, ID }, that is the +%% pragma prefix, version and id coverages of +%% the scope SCOPE +pragma_cover(PragmaTab,Name,Scope,LineNr) -> + PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr), + VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr), + ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr), + { PFX, VSN, ID }. + + + +%% Finds out which pragma PREFIX that affects +%% the scope Scope +pragma_prefix(G,Scope,Object) -> + pragma_prefix_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). + + +%% Finds out which pragma PREFIX that affects +%% the scope Scope +pragma_prefix_cover(PragmaTab,Name,Scope,LineNr) -> + case lookup(PragmaTab,prefix) of + [] -> + none; + PragmaPrefixList -> + FilteredPragmaPrefixList = + filter_pragma_prefix_list(PragmaTab,Name,Scope,PragmaPrefixList), + case most_local(FilteredPragmaPrefixList,Scope) of + [] -> + none; + MostLocalList -> + case dominant_prefix(MostLocalList,LineNr) of + none -> + none; + + %% Just filter empty pragma prefix + {prefix,{pragma,{_,_,_},_,{'<string_literal>',_,[]}},_,_,_,_} -> + none; + + DP -> + %% Return the scoped id (reversed list of + %% path elements, but remember to remove + %% '[]' that represents the top level + slashify(lists:sublist(Scope, 1, + length(Scope) - length(element(4,DP))) ++ + [ element(3,element(4,element(2,DP)))]) + end + end + end. + + +%% Returns a slashified name, [I1, M1] becomes "M1/I1" +slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, + hd(List), tl(List)). + + +%% Finds out which pragma VERSION that affects +%% the scope Scope +pragma_version(G,Scope,Object) -> + pragma_version_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). + +%% Finds out which pragma VERSION that affects +%% the scope Scope +pragma_version_cover(PragmaTab,Name,Scope,LineNr) -> + case lookup(PragmaTab,version) of + [] -> + default_version(); + PragmaVersionList -> + case all_actual_for_version_or_id( PragmaVersionList, Name ) of + [] -> + default_version(); + ActualVersionList -> + case most_local(ActualVersionList,Scope) of + [] -> + default_version(); + MostLocalList -> + case dominant_version(MostLocalList,LineNr) of + DV -> + element(4,element(2,DV)) + end + end + end + end. + + +default_version() -> "1.0". + + + +%% Finds out which pragma ID that affects +%% the scope Scope +pragma_id(G,Scope,Object) -> + pragma_id_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). + +%% Finds out which pragma ID that affects +%% the scope Scope +pragma_id_cover(PragmaTab,Name,Scope,LineNr) -> + case lookup(PragmaTab,id) of + [] -> + none; + PragmaIdList -> + case all_actual_for_version_or_id( PragmaIdList, Name ) of + [] -> + none; + ActualIdList -> + case most_local(ActualIdList,Scope) of + [] -> + none; + MostLocalList -> + case dominant_id(MostLocalList,LineNr) of + PI -> + element(3,element(4,element(2,PI))) + end + end + end + end. + + + + +%% Finds out which pragma VERSION ( or ID ) that +%% that affects the scope object with name NAME +all_actual_for_version_or_id(NList, Name) -> + all_actual_for_version_or_id( NList, [], Name ). + +all_actual_for_version_or_id([], Actual, _) -> + Actual; +all_actual_for_version_or_id([First|Rest], Found, Name) -> + case is_actual_for_version_or_id(First,Name) of + true -> + all_actual_for_version_or_id(Rest, [First|Found], Name); + false -> + all_actual_for_version_or_id(Rest, Found, Name) + end. + +is_actual_for_version_or_id( Current, Name ) -> + case element(3,element(3,element(2,Current))) of + Name -> + true; + OtherName -> + suffix([Name],tokens(OtherName,"::")) + end. + + + + +%% Find the most locally defind pragmas +%% to the scope SCOPE +most_local( SList, Scope ) -> + case SList of + [] -> + []; + [First|Rest] -> + case suffix( element(4,First), Scope ) of + true -> + most_local( Rest, First, Scope, [First] ); + false -> + most_local( Rest, Scope ) + end + end. + +%% Returns a list of all pragmas found in the +%% same scope. Should choose the right one by looking +%% att the position of the pragma in relation to +%% the current object..... ( For hairy cases ). +most_local( SList, Current, Scope, AllFound ) -> + case SList of + [] -> + AllFound; + [First|Rest] -> + FirstScope = element(4,First), + case suffix( FirstScope, Scope ) of + true -> + CurrentScope = element(4,Current), + case suffix( CurrentScope, FirstScope ) of + true -> + case length( CurrentScope ) == length( FirstScope ) of + true -> %% SAME SCOPE ! KEEP BOTH + most_local( Rest, Current, Scope, [First|AllFound] ); + false -> + most_local( Rest, First, Scope, [First] ) + end; + false -> + most_local( Rest, Current, Scope, AllFound ) + end; + false -> + most_local( Rest, Current, Scope, AllFound ) + end + end. + + + + +%% Find the most dominant prefix pragmas +%% located onto the SAME scope. Now +%% we look att the line number, the position +%% on the file. +dominant_prefix(SList,LineNr) -> + case SList of + [First|Rest] -> + dominant_prefix(Rest,First,LineNr) + end. + + +dominant_prefix([],{prefix,X,PLNr,N,F,T},LineNr) -> + case LineNr > PLNr of + true -> + {prefix,X,PLNr,N,F,T}; + false -> + none + end; +dominant_prefix([{prefix,FX,FPLNr,FN,F1,T1}|Rest],{prefix,CX,CPLNr,CN,F2,T2},LineNr) -> + case LineNr > FPLNr of % Check if FIRST before the object + true -> + case FPLNr > CPLNr of % Check if FIRST after CURRENT + true -> + dominant_prefix(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); + false -> + dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) + end; + false -> % FIRST does not affect the object + dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) + end. + + + + +%% Find the most dominant version pragmas +%% located onto the SAME scope. Now +%% we look att the line number, the position +%% on the file. +dominant_version(SList,LineNr) -> + case SList of + [First|Rest] -> + dominant_version(Rest,First,LineNr) + end. + + +dominant_version([],Current,_) -> Current; +dominant_version([{version,FX,FPLNr,FN,F1,T1}|Rest],{version,CX,CPLNr,CN,F2,T2},LineNr) -> + case FPLNr > CPLNr of % Check if FIRST after CURRENT + true -> + dominant_version(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); + false -> + dominant_version(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) + end. + + + + +%% Find the most dominant id pragmas +%% located onto the SAME scope. Now +%% we look att the line number, the position +%% on the file. +dominant_id(SList,LineNr) -> + case SList of + [First|Rest] -> + dominant_id(Rest,First,LineNr) + end. + + +dominant_id([],Current,_) -> Current; +dominant_id([{id,FX,FPLNr,FN,F1,T1}|Rest],{id,CX,CPLNr,CN,F2,T2},LineNr) -> + case FPLNr > CPLNr of % Check if FIRST after CURRENT + true -> + dominant_id(Rest,{id,FX,FPLNr,FN,F1,T1},LineNr); + false -> + dominant_id(Rest,{id,CX,CPLNr,CN,F2,T2},LineNr) + end. + + + + + +%% This registers a module defined inside the file or +%% an included file. A tuple that describes the module +%% is added to the table. +%% Observe that the modules registered are ONLY those +%% who are in the top level, not definedd inside others ! +mk_ref(G,Name,Type) -> + case length(Name) > 1 of + true -> %% The interface is NOT defined att top level + true; + false -> + S = ic_genobj:pragmatab(G), + File = get_idlfile(S), % The current file or an included one. + case idlfile(G) of % The current file to be compiled. + File -> + insert(S,{Type,Name,File,local}); + _ -> + insert(S,{Type,Name,File,included}) + end + end. + + +%% The same as mk_ref/3 but this registers everything with +%% all vital information available inside files. +%% Registers ESSENTIAL data for included files +mk_file_data(G,X,Scope,Type) -> + S = ic_genobj:pragmatab(G), + Name = get_id2(X), + PreprocFile = get_idlfile(S), % The current file or an included one. + CompFile = idlfile(G), % The current file compiled + Depth = length(Scope), % The depth of the scope + ScopedName = ic_util:to_undersc([Name|Scope]), + Line = ic_forms:get_line(X), + case PreprocFile of + CompFile -> + insert(S,{file_data_local,CompFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}); + PreprocFile -> + insert(S,{file_data_included,PreprocFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}) + end. + + + +%% Return a list with all the headers from +%% the local file that represent the module +%% or interface that is preciding the current +get_local_c_headers(G,X) -> + S = ic_genobj:pragmatab(G), + Local = lookup(S,file_data_local), + FoundLocal = get_local_c_headers(X,Local,Local), + no_doubles(FoundLocal). + +get_local_c_headers(X,Local,Local) -> + get_local_c_headers(X,Local,Local,[]). + +get_local_c_headers(_X,[],_All,Found) -> + Found; +get_local_c_headers(X,[{file_data_local,_PF_idl,_,module,_,_,SN,_,Line}|Hs],All,Found)-> + case ic_forms:get_line(X) > Line of + true -> + get_local_c_headers(X,Hs,All,[SN|Found]); + false -> + get_local_c_headers(X,Hs,All,Found) + end; +get_local_c_headers(X,[{file_data_local,_PF_idl,_,interface,_,_,SN,_,Line}|Hs],All,Found)-> + case ic_forms:get_line(X) > Line of + true -> + get_local_c_headers(X,Hs,All,[SN|Found]); + false -> + get_local_c_headers(X,Hs,All,Found) + end; +get_local_c_headers(X,[_|Hs],All,Found) -> + get_local_c_headers(X,Hs,All,Found). + + + +%% Return a list with all the headers from +%% the included file that represent the module +%% or interface that have to be included +get_included_c_headers(G) -> + S = ic_genobj:pragmatab(G), + Included = lookup(S,file_data_included), + FoundIncluded = get_included_c_headers(Included,Included), + no_doubles(FoundIncluded). + +get_included_c_headers(Included,Included) -> + get_included_c_headers(Included,Included,[]). + +get_included_c_headers([],_All,Found) -> + Found; +get_included_c_headers([{file_data_included,PF_idl,_CF_idl,T,_S,_N,SN,0,_}|Hs],All,Found) -> + Len = length(PF_idl), + FN = string:sub_string(PF_idl,1,Len-4), + case only_top_level(PF_idl,All) of + true -> + %% + L = string:tokens(FN,"/"), + FN2 = lists:last(L), + %% + get_included_c_headers(Hs,All,["oe_"++FN2|Found]); + false -> + case T of + module -> + case contains_interface(PF_idl,All) of + true -> + %% + L = string:tokens(FN,"/"), + FN2 = lists:last(L), + %% + get_included_c_headers(Hs,All,["oe_"++FN2|Found]); + false -> + get_included_c_headers(Hs,All,[SN|Found]) + end; + interface -> + case contains_interface(PF_idl,All) of + true -> + %% + L = string:tokens(FN,"/"), + FN2 = lists:last(L), + %% + get_included_c_headers(Hs,All,["oe_"++FN2|Found]); + false -> + get_included_c_headers(Hs,All,[SN|Found]) + end; + _ -> + get_included_c_headers(Hs,All,["oe_"++FN|Found]) + end + end; +get_included_c_headers([{file_data_included,_PF_idl,_,module,_,_,SN,_,_}|Hs],All,Found)-> + get_included_c_headers(Hs,All,[SN|Found]); +get_included_c_headers([{file_data_included,_PF_idl,_,interface,_,_,SN,_,_}|Hs],All,Found)-> + get_included_c_headers(Hs,All,[SN|Found]); +get_included_c_headers([_|Hs],All,Found) -> + get_included_c_headers(Hs,All,Found). + +%% Help functions for the above + +only_top_level(_PF_idl,[]) -> + true; +only_top_level(PF_idl,[H|Hs]) -> + case element(2,H) of + PF_idl -> + case element(8,H) > 0 of + true -> + false; + false -> + only_top_level(PF_idl,Hs) + end; + _ -> + only_top_level(PF_idl,Hs) + end. + +contains_interface(_PF_idl,[]) -> + false; +contains_interface(PF_idl,[H|Hs]) -> + case element(2,H) of + PF_idl -> + case element(4,H) of + interface -> + case element(8,H) > 0 of + true -> + true; + false -> + contains_interface(PF_idl,Hs) + end; + _ -> + contains_interface(PF_idl,Hs) + end; + _ -> + contains_interface(PF_idl,Hs) + end. + + + +%% This returns a list of everything defined in an included file. +get_incl_refs(G) -> + S = ic_genobj:pragmatab(G), + + RefList = + ets:match(S,{mod_ref,'$0','_',included}) ++ + ets:match(S,{ifc_ref,'$0','_',included}) ++ + ets:match(S,{const_ref,'$0','_',included}) ++ + ets:match(S,{typedef_ref,'$0','_',included}) ++ + ets:match(S,{except_ref,'$0','_',included}) ++ + ets:match(S,{struct_ref,'$0','_',included}) ++ + ets:match(S,{union_ref,'$0','_',included}) ++ + ets:match(S,{enum_ref,'$0','_',included}) ++ + ets:match(S,{attr_ref,'$0','_',included}), + + case RefList of + [] -> + none; + _ -> + RefList + end. + + + +%% This returns a list of everything locally defined. +get_local_refs(G) -> + S = ic_genobj:pragmatab(G), + + RefList = + ets:match(S,{mod_ref,'$0','_',local}) ++ + ets:match(S,{ifc_ref,'$0','_',local}) ++ + ets:match(S,{const_ref,'$0','_',local}) ++ + ets:match(S,{typedef_ref,'$0','_',local}) ++ + ets:match(S,{except_ref,'$0','_',local}) ++ + ets:match(S,{struct_ref,'$0','_',local}) ++ + ets:match(S,{union_ref,'$0','_',local}) ++ + ets:match(S,{enum_ref,'$0','_',local}) ++ + ets:match(S,{attr_ref,'$0','_',local}), + + case RefList of + [] -> + none; + _ -> + RefList + end. + + + + + +%% This is intented to be used for solving the identification +%% problem introduced by pragmas. It creates aliases between +%% scoped and "final" identities. +mk_alias(G,PragmaId,ScopedId) -> + %io:format("~nMaking alias -> ~p~n",[PragmaId]), + S = ic_genobj:pragmatab(G), + insert(S,{alias,ScopedId,PragmaId}). + + +%% This is used to find out if the object described with +%% the scoped id is created. If this is the case, it should +%% be registered as an alias and the identity of the object +%% is returned. Otherwize "none" is returned. +get_alias(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + case ets:match(S,{alias,ScopedId,'$1'}) of + [] -> + none; + [[IfrId]] -> + %io:format("~nFound alias -> ~p~n",[IfrId]), + IfrId + end. + + + +%% Returns the alias id or constructs an id +scope2id(G,ScopedId) -> + case get_alias(G,ScopedId) of + none -> + case is_included(G,ScopedId) of + true -> %% File included + get_included_IR_ID(G,ScopedId); + false -> %% File local + NewIfrId = mk_id(ScopedId), % Create a "standard" id + mk_alias(G,NewIfrId,ScopedId), % Create an alias + NewIfrId + end; + IfrId -> + IfrId + end. + + + + +is_included(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + Name = ic_util:to_undersc(ScopedId), + case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of + [[]] -> + true; + _ -> + false + end. + + + +get_included_IR_ID(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + ScopedName = ic_util:to_undersc(ScopedId), + [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}), + {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr), + case Id of + none -> + case Prefix of + none -> + IR_ID = + lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])), + ic_pragma:mk_alias(G,IR_ID,ScopedId), + IR_ID; + _ -> + IR_ID = + lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])), + ic_pragma:mk_alias(G,IR_ID,ScopedId), + IR_ID + end; + _ -> + ic_pragma:mk_alias(G,Id,ScopedId), + Id + end. + + + + + +%% Returns the scope for object +id2scope(G,IfrId) -> + S = ic_genobj:pragmatab(G), + case lookup(S,alias) of + [] -> + mk_scope(IfrId); + AliasList -> + case keysearch(IfrId,3,AliasList) of + false -> + mk_scope(IfrId); + {value,{alias,ScopedId,_}} -> + ScopedId + end + end. + +%% Returns a "standard" IDL ID by getting the scope list +mk_id(ScopedId) -> + "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version(). + +%% Returns the scope of an object when getting a "standard" IDL ID +mk_scope(IfrId) -> + [_,Body,_] = tokens(IfrId,":"), + reverse(tokens(Body,"/")). + + + +%% This is used to note the exact compiled file +%% under pragma creation. There are two options, the +%% main file or files included by the main file. This +%% just denotes the CURRENT file, the main file or +%% the included ones. A very usual field is the file +%% path that shows the include path of the file + +init_idlfile(G,S) -> + IdlFile = idlfile(G), + insert(S,{file,IdlFile,[]}). + +set_idlfile(S,FileName) -> + FilePath = get_filepath(S), + case FilePath of + [] -> + ets:delete(S,file), + insert(S,{file,FileName,[FileName|FilePath]}); + _ -> + case hd(FilePath) of + [] -> + ets:delete(S,file), + insert(S,{file,FileName,[FileName|FilePath]}); + _ -> + case tl(FilePath) of + [] -> + ets:delete(S,file), + insert(S,{file,FileName,[FileName|FilePath]}); + _ -> + case hd(tl(FilePath)) of + [] -> + ets:delete(S,file), + insert(S,{file,FileName,[FileName|FilePath]}); + FileName -> + ets:delete(S,file), + insert(S,{dependency,FilePath}), % Add dependency branch + insert(S,{file,FileName,tl(FilePath)}); + _ -> + ets:delete(S,file), + insert(S,{file,FileName,[FileName|FilePath]}) + end + end + end + end. + +get_idlfile(S) -> + [FT] = lookup(S,file), + element(2,FT). + +get_filepath(S) -> + [FT] = lookup(S,file), + element(3,FT). + + +%% This returns a list of file names +%% that direct or indirect the current +%% compiled file is depended on. +get_dependencies(G) -> + S = ic_genobj:pragmatab(G), + case lookup(S,dependency) of + [] -> + []; + Dependencies -> + {get_idlfile(S),get_dependencies(Dependencies,[])} + end. + +get_dependencies([],Dependencies) -> + no_doubles(Dependencies); +get_dependencies([{dependency,Path}|Tail],Current) -> + get_dependencies(Tail,[hd(Path)|Current]). + + +no_doubles(List) -> + no_doubles(List,[]). + +no_doubles([],NoDoubles) -> + NoDoubles; +no_doubles([X|Xs],Current) -> + case member(X,Xs) of + true -> + no_doubles(Xs,Current); + false -> + no_doubles(Xs,[X|Current]) + end. + + + + +%% Pragma compilation status initialization +init_pragma_status(S) -> + insert(S,{status,true,0}). + +%% Pragma compilation status set to failure +%% and count up the number of errors +set_compilation_failure(S) -> + [{status,_,ErrorNr}] = lookup(S,status), + ets:delete(S,status), + insert(S,{status,false,ErrorNr+1}). + +%% Pragma compilation status set to lookup +get_pragma_compilation_status(S) -> + [Status] = lookup(S,status), + element(2,Status). + +%% Pragma error number +get_pragma_error_nr(S) -> + [Status] = lookup(S,status), + element(3,Status). + + +%% Short check +is_short(N_str) when is_list(N_str) -> + case is_short_decimal_str(N_str) of + true -> + true; + false -> + false + end; +is_short(N) when is_integer(N)-> + (N < 65535) and (N > -65536); +is_short(_) -> false. + + +%% Check if the string is a +%% list of characters representing +%% a short. Avoid crash !. +is_short_decimal_str(N_str) -> + case is_decimal_str(N_str) of + true -> + N = list_to_integer(N_str), + (N < 65535) and (N > -65536); + false -> + false + end. + +%% Check if the string is a +%% list of characters representing +%% decimals. +is_decimal_str([]) -> + true; +is_decimal_str([First|Rest]) -> + case is_decimal_char(First) of + true -> + is_decimal_str(Rest); + false -> + false + end. + +%% True if D is a character +%% representing a decimal (0-9). +is_decimal_char(D) -> + case (48=<D) and (D=<57) of + true -> + true; + false -> + false + end. + + +%% Prints out all the table +print_tab(G) -> + io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]). + + +list_to_term(List) -> + case catch erl_scan:string(List) of + {ok, Tokens, _} -> + case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of + {ok,Term} -> + Term; + _ -> + error + end; + _ -> + error + end. + + + +%% Cleanup all other code options for a specified scope +%% in the same file, but the most dominant. +cleanup_codeOptions(G,S,ScopedId) -> + case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of + [] -> + %% No codeOpt directive is placed inside the + %% currently compiled file. Try to find other + %% directives located in included files. + true; + List -> + %% A codeOpt directive is placed inside the + %% currently compiled file. This dominates + %% all other directives. + CodeOption = best_positioned_codeOpt(List), + %% Remove code options that do not affect + %% the code production (redundant) + remove_redundant_codeOpt(S,[ScopedId|CodeOption]) + end. + + +%% Best positioned is the codeopt located +%% "highest" on the SAME file, the one with +%% lowest line number. +best_positioned_codeOpt([X|Xs]) -> + best_positioned_codeOpt(Xs,X). + +best_positioned_codeOpt([],Found) -> + Found; +best_positioned_codeOpt([X|Xs],Current) -> + case hd(tl(X)) > hd(tl(Current)) of + true -> + best_positioned_codeOpt(Xs,Current); + false -> + best_positioned_codeOpt(Xs,X) + end. + + +remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) -> + ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}), + ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}). + + + + +add_inh_data(G,InclScope,X) -> + S = ic_genobj:pragmatab(G), + case X#interface.inherit of + [] -> + true; + [InhBody] -> + Scope = [get_id2(X)|InclScope], + insert(S,{inherits,Scope,InhBody}); + InhList -> + add_inh_data(G, S, InclScope, X, InhList) + end. + +add_inh_data(_,_,_,_,[]) -> + true; +add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) -> + Scope = [get_id2(X)|InclScope], + insert(S, {inherits,Scope,InhBody}), + add_inh_data(G, S, InclScope, X, InhBodies). + + +%% Returns a default broker data +defaultBrokerData(G) -> + {to_atom(ic_genobj:impl(G)),transparent}. + + +%% Loops through the form and sdds inheritence data +preproc(G, N, [X|Xs]) when is_record(X, interface) -> + %% Add inheritence data to pragmatab + ic_pragma:add_inh_data(G,N,X), + N2 = [get_id2(X) | N], + preproc(G, N2, get_body(X)), + lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end, + X#interface.inherit_body), + preproc(G, N, Xs); + +preproc(G,N,[X|Xs]) when is_record(X, module) -> + N2 = [get_id2(X) | N], + preproc(G, N2, get_body(X)), + preproc(G,N,Xs); + +preproc(G,N,[_X|Xs]) -> + preproc(G,N,Xs); + +preproc(_G, _N, []) -> + ok. + + +%% Returns a tuple / list of tuples { Mod, Type } +%% Does not check overridence because it is the +%% top scope for the module to be produced and +%% cannot be overriden. +getBrokerData(G,X,Scope) -> + S = ic_genobj:pragmatab(G), + cleanup_codeOptions(G,S,Scope), + + %% Check if it is an operation denoted + case isOperation(S,Scope) of + %% Yes, check options + true -> + %% Look if there is a specific code option on top file + case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of + true -> + %% Yes, let it work + getBrokerData(G,S,X,Scope,[Scope],[]); + false -> + %% No, try to see if there is codeoption on top file + case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of + true -> + %% Yes, override every other specific code option + [_H|T] = Scope, + getBrokerData(G,S,X,Scope,[T],[]); + false -> + %% No, let inherited specific code options work + getBrokerData(G,S,X,Scope,[Scope],[]) + end + end; + %% No, continue + false -> + getBrokerData(G,S,X,Scope,[Scope],[]) + end. + +%% Returns a tuple / list of tuples { Mod, Type } +%% Inside loop, uses overridence. +getBrokerData(G,X,RS,Scope,CSF) -> + S = ic_genobj:pragmatab(G), + cleanup_codeOptions(G,S,Scope), + OvScope = overridedFrom(S,RS,Scope), + getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]). + + + +getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when is_integer(First) -> + Scope = [[First]|Rest], + case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of + [] -> + case ets:match(S,{inherits,Scope,'$1'}) of + [] -> %% No inheritence, no pragma codeopt + defaultBrokerData(G); %% Default + [InhScope] -> + getBrokerData(G,S,X,RS,InhScope,CSF); + InhList -> + getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) + end; + [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt + {Module,Type}; + List -> %% Multiple branches with pragma codeopt + flatten(List) + end; + +getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) -> + getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF); + +getBrokerData(G,S,X,RS,[Scope],CSF) -> + %io:format(" 1"), + case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of + [] -> + %io:format(" 2"), + case ets:match(S,{inherits,Scope,'$1'}) of + [] -> %% No inheritence, no pragma codeopt + %io:format(" 5"), + defaultBrokerData(G); %% Default + [InhScope] -> + %io:format(" 6"), + getBrokerData(G,S,X,RS,InhScope,CSF); + InhList -> + %io:format(" 7"), + getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) + end; + [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt + %io:format(" 3"), + {Module,Type}; + List -> %% Multiple branches with pragma codeopt + %io:format(" 4"), + flatten(List) + end. + + +%% Special treatment when X is an operation +getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when is_record(X,op)-> + %io:format(" 8"), + case ets:match(S,{op,get_id2(X),'$1','_','_'}) of + [] -> + %io:format(" 10"), + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF); + + [[Scope]] -> + %io:format(" 11"), + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF); + + [[OpScope]] -> + %io:format(" 12"), + case member([OpScope],InhList) of + true -> + %io:format(" 14"), + %% No inherited scopes + getBrokerData(G,X,RS,OpScope,CSF); + false -> + %io:format(" 15"), + %% Inherited scopes + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF) + end; + + ListOfOpScopes -> + %io:format(" 13"), + case get_inherited(S,Scope,ListOfOpScopes) of + [[OpScope]] -> + case member([OpScope],InhList) of + true -> + getBrokerData(G,X,RS,OpScope,CSF); + false -> + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF) + end; + _ -> + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF) + end + end; +%% Just add InhList after removing all inherited +getBrokerDataInh(G,S,X,RS,_Scope,CSF,InhList) -> + %io:format(" 9"), + CleanList = remove_inherited(S,InhList), + getBrokerDataLoop(G,S,X,RS,CleanList,CSF). + + + + +%% Loops over a list of scopes +getBrokerDataLoop(G,S,X,RS,List,CSF) -> + getBrokerDataLoop(G,S,X,RS,List,[],CSF). + +getBrokerDataLoop(G,_,_X,_RS,[],BrokerDataList,_CSF) -> + case no_doubles(BrokerDataList) of + [BrokerData] -> %% No pragma codeopt / Multiple branches with pragma codeopt + BrokerData; + List -> + DefaultBD = defaultBrokerData(G), + case member(DefaultBD,List) of + true -> + %% Remove default, choose codeoption + NewList = delete(DefaultBD,List), + case NewList of + [BData] -> %% A branch only, with pragma codeopt + BData; + _Other -> %% Multiple branches with pragma codeopt + %%io:format("Multiple branches ~p~n",[Other]), + NewList + end; + false -> %% Multiple branches with pragma codeopt + flatten(List) + end + end; + +getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],_Found,CSF) when is_integer(Scope) -> + getBrokerData(G,S,X,RS,[[Scope]|Scopes],CSF); + +getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],Found,CSF) -> + %% Start from the beginning, check for overridings + case member(overridedFrom(S,RS,Scope),CSF) of %% Avoid infinite loops + true -> + getBrokerDataLoop(G,S,X,RS,Scopes,Found,CSF); + false -> + BrokerData = getBrokerData(G,X,RS,Scope,CSF), + getBrokerDataLoop(G,S,X,RS,Scopes,[BrokerData|Found],[Scope|CSF]) + end. + + + + +%%%-------------------------------------- +%%% Finds out the overrider of a scope +%%%-------------------------------------- +overridedFrom(S,RS,Scope) -> + overridedFrom(S,RS,Scope,Scope). + +overridedFrom(S,RS,Last,Scope) -> + case ets:match(S,{inherits,'$0',Scope}) of + [] -> + %% No inheritence, no pragma codeopt, + %% choose the last scope. + Last; + + [[RS]] -> + %% Garbage, unused interface with pragma + %% code option ! Danger ! + Last; + + [[InhScope]] -> + case ets:match(S,{codeopt,InhScope,'$1','_','_','_'}) of + [] -> + %% InhScope has no code options, keep Last. + overridedFrom(S,RS,Scope,InhScope); + _ -> + %% InhScope has code option, Last = InhScope. + overridedFrom(S,RS,InhScope,InhScope) + end; + List -> + %% Several inherit from Scope, choose the one feeseble, + %% the one DIRECTLY inherited by Scope and not through + %% other interface. + case remove_inheriters(S,RS,List) of + [] -> + Scope; + Removed -> + Removed + end + end. + +%%%------------------------------------------------------ +%%% Removes all the scopes that inherit from others +%%%------------------------------------------------------ +remove_inheriters(S,RS,InheriterList) -> + DominantList = + dominantList(S,InheriterList), + ReducedInhList = + [X || X <- InheriterList, + member(X,DominantList)], + + case ReducedInhList of + [] -> + []; + [_OneOnly] -> + ReducedInhList; + _Other -> + EtsList = ets:tab2list(S), + CleanList = + [X || X <- EtsList, element(1,X) == inherits], +% CodeOptList = +% [X || X <- EtsList, element(1,X) == codeopt], + NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), + + [ [X] || [X] <- NoInheriters, + inherits(RS,X,CleanList)] + end. + +remove_inheriters2(_,[A],_) -> + [A]; +remove_inheriters2(_S,[A,B],EtsList) -> + case remove_inh(A,B,[A,B],EtsList) of + [[X]] -> + X; + List -> + List + end; +remove_inheriters2(S,[A,B|Rest],EtsList) -> + case remove_inh(A,B,[A,B|Rest],EtsList) of + [A,B|Rest] -> + [A,B|Rest]; + NewList -> + remove_inheriters2(S,NewList,EtsList) + end. + +remove_inh([X],[Y],List,EtsList) -> + case inherits(X,Y,EtsList) of + true -> + delete([X],List); + false -> + case inherits(Y,X,EtsList) of + true -> + delete([Y],List); + false -> + List + end + end. + + + +%%%---------------------------------------------- +%%% Should remove all scope links that inherit +%%% from others in the list +%%%---------------------------------------------- +remove_inherited(S,InheriterList) -> + EtsList = ets:tab2list(S), + CleanList = + [X || X <- EtsList, element(1,X) == inherits], + remove_inherited(S,InheriterList,CleanList). + + +remove_inherited(_S,[A,B],EtsList) -> + case remove_inhed(A,B,[A,B],EtsList) of + [[X]] -> + [[X]]; + List -> + List + end; +remove_inherited(S,[A,B|Rest],EtsList) -> + case remove_inhed(A,B,[A,B|Rest],EtsList) of + [A,B|Rest] -> + [A,B|Rest]; + NewList -> + remove_inherited(S,NewList,EtsList) + end. + + +remove_inhed([X],[Y],List,EtsList) -> + case inherits(X,Y,EtsList) of + true -> + delete([Y],List); + false -> + case inherits(Y,X,EtsList) of + true -> + delete([X],List); + false -> + List + end + end. + + + + + + + +%%%---------------------------------------------- +%%% Should return all scope links that is +%% are inherited from scope in the list +%%%---------------------------------------------- +get_inherited(S,Scope,OpScopeList) -> + EtsList = ets:tab2list(S), + [[element(3,X)] || X <- EtsList, + element(1,X) == inherits, + element(2,X) == Scope, + member([element(3,X)],OpScopeList)]. + + + + + + + +%%%--------------------------------------------------- +%%% Returns a the list of scopes that have codeoption +%%% from a list of scopes +%%%--------------------------------------------------- +dominantList(S,IL) -> + dominantList(S,IL,[]). + +dominantList(_S,[],Found) -> + Found; +dominantList(S,[[X]|Xs],Found) -> + case ets:match(S,{codeopt,X,'$1','_','_','_'}) of + [] -> + dominantList(S,Xs,Found); + _ -> + dominantList(S,Xs,[[X]|Found]) + end. + + + + +%%%--------------------------------------------------- +%%% Returns true if X direct or indirect inherits Y +%%%--------------------------------------------------- +inherits(X,Y,EtsList) -> + case member({inherits,X,Y},EtsList) of + true -> + %% Direct inherited + true; + false -> + %% Indirectly inherited + AllInh = [ B || {inherits,A,B} <- EtsList, A == X ], + inherits(X,Y,AllInh,EtsList) + end. + +inherits(_X,_Y,[],_EtsList) -> + false; +inherits(X,Y,[Z|Zs],EtsList) -> + case inherits2(X,Y,Z,EtsList) of + true -> + true; + false -> + inherits(X,Y,Zs,EtsList) + end. + +inherits2(_X,Y,Z,EtsList) -> + case member({inherits,Z,Y},EtsList) of + true -> + true; + false -> + inherits(Z,Y,EtsList) + end. + + + +%% +%% is_inherited_by/3 +%% +%% Returns : +%% +%% true if the first parameter is +%% inherited by the second one +%% +%% false otherwise +%% +is_inherited_by(Interface1,Interface2,PragmaTab) -> + FullList = ets:tab2list(PragmaTab), + InheritsList = + [X || X <- FullList, element(1,X) == inherits], + inherits(Interface2,Interface1,InheritsList). + + + + +%% Filters all pragma prefix from list not in same file +%% the object + +filter_pragma_prefix_list(PragmaTab, Name, Scope, List) -> + IdlFile = scoped_names_idl_file(PragmaTab, Name, Scope), + filter_pragma_prefix_list2(PragmaTab,IdlFile,List,[]). + + +filter_pragma_prefix_list2(_,_,[],Found) -> + Found; +filter_pragma_prefix_list2(PT, IdlFile, [PP|PPs], Found) -> + case PP of + {prefix,_,_,_,IdlFile,_} -> %% Same file as the Object, keep + filter_pragma_prefix_list2(PT, IdlFile, PPs, [PP|Found]); + + _Other -> %% NOT in same file as the Object, throw away + filter_pragma_prefix_list2(PT, IdlFile, PPs, Found) + end. + +scoped_names_idl_file(PragmaTab, Name, Scope) -> + case ets:match(PragmaTab,{'_','$0','_','$2',Scope,Name,'_','_','_'}) of + [[IdlFile, _Type]] -> %% Usual case + IdlFile; + [[_File,module]|_Files] -> %% Multiple modules, get LOCAL file + case ets:match(PragmaTab,{file_data_local,'$0','_',module,Scope,Name,'_','_','_'}) of + [[LocalIdlFile]] -> + LocalIdlFile; + _ -> %% Should NEVER occur + error + end; + + _ -> + error %% Should NEVER occur + end. + + + + + + +%%------------------------------------------------- +%% +%% Register specific pragma code options +%% +%% If there is an operation with that +%% scope, denote this as {codeopt_specific,Scope} +%% +%%------------------------------------------------- +denote_specific_code_opts(G) -> + case ic_options:get_opt(G, be) of + noc -> + S = ic_genobj:pragmatab(G), + COList = ets:match(S,{codeopt,'$0','_','_','_','_'}), + OPList = ets:match(S,{op,'$0','$1','_','_'}), + denote_specific_code_opts(S,COList,OPList); + _ -> + ok + end. + +denote_specific_code_opts(_,_,[]) -> + ok; +denote_specific_code_opts(S,COList,[[OpN,OpS]|OPSs]) -> + case lists:member([[OpN|OpS]],COList) of + true -> + insert(S, {codeopt_specific,[OpN|OpS]}); + false -> + ok + end, + denote_specific_code_opts(S,COList,OPSs). + + + +%%--------------------------------------------- +%% +%% Returns true/false if it denotes an operation +%% +%%--------------------------------------------- +isOperation(_S,[]) -> + false; +isOperation(_S,[_]) -> + false; +isOperation(S,[H|T]) -> + case ets:match(S,{op,H,T,'$2','$3'}) of + [] -> + false; + _ -> + true + end. + + +hasSpecificCodeoptionOnTopFile(S,File,Scope) -> + case ets:match(S,{codeopt,Scope,'_','$2',File,[File]}) of + [] -> + false; + _ -> + true + end. + + +hasNonSpecificCodeoptionOnTopFile(S,File) -> + case ets:match(S,{codeopt,'_','_','$2',File,[File]}) of + [] -> + false; + _ -> + true + end. + + + +%%--------------------------------------------- +%% +%% Returns {ok,IfrId}/error when searching a random local type +%% +%%--------------------------------------------- + + +fetchRandomLocalType(G) -> + + S = ic_genobj:pragmatab(G), + + case ets:match(S,{file_data_local,'_','_','$2','$3','$4','_','_','_'}) of + [] -> + false; + + List -> + fetchRandomLocalType(S,List) + end. + + +fetchRandomLocalType(_,[]) -> + false; +fetchRandomLocalType(S,[[module|_]|Tail]) -> + fetchRandomLocalType(S,Tail); +fetchRandomLocalType(S,[[_,Scope,Name]|Tail]) -> + case ets:match(S,{alias,[Name|Scope],'$1'}) of + [] -> + fetchRandomLocalType(S,Tail); + [[IfrId]] -> + {ok,IfrId} + end. + + + +%%--------------------------------------------- +%% +%% Returns A list of local operation mapping +%% for a given scope +%% +%%--------------------------------------------- + + +fetchLocalOperationNames(G,I) -> + S = ic_genobj:pragmatab(G), + case ets:match(S,{file_data_local,'_','_',op,I,'$4','_','_','_'}) of + [] -> + []; + List -> + fetchLocalOperationNames2(List,[]) + end. + +fetchLocalOperationNames2([],Found) -> + lists:reverse(Found); +fetchLocalOperationNames2([[Name]|Names],Found) -> + fetchLocalOperationNames2(Names,[Name|Found]). + + + +%%------------------------------------------------ +%% +%% Returns a true if this scoped id is a local +%% one, false otherwise +%% +%%------------------------------------------------ +is_local(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + Name = ic_util:to_undersc(ScopedId), + case ets:match(S,{file_data_local,'_','_','_',tl(ScopedId),'_',Name,'_','_'}) of + [[]] -> + true; + _ -> + false + end. diff --git a/lib/ic/src/ic_sequence_java.erl b/lib/ic/src/ic_sequence_java.erl new file mode 100644 index 0000000000..b57652fb82 --- /dev/null +++ b/lib/ic/src/ic_sequence_java.erl @@ -0,0 +1,239 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_sequence_java). + + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([gen/4]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: gen/4 +%%----------------------------------------------------------------- +gen(G, N, X, SequenceName) when is_record(X, sequence) -> + emit_holder_class(G, N, X, SequenceName), + emit_helper_class(G, N, X, SequenceName); +gen(_G, _N, _X, _SequenceName) -> + ok. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + + +%%----------------------------------------------------------------- +%% Func: emit_holder_class/4 +%%----------------------------------------------------------------- +emit_holder_class(G, N, X, SequenceName) -> + SName = string:concat(SequenceName, "Holder"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + SequenceType = ic_java_type:getType(G, N, X), + + ic_codegen:emit(Fd, ["final public class ",SequenceName,"Holder {\n" + " // instance variables\n" + " public ",SequenceType," value;\n\n" + " // constructors\n" + " public ",SequenceName,"Holder() {}\n" + " public ",SequenceName,"Holder(",SequenceType," initial) {\n" + " value = initial;\n" + " }\n\n" + + " // methods\n" + + " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception{\n" + " ",SequenceName,"Helper.marshal(out, value);\n" + " }\n\n" + + " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" + " value = ",SequenceName,"Helper.unmarshal(in);\n" + " }\n\n" + "}\n"]), + file:close(Fd). + + + +emit_helper_class(G, N, X, SequenceName) -> + SName = string:concat(SequenceName, "Helper"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + SequenceType = ic_java_type:getType(G, N, X), + ElementType = ic_forms:get_type(X), + + ic_codegen:emit(Fd, ["public class ",SequenceName,"Helper {\n" + + " // constructors\n" + " private ",SequenceName,"Helper() {}\n\n" + + " // methods\n" + " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",SequenceType," _value) \n" + " throws java.lang.Exception {\n\n"]), + + emit_sequence_marshal_function(G, N, X, Fd, SequenceName, ElementType), + + ic_codegen:emit(Fd, [" }\n\n" + + " public static ",SequenceType," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in) \n" + " throws java.lang.Exception {\n\n"]), + + emit_sequence_unmarshal_function(G, N, X, Fd, SequenceName, ElementType), + + ic_codegen:emit(Fd, [" }\n\n" + + " public static String id() {\n" + " return \"",ic_pragma:scope2id(G, [SequenceName | N]),"\";\n" + " }\n\n" + + " public static String name() {\n" + " return \"",SequenceName,"\";\n" + " }\n\n"]), + + ic_jbe:emit_type_function(G, N, X, Fd), + + ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",SequenceType," _this)\n" + " throws java.lang.Exception {\n\n" + + " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" + " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" + + " _any.type(type());\n" + " marshal(_os, _this);\n" + " _any.insert_Streamable(_os);\n" + " }\n\n" + + " public static ",SequenceType," extract(",?ICPACKAGE,"Any _any)\n" + " throws java.lang.Exception {\n\n" + + " return unmarshal(_any.extract_Streamable());\n" + " }\n\n" + + + %% In corba mapping there is also a _type function here. + "}\n\n"]), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_sequence_marshal_function/6 +%%----------------------------------------------------------------- +emit_sequence_marshal_function(G, N, X, Fd, _SequenceName, ElementType) -> + ic_codegen:emit(Fd, [" int _length = _value.length;\n\n" + + " _out.write_list_head(_length);\n\n" + + " if (_length > 0) {\n" + " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), + + case ic_java_type:isBasicType(G, N, ElementType) of + true -> + ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, X, ElementType),"(_value[_tmp]);\n\n"]); + false -> + ic_codegen:emit(Fd, [" ",ic_java_type:marshalFun(G, N, X, ElementType),"(_out, _value[_tmp]);\n\n"]) + end, + + ic_codegen:emit(Fd, [" _out.write_nil();\n" + " }\n\n"]). + + + + +%%----------------------------------------------------------------- +%% Func: emit_sequence_unmarshal_function/6 +%%----------------------------------------------------------------- +emit_sequence_unmarshal_function(G, N, X, Fd, _SequenceName, ElementType) -> + + SequenceElementType = ic_java_type:getType(G, N, ElementType), + + ic_codegen:emit(Fd, [" int _tag,_length;\n" + " ",SequenceElementType," _sequence[];\n" + " _tag = _in.peek();\n\n"]), + + case ic_java_type:isIntegerType(G, N, ElementType) of + true -> + ic_codegen:emit(Fd, [" switch(_tag) {\n" + " case ",?ERLANGPACKAGE,"OtpExternal.stringTag:\n" + " byte _compressed[] = (_in.read_string()).getBytes();\n" + " _length = _compressed.length;\n" + " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" + + " for(int _tmp = 0; _tmp < _length; _tmp++)\n" + " _sequence[_tmp] = (",ic_java_type:getType(G, N, ElementType),")(_compressed[_tmp] & 0xff);\n\n" + + " break;\n" + " default:\n" + " _length = _in.read_list_head();\n" + " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" + + " if(_length > 0) {\n" + " for(int _tmp = 0; _tmp < _length; _tmp++)\n" + " _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n" + + " _in.read_nil();\n" + " }\n" + " }\n"]); + false -> + ic_codegen:emit(Fd, [" _length = _in.read_list_head();\n" + " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" + + " if(_length > 0) {\n" + " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), + case ic_java_type:isBasicType(G, N, ElementType) of + true -> + ic_codegen:emit(Fd, [" _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n"]); + _ -> + ic_codegen:emit(Fd, [" _sequence[_tmp] = ",ic_java_type:getUnmarshalType(G, N, X, ElementType),".unmarshal(_in);\n\n"]) + end, + + ic_codegen:emit(Fd, [" _in.read_nil();\n" + " }\n\n"]) + end, + + ic_codegen:emit(Fd, " return _sequence;\n"). + + + + +%%--------------------------------------------------- +%% Utilities +%%--------------------------------------------------- + + + + + + + + + diff --git a/lib/ic/src/ic_struct_java.erl b/lib/ic/src/ic_struct_java.erl new file mode 100644 index 0000000000..e577fd64a3 --- /dev/null +++ b/lib/ic/src/ic_struct_java.erl @@ -0,0 +1,314 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_struct_java). + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([gen/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- +gen(G, N, X) when is_record(X, struct) -> + StructName = ic_forms:get_java_id(X), + WireStructName = ic_forms:get_id2(X), + emit_struct_class(G, N, X, StructName), + emit_holder_class(G, N, X, StructName), + emit_helper_class(G, N, X, StructName, WireStructName), + N2 = [StructName ++ "Package" |N], + ic_jbe:gen(G, N2, ic_forms:get_body(X)); +gen(_G, _N, _X) -> + ok. + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: emit_struct_class/4 +%%----------------------------------------------------------------- +emit_struct_class(G, N, X, StructName) -> + {Fd, _}= ic_file:open_java_file(G, N, StructName), + + MList = struct_member_list(G, N, X), + ArgList = gen_parameter_list(G, [ StructName ++ "Package" |N], X, MList), + + ic_codegen:emit(Fd, ["final public class ",StructName," {\n" + " // instance variables\n"]), + + emit_struct_members_declarations(G, [StructName ++ "Package" |N], + X, Fd, MList), + + ic_codegen:emit(Fd, ["\n // constructors\n" + " public ",StructName,"() {}\n\n" + + " public ",StructName,"(",ArgList,") {\n"]), + + emit_struct_members_initialisation(G, N, X, Fd, MList), + + ic_codegen:emit(Fd, [" }\n\n" + + "}\n\n"]), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_holder_class/4 +%%----------------------------------------------------------------- +emit_holder_class(G, N, _X, StructName) -> + SName = string:concat(StructName, "Holder"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + ic_codegen:emit(Fd, ["final public class ",StructName,"Holder {\n" + + " // instance variables\n" + " public ",StructName," value;\n\n" + + " // constructors\n" + " public ",StructName,"Holder() {}\n\n" + + " public ",StructName,"Holder(",StructName," initial) {\n" + " value = initial;\n" + " }\n\n" + + " // methods\n"]), + + ic_codegen:emit(Fd, [" public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" + " ",StructName,"Helper.marshal(out, value);\n" + " }\n\n" + + " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" + " value = ",StructName,"Helper.unmarshal(in);\n" + " }\n" + + "}\n\n"]), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_helper_class/5 +%%----------------------------------------------------------------- +emit_helper_class(G, N, X, StructName, WireStructName) -> + SName = string:concat(StructName, "Helper"), + {Fd, _}= ic_file:open_java_file(G, N, SName), + + ic_codegen:emit(Fd, ["public class ",StructName,"Helper {\n" + + " // constructors\n" + " private ",StructName,"Helper() {}\n\n" + + " // methods\n"]), + + MList = struct_member_list(G, N, X), + + ic_codegen:emit(Fd, [" public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",StructName," _value)\n" + " throws java.lang.Exception {\n\n"]), + + emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList), + + ic_codegen:emit(Fd, [" }\n\n" + + " public static ",StructName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" + " throws java.lang.Exception {\n\n"]), + + emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList), + + ic_codegen:emit(Fd, [" }\n\n" + + " public static String id() {\n" + " return \"",ictk:get_IR_ID(G, N, X),"\";\n" + " }\n\n" + + " public static String name() {\n" + " return \"",StructName,"\";\n" + " }\n\n"]), + + ic_jbe:emit_type_function(G, N, X, Fd), + + ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",StructName," _this)\n" + " throws java.lang.Exception {\n\n" + + " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" + " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" + + " _any.type(type());\n" + " marshal(_os, _this);\n" + " _any.insert_Streamable(_os);\n" + " }\n\n" + + " public static ",StructName," extract(",?ICPACKAGE,"Any _any)\n" + " throws java.lang.Exception {\n\n" + + " return unmarshal(_any.extract_Streamable());\n" + " }\n\n" + + + %% In corba mapping there is also a _type function here. + "}\n"]), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_struct_members_declarations/ +%%----------------------------------------------------------------- +emit_struct_members_declarations(_, _, _, _, []) -> + ok; +emit_struct_members_declarations(G, N, X, Fd, [{Member, _Type, Id} | MList]) -> + ic_codegen:emit(Fd, [" public ",ic_java_type:getType(G, N, Member)," ",Id,";\n"]), + emit_struct_members_declarations(G, N, X, Fd, MList). + + + +%%----------------------------------------------------------------- +%% Func: emit_struct_members_initialisation/5 +%%----------------------------------------------------------------- +emit_struct_members_initialisation(_, _, _, _, []) -> + ok; +emit_struct_members_initialisation(G, N, X, Fd, [{_Member, _Type, Id} | MList]) -> + ic_codegen:emit(Fd, [" ",Id," = _",Id,";\n"]), + emit_struct_members_initialisation(G, N, X, Fd, MList). + + + + +%%----------------------------------------------------------------- +%% Func: emit_struct_marshal_function/7 +%%----------------------------------------------------------------- +emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> + + ic_codegen:emit(Fd, [" _out.write_tuple_head(",integer_to_list(length(MList) + 1),");\n" + " _out.write_atom(\"",ic_util:to_undersc([WireStructName|N]),"\");\n\n"]), + + emit_struct_marshal_function_loop(G, [StructName ++ "Package" |N], + X, Fd, MList, 1). + +%%----------------------------------------------------------------- +%% Func: emit_struct_marshal_function_loop/6 +%%----------------------------------------------------------------- +emit_struct_marshal_function_loop(_, _, _, Fd, [], _) -> + ic_codegen:nl(Fd); +emit_struct_marshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> + + case ic_java_type:isBasicType(G, N, Member) of + true -> + ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, Member, Type),"(_value.",Id,");\n"]); + _ -> + if (element(1,hd(element(3,Member))) == array) -> + ic_codegen:emit(Fd, + [" ", + ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]), + "Helper.marshal(_out, _value.",Id,");\n"]); + true -> + ic_codegen:emit(Fd, [" ", + ic_java_type:marshalFun(G, N, Member, Type), + "(_out, _value.",Id,");\n"]) + end + end, + + emit_struct_marshal_function_loop(G, N, X, Fd, MList, Num+1). + + + + +%%----------------------------------------------------------------- +%% Func: emit_struct_unmarshal_function/7 +%%----------------------------------------------------------------- +emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> + + ic_codegen:emit(Fd, [" _in.read_tuple_head();\n\n" + + " if ((_in.read_atom()).compareTo(\"", + ic_util:to_undersc([WireStructName|N]), + "\") != 0)\n" + " throw new java.lang.Exception(\"\");\n\n" + + " ",StructName," _value = new ",StructName,"();\n"]), + + emit_struct_unmarshal_function_loop(G, [StructName ++ "Package"|N], + X, Fd, MList, 1), + + ic_codegen:emit(Fd, " return _value;\n"). + +%%----------------------------------------------------------------- +%% Func: emit_union_unmarshal_function_loop/6 +%%----------------------------------------------------------------- +emit_struct_unmarshal_function_loop(_, _, _, Fd, [], _) -> + ic_codegen:nl(Fd); +emit_struct_unmarshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> + + case ic_java_type:isBasicType(G, N, Member) of + true -> + ic_codegen:emit(Fd, [" _value.",Id," = _in",ic_java_type:unMarshalFun(G, N, Member, Type),";\n"]); + _ -> + if (element(1,hd(element(3,Member))) == array) -> + ic_codegen:emit(Fd, + [" _value.",Id," = ",ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]),"Helper.unmarshal(_in);\n"]); + true -> + ic_codegen:emit(Fd, + [" _value.",Id," = ",ic_java_type:getUnmarshalType(G, N, Member, Type),".unmarshal(_in);\n"]) + end + end, + + emit_struct_unmarshal_function_loop(G, N, X, Fd, MList, Num +1). + + + +%%----------------------------------------------------------------- +%% Func: gen_parameter_list/4 +%%----------------------------------------------------------------- +gen_parameter_list(G, N, _X, [{Member, _Type, Id}]) -> + ic_java_type:getType(G,N,Member) ++ + " _" ++ + ic_util:to_list(Id); +gen_parameter_list(G, N, X, [{Member, _Type, Id} | MList]) -> + ic_java_type:getType(G,N,Member) ++ + " _" ++ + ic_util:to_list(Id) ++ + ", " ++ + gen_parameter_list(G, N, X, MList). + + +%%----------------------------------------------------------------- +%% Func: struct_member_list/3 +%%----------------------------------------------------------------- +struct_member_list(_G, _N, X) -> + M = lists:map( + fun(Member) -> + lists:map( + fun(Id) -> + Type = ic_forms:get_type(Member), + { Member, Type, ic_forms:get_java_id(Id)} + end, + ic_forms:get_idlist(Member)) + end, + ic_forms:get_body(X)), + lists:flatten(M). + + + diff --git a/lib/ic/src/ic_symtab.erl b/lib/ic/src/ic_symtab.erl new file mode 100644 index 0000000000..889c75e3a2 --- /dev/null +++ b/lib/ic/src/ic_symtab.erl @@ -0,0 +1,232 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_symtab). + + +-include_lib("ic/src/ic.hrl"). +-include_lib("ic/src/icforms.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([new/0, store/3, retrieve/2, soft_retrieve/2, intf_resolv/3]). +-export([get_full_scoped_name/3, scoped_id_new_global/1, scoped_id_new/1]). +-export([scoped_id_strip/1,symtab_add_faked_included_types/1]). +-export([scoped_id_is_global/1, scoped_id_add/2]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + + +%%-------------------------------------------------------------------- +%% +%% Symbol table routines +%% +%% Symbol tables handles mappings Id -> Value, where Id is an +%% ordinary Id from the parser (or a string) and value is an +%% arbitrary term. +%% +%%-------------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: new/0 (used to be symtab_new) +%%----------------------------------------------------------------- +new() -> + ets:new(symtab, [set, public]). + +%%----------------------------------------------------------------- +%% Func: store/3 (used to be symtab_store) +%%----------------------------------------------------------------- +store(G, N, X) -> + Name = [ic_forms:get_id2(X) | N], + %%io:format("Adding id: ~p~n", [N]), + case soft_retrieve(G, Name) of + {error, _} -> + ets:insert(G#genobj.symtab, {Name, X}); + {ok, Y} when is_record(Y, forward) -> + ets:insert(G#genobj.symtab, {Name, X}); + {ok, _Y} -> + ic_error:error(G, {multiply_defined, X}) + end. + + +%%----------------------------------------------------------------- +%% Func: retrieve/2 (used to be symtab_retrieve) +%% +%% Makes a lookup in the symbol table for Id. Will throw +%% not_found if it fails. +%%----------------------------------------------------------------- +retrieve(G, Id) -> + case ets:lookup(G#genobj.symtab, Id) of + [{_, Val}] -> Val; + [] -> ic_error:error(G, {symtab_not_found, Id}) + end. + + +%%----------------------------------------------------------------- +%% Func: soft_retrieve/2 (used to be symtab_soft_retrieve) +%% +%% Same as retrieve but will use tagged return values. +%% +%%----------------------------------------------------------------- +soft_retrieve(G, Id) -> + case ets:lookup(G#genobj.symtab, Id) of + [{_, Val}] -> {ok, Val}; + [] -> {error, {symtab_not_found, Id}} + end. + + +%%----------------------------------------------------------------- +%% Func: intf_resolv/3 and resolv2/3 +%% (used to be symtab_intf_resolv and symtab_intf_resolv2) +%% +%% Tries to resolv the interface identifier reference. The id can +%% be either a scoped name or an standard identifier. The +%% function returns a global reference to the id. +%% +%% Will throw not_found if the id really cannot be found. Will +%% throw illegal_forward if any forward references are founf in +%% the inheritance list. +%% +%%----------------------------------------------------------------- +intf_resolv(G, Scope, Id) -> + case scoped_id_is_global(Id) of + true -> + retrieve(G, Id), + Id; + false -> + intf_resolv2(G, Scope, Id) + end. + +intf_resolv2(G, Scope, Id) -> + N = scoped_id_add(Scope, Id), + case soft_retrieve(G, scoped_id_strip(N)) of + {ok, F} when is_record(F, forward) -> + ic_error:error(G, {illegal_forward, Id}), []; + {ok, _Val} -> + scoped_id_mk_global(N); + _ -> + case scoped_id_is_top(Scope) of + false -> + intf_resolv2(G, scoped_id_up_one(Scope), Id); + true -> + ic_error:error(G, {symtab_not_found, Id}), [] + end + end. + + + +%%-------------------------------------------------------------------- +%% +%% Scoped id routines +%% +%% A scoped id is an id written as M::Id in IDL. Scoped ids are +%% implemented as lists of id in reverse order, so M1::F1 becomes +%% [F1, M1]. +%% +%%-------------------------------------------------------------------- + +get_full_scoped_name(G, N, S) when element(1, S) == scoped_id -> + ictype:scoped_lookup(G, ic_genobj:tktab(G), N, S). + +scoped_id_new_global(Id) -> + X=scoped_id_new(Id), X#scoped_id{type=global}. + +scoped_id_new(Id) -> + #scoped_id{line=ic_forms:get_line(Id), id=[ic_forms:get_id(Id)]}. + +%% Adds one more id to the list of ids +scoped_id_add(S1, S2) when is_record(S2, scoped_id) -> + S1#scoped_id{id=S2#scoped_id.id ++ S1#scoped_id.id, + line=S2#scoped_id.line}; +scoped_id_add(S, Id) -> + S#scoped_id{id=[ic_forms:get_id(Id) | S#scoped_id.id], line=ic_forms:get_line(Id)}. + + +scoped_id_mk_global(S) -> S#scoped_id{type=global}. + +scoped_id_is_global(S) when is_record(S, scoped_id), S#scoped_id.type==global -> + true; +scoped_id_is_global(_) -> false. + +%% Top level scope (i.e no more cd ..) +scoped_id_is_top(S) when S#scoped_id.id==[] -> true; +scoped_id_is_top(_) -> false. + + +scoped_id_up_one(S) -> S#scoped_id{id=tl(S#scoped_id.id)}. % cd .. in scope +%%scoped_id_get_def(S) -> hd(S#scoped_id.id). % Last added id +scoped_id_strip(S) -> S#scoped_id.id. % Strips all junk + + + + +% Add CORBA::<Types> that as if they +% were defined in an included file. +% This is only supported in the case +% of Corba backend +symtab_add_faked_included_types(G) -> + case ic_options:get_opt(G, be) of + false -> + %% Add TypeCode as if it were defiend in included file + ets:insert(G#genobj.symtab, {["CORBA"], + {interface,{'<identifier>',0,"TypeCode"}, + [], + [], + [], + {tk_objref, + "IDL:omg.org/CORBA/TypeCode:1.0", + "TypeCode"}}}); + erl_corba -> + %% Add TypeCode as if it were defiend in included file + ets:insert(G#genobj.symtab, {["CORBA"], + {interface,{'<identifier>',0,"TypeCode"}, + [], + [], + [], + {tk_objref, + "IDL:omg.org/CORBA/TypeCode:1.0", + "TypeCode"}}}); + erl_template -> + %% Add TypeCode as if it were defiend in included file + ets:insert(G#genobj.symtab, {["CORBA"], + {interface,{'<identifier>',0,"TypeCode"}, + [], + [], + [], + {tk_objref, + "IDL:omg.org/CORBA/TypeCode:1.0", + "TypeCode"}}}); + _ -> + ok + end. + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_union_java.erl b/lib/ic/src/ic_union_java.erl new file mode 100644 index 0000000000..4be93f3c1f --- /dev/null +++ b/lib/ic/src/ic_union_java.erl @@ -0,0 +1,754 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + + +-module(ic_union_java). + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([gen/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: gen/3 +%%----------------------------------------------------------------- +gen(G, N, X) when is_record(X, union) -> + + %% Create a TK value if not existed + %% Should be integrated in fetchTk + %% instead + NewX = case ic_forms:get_tk(X) of + undefined -> + S = ic_genobj:tktab(G), + Tk = ictype:tk(G, S, N, X), + #union{ id = X#union.id, + type = X#union.type, + body = X#union.body, + tk = Tk }; + _Tk -> + X + end, + + UnionName = ic_forms:get_java_id(NewX), + WiredUnionName = ic_forms:get_id2(NewX), + N2 = [UnionName ++ "Package"|N], + %%?PRINTDEBUG2("Recursive call over type ~p", + %% [[ic_forms:get_type(NewX)]]), + ic_jbe:gen(G, N, [ic_forms:get_type(NewX)]), + %%?PRINTDEBUG2("Recursive call over body: ~p", + %% [ic_forms:get_body(NewX)]), + ic_jbe:gen(G, N2, ic_forms:get_body(NewX)), + + emit_union_class(G, N, NewX, UnionName), + emit_holder_class(G, N, NewX, UnionName), + emit_helper_class(G, N, NewX, UnionName, WiredUnionName); +gen(_G, _N, _X) -> + ok. + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: emit_union_class/4 +%%----------------------------------------------------------------- +emit_union_class(G, N, X, UnionName) -> + {Fd, _} = ic_file:open_java_file(G, N, UnionName), + + DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], + ic_forms:get_type(X)), + + MList = union_member_list(G, N, X, DiscrType), + + ic_codegen:emit(Fd, "final public class ~s {\n",[UnionName]), + + ic_codegen:emit(Fd, " // instance variables\n", []), + ic_codegen:emit(Fd, " private boolean _initialized;\n", []), + ic_codegen:emit(Fd, " private ~s _discriminator;\n", [DiscrType]), + ic_codegen:emit(Fd, " private java.lang.Object _value;\n", []), + + {tk_union,_, _,DiscrTk, _, _} = ic_forms:get_tk(X), + + DV = get_default_val(G, [UnionName |N], DiscrType, DiscrTk, MList), + + case DV of + none -> %% all values in case + ok; + _ -> + ic_codegen:emit(Fd, " private ~s _default = ~s;\n", + [DiscrType, DV]) + end, + + ic_codegen:nl(Fd), + ic_codegen:emit(Fd, " // constructors\n", []), + + ic_codegen:emit(Fd, " public ~s() {\n", [UnionName]), + ic_codegen:emit(Fd, " _initialized = false;\n", []), + ic_codegen:emit(Fd, " _value = null;\n", []), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, " // discriminator access\n", []), + + ic_codegen:emit(Fd, " public ~s discriminator() " + "throws java.lang.Exception {\n", [DiscrType]), + ic_codegen:emit(Fd, " if (!_initialized) {\n", []), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:emit(Fd, " return _discriminator;\n", []), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:nl(Fd), + + emit_union_members_functions(G, [UnionName ++ "Package"|N], X, + Fd, UnionName, DiscrType, MList, MList), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, "}\n", []), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_holder_class/4 +%%----------------------------------------------------------------- +emit_holder_class(G, N, _X, UnionName) -> + UName = string:concat(UnionName, "Holder"), + {Fd, _} = ic_file:open_java_file(G, N, UName), + + ic_codegen:emit(Fd, "final public class ~sHolder {\n",[UnionName]), + + ic_codegen:emit(Fd, " // instance variables\n"), + ic_codegen:emit(Fd, " public ~s value;\n", [UnionName]), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, " // constructors\n"), + ic_codegen:emit(Fd, " public ~sHolder() {}\n", [UnionName]), + ic_codegen:emit(Fd, " public ~sHolder(~s initial) {\n", + [UnionName, UnionName]), + ic_codegen:emit(Fd, " value = initial;\n"), + ic_codegen:emit(Fd, " }\n"), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, " // methods\n"), + + ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out) throws java.lang.Exception {\n", + [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [UnionName]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in) throws java.lang.Exception {\n", + [?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [UnionName]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, "}\n"), + file:close(Fd). + + +%%----------------------------------------------------------------- +%% Func: emit_helper_class/4 +%%----------------------------------------------------------------- +emit_helper_class(G, N, X, UnionName, WiredUnionName) -> + UName = string:concat(UnionName, "Helper"), + {Fd, _} = ic_file:open_java_file(G, N, UName), + + DiscrType = ic_java_type:getType(G, [ UnionName ++ "Package" |N], + ic_forms:get_type(X)), + + ic_codegen:emit(Fd, "public class ~sHelper {\n",[UnionName]), + + ic_codegen:emit(Fd, " // constructors\n", []), + ic_codegen:emit(Fd, " private ~sHelper() {}\n", [UnionName]), + ic_codegen:nl(Fd), + + ic_codegen:emit(Fd, " // methods\n", []), + MList = union_member_list(G, N, X, DiscrType), + + ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s _value)\n", + [?ERLANGPACKAGE, UnionName]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static ~s unmarshal(~sOtpInputStream _in)\n", + [UnionName, ?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static String id() {\n"), + ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static String name() {\n"), + ic_codegen:emit(Fd, " return ~p;\n",[UnionName]), + ic_codegen:emit(Fd, " }\n\n"), + + ic_jbe:emit_type_function(G, N, X, Fd), + + + ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s _this)\n", + [?ICPACKAGE,UnionName]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), + ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), + + ic_codegen:emit(Fd, " _any.type(type());\n"), + ic_codegen:emit(Fd, " marshal(_os, _this);\n"), + ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static ~s extract(~sAny _any)\n", + [UnionName,?ICPACKAGE]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), + + ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " public static int discriminatorAsInt(~s _discriminator)\n", + [DiscrType]), + ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), + emit_discriminator_as_int(G, N, ic_forms:get_type(X), Fd), + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, "}\n"), + file:close(Fd). + +%%----------------------------------------------------------------- +%% Func: emit_union_members_functions/7 +%%----------------------------------------------------------------- +emit_union_members_functions(_, _, _, _, _, _, [], _) -> + ok; +emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, + [{Label, Case, TypeDef, Id, Ls} | MList], MListTot) -> + + CaseId = Case#case_dcl.id, %% Maybe Array + CaseType = Case#case_dcl.type, %% Maybe Sequence + + Type = if element(1,CaseId) == array -> + ic_java_type:getType(G, N, TypeDef) ++ + ic_java_type:getdim(CaseId#array.size); + true -> + ic_java_type:getType(G, N, TypeDef) + end, + + HolderType = + if element(1,CaseId) == array -> + ic_java_type:getHolderType(G, N, CaseId); + true -> + if element(1,CaseType) == sequence -> + ic_util:to_dot(G,[Id|N]) ++"Holder"; + true -> + ic_java_type:getHolderType(G, N, TypeDef) + end + end, + + %% + %% Set method + %% + ic_codegen:emit(Fd, " // ~s access and set functions\n",[Id]), + ic_codegen:emit(Fd, " public void ~s(~s value) " + "throws java.lang.Exception {\n", + [Id, Type]), + ic_codegen:emit(Fd, " _initialized = true;\n", []), + case Label of + "default" -> + ic_codegen:emit(Fd, " _discriminator = (~s) _default;\n", + [DiscrType]); + _ -> + case ic_java_type:isBasicType(G, N, ic_forms:get_type(X)) of + true -> + ic_codegen:emit(Fd, " _discriminator = (~s) " + "~s;\n", + [DiscrType, Label]); + _ -> + ic_codegen:emit(Fd, " _discriminator = (~s) " + "~s.~s;\n", + [DiscrType, DiscrType, Label]) + end + end, + ic_codegen:emit(Fd, " _value = new ~s(value);\n", + [HolderType]), + ic_codegen:emit(Fd, " }\n", []), + + %% + %% Check this entry has more than one label and the generate an extra set method. + %% + case Ls of + [] -> + ok; + _ -> + ic_codegen:emit(Fd, " public void ~s(~s discriminator, ~s value) " + "throws java.lang.Exception {\n", + [Id, DiscrType, Type]), + ic_codegen:emit(Fd, " _initialized = true;\n", []), + ic_codegen:emit(Fd, " _discriminator = (~s) discriminator;\n", + [DiscrType]), + ic_codegen:emit(Fd, " _value = new ~s(value);\n", + [HolderType]), + ic_codegen:emit(Fd, " }\n", []) + end, + + %% + %% Get method + %% + ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n", + [Type, Id]), + ic_codegen:emit(Fd, " if (!_initialized) {\n", []), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt" + "(discriminator())) {\n", + [UnionName]), + if + Label == "default" -> + ic_codegen:emit(Fd, " default:\n", []), + ic_codegen:emit(Fd, " break;\n", []), + emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, + MListTot), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []); + true -> + ic_codegen:emit(Fd, " case ~s:\n", + [get_case_as_int(G, N, ic_forms:get_type(X), + DiscrType, Label)]), + ic_codegen:emit(Fd, " break;\n", []), + ic_codegen:emit(Fd, " default:\n", []), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []) + end, + ic_codegen:emit(Fd, " }\n", []), + + ic_codegen:emit(Fd, " return ((~s) _value).value;\n", + [HolderType]), + ic_codegen:emit(Fd, " }\n", []), + ic_codegen:nl(Fd), + emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, MList, + MListTot). + + +%%----------------------------------------------------------------- +%% Func: emit_default_access_fun_switch_cases/6 +%%----------------------------------------------------------------- +emit_default_access_fun_switch_cases(_G, _N, _X, _Fd, _DiscrType, []) -> + ok; +emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, + [{"default", _, _, _, _} |MList]) -> + emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList); +emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, + [{Label, _Case, _TypeDef, _Id, _} | MList]) -> + ic_codegen:emit(Fd, " case ~s:\n", + [get_case_as_int(G, N, ic_forms:get_type(X), + DiscrType, Label)]), + emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList). + + + +%%----------------------------------------------------------------- +%% Func: emit_union_unmarshal_function/5 +%%----------------------------------------------------------------- +emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> + DiscrTypeForm = ic_forms:get_type(X), + DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], + DiscrTypeForm), + + ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), + + ic_codegen:emit(Fd, " if ((_in.read_atom()).compareTo(~p) != 0)\n", + [ic_util:to_undersc([WiredUnionName|N])]), + ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n\n",[]), + + ic_codegen:emit(Fd, " ~s _value = new ~s();\n", [UnionName, UnionName]), + + %% Decode discriminator + case ic_java_type:isBasicType(G, N, DiscrTypeForm) of + true -> + ic_codegen:emit(Fd, " ~s _discriminator = _in~s;\n\n", + [DiscrType, + ic_java_type:unMarshalFun(G, N, X, DiscrTypeForm)]); + _ -> + ic_codegen:emit(Fd, " ~s _discriminator = ~s.unmarshal(_in);\n\n", + [DiscrType,ic_java_type:getUnmarshalType(G, N, X, DiscrTypeForm)]) + end, + + ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt(_discriminator)) {\n", + [UnionName]), + + emit_union_unmarshal_function_loop(G, [UnionName ++ "Package"|N], X, + Fd, DiscrType, MList), + + ic_codegen:emit(Fd, " }\n\n"), + + ic_codegen:emit(Fd, " return _value;\n"). + +%%----------------------------------------------------------------- +%% Func: emit_union_unmarshal_function_loop/6 +%%----------------------------------------------------------------- +emit_union_unmarshal_function_loop(_, _, _, _, _, []) -> + ok; +emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, + [{Label, Case, Type, Id, Ls} |MList]) -> + case Label of + "default" -> + ic_codegen:emit(Fd, " default:\n"); + _ -> + ic_codegen:emit(Fd, " case ~s:\n", + [get_case_as_int(G, N, ic_forms:get_type(X), + DiscrType, Label)]) + end, + + gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), + + CaseId = Case#case_dcl.id, %% Maybe Array + CaseType = Case#case_dcl.type, %% Maybe Sequence + + case element(1,CaseId) of + array -> + ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", + [Id, + ic_java_type:getUnmarshalType(G, N, Case, CaseId)]); + + _ -> + case element(1, CaseType) of + sequence -> + ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", + [Id, + ic_java_type:getUnmarshalType(G, N, Case, CaseType)]); + _ -> + case ic_java_type:isBasicType(G, N, CaseType) of + true -> + ic_codegen:emit(Fd, " _value.~s(_in~s);\n", + [Id, + ic_java_type:unMarshalFun(G, N, X, Type)]); + false -> + ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", + [Id, + ic_java_type:getUnmarshalType(G, N, X, Type)]) + end + end + end, + + ic_codegen:emit(Fd, " break;\n", []), + emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, MList). + + + + + +%%----------------------------------------------------------------- +%% Func: emit_union_marshal_function/6 +%%----------------------------------------------------------------- +emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> + + DiscrTypeForm = ic_forms:get_type(X), + DiscrType = ic_java_type:getType(G, [UnionName ++ "Package" |N], + DiscrTypeForm), + + ic_codegen:emit(Fd, " _out.write_tuple_head(3);\n"), + ic_codegen:emit(Fd, " _out.write_atom(~p);\n", + [ic_util:to_undersc([WiredUnionName|N])]), + + case ic_java_type:isBasicType(G, N, DiscrTypeForm) of + true -> + ic_codegen:emit(Fd, " _out~s(_value.discriminator());\n\n", + [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]); + false -> + ic_codegen:emit(Fd, " ~s(_out, _value.discriminator());\n\n", + [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]) + end, + + ic_codegen:emit(Fd, " switch(~sHelper.discriminatorAsInt(_value.discriminator())) {\n", + [UnionName]), + + emit_union_marshal_function_loop(G, + [ UnionName ++ "Package"|N], + X, + Fd, + DiscrType, + MList), + + ic_codegen:emit(Fd, " }\n\n", []). + + +%%----------------------------------------------------------------- +%% Func: emit_union_marshal_function_loop/ +%%----------------------------------------------------------------- +emit_union_marshal_function_loop(_, _, _, _, _, []) -> + ok; +emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, + [{Label, Case, Type, Id, Ls} |MList]) -> + case Label of + "default" -> + ic_codegen:emit(Fd, " default:\n", + []); + _ -> + ic_codegen:emit(Fd, " case ~s:\n", + [get_case_as_int(G, N, ic_forms:get_type(X), + DiscrType, Label)]) + end, + + gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), + + + CaseId = Case#case_dcl.id, %% Maybe Array + CaseType = Case#case_dcl.type, %% Maybe Sequence + + case element(1,CaseId) of + array -> + ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", + [ic_java_type:marshalFun(G, N, Case, CaseId), + Id]); + _ -> + case element(1, CaseType) of + sequence -> + ic_codegen:emit(Fd, " ~s.marshal(_out, _value.~s());\n", + [ic_util:to_dot(G,[Id|N]) ++ "Helper", + Id]); + _ -> + case ic_java_type:isBasicType(G, N, CaseType) of + true -> + ic_codegen:emit(Fd, " _out~s(_value.~s());\n", + [ic_java_type:marshalFun(G, N, X, Type), + Id]); + false -> + ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", + [ic_java_type:marshalFun(G, N, X, Type), + Id]) + end + end + end, + + ic_codegen:emit(Fd, " break;\n", []), + emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, MList). + + + +gen_multiple_cases(_G, _N, _X, _Fd, _DiscrType, []) -> + ok; +gen_multiple_cases(G, N, X, Fd, DiscrType, [Label |Ls]) -> + ic_codegen:emit(Fd, " case ~s:\n", + [get_case_as_int(G, N, ic_forms:get_type(X), + DiscrType, getLabel(DiscrType, Label))]), + gen_multiple_cases(G, N, X, Fd, DiscrType, Ls). + + +%%----------------------------------------------------------------- +%% Func: union_member_list/3 +%%----------------------------------------------------------------- +union_member_list(G, N, X, DiscrType) -> + M = lists:map( + fun(Case) -> + {Label, LabelList} = case check_default(ic_forms:get_idlist(Case)) of + {{default, C}, List} -> + {{default, C}, List}; + {L, []} -> + {L, []}; + {_, [L |Ls]} -> + {L, Ls} + end, + + CName = ic_forms:get_java_id(Case), + CId = Case#case_dcl.id, + CType = Case#case_dcl.type, + + if element(1,CId) == array -> + N2 = [ic_forms:get_id2(X) ++ "Package" |N], + ic_array_java:gen(G, N2, Case, CId); + true -> + if element(1,Case#case_dcl.type) == sequence -> + N2 = [ic_forms:get_id2(X) ++ "Package" |N], + ic_sequence_java:gen(G, N2, CType, CName); + true -> + ok + end + end, + + {getLabel(DiscrType, Label), + Case, + ic_forms:get_type(Case), + CName, + LabelList} + end, + ic_forms:get_body(X)), + lists:flatten(M). + +check_default([]) -> + {false, []}; +check_default([{default, X} |Ls]) -> + {{default, X}, Ls}; +check_default([L]) -> + {false, [L]}; +check_default([L |Ls]) -> + {X, Y} = check_default(Ls), + {X, [L | Y]}. + +getLabel(_, {'<integer_literal>', _, N}) -> + N; +getLabel(_, {'<character_literal>', _, N}) -> + "'" ++ N ++ "'"; +getLabel(_, {'<wcharacter_literal>', _, N}) -> + "'" ++ N ++ "'"; +getLabel(_, {'TRUE',_}) -> + "true"; +getLabel(_, {'FALSE',_}) -> + "true"; +getLabel(_, {default, _}) -> + "default"; +getLabel(_DiscrType, X) -> %%DiscrType ++ "." ++ + ic_util:to_dot(ic_forms:get_id(X)). + +get_default_val(G, N, _, tk_short, MList) -> + integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, _, tk_long, MList) -> + integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, _, tk_ushort, MList) -> + integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, _, tk_ulong, MList) -> + integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, _, tk_char, MList) -> + char_default_val(G, N, $a, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, _, tk_boolean, MList) -> + boolean_default_val(G, N, lists:map(fun({V, _, _, _, _}) -> V end, MList)); +get_default_val(G, N, DiscrType, {tk_enum, _, _, Values}, MList) -> + enum_default_val(G, N, DiscrType, Values, MList). + +integer_default_val(G, N, Num, MList) -> + Num2 = integer_to_list(Num), + case lists:member(Num2, MList) of + true -> + integer_default_val(G, N, Num + 1, MList); + false -> + Num2 + end. + +char_default_val(G, N, CharNum, MList) -> + Str = "'", + CharNum2 = Str ++ [CharNum | Str], + case lists:member(CharNum2, MList) of + true -> + char_default_val(G, N, CharNum + 1, MList); + false -> + CharNum2 + end. + +boolean_default_val(G, N, MList) -> + if + length(MList) > 2 -> + ic_error:error(G, {plain_error_string, + lists:flatten( + io_lib:format("Default value found while all values have label on ~s", + [ic_util:to_colon(N)]))}), + none; + true -> + case MList of + ["true"] -> + "false"; + ["false"] -> + "true"; + ["default","true"] -> + "false"; + ["true","default"] -> + "false"; + ["default","false"] -> + "true"; + ["false","default"] -> + "true"; + _ -> + none + end + end. + + + + +enum_default_val(G, N, DiscrType, Values, Mlist) -> + + VLen = length(Values), + MLen = length(Mlist), + + case MLen > VLen of + true -> + ic_error:error(G, {plain_error_string, + lists:flatten( + io_lib:format("Default value found while all values have label on ~s", + [ic_util:to_colon(N)]))}), + none; + false -> + enum_default_val_loop(G, N, DiscrType, Values, Mlist) + end. + +enum_default_val_loop(_G, _N, _, [], []) -> + none; +enum_default_val_loop(_G, _N, DiscrType, [Value| _], []) -> + DiscrType ++ "." ++ Value; +enum_default_val_loop(G, N, DiscrType, Values, [Case | MList]) when is_tuple(Case) -> + NewValues = lists:delete(element(1,Case), Values), + enum_default_val_loop(G, N, DiscrType, NewValues, MList). + + + +emit_discriminator_as_int(G, N, T, Fd) -> + case ictype:isBoolean(G,N,T) of + true -> + ic_codegen:emit(Fd, " if(_discriminator)\n", []), + ic_codegen:emit(Fd, " return 1;\n", []), + ic_codegen:emit(Fd, " else\n", []), + ic_codegen:emit(Fd, " return 0;\n", []); + false -> + case ictype:isEnum(G, N, T) of + true -> + ic_codegen:emit(Fd, " return _discriminator.value();\n", + []); + false -> + ic_codegen:emit(Fd, " return _discriminator;\n", []) + end + end. + + +get_case_as_int(G, N, T, DiscrJavaTypeName, Label) -> + case ictype:isBoolean(G,N,T) of + true -> + case Label of + "true" -> + "1"; + "false" -> + "0" + end; + false -> + case ictype:isEnum(G, N, T) of + true -> + DiscrJavaTypeName ++ "._" ++ Label; + false -> + "(" ++ DiscrJavaTypeName ++ ") " ++ Label + end + end. + + + diff --git a/lib/ic/src/ic_util.erl b/lib/ic/src/ic_util.erl new file mode 100644 index 0000000000..1a6acb286a --- /dev/null +++ b/lib/ic/src/ic_util.erl @@ -0,0 +1,313 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ic_util). + + +-include("icforms.hrl"). +-include("ic.hrl"). +-include("ic_debug.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- + +-export([mk_align/1, mk_list/1, join/2, chain/2, mk_name/2, + mk_OE_name/2, mk_oe_name/2, mk_var/1]). + +-export([to_atom/1, to_colon/1, to_list/1, to_undersc/1, to_dot/1, + to_dot/2]). +-export([to_uppercase/1, adjustScopeToJava/2, eval_java/3, eval_c/3]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +%% mk_list produces a nice comma separated string of variable names +mk_list([]) -> []; +mk_list([Arg | Args]) -> + Arg ++ mk_list2(Args). +mk_list2([Arg | Args]) -> + ", " ++ Arg ++ mk_list2(Args); +mk_list2([]) -> []. + +%% Produce a list of items separated by S. +join([E1, E2| Es], S) -> + [E1, S| join([E2| Es], S)]; +join([E], _) -> + [E]; +join([], _) -> + []. + +%% Produce a list of items, each terminated by T. +chain([E| Es], T) -> + [E, T| chain(Es, T)]; +chain([], _) -> + []. + + +%% Shall convert a string to a Erlang variable name (Capitalise) +mk_var( [N | Str] ) when N >= $a, N =< $z -> + [ N+$A-$a | Str ]; +mk_var( [N | Str] ) when N >= $A, N =< $Z -> [N | Str]. + +%% Shall produce a "public" name for name. When we introduce new +%% identifiers in the mapping that must not collide with those from +%% the IDL spec. +%% +%% NOTE: Change name of IFR ID in system exceptions in corba.hrl when +%% prefix is changed here. +%% +mk_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). +mk_OE_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). +mk_oe_name(_Gen, Name) -> lists:flatten(["oe_" | Name]). + +mk_align(String) -> + io_lib:format("OE_ALIGN(~s)",[String]). + +to_atom(A) when is_atom(A) -> A; +to_atom(L) when is_list(L) -> list_to_atom(L). + +to_list(A) when is_list(A) -> A; +to_list(L) when is_atom(L) -> atom_to_list(L); +to_list(X) when is_integer(X) -> integer_to_list(X). + + + +%% Produce a colon (or under score) separated string repr of the name +%% X +%% +to_colon(X) when element(1, X) == scoped_id -> + to_colon2(ic_symtab:scoped_id_strip(X)); +to_colon(L) -> to_colon2(L). + +to_colon2([X]) -> X; +to_colon2([X | Xs]) -> to_colon2(Xs) ++ "::" ++ X; +to_colon2([]) -> "". + + +to_undersc(X) when element(1, X) == scoped_id -> + to_undersc2(ic_symtab:scoped_id_strip(X)); +to_undersc(L) -> to_undersc2(L). + +to_undersc2([X]) -> X; +to_undersc2([X | Xs]) -> to_undersc2(Xs) ++ "_" ++ X; +to_undersc2([]) -> "". + + +%% Z is a single name +to_uppercase(Z) -> + lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; + (X) -> X end, Z). + + +%% +to_dot(X) when element(1, X) == scoped_id -> + to_dotLoop(ic_symtab:scoped_id_strip(X)); +to_dot(L) -> to_dotLoop(L). + +to_dotLoop([X]) -> ic_forms:get_java_id(X); +to_dotLoop([X | Xs]) -> to_dotLoop(Xs) ++ "." ++ ic_forms:get_java_id(X); +to_dotLoop([]) -> "". + + + +%% +to_dot(G,X) when element(1, X) == scoped_id -> + S = ic_genobj:pragmatab(G), + ScopedId = ic_symtab:scoped_id_strip(X), + case isConstScopedId(S, ScopedId) of %% Costants are left as is + true -> + to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); + false -> + to_dotLoop(S,ScopedId) + end; +to_dot(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + case isConstScopedId(S, ScopedId) of %% Costants are left as is + true -> + to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); + false -> + to_dotLoop(S,ScopedId) + end. + +addDotValue(S, [_C | Ss]) -> + case isInterfaceScopedId(S, Ss) of + true -> + ""; + false -> + ".value" + end. + +to_dotLoop(S,[X]) -> + case isInterfaceScopedId(S, [X]) of + true -> + ic_forms:get_java_id(X) ++ "Package"; + false -> + ic_forms:get_java_id(X) + end; +to_dotLoop(S,[X | Xs]) -> + case isInterfaceScopedId(S, [X | Xs]) of + true -> + to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) ++ "Package"; + false -> + to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) + end; +to_dotLoop(_S,[]) -> "". + +isInterfaceScopedId(_S,[]) -> + false; +isInterfaceScopedId(S,[X|Xs]) -> + case ets:match(S,{file_data_local,'_','_',interface,Xs,X,'_','_','_'}) of + [] -> + case ets:match(S,{file_data_included,'_','_',interface,Xs,X,'_','_','_'}) of + [] -> + false; + _ -> + true + end; + _ -> + true + end. + +isConstScopedId(_S,[]) -> + false; +isConstScopedId(S,[X|Xs]) -> + case ets:match(S,{file_data_local,'_','_',const,Xs,X,'_','_','_'}) of + [] -> + case ets:match(S,{file_data_included,'_','_',const,Xs,X,'_','_','_'}) of + [] -> + false; + _ -> + true + end; + _ -> + true + end. + + + +%% +adjustScopeToJava(G,X) when element(1, X) == scoped_id -> + S = ic_genobj:pragmatab(G), + ScopedId = ic_symtab:scoped_id_strip(X), + case isConstScopedId(S, ScopedId) of %% Costants are left as is + true -> + ic_forms:get_java_id(ScopedId); + false -> + adjustScopeToJavaLoop(S,ScopedId) + end; +adjustScopeToJava(G,ScopedId) -> + S = ic_genobj:pragmatab(G), + case isConstScopedId(S, ScopedId) of %% Costants are left as is + true -> + ic_forms:get_java_id(ScopedId); + false -> + adjustScopeToJavaLoop(S,ScopedId) + end. + + + +adjustScopeToJavaLoop(_S,[]) -> + []; +adjustScopeToJavaLoop(S,[X | Xs]) -> + case isInterfaceScopedId(S, [X | Xs]) of + true -> + [ic_forms:get_java_id(X) ++ "Package" | adjustScopeToJavaLoop(S,Xs)]; + false -> + [ic_forms:get_java_id(X) | adjustScopeToJavaLoop(S,Xs)] + end. + + +%% +%% Expression evaluator for java +%% +%% Well, this is not an evaluator, it just +%% prints the hole operation, sorry. +%% +eval_java(G,N,Arg) when is_record(Arg, scoped_id) -> + {FSN, _, _, _} = + ic_symtab:get_full_scoped_name(G, N, Arg), + ic_util:to_dot(G,FSN); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> + element(3,Arg); +eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> + element(3,Arg); +eval_java(G,N,{Op,Arg1,Arg2}) -> + "(" ++ eval_java(G,N,Arg1) ++ + ic_forms:get_java_id(Op) ++ + eval_java(G,N,Arg2) ++ ")". + + + +%% +%% Expression evaluator for c +%% +%% Well, this is not an evaluator, it just +%% prints the hole operation, sorry. +%% +eval_c(G,N,Arg) when is_record(Arg, scoped_id) -> + {FSN, _, _, _} = + ic_symtab:get_full_scoped_name(G, N, Arg), + ic_util:to_undersc(FSN); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> + element(3,Arg); +eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> + element(3,Arg); +eval_c(G,N,{Op,Arg1,Arg2}) -> + "(" ++ eval_c(G,N,Arg1) ++ + atom_to_list(Op) ++ + eval_c(G,N,Arg2) ++ ")". + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- + + + + + + diff --git a/lib/ic/src/icenum.erl b/lib/ic/src/icenum.erl new file mode 100644 index 0000000000..0af200e229 --- /dev/null +++ b/lib/ic/src/icenum.erl @@ -0,0 +1,205 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%----------------------------------------------------------------- +%% File: icenum.erl +%% +%% +%%----------------------------------------------------------------- +%% +%% Code generation for enum's. +%%----------------------------------------------------------------- +-module(icenum). + +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). + +-include("icforms.hrl"). +-include("ic.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([enum_gen/4]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +enum_gen(G, N, X, c) when is_record(X, enum) -> + emit_c_enum(G, N, X); +enum_gen(_G, _N, _X, _L) -> + ok. + + +emit_c_enum(G, N, X) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + EnumName = [ic_forms:get_id2(X) | N], + + case ic_pragma:is_local(G,EnumName) of + true -> + + Fd = ic_genobj:hrlfiled(G), + EnumNameStr = ic_util:to_undersc(EnumName), + ic_code:insert_typedef(G, EnumNameStr, {enum, EnumNameStr}), + {tk_enum,_,_,EList} = ic_forms:get_tk(X), + emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), + emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), + ic_codegen:mcomment_light(Fd, + [io_lib:format("Enum definition: ~s", + [EnumNameStr])], + c), + emit(Fd, "typedef CORBA_enum {", []), + emit_c_enum_values(G, N, Fd, EList), + emit(Fd, "} ~s ;\n\n", [EnumNameStr]), + create_c_enum_file(G, N, EnumNameStr, EList), + emit(Fd, "\n#endif\n\n"); + + false -> %% Do not generate included types att all. + ok + end; + + false -> + ok + end. + + +emit_c_enum_values(_G, N, Fd, [E]) -> + emit(Fd, "~s", [ic_util:to_undersc([E| N])]); +emit_c_enum_values(G, N, Fd, [E |Es]) -> + emit(Fd, "~s, ", [ic_util:to_undersc([E| N])]), + emit_c_enum_values(G, N, Fd, Es). + + +open_c_coding_file(G, Name) -> + SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), + FName = + ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), + case file:open(FName, [write]) of + {ok, Fd} -> + {Fd, SName}; + Other -> + exit(Other) + end. + + +create_c_enum_file(G, N, Name, Elist) -> + + {Fd , SName} = open_c_coding_file(G, Name), + HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + HrlFName = filename:basename(ic_genobj:include_file(G)), + ic_codegen:emit_stub_head(G, Fd, SName, c), + emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile + %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + %% HrlFName = filename:basename(ic_genobj:include_file(G)), + %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + emit(Fd, "char* ~s[~p] = {\n", [ic_util:mk_oe_name(G, Name), + length(Elist)]), + emit_c_enum_array_values(Fd, Elist), + emit(Fd, "};\n\n",[]), + emit_sizecount(G, N, Fd, HFd, Name, Elist), + emit_encode(G, N, Fd, HFd, Name, Elist), + emit_decode(G, N, Fd, HFd, Name, Elist), + file:close(Fd). + +emit_c_enum_array_values(Fd, [E]) -> + emit(Fd, " ~p\n", [E]); +emit_c_enum_array_values(Fd, [E |Es]) -> + emit(Fd, " ~p,\n", [E]), + emit_c_enum_array_values(Fd, Es). + + +emit_sizecount(G, _N, Fd, HFd, Name, _Elist) -> + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", + [ic_util:mk_oe_name(G, "sizecalc_"), Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size)\n" + "{\n", + [ic_util:mk_oe_name(G, "sizecalc_"), Name]), + emit(Fd, " int oe_error_code = 0;\n\n",[]), + + AlignName = lists:concat(["*oe_size + sizeof(",Name,")"]), + emit(Fd, " *oe_size = ~s;\n\n",[ic_util:mk_align(AlignName)]), + + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n\n",[]). + + +emit_encode(G, _N, Fd, HFd, Name, _Elist) -> + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", + [ic_util:mk_oe_name(G, "encode_"), Name, Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", + [ic_util:mk_oe_name(G, "encode_"), Name, Name]), + emit(Fd, " int oe_error_code = 0;\n\n",[]), + + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, ~s[oe_rec])) < 0) {\n", + [ic_util:mk_oe_name(G, Name)]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n\n",[]). + +emit_decode(G, _N, Fd, HFd, Name, Elist) -> + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", + [ic_util:mk_oe_name(G, "decode_"), Name, Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_outindex, " + "~s *oe_out) {\n\n", + [ic_util:mk_oe_name(G, "decode_"), Name, Name]), + emit(Fd, " int oe_error_code = 0;\n",[]), + emit(Fd, " int oe_i;\n",[]), + emit(Fd, " char oe_atom[256];\n\n",[]), + + AlignName = lists:concat(["*oe_outindex + sizeof(",Name,")"]), + emit(Fd, " *oe_outindex = ~s;\n\n",[ic_util:mk_align(AlignName)]), + + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_atom)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + + Len = length(Elist), + emit(Fd, " for(oe_i = 0; oe_i < ~p && strcmp(oe_atom, ~s[oe_i]); oe_i++);\n", + [Len, ic_util:mk_oe_name(G, Name)]), + emit(Fd, " *oe_out = oe_i;\n\n", []), + + emit(Fd, " if (oe_i == ~p) {\n",[Len]), + emit_c_enc_rpt(Fd, " ", "decode atom failure", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " return 0;\n",[]), + emit(Fd, "}\n\n",[]). + + + + + diff --git a/lib/ic/src/iceval.erl b/lib/ic/src/iceval.erl new file mode 100644 index 0000000000..81093dcd5b --- /dev/null +++ b/lib/ic/src/iceval.erl @@ -0,0 +1,555 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(iceval). + +-include("icforms.hrl"). + +-export([eval_const/5, eval_e/5]). + +-export([check_tk/3, get_val/1, mk_val/1]). + +-define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end). +-define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end). + +-define(BASE, 100000000000000000000000000000000). +-define(FIXED_MAX, 9999999999999999999999999999999). + +%% Called fr: ictype 99, 522, 533 +%% Fixed constants can be declared as: +%% (1) const fixed pi = 3.14D; or +%% (2) typedef fixed<3,2> f32; +%% const f32 pi = 3.14D; +%% Hence, if fixed is declared as (1) we must handle it especially. +eval_const(G, S, N, tk_fixed, Expr) -> + case catch eval_e(G, S, N, tk_fixed, Expr) of + T when element(1, T) == error -> 0; + V when is_record(V, fixed) -> + {ok, {tk_fixed, V#fixed.digits, V#fixed.scale}, V}; + V -> + ic_error:error(G, {bad_tk_match, Expr, tk_fixed, get_val(V)}) + end; +eval_const(G, S, N, TK, Expr) -> + case catch eval_e(G, S, N, TK, Expr) of + T when element(1, T) == error -> 0; + V -> + case check_tk(G, TK, V) of + true -> ok; + false -> + ic_error:error(G, {bad_tk_match, Expr, TK, get_val(V)}) + end, + get_val(V) + end. + + +check_op(G, S, N, Tk, Types, Op, E1, E2) -> + V1 = eval_e(G, S, N, Tk, E1), + V2 = eval_e(G, S, N, Tk, E2), + check_types(G, Op, E1, Types, V1), + check_types(G, Op, E2, Types, V2), + case check_comb(V1, V2) of + true -> + {V1, V2}; + false -> + Err = {bad_type_combination, E1, get_val(V1), get_val(V2)}, + ic_error:error(G, Err), + throw({error, Err}) + end. + +check_op(G, S, N, Tk, Types, Op, E1) -> + V1 = eval_e(G, S, N, Tk, E1), + check_types(G, Op, E1, Types, V1), + V1. + +%% Match the declared type TK against the factual value of an constant +%% +check_tk(_G, _Any, default) -> true; % Default case in union +check_tk(_G, positive_int, V) when is_integer(V) andalso V >= 0 -> true; +check_tk(_G, tk_long, V) when is_integer(V) -> true; +check_tk(_G, tk_longlong, V) when is_integer(V) -> true; %% LLON_G +check_tk(_G, tk_short, V) when is_integer(V) -> true; +check_tk(_G, tk_ushort, V) when is_integer(V) andalso V >= 0 -> true; +check_tk(_G, tk_ulong, V) when is_integer(V) andalso V >= 0 -> true; +check_tk(_G, tk_ulonglong, V) when is_integer(V) andalso V >= 0 -> true; %% ULLON_G +check_tk(_G, tk_float, V) when is_float(V) -> true; +check_tk(_G, tk_double, V) when is_float(V) -> true; +check_tk(_G, tk_boolean, V) -> is_bool(V); +check_tk(_G, tk_char, {char, _V}) -> true; +check_tk(_G, tk_wchar, {wchar, _V}) -> true; %% WCHAR +check_tk(_G, {tk_string, _Len}, {string, _V}) -> true; +check_tk(_G, {tk_wstring, _Len}, {wstring, _V}) -> true; %% WSTRING +check_tk(_G, {tk_fixed, Digits, Scale}, {fixed, Digits, Scale, _V}) -> true; +check_tk(_G, tk_octet, V) when is_integer(V) -> true; +%%check_tk(_G, tk_null, V) when integer(V) -> true; +%%check_tk(_G, tk_void, V) when integer(V) -> true; +%%check_tk(_G, tk_any, V) when integer(V) -> true; +%%check_tk(_G, {tk_objref, "", "Object"}, V) when integer(V) -> true. +check_tk(_G, {tk_enum, _, _, Body}, {enum_id, Id}) -> + until(fun(X) when X == Id -> true; + (_X) -> + false + end, Body); +check_tk(_G, _TK, _V) -> + false. + +get_val({string, X}) -> X; +get_val({wstring, X}) -> X; %% WCHAR +get_val({char, X}) -> X; +get_val({wchar, X}) -> X; %% WSTRING +get_val({enum_id, X}) -> X; +get_val(X) -> X. + +check_types(G, Op, Expr, TypeList, V) -> + case until(fun(int) when is_integer(V) -> true; + (float) when is_float(V) -> true; + (bool) when V==true -> true; + (bool) when V==false -> true; + (fixed) when is_record(V, fixed) -> true; + (_) -> false end, + TypeList) of + true -> true; + false -> + Err = {bad_type, Expr, Op, TypeList, V}, + ic_error:error(G, Err), + throw({error, Err}) + end. + +%%get_op(T) when tuple(T) -> element(1, T). + +%% Should be in lists +until(F, [H|T]) -> + case F(H) of + true -> true; + false -> until(F, T) + end; +until(_F, []) -> false. + +%% Section of all the boolean operators (because Erlang ops don't like +%% boolean values. +e_or(X, Y) when is_integer(X) andalso is_integer(Y) -> X bor Y; +e_or(true, _) -> true; +e_or(_, true) -> true; +e_or(_, _) -> false. + +e_and(X, Y) when is_integer(X) andalso is_integer(Y) -> X band Y; +e_and(true, true) -> true; +e_and(_, _) -> false. + +e_xor(X, Y) when is_integer(X) andalso is_integer(Y) -> X bxor Y; +e_xor(X, X) -> false; +e_xor(_, _) -> true. + +%% Handling infix operators (+,-,*,/) for fixed type. +%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> +e_fixed_add(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + Scale = ?get_max(S1, S2), + Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, + %% We must normalize the values before adding. Why? + %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the + %% correct result we must add 4230 and 5200 == 9430. + {PV1, PV2} = normalize(S1, V1, S2, V2), + check_fixed_overflow(#fixed{digits = Digits, + scale = Scale, + value = (PV1 + PV2)}). + +%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> +e_fixed_sub(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + Scale = ?get_max(S1, S2), + Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, + {PV1, PV2} = normalize(S1, V1, S2, V2), + check_fixed_overflow(#fixed{digits = Digits, + scale = Scale, + value = (PV1 - PV2)}). + +%% Boundries determined as fixed<d1+d2, s1+s2> +e_fixed_mul(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + check_fixed_overflow(#fixed{digits = (D1+D2), + scale = (S1+S2), + value = V1*V2}). + +%% Boundries determined as fixed<(d1-s1+s2) + s inf ,s inf> +e_fixed_div(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = _D2, scale = S2, value = V2}) -> + {PV1, PV2} = normalize(S1, V1, S2, V2), + DigitsMin = (D1-S1+S2), + R1 = (PV1 div PV2), + R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)), + {Result2, Sinf} = delete_zeros_value(R2, 0, R1), + check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf, + value = Result2}). + + +%% Checks combination of argument types, basically floats and ints are +%% interchangeable, and all types are allowed with themselves. No +%% other combinations are allowed +%% +check_comb(X, Y) when is_integer(X) andalso is_integer(Y) -> true; +check_comb(X, Y) when is_float(X) andalso is_integer(Y) -> true; +check_comb(X, Y) when is_integer(X) andalso is_float(Y) -> true; +check_comb(X, Y) when is_float(X) andalso is_float(Y) -> true; +check_comb({X, _}, {X, _}) -> true; % Strings and chars are tuples +check_comb({fixed, _, _, _}, {fixed, _, _, _}) -> true; +check_comb(X, Y) -> + case {is_bool(X), is_bool(Y)} of + {true, true} -> + true; + _ -> + false + end. + +is_bool(true) -> true; +is_bool(false) -> true; +is_bool(_) -> false. + + +%%%% (15) +eval_e(G, S, N, Tk, {'or', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'or', T1, T2), + e_or(E1, E2); + +%%%% (16) +eval_e(G, S, N, Tk, {'xor', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'xor', T1, T2), + e_xor(E1, E2); + +%%%% (17) +eval_e(G, S, N, Tk, {'and', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'and', T1, T2), + e_and(E1, E2); + +%%%% (18) +eval_e(G, S, N, Tk, {'rshift', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int], 'rshift', T1, T2), + E1 bsr E2; +eval_e(G, S, N, Tk, {'lshift', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int], 'lshift', T1, T2), + E1 bsl E2; + +%%%% (19) +eval_e(G, S, N, Tk, {'+', T1, T2}) -> + case check_op(G, S, N, Tk, [int, float, fixed], '+', T1, T2) of + {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> + e_fixed_add(F1, F2); + {E1, E2} -> + E1 + E2 + end; +eval_e(G, S, N, Tk, {'-', T1, T2}) -> + case check_op(G, S, N, Tk, [int, float, fixed], '-', T1, T2) of + {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> + e_fixed_sub(F1, F2); + {E1, E2} -> + E1 - E2 + end; + +%%%% (20) +eval_e(G, S, N, Tk, {'*', T1, T2}) -> + case check_op(G, S, N, Tk, [int, float, fixed], '*', T1, T2) of + {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> + e_fixed_mul(F1, F2); + {E1, E2} -> + E1 * E2 + end; +eval_e(G, S, N, Tk, {'/', T1, T2}) -> + case check_op(G, S, N, Tk, [int, float, fixed], '/', T1, T2) of + {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> + e_fixed_div(F1, F2); + {E1, E2} -> + E1 / E2 + end; +eval_e(G, S, N, Tk, {'%', T1, T2}) -> + {E1, E2} = check_op(G, S, N, Tk, [int], '%', T1, T2), + E1 rem E2; + +%%%% (21) +eval_e(G, S, N, Tk, {{'-', _Line}, T}) -> + case check_op(G, S, N, Tk, [int, float, fixed], '-', T) of + F when is_record(F,fixed) -> + F#fixed{value = -(F#fixed.value)}; + Number -> + -Number + end; +eval_e(G, S, N, Tk, {{'+', _Line}, T}) -> + check_op(G, S, N, Tk, [int, float, fixed], '+', T); +eval_e(G, S, N, Tk, {{'~', Line}, T}) -> + ic_error:error(G, {unsupported_op, {'~', Line}}), + eval_e(G, S, N, Tk, T); + + +%% Ints are repr. by an Erlang integer val, floats and doubles by +%% Erlang floats, chars and strings must be tuplerized for type +%% checking. These tuples are removed just before returning from top +%% function. +%% +eval_e(_G, _S, _N, tk_fixed, {'<fixed_pt_literal>', _Line, X}) -> + create_fixed(X); +eval_e(G, _S, _N, {tk_fixed, Digits, Scale}, {'<fixed_pt_literal>', Line, X}) + when Digits < 32, Digits >= Scale -> + case convert_fixed(X, [], Digits, Digits-Scale) of + {error, Format, Args} -> + ic_error:error(G, {bad_fixed, Format, Args, Line}); + FixedData -> + {fixed, Digits, Scale, FixedData} + end; +eval_e(_G, _S, _N, _Tk, {'<integer_literal>', _Line, X}) -> list_to_integer(X); +eval_e(_G, _S, _N, {tk_string,_}, {'<string_literal>', _Line, X}) -> {string, X}; +eval_e(_G, _S, _N, {tk_wstring,_}, {'<wstring_literal>', _Line, X}) -> {wstring, X}; %% WSTRING +eval_e(_G, _S, _N, tk_char, {'<character_literal>', _Line, X}) -> {char, hd(X)}; +eval_e(_G, _S, _N, tk_wchar, {'<wcharacter_literal>', _Line, X}) -> {wchar, hd(X)}; %% WCHAR +eval_e(_G, _S, _N, _Tk, {'TRUE', _Line}) -> true; +eval_e(_G, _S, _N, _Tk, {'FALSE', _Line}) -> false; +eval_e(_G, _S, _N, _Tk, {'<floating_pt_literal>', _Line, X}) -> to_float(X); +%% Some possible error conditions +eval_e(_G, _S, _N, _Tk, {'<character_literal>', _Line, X}) -> {char, hd(X)}; %% ERROR? +%% +eval_e(G, S, N, _Tk, X) when element(1, X) == scoped_id -> + mk_val(ictype:scoped_lookup(G, S, N, X)); +eval_e(_G, _S, _N, _Tk, {default, _}) -> default; % Default case in union +eval_e(G, _S, _N, Tk, Val) -> + ic_error:error(G, {plain_error_string, Val, + io_lib:format("value and declared type ~p differ", [Tk])}). + +%% A fixed type can be 123.45 or 123 but we represent it as integers (i.e. 12345 or 123). +convert_fixed([], Acc, 0, _) -> + list_to_integer(lists:reverse(Acc)); +convert_fixed([], _Acc, _, _) -> + {error, "Fixed type do not match the digits field", []}; +convert_fixed([$.|Rest], Acc, Digits, 0) -> + convert_fixed(Rest, Acc, Digits, -1); +convert_fixed([$.|_Rest], _Acc, _, _) -> + {error, "Fixed decimal point placed incorrectly", []}; +convert_fixed([X|Rest], Acc, Digits, Position) -> + convert_fixed(Rest, [X|Acc], Digits-1, Position-1). + + +create_fixed([$0|Rest]) -> + %% Leading zeros shall be ignored. + create_fixed(Rest); +create_fixed(Fixed) -> + create_fixed(Fixed, [], 0, 0, false). + +create_fixed([], Acc, Total, Frac, true) -> + {Fixed, N} = remove_trailing_zeros(Acc, 0), + Digits = Total-N, + Scale = Frac-N, + #fixed{digits = Digits, scale = Scale, value = list_to_integer(Fixed)}; +create_fixed([], Acc, Total, _Frac, false) -> + %% A '.' never found. Hence, must be 2000D + #fixed{digits = Total, scale = 0, value = list_to_integer(lists:reverse(Acc))}; +create_fixed([$.|Rest], Acc, Total, _, _) -> + create_fixed(Rest, Acc, Total, 0, true); +create_fixed([X|Rest], Acc, Total, Frac, FoundDot) -> + create_fixed(Rest, [X|Acc], Total+1, Frac+1, FoundDot). + +remove_trailing_zeros([$0|Rest], N) -> + remove_trailing_zeros(Rest, N+1); +remove_trailing_zeros(Fixed, N) -> + {lists:reverse(Fixed), N}. + +%% Make the newly looked up value a value that can be type checked. +mk_val({_, _, {tk_string, _}, V}) -> {string, V}; +mk_val({_, _, {tk_wstring, _}, V}) -> {wstring, V}; %% WSTRING +mk_val({_, _, tk_char, V}) -> {char, V}; +mk_val({_, _, tk_wchar, V}) -> {wchar, V}; %% WCHAR +mk_val({_, _, enum_val, V}) -> + {enum_id, ic_forms:get_id2(V)}; +mk_val(X) when element(1, X) == error -> X; +mk_val({_, _, _TK, V}) -> + V; +mk_val(V) -> V. + + + +%% Floating point numbers +%% +%% Conversion to Erlang floating points is neccessary because +%% list_to_float BIF differs from IDL floats. "1e2" ".4e2" is +%% allowed in IDL and must be translated to "1.0e2" and "0.4e2" + +to_float(X) -> + list_to_float(erlangify(X)). + +erlangify([$. | R]) -> + [$0, $. | R]; +erlangify(R) -> + look_for_dot(R). + +look_for_dot([$. | R]) -> [$. | dot_pending(R)]; +look_for_dot([$e | R]) -> [$., $0, $e | R]; +look_for_dot([$E | R]) -> [$., $0, $E | R]; +look_for_dot([X | R]) -> [X | look_for_dot(R)]. + +dot_pending([$e | R]) -> [$0, $e | R]; +dot_pending([$E | R]) -> [$0, $E | R]; +dot_pending([]) -> [$0]; +dot_pending(R) -> R. + + +%%------------------------------------------------------------------ +%%--------------- Fixed Datatype Helper Functions ------------------ +%%------------------------------------------------------------------ +%% Pretty?! No, but since we now the upper-limit this is the fastest way +%% to calculate 10^x +power(0) -> 1; +power(1) -> 10; +power(2) -> 100; +power(3) -> 1000; +power(4) -> 10000; +power(5) -> 100000; +power(6) -> 1000000; +power(7) -> 10000000; +power(8) -> 100000000; +power(9) -> 1000000000; +power(10) -> 10000000000; +power(11) -> 100000000000; +power(12) -> 1000000000000; +power(13) -> 10000000000000; +power(14) -> 100000000000000; +power(15) -> 1000000000000000; +power(16) -> 10000000000000000; +power(17) -> 100000000000000000; +power(18) -> 1000000000000000000; +power(19) -> 10000000000000000000; +power(20) -> 100000000000000000000; +power(21) -> 1000000000000000000000; +power(22) -> 10000000000000000000000; +power(23) -> 100000000000000000000000; +power(24) -> 1000000000000000000000000; +power(25) -> 10000000000000000000000000; +power(26) -> 100000000000000000000000000; +power(27) -> 1000000000000000000000000000; +power(28) -> 10000000000000000000000000000; +power(29) -> 100000000000000000000000000000; +power(30) -> 1000000000000000000000000000000; +power(31) -> 10000000000000000000000000000000; +power(_) -> 10000000000000000000000000000000. + + + +%% If the result of an operation (+, -, * or /) causes overflow we use this +%% operation. However, since these calculations are performed during compiletime, +%% shouldn't the IDL-specification be changed to not cause overflow?! But, since +%% the OMG standard allows this we must support it. +check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) -> + case count_digits(abs(Value)) of + overflow -> + {N, NewVal} = cut_overflow(0, Value), +% NewDigits = Digits - N, + if + N > Scale -> + #fixed{digits = 31, scale = 0, value = NewVal}; + true -> + NewScale = Scale - N, + {NewVal2, Removed} = delete_zeros(NewVal, NewScale), + #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2} + end; + Count when Count > Digits -> + Diff = Count-Digits, + if + Diff > Scale -> + #fixed{digits = Digits, scale = 0, + value = (Value div power(Diff))}; + true -> + NewScale = Scale-Diff, + {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale), + #fixed{digits = Digits-Removed, + scale = NewScale-Removed, + value = NewVal} + end; + Count -> + {NewVal, Removed} = delete_zeros(Value, Scale), + #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal} + end. + +%% This function see to that the values are of the same baase. +normalize(S, V1, S, V2) -> + {V1, V2}; +normalize(S1, V1, S2, V2) when S1 > S2 -> + {V1, V2*power(S1-S2)}; +normalize(S1, V1, S2, V2) -> + {V1*power(S2-S1), V2}. + +%% If we have access to the integer part of the fixed type we use this +%% operation to remove all trailing zeros. If we know the scale, length of +%% fraction part, we can use delete_zeros as well. But, after a division +%% it's hard to know the scale and we don't need to calcluate the integer part. +delete_zeros_value(0, N, _) -> + {0, 32-N}; +delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 -> + delete_zeros_value((X div 10), N+1, M); +delete_zeros_value(X, N, _) -> + {X, 32-N}. + +%% If we know the exact scale of a fixed type we can use this operation to +%% remove all trailing zeros. +delete_zeros(0, _) -> + {0,0}; +delete_zeros(X, Max) -> + delete_zeros(X, 0, Max). +delete_zeros(X, Max, Max) -> + {X, Max}; +delete_zeros(X, N, Max) when (X rem 10) == 0 -> + delete_zeros((X div 10), N+1, Max); +delete_zeros(X, N, _) -> + {X, N}. + +cut_overflow(N, X) when X > ?FIXED_MAX -> + cut_overflow(N+1, (X div 10)); +cut_overflow(N, X) -> + {N, X}. + +%% A fast way to check the size of a fixed data type. +count_digits(X) when X > ?FIXED_MAX -> overflow; +count_digits(X) when X >= 1000000000000000000000000000000 -> 31; +count_digits(X) when X >= 100000000000000000000000000000 -> 30; +count_digits(X) when X >= 10000000000000000000000000000 -> 29; +count_digits(X) when X >= 1000000000000000000000000000 -> 28; +count_digits(X) when X >= 100000000000000000000000000 -> 27; +count_digits(X) when X >= 10000000000000000000000000 -> 26; +count_digits(X) when X >= 1000000000000000000000000 -> 25; +count_digits(X) when X >= 100000000000000000000000 -> 24; +count_digits(X) when X >= 10000000000000000000000 -> 23; +count_digits(X) when X >= 1000000000000000000000 -> 22; +count_digits(X) when X >= 100000000000000000000 -> 21; +count_digits(X) when X >= 10000000000000000000 -> 20; +count_digits(X) when X >= 1000000000000000000 -> 19; +count_digits(X) when X >= 100000000000000000 -> 18; +count_digits(X) when X >= 10000000000000000 -> 17; +count_digits(X) when X >= 1000000000000000 -> 16; +count_digits(X) when X >= 100000000000000 -> 15; +count_digits(X) when X >= 10000000000000 -> 14; +count_digits(X) when X >= 1000000000000 -> 13; +count_digits(X) when X >= 100000000000 -> 12; +count_digits(X) when X >= 10000000000 -> 11; +count_digits(X) when X >= 1000000000 -> 10; +count_digits(X) when X >= 100000000 -> 9; +count_digits(X) when X >= 10000000 -> 8; +count_digits(X) when X >= 1000000 -> 7; +count_digits(X) when X >= 100000 -> 6; +count_digits(X) when X >= 10000 -> 5; +count_digits(X) when X >= 1000 -> 4; +count_digits(X) when X >= 100 -> 3; +count_digits(X) when X >= 10 -> 2; +count_digits(_X) -> 1. + +%%------------------------------------------------------------------ +%%--------------- END Fixed Datatype Helper Functions -------------- +%%------------------------------------------------------------------ diff --git a/lib/ic/src/icforms.hrl b/lib/ic/src/icforms.hrl new file mode 100644 index 0000000000..d1869e6330 --- /dev/null +++ b/lib/ic/src/icforms.hrl @@ -0,0 +1,68 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%% +%% Module documentation: +%% --------------------- +%% +%% Header file for the Erlang IDL compiler. Contains all records +%% used in the parse tree +%% +%% +%%------------------------------------------------------------ + + + +%%------------------------------------------------------------ + +-record(module, {id, body}). +-record(interface, {id, inherit, body, inherit_body, tk}). +-record(forward, {id, tk}). +-record(const, {type, id, val, tk}). +-record(type_dcl, {type, tk}). +-record(typedef, {type, id, tk}). +-record(struct, {id, body, tk}). +-record(member, {type, id}). +-record(union, {id, type, body, tk}). +-record(case_dcl, {label, id, type}). +-record(enum, {id, body, tk}). +-record(enumerator, {id}). +-record(sequence, {type, length=0}). +-record(string, {length=0}). +-record(wstring, {length=0}). %% WSTRING +-record(array, {id, size}). +-record(attr, {readonly, type, id, tk}). +-record(except, {id, body, tk}). +-record(op, {oneway, type, id, params, raises, ctx, tk}). +-record(param, {inout, type, id, tk}). +-record(fixed, {digits, scale, value}). + +%% NON-STANDARD +-record(preproc, {cat, id, aux}). +-record(pragma, {type, to, apply}). + + + + + + + + + + diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl new file mode 100644 index 0000000000..25b0f452e7 --- /dev/null +++ b/lib/ic/src/icparse.yrl @@ -0,0 +1,864 @@ +%%<copyright> +%% <year>1997-2007</year> +%% <holder>Ericsson AB, All Rights Reserved</holder> +%%</copyright> +%%<legalnotice> +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% The Initial Developer of the Original Code is Ericsson AB. +%%</legalnotice> +%% +%%------------------------------------------------------------ +%% Yecc spec for IDL +%% +%% +%% +%% Implementation Detail: +%% OorM_ means OneORMany and is used instead of +%% the "+" BNF notation +%% ZorM_ means ZeroORMany and is used instead of +%% the "*" BNF notation +%% +%% All the reverse/1 calls are because yecc+lists naturally leads +%% to reversed lists, which then have to be reversed. Maybe fix +%% this? +%% +%% Implementation history +%% +%% The IDL language supported is not the complete IDL. We skipped +%% the multiple declarator syntax allowed (i.e. typedef long T1, +%% T2). This also applies to attributes members in structs, +%% unions and exceptions, and to case labels in unions. The cases +%% where IDL has been altered is marked with comments containing +%% NIY. +%% +%% Above is chaging. Whenever we change a clause, we put (FIXED) in +%% its comment. +%% +%%------------------------------------------------------------ + + + + + +Nonterminals + '<op_type_spec>' + '<enumerator>' + '<switch_body>' + 'OorM_<case>' + '<member_list>' + '<struct_type>' + '<unsigned_int>' + '<constr_type_spec>' + '<shift_expr>' + '<or_expr>' + '<inheritance_spec>' + 'ZorM_<param_dcl>' + 'Opt_<context_expr>' + '<attr_dcl>' + '<array_declarator>' + '<element_spec>' + '<signed_int>' + '<primary_expr>' + '<interface_dcl>' + 'ZorM_<string_literal>' + 'Opt_<raises_expr>' + '<integer_type>' + '<signed_long_int>' + '<literal>' + '<export>' + '<forward_dcl>' + 'OorM_<definition>' + '<base_type_spec>' + '<op_dcl>' + '<const_exp>' + '<case>' + '<any_type>' + '<signed_short_int>' + '<unary_expr>' + '<context_expr>' + 'ZorM_<scoped_name>' + '<switch_type_spec>' + '<complex_declarator>' + '<declarators>' + 'OorM_<member>' + '<interface>' + '<parameter_dcls>' + '<op_attribute>' + '<positive_int_const>' + 'OorM_<fixed_array_size>' + '<sequence_type>' + '<case_label>' + '<octet_type>' + '<type_dcl>' + '<module>' + '<specification>' + '<declarator>' + '<boolean_type>' + '<union_type>' + '<add_expr>' + '<interface_body>' + '<except_dcl>' + '<fixed_array_size>' + '<unsigned_short_int>' + '<boolean_literal>' + '<and_expr>' + 'Opt_<inheritance_spec>' + '<scoped_name>' + '<param_type_spec>' + 'ZorM_<member>' + '<char_type>' + '<const_dcl>' + '<param_dcl>' + 'ZorM_<simple_declarator>' + 'ZorM_<declarator>' + '<const_type>' + '<definition>' + '<param_attribute>' + '<simple_declarator>' + 'Opt_readonly' + '<simple_type_spec>' + '<enum_type>' + '<type_spec>' + 'OorM_<case_label>' + '<floating_pt_type>' + '<template_type_spec>' + '<mult_expr>' + '<xor_expr>' + '<string_type>' + '<raises_expr>' + 'Opt_<op_attribute>' + 'ZorM_<enumerator>' + '<member>' + '<unsigned_long_int>' + '<type_declarator>' + '<unary_operator>' + 'ZorM_<export>' + '<interface_header>' + 'OE_preproc' % NON standard + 'OE_pragma' % NON standard + 'Ugly_pragmas' % NON standard + 'ZorM_<integer_literal>' + '<fixed_pt_type>' + '<fixed_pt_const_type>' + . + + +Terminals + '#' + 'in' + '[' + 'interface' + '(' + 'case' + 'union' + 'struct' + '<character_literal>' + '<wcharacter_literal>' + ')' + ']' + 'any' + 'long' + 'float' + 'out' + '*' + '^' + 'enum' + 'double' + '+' + 'context' + 'oneway' + 'sequence' + ',' + 'FALSE' + '<identifier>' + '{' + 'readonly' + ':' + '-' + 'void' + ';' + 'char' + 'wchar' %% WCHAR + '|' + 'inout' + '}' + 'attribute' + '<' + 'octet' + '/' + 'TRUE' + '~' + '=' + '>' + 'switch' + 'unsigned' + 'typedef' + '>>' + 'const' + '<string_literal>' + '<wstring_literal>' + 'raises' + 'string' + 'wstring' + 'fixed' + 'default' + 'short' + '%' + '<<' + 'module' + 'exception' + 'boolean' + '<integer_literal>' + '<fixed_pt_literal>' + '<floating_pt_literal>' + '&' + '::' + 'Object' + . + + +Rootsymbol '<specification>'. + + +%%------------------------------------------------------------ +%% Clauses +%% + +%% Handling of pragmas. +%% Pragma prefix, id and version are not standard. + +%% pragma prefix, or codeopt +OE_pragma -> '#' '<integer_literal>' '<identifier>' + '<identifier>' '<string_literal>' '#' + : #pragma{type='$4', to=followed, apply='$5'} . + +%% pragma id +OE_pragma -> '#' '<integer_literal>' '<identifier>' + '<identifier>' '<identifier>' '<string_literal>' '#' + : #pragma{type='$4', to='$5', apply='$6'} . + +%% pragma version +OE_pragma -> '#' '<integer_literal>' '<identifier>' + '<identifier>' '<identifier>' '<floating_pt_literal>' '#' + : #pragma{type='$4', to='$5', apply=ic_options:float_to_version('$6')} . + + + + + + + +%% Ugly pragmas +Ugly_pragmas -> '$empty' : []. +Ugly_pragmas -> 'Ugly_pragmas' 'OE_pragma' : ['$2'|'$1']. + + + +%% (0) Handling of preprocessor stuff. + +OE_preproc -> '#' '#' . + +OE_preproc -> '#' '<integer_literal>' '<string_literal>' + 'ZorM_<integer_literal>' '#' + : case '$4' of + [] -> + case '$2' of + {_,_,"1"} -> + #preproc{cat=line_nr, id='$3', aux='$4'}; + _ -> + [] + end; + _ -> + #preproc{cat=line_nr, id='$3', aux='$4'} + end. + +%% (0b) Non-standard +'ZorM_<integer_literal>' -> '$empty' : [] . +'ZorM_<integer_literal>' -> '<integer_literal>' 'ZorM_<integer_literal>' + : ['$1' | '$2'] . + +%% (1) +'<specification>' -> 'OorM_<definition>' : reverse('$1') . + + +%% Added clause +'OorM_<definition>' -> '<definition>' : ['$1'] . +'OorM_<definition>' -> 'OorM_<definition>' '<definition>' +: ['$2' | '$1'] . + + +%% (2) +'<definition>' -> '<type_dcl>' ';' : '$1' . +'<definition>' -> '<const_dcl>' ';' : '$1' . +'<definition>' -> '<except_dcl>' ';' : '$1' . +'<definition>' -> '<interface>' ';' : '$1' . +'<definition>' -> '<module>' ';' : '$1' . +'<definition>' -> 'OE_preproc' : '$1' . +'<definition>' -> 'OE_pragma' : '$1' . + + +%% (3) +'<module>' -> 'module' '<identifier>' '{' 'OorM_<definition>' '}' +: #module{ id='$2', body=reverse('$4')}. + + +%% (4) +'<interface>' -> '<interface_dcl>' : '$1' . +'<interface>' -> '<forward_dcl>' : '$1' . + + +%% (5) +'<interface_dcl>' -> '<interface_header>' '{' '<interface_body>' '}' + : #interface{id=element(1, '$1'), inherit=element(2, '$1'), + body=lists:reverse('$3')} . + + +%% (6) +'<forward_dcl>' -> 'interface' '<identifier>' +: #forward{id='$2'} . + + +%% (7) +'<interface_header>' -> 'interface' '<identifier>' 'Opt_<inheritance_spec>' +: {'$2', '$3'} . + + +%% (8) +'<interface_body>' -> 'ZorM_<export>' : '$1' . + + +%% Added clause +'ZorM_<export>' -> '$empty' : [] . +'ZorM_<export>' -> 'ZorM_<export>' '<export>' + %% Complicated because <export> might be a list (of type defs for instance) + : if is_list('$2') -> '$2' ++ '$1'; + true -> ['$2' | '$1'] + end . + + +%% (9) +'<export>' -> '<type_dcl>' ';' : '$1' . +'<export>' -> '<const_dcl>' ';' : '$1' . +'<export>' -> '<except_dcl>' ';' : '$1' . +'<export>' -> '<attr_dcl>' ';' : '$1' . +'<export>' -> '<op_dcl>' ';' : '$1' . +'<export>' -> 'OE_preproc' : '$1' . +'<export>' -> 'OE_pragma' : '$1' . + +%% Added clause +'Opt_<inheritance_spec>' -> '$empty' : []. +'Opt_<inheritance_spec>' -> '<inheritance_spec>' : '$1'. + +%% (10) +'<inheritance_spec>' -> ':' '<scoped_name>' 'ZorM_<scoped_name>' + : ['$2' | reverse('$3')] . + + +%% Added clause +'ZorM_<scoped_name>' -> '$empty' : [] . +'ZorM_<scoped_name>' -> 'ZorM_<scoped_name>' ',' '<scoped_name>' + : ['$3' | '$1'] . + + +%% (11) +'<scoped_name>' -> '<identifier>' : ic_symtab:scoped_id_new('$1') . +'<scoped_name>' -> '::' '<identifier>' : ic_symtab:scoped_id_new_global('$2') . +'<scoped_name>' -> '<scoped_name>' '::' '<identifier>' + : ic_symtab:scoped_id_add('$1', '$3') . + + +%% (12) +'<const_dcl>' -> 'const' '<const_type>' '<identifier>' '=' '<const_exp>' + : #const{type='$2', id='$3', val='$5'} . + + +%% (13) +'<const_type>' -> '<integer_type>' : '$1' . +'<const_type>' -> '<char_type>' : '$1' . +'<const_type>' -> '<boolean_type>' : '$1' . +'<const_type>' -> '<floating_pt_type>' : '$1' . +'<const_type>' -> '<string_type>' : '$1' . +'<const_type>' -> '<fixed_pt_const_type>' : '$1' . +'<const_type>' -> '<scoped_name>' : '$1' . +'<const_type>' -> '<octet_type>' : '$1' . + + +%% (14) +'<const_exp>' -> '<or_expr>' : '$1' . + + +%% (15) +'<or_expr>' -> '<xor_expr>' : '$1' . +'<or_expr>' -> '<or_expr>' '|' '<xor_expr>' : {'or', '$1', '$3'} . + + +%% (16) +'<xor_expr>' -> '<and_expr>' : '$1' . +'<xor_expr>' -> '<xor_expr>' '^' '<and_expr>' : {'xor', '$1', '$3'} . + + +%% (17) +'<and_expr>' -> '<shift_expr>' : '$1' . +'<and_expr>' -> '<and_expr>' '&' '<shift_expr>' : {'and', '$1', '$3'} . + + +%% (18) +'<shift_expr>' -> '<add_expr>' : '$1' . +'<shift_expr>' -> '<shift_expr>' '>>' '<add_expr>' : {'rshift', '$1', '$3'} . +'<shift_expr>' -> '<shift_expr>' '<<' '<add_expr>' : {'lshift', '$1', '$3'} . + + +%% (19) +'<add_expr>' -> '<mult_expr>' : '$1' . +'<add_expr>' -> '<add_expr>' '+' '<mult_expr>' : {'+', '$1', '$3'} . +'<add_expr>' -> '<add_expr>' '-' '<mult_expr>' : {'-', '$1', '$3'} . + + +%% (20) +'<mult_expr>' -> '<unary_expr>' : '$1' . +'<mult_expr>' -> '<mult_expr>' '*' '<unary_expr>' : {'*', '$1', '$3'} . +'<mult_expr>' -> '<mult_expr>' '/' '<unary_expr>' : {'/', '$1', '$3'} . +'<mult_expr>' -> '<mult_expr>' '%' '<unary_expr>' : {'%', '$1', '$3'} . + + +%% (21) +'<unary_expr>' -> '<unary_operator>' '<primary_expr>' : {'$1', '$2'} . +'<unary_expr>' -> '<primary_expr>' : '$1' . + + +%% (22) +'<unary_operator>' -> '-' : '$1' . +'<unary_operator>' -> '+' : '$1' . +'<unary_operator>' -> '~' : '$1' . + + +%% (23) +'<primary_expr>' -> '<scoped_name>' : '$1' . +'<primary_expr>' -> '<literal>' : '$1' . +'<primary_expr>' -> '(' '<const_exp>' ')' : '$2' . + + +%% (24) +'<literal>' -> '<integer_literal>' : '$1' . +'<literal>' -> '<wstring_literal>' : '$1' . +'<literal>' -> '<string_literal>' : '$1' . +'<literal>' -> '<character_literal>' : '$1' . +'<literal>' -> '<wcharacter_literal>' : '$1' . +'<literal>' -> '<fixed_pt_literal>' : '$1' . +'<literal>' -> '<floating_pt_literal>' : '$1' . +'<literal>' -> '<boolean_literal>' : '$1' . + + +%% (25) +'<boolean_literal>' -> 'TRUE' : '$1' . +'<boolean_literal>' -> 'FALSE' : '$1' . + + +%% (26) +'<positive_int_const>' -> '<const_exp>' : '$1' . + + +%% (27) +'<type_dcl>' -> 'typedef' '<type_declarator>' : '$2' . +'<type_dcl>' -> '<struct_type>' : '$1' . +'<type_dcl>' -> '<union_type>' : '$1' . +'<type_dcl>' -> '<enum_type>' : '$1' . + +%% (28) NIY multiple declarators (FIXED) +'<type_declarator>' -> '<type_spec>' '<declarators>' + : #typedef{type='$1', id='$2'} . %%%ic:unfold(#typedef{type='$1', id='$2'}) . +%%'<type_declarator>' -> '<type_spec>' '<declarator>' +%% : #typedef{type='$1', id='$2'} . + +%% (29) +'<type_spec>' -> '<simple_type_spec>' : '$1' . +'<type_spec>' -> '<constr_type_spec>' : '$1' . + + +%% (30) +'<simple_type_spec>' -> '<base_type_spec>' : '$1' . +'<simple_type_spec>' -> '<template_type_spec>' : '$1' . +'<simple_type_spec>' -> '<scoped_name>' : '$1' . + + +%% (31) +'<base_type_spec>' -> '<floating_pt_type>' : '$1' . +'<base_type_spec>' -> '<integer_type>' : '$1' . +'<base_type_spec>' -> '<char_type>' : '$1' . +'<base_type_spec>' -> '<boolean_type>' : '$1' . +'<base_type_spec>' -> '<octet_type>' : '$1' . +'<base_type_spec>' -> '<any_type>' : '$1' . +'<base_type_spec>' -> 'Object' : '$1' . %% NON Standard, isn't a base type + + +%% (32) +'<template_type_spec>' -> '<sequence_type>' : '$1' . +'<template_type_spec>' -> '<string_type>' : '$1' . +'<template_type_spec>' -> '<fixed_pt_type>' : '$1' . + + +%% (33) +'<constr_type_spec>' -> '<struct_type>' : '$1' . +'<constr_type_spec>' -> '<union_type>' : '$1' . +'<constr_type_spec>' -> '<enum_type>' : '$1' . + + +%% (34) +'<declarators>' -> '<declarator>' 'ZorM_<declarator>' +: ['$1' | reverse('$2')] . + +%% Added clause +'ZorM_<declarator>' -> '$empty' : [] . +'ZorM_<declarator>' -> 'ZorM_<declarator>' ',' '<declarator>' +: ['$3' | '$1'] . + + +%% (35) +'<declarator>' -> '<simple_declarator>' : '$1' . +'<declarator>' -> '<complex_declarator>' : '$1' . + + +%% (36) +'<simple_declarator>' -> '<identifier>' : '$1' . + + +%% (37) +'<complex_declarator>' -> '<array_declarator>' : '$1' . + + +%% (38) +'<floating_pt_type>' -> 'float' : '$1' . +'<floating_pt_type>' -> 'double' : '$1' . + + +%% (39) +'<integer_type>' -> '<signed_int>' : '$1' . +'<integer_type>' -> '<unsigned_int>' : {'unsigned', '$1'} . + + +%% (40) +'<signed_int>' -> '<signed_long_int>' : '$1' . +'<signed_int>' -> '<signed_short_int>' : '$1' . + + +%% (41) +'<signed_long_int>' -> 'long' : '$1' . +'<signed_long_int>' -> 'long' 'long': {'long long', element(2,'$2')} . + + +%% (42) +'<signed_short_int>' -> 'short' : '$1' . + + +%% (43) +'<unsigned_int>' -> '<unsigned_long_int>' : '$1' . +'<unsigned_int>' -> '<unsigned_short_int>' : '$1' . + + +%% (44) +'<unsigned_long_int>' -> 'unsigned' 'long' : '$2' . +'<unsigned_long_int>' -> 'unsigned' 'long' 'long' : {'long long', element(2,'$2')} . %% ULLONG + + +%% (45) +'<unsigned_short_int>' -> 'unsigned' 'short' : '$2' . + + +%% (46) +'<char_type>' -> 'char' : '$1' . +'<char_type>' -> 'wchar' : '$1' . %% WCHAR + + +%% (47) +'<boolean_type>' -> 'boolean' : '$1' . + + +%% (48) +'<octet_type>' -> 'octet' : '$1' . + + +%% (49) +'<any_type>' -> 'any' : '$1' . + +%% +'<fixed_pt_const_type>' -> 'fixed' : '$1'. + +%% (50) NIY: unfolding of struct decls (FIXED) +%%'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' +%% : #struct{id='$2', body=ic:unfold('$4')} . +'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' + : #struct{id='$2', body='$4'} . + + +%% (51) +'<member_list>' -> 'OorM_<member>' : reverse('$1') . + + +%% Added clause +%%'OorM_<member>' -> '<member>' : ['$1'] . +%%'OorM_<member>' -> 'OorM_<member>' '<member>' +%% : ['$2' | '$1'] . + +'OorM_<member>' -> '<member>' : '$1' . +'OorM_<member>' -> 'OorM_<member>' '<member>' + : '$2' ++ '$1' . + + + +%% (52) NIY: member multiple declarators (FIXED) +%%'<member>' -> '<type_spec>' '<declarators>' ';' +%% : #member{type='$1', id='$2'} . + +'<member>' -> 'Ugly_pragmas' '<type_spec>' '<declarators>' 'Ugly_pragmas' ';' 'Ugly_pragmas' + : '$1' ++ '$4' ++ '$6' ++ [#member{type='$2', id='$3'}] . + + +%% (53) NIY: unfolding of union cases (FIXED) +%%'<union_type>' -> 'union' '<identifier>' 'switch' +%% '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' +%% : #union{id='$2', type='$5', body=ic:unfold('$8')} . +'<union_type>' -> 'union' '<identifier>' 'switch' + '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' + : #union{id='$2', type='$5', body='$8'} . + + +%% (54) +'<switch_type_spec>' -> '<integer_type>' : '$1' . +'<switch_type_spec>' -> '<char_type>' : '$1' . +'<switch_type_spec>' -> '<boolean_type>' : '$1' . +'<switch_type_spec>' -> '<enum_type>' : '$1' . +'<switch_type_spec>' -> '<scoped_name>' : '$1' . + + +%% (55) +'<switch_body>' -> 'OorM_<case>' : reverse(lists:flatten('$1')) . + +%%'<switch_body>' -> 'OorM_<case>' : '$1' . + + +%% Added clause +'OorM_<case>' -> '<case>' : ['$1'] . +'OorM_<case>' -> 'OorM_<case>' '<case>' : ['$2' | '$1'] . + + +%% (56) NIY thing: multiple case labels (FIXED) +%%'<case>' -> 'OorM_<case_label>' '<element_spec>' ';' +%% : '$2'#case_dcl{label=reverse('$1')} . + +'<case>' -> + 'Ugly_pragmas' 'OorM_<case_label>' + 'Ugly_pragmas' '<element_spec>' + 'Ugly_pragmas' ';' 'Ugly_pragmas' + : '$1' ++ '$3' ++ '$5' ++ '$7' ++ [ '$4'#case_dcl{label=reverse('$2')} ] . + + +%% Added clause +%%'OorM_<case_label>' -> '<case_label>' : ['$1'] . +%%'OorM_<case_label>' -> 'OorM_<case_label>' '<case_label>' : ['$2' | '$1'] . + +'OorM_<case_label>' -> 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' + : '$1' ++ ['$2'] ++ '$3' . +'OorM_<case_label>' -> 'OorM_<case_label>' 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' + : '$2' ++ ['$3'|'$1'] ++ '$4'. + + +%% (57) +'<case_label>' -> 'case' '<const_exp>' ':' : '$2' . +'<case_label>' -> 'default' ':' : '$1' . + + +%% (58) +'<element_spec>' -> '<type_spec>' '<declarator>' +: #case_dcl{type='$1', id='$2'} . + + +%% (59) +%%'<enum_type>' -> 'enum' '<identifier>' +%%'{' '<enumerator>' 'ZorM_<enumerator>' '}' +%%: #enum{id='$2', body=['$4' | reverse('$5')]} . + +'<enum_type>' -> 'enum' '<identifier>' +'{' 'Ugly_pragmas' '<enumerator>' 'Ugly_pragmas' 'ZorM_<enumerator>' 'Ugly_pragmas' '}' +: #enum{id='$2', body='$4'++'$6'++'$8'++['$5' | reverse('$7')]} . + + + +%% Added clause +%%'ZorM_<enumerator>' -> '$empty' : [] . +%%'ZorM_<enumerator>' -> 'ZorM_<enumerator>' ',' '<enumerator>' : ['$3' | '$1'] . + +'ZorM_<enumerator>' -> '$empty' : [] . +'ZorM_<enumerator>' -> 'ZorM_<enumerator>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<enumerator>' + : '$2'++'$4'++['$5' | '$1'] . + +%% (60) +'<enumerator>' -> '<identifier>' : #enumerator{id='$1'} . + + +%% (61) +'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' ',' + '<positive_int_const>' '>' + : #sequence{type='$3', length='$5'} . +'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' '>' + : #sequence{type='$3'} . + + +%% (62) +'<string_type>' -> 'string' '<' '<positive_int_const>' '>' + : #string{length='$3'} . +'<string_type>' -> 'string' : #string{} . + +'<string_type>' -> 'wstring' '<' '<positive_int_const>' '>' %% WSTRING + : #wstring{length='$3'} . +'<string_type>' -> 'wstring' : #wstring{} . %% WSTRING + + +%% (63) +'<array_declarator>' -> '<identifier>' 'OorM_<fixed_array_size>' + : #array{id='$1', size=reverse('$2')} . + + +%% Added clause +'OorM_<fixed_array_size>' -> '<fixed_array_size>' : ['$1'] . +'OorM_<fixed_array_size>' -> 'OorM_<fixed_array_size>' '<fixed_array_size>' + : ['$2' | '$1'] . + + +%% (64) +'<fixed_array_size>' -> '[' '<positive_int_const>' ']' : '$2' . + + +%% (65) NIY: multiple attribute declarators (FIXED) +'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' + '<simple_declarator>' 'ZorM_<simple_declarator>' + : #attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]} . +%% : ic:unfold(#attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]}) . +%%'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' +%% '<simple_declarator>' + + +%% (66) NIY: unfolding of exception bodies (FIXED) +%%'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' +%% : #except{id='$2', body=ic:unfold('$4')} . +'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' + : #except{id='$2', body=reverse('$4')} . + +%% (67) +'<op_dcl>' -> 'Opt_<op_attribute>' '<op_type_spec>' '<identifier>' '<parameter_dcls>' 'Opt_<raises_expr>' 'Opt_<context_expr>' + : #op{oneway='$1', type='$2', id='$3', params='$4', raises='$5', ctx='$6'} . + +%% Added clause +'Opt_<op_attribute>' -> '$empty' : nil. +'Opt_<op_attribute>' -> '<op_attribute>' : '$1'. + +%% (68) +'<op_attribute>' -> 'oneway' : '$1' . + + +%% (69) +'<op_type_spec>' -> '<param_type_spec>' : '$1' . +'<op_type_spec>' -> 'void' : '$1' . + + +%% (70) Rewritten +%'<parameter_dcls>' -> '(' '<param_dcl>' 'ZorM_<param_dcl>' ')' +% : ['$2' | reverse('$3')] . +%'<parameter_dcls>' -> '(' ')' : [] . + +'<parameter_dcls>' -> '(' 'Ugly_pragmas' '<param_dcl>' 'ZorM_<param_dcl>' ')' + : '$2' ++ ['$3' | reverse('$4')] . +'<parameter_dcls>' -> '(' 'Ugly_pragmas' ')' : '$2' . + + +%% Added clause +%'ZorM_<param_dcl>' -> '$empty' : [] . +%'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' ',' '<param_dcl>' : ['$3' | '$1'] . + + +'ZorM_<param_dcl>' -> 'Ugly_pragmas' : '$1' . +'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<param_dcl>' 'Ugly_pragmas' + : '$2' ++ '$4' ++ '$6' ++ ['$5' | '$1'] . + + + + +%% (71) +'<param_dcl>' -> '<param_attribute>' '<param_type_spec>' '<simple_declarator>' + : #param{inout='$1', type='$2', id='$3'} . + + +%% (72) +'<param_attribute>' -> 'in' : '$1' . +'<param_attribute>' -> 'out' : '$1' . +'<param_attribute>' -> 'inout' : '$1' . + + +%% Added clause +'Opt_<raises_expr>' -> '$empty' : [] . +'Opt_<raises_expr>' -> '<raises_expr>' : '$1' . + +%% (73) +'<raises_expr>' -> 'raises' '(' '<scoped_name>' 'ZorM_<scoped_name>' ')' + : ['$3'| reverse('$4')] . + + +%% Added clause +'Opt_<context_expr>' -> '$empty' : [] . +'Opt_<context_expr>' -> '<context_expr>' : '$1'. + +%% (74) +'<context_expr>' -> 'context' '(' '<string_literal>' 'ZorM_<string_literal>'')' + : ['$3' | reverse('$4')] . + + + +%% (75) +'<param_type_spec>' -> '<base_type_spec>' : '$1' . +'<param_type_spec>' -> '<string_type>' : '$1' . +'<param_type_spec>' -> '<scoped_name>' : '$1' . + + +%% (96) +'<fixed_pt_type>' -> 'fixed' '<' '<positive_int_const>' ',' '<positive_int_const>' '>' + : #fixed{digits='$3',scale='$5'} . + + +%% Added clause +'ZorM_<string_literal>' -> '$empty' : [] . +'ZorM_<string_literal>' -> 'ZorM_<string_literal>' ',' '<string_literal>' + : ['$3' | '$1'] . + +%% Added clause +'ZorM_<simple_declarator>' -> '$empty' : [] . +'ZorM_<simple_declarator>' -> 'ZorM_<simple_declarator>' ',' +'<simple_declarator>' : ['$3' | '$1'] . + +%% Added clause +%%'ZorM_<member>' -> '$empty' : [] . +%%'ZorM_<member>' -> 'ZorM_<member>' '<member>' : ['$2' | '$1'] . + +'ZorM_<member>' -> 'Ugly_pragmas' : '$1' . +'ZorM_<member>' -> 'ZorM_<member>' '<member>' : '$2' ++ '$1' . + + +%% Added clause +'Opt_readonly' -> '$empty' : nil. +'Opt_readonly' -> 'readonly' : '$1'. + + + +Erlang code. +%%----------------------------------------------------------- + + + diff --git a/lib/ic/src/icpreproc.erl b/lib/ic/src/icpreproc.erl new file mode 100644 index 0000000000..0ed7813ebd --- /dev/null +++ b/lib/ic/src/icpreproc.erl @@ -0,0 +1,111 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(icpreproc). + + + +-export([preproc/2]). + + +-import(lists, [filter/2]). + + +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- + + +preproc(G, File) -> + Cmd = ic_options:get_opt(G, preproc_cmd), + Flags = ic_options:get_opt(G, preproc_flags), + + + case Cmd of + "erl" -> + case ic_pp:run(File,Flags) of + {ok, [$#, $ , $1 | Rest], []} -> + [$#, $ , $1 | Rest]; + {ok, [$#, $ , $1 | Rest], Warning} -> + print_warning(G,Warning), + [$#, $ , $1 | Rest]; + {error,Error} -> + print_error(G,Error) + end; + + _ -> + Line = Cmd++" "++Flags++" "++File, + % FIXME: Check status code of command instead of this test + case os:cmd(Line) of + [$#, $ , C | Rest] when is_integer(C), C > $0, C =< $9 -> + [$#, $ , C | Rest]; + X -> + ic_error:fatal_error(G, {preproc, filter(X)}) + end + end. + + +filter(X) -> + X2 = divide_nl(X, []), + filter_x_switch(X2). + + +divide_nl([10 | Xs], Out) -> + [lists:reverse(Out) | divide_nl(Xs, [])]; +divide_nl([X | Xs], Out) -> divide_nl(Xs, [X|Out]); +divide_nl([], Out) -> lists:reverse(Out). + + +filter_x_switch(L) -> + filter(fun([$g,$c,$c,$:,$ ,$W,$a,$r,$n,$i,$n,$g,$:,$ ,$`,$-,$x,$ | _]) -> + false; + (_) -> true end, L). + + +print_error(_G,[]) -> + ok; +print_error(G,[{File,Line,Text}]) -> + ErrorText = File++":"++integer_to_list(Line)++": "++Text, + ic_error:fatal_error(G, {ic_pp_error, ErrorText}), + ok; +print_error(G,[{File,Line,Text}|T]) -> + ErrorText = File++":"++integer_to_list(Line)++": "++Text, + ic_error:error(G, {ic_pp_error, ErrorText}), + print_error(G,T); +print_error(G,[H]) -> + ErrorText = H++"\n", + ic_error:fatal_error(G, {ic_pp_error, ErrorText}), + ok; +print_error(G,[H|T]) -> + ErrorText = H++"\n", + ic_error:error(G, {ic_pp_error, ErrorText}), + print_error(G,T). + + +print_warning(_G,[]) -> + ok; +print_warning(G,[{File,Line,Text}|T]) -> + WarText = File++":"++integer_to_list(Line)++": "++Text, + ic_error:warn(G, {ic_pp_warning, WarText}), + print_warning(G,T); +print_warning(G,[H|T]) -> + WarText = H++"\n", + ic_error:warn(G, {ic_pp_warning, WarText}), + print_warning(G,T). + + diff --git a/lib/ic/src/icscan.erl b/lib/ic/src/icscan.erl new file mode 100644 index 0000000000..0960ba5d70 --- /dev/null +++ b/lib/ic/src/icscan.erl @@ -0,0 +1,452 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(icscan). + + +-export([scan/2]). + +-include("ic.hrl"). + + +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- + +-import(lists, [reverse/1]). + + +scan(G, File) -> + PL = call_preproc(G, File), + call_scan(G, PL). + +call_preproc(G, File) -> + case ic_options:get_opt(G, use_preproc) of + true -> + icpreproc:preproc(G, File); + false -> + case catch file:read_file(File) of + {ok, Bin} -> + binary_to_list(Bin); + Other -> + exit(Other) + end + end. + +call_scan(G, PL) -> + BE = ic_options:get_opt(G, be), + RSL = scan(G, BE, PL, 1, []), + lists:reverse(RSL). + + +%% Guard macros used at top scan functions only +-define(is_number(X), X >= $0 , X =< $9). +-define(is_upper(X), X >= $A , X =< $Z). +-define(is_lower(X), X >= $a, X =< $z). +-define(is_hex_uc(X), X >= $A , X =< $F). +-define(is_hex_lc(X), X >= $a , X =< $f). +-define(is_octal(X), X >=$0, X =< $7). + +%% Handle: +%% const wchar aWChar = L'X'; +scan(G, BE, [$L, $'|Str], Line, Out) -> + scan_const(G, BE, wchar, Str, [], Line, Out); +scan(G, BE, [$L, $"|Str], Line, Out) -> + scan_const(G, BE, wstring, Str, [], Line, Out); +scan(G, BE, [$_, X|Str], Line, Out) when ?is_upper(X) -> + scan_name(G, BE, Str, [X], false, Line, Out); +scan(G, BE, [$_, X|Str], Line, Out) when ?is_lower(X) -> + scan_name(G, BE, Str, [X], false, Line, Out); +scan(G, BE, [X|Str], Line, Out) when ?is_upper(X) -> + scan_name(G, BE, Str, [X], true, Line, Out); +scan(G, BE, [X|Str], Line, Out) when ?is_lower(X) -> + scan_name(G, BE, Str, [X], true, Line, Out); +scan(G, BE, [X|Str], Line, Out) when ?is_number(X) -> + scan_number(G, BE, Str, [X], Line, Out); +scan(G, BE, [9| T], Line, Out) -> scan(G, BE, T, Line, Out); +scan(G, BE, [32| T], Line, Out) -> scan(G, BE, T, Line, Out); +scan(G, BE, [$\r|Str], Line, Out) -> + scan(G, BE, Str, Line, Out); +scan(G, BE, [$\n|Str], Line, Out) -> + scan(G, BE, Str, Line+1, Out); +scan(G, BE, [$:, $: | Str], Line, Out) -> + scan(G, BE, Str, Line, [{'::', Line} | Out]); +scan(G, BE, [$/, $/ | Str], Line, Out) -> + Rest = skip_to_nl(Str), + scan(G, BE, Rest, Line, Out); +scan(G, BE, [$/, $* | Str], Line, Out) -> + Rest = skip_comment(Str), + scan(G, BE, Rest, Line, Out); +scan(G, BE, [$", $\\|Str], Line, Out) -> + scan_const(G, BE, string, [$\\|Str], [], Line, Out); +scan(G, BE, [$"|Str], Line, Out) -> + scan_const(G, BE, string, Str, [], Line, Out); +scan(G, BE, [$', $\\|Str], Line, Out) -> + scan_const(G, BE, char, [$\\|Str], [], Line, Out); +scan(G, BE, [$'|Str], Line, Out) -> + scan_const(G, BE, char, Str, [], Line, Out); +scan(G, BE, [$\\|Str], Line, Out) -> + scan_const(G, BE, escaped, [$\\|Str], [], Line, Out); +scan(G, BE, [$. | Str], Line, Out) -> + scan_frac(G, BE, Str, [$.], Line, Out); +scan(G, BE, [$# | Str], Line, Out) -> + scan_preproc(G, BE, Str, Line, Out); +scan(G, BE, [$<, $< | Str], Line, Out) -> + scan(G, BE, Str, Line, [{'<<', Line} | Out]); +scan(G, BE, [$>, $> | Str], Line, Out) -> + scan(G, BE, Str, Line, [{'>>', Line} | Out]); +scan(G, BE, [C|Str], Line, Out) -> + scan(G, BE, Str, Line, [{list_to_atom([C]), Line} | Out]); + +scan(_G, _BE, [], _Line, Out) -> + Out. + + +scan_number(G, BE, [X|Str], [$0], Line, Out) when X == $X ; X ==$x -> + case Str of + [D|_TmpStr] when ?is_number(D); ?is_hex_uc(D); ?is_hex_lc(D) -> + {Num,Rest} = scan_hex_number(Str,0), + scan(G, BE, Rest, Line, [{'<integer_literal>', Line, + integer_to_list(Num)} | Out]); + [D|TmpStr] -> + scan(G, BE, TmpStr, Line, [{list_to_atom([D]), Line} | Out]) + end; +scan_number(G, BE, Str, [$0], Line, Out) -> + %% If an integer literal starts with a 0 it may indicate that + %% it is represented as an octal number. But, it can also be a fixed + %% type which must use padding to match a fixed typedef. For example: + %% typedef fixed<5,2> fixed52; + %% 123.45d, 123.00d and 023.00d is all valid fixed values. + %% Naturally, a float can be defined as 0.14 or 00.14. + case pre_scan_number(Str, [], octal) of + octal -> + {Num, Rest} = scan_octal_number(Str,0), + scan(G, BE, Rest, Line, [{'<integer_literal>', Line, + integer_to_list(Num)} | Out]); + {fixed, Fixed, Rest} -> + scan(G, BE, Rest, Line, [{'<fixed_pt_literal>', Line, Fixed} | Out]); + float -> + %% Not very likely that someone defines a constant as 00.14 but ... + NewStr = remove_leading_zeroes(Str), + scan(G, BE, NewStr, Line, Out) + end; +scan_number(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> + scan_number(G, BE, Str, [X|Accum], Line, Out); +scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$. -> + scan_frac(G, BE, Str, [X|Accum], Line, Out); +scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$e -> + scan_exp(G, BE, Str, [X|Accum], Line, Out); +scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$D ; X==$d -> + scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, + (lists:reverse(Accum))} | Out]); +scan_number(G, BE, Str, Accum, Line, Out) -> + scan(G, BE, Str, Line, [{'<integer_literal>', Line, + (lists:reverse(Accum))} | Out]). + + +remove_leading_zeroes([$0|Rest]) -> + remove_leading_zeroes(Rest); +remove_leading_zeroes(L) -> + L. + +scan_hex_number([X|Rest],Acc) when X >=$a, X =< $f -> + scan_hex_number(Rest,(Acc bsl 4) + (X - $a + 10)); +scan_hex_number([X|Rest],Acc) when X >=$A, X =< $F -> + scan_hex_number(Rest,(Acc bsl 4) + (X - $A + 10)); +scan_hex_number([X|Rest],Acc) when X >=$0, X =< $9 -> + scan_hex_number(Rest,(Acc bsl 4) + (X-$0)); +scan_hex_number(Rest,Acc) -> + {Acc,Rest}. + +pre_scan_number([$d|Rest], Acc, _) -> + {fixed, [$0|lists:reverse(Acc)], Rest}; +pre_scan_number([$D|Rest], Acc, _) -> + {fixed, [$0|lists:reverse(Acc)], Rest}; +pre_scan_number([$.|Rest], Acc, _) -> + %% Actually, we don't know if it's a float since it can be a fixed. + pre_scan_number(Rest, [$.|Acc], float); +pre_scan_number([X|_], _Acc, _) when X == $E ; X ==$e -> + %% Now we now it's a float. + float; +pre_scan_number([X|Rest], Acc, Type) when ?is_number(X) -> + pre_scan_number(Rest, [X|Acc], Type); +pre_scan_number(_Rest, _Acc, Type) -> + %% At this point we know it's a octal or float. + Type. + +scan_octal_number([X|Rest],Acc) when ?is_octal(X) -> + scan_octal_number(Rest,(Acc bsl 3) + (X-$0)); +scan_octal_number(Rest,Acc) -> + {Acc, Rest}. + +%% Floating point number scan. +%% +%% Non trivial scan. A float consists of an integral part, a +%% decimal point, a fraction part, an e or E and a signed integer +%% exponent. Either the integer part or the fraction part but not +%% both may be missing, and either the decimal point or the +%% exponent part but not both may be missing. The exponent part +%% must consist of an e or E and a possibly signed exponent. +%% +%% Analysis shows that "1." ".7" "1e2" ".5e-3" "1.7e2" "1.7e-2" +%% is allowed and "1" ".e9" is not. The sign is only allowed just +%% after an e or E. The scanner reads a number as an integer +%% until it encounters a "." so the integer part only error case +%% will not be caught in the scanner (but rather in expression +%% evaluation) + +scan_frac(G, _BE, [$e | _Str], [$.], Line, _Out) -> + ic_error:fatal_error(G, {illegal_float, Line}); +scan_frac(G, _BE, [$E | _Str], [$.], Line, _Out) -> + ic_error:fatal_error(G, {illegal_float, Line}); +scan_frac(G, BE, Str, Accum, Line, Out) -> + scan_frac2(G, BE, Str, Accum, Line, Out). + +scan_frac2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> + scan_frac2(G, BE, Str, [X|Accum], Line, Out); +scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$E -> + scan_exp(G, BE, Str, [X|Accum], Line, Out); +%% The following case is for fixed (e.g. 123.45d). +scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$d ; X==$D -> + scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, + (lists:reverse(Accum))} | Out]); +scan_frac2(G, BE, Str, Accum, Line, Out) -> + scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, + (lists:reverse(Accum))} | Out]). + +scan_exp(G, BE, [X|Str], Accum, Line, Out) when X==$- -> + scan_exp2(G, BE, Str, [X|Accum], Line, Out); +scan_exp(G, BE, Str, Accum, Line, Out) -> + scan_exp2(G, BE, Str, Accum, Line, Out). + +scan_exp2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> + scan_exp2(G, BE, Str, [X|Accum], Line, Out); +scan_exp2(G, BE, Str, Accum, Line, Out) -> + scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, + (lists:reverse(Accum))} | Out]). + + +scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_upper(X) -> + scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); +scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_lower(X) -> + scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); +scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_number(X) -> + scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); +scan_name(G, BE, [$_|Str], Accum, TypeCheck, Line, Out) -> + scan_name(G, BE, Str, [$_|Accum], TypeCheck, Line, Out); +scan_name(G, BE, S, Accum, false, Line, Out) -> + %% The CORBA 2.3 specification allows the user to override typechecking: + %% typedef string _native; + %% interface i { + %% void foo(in _native VT); + %% }; + %% BUT, the IFR-id remains the same ("IDL:native:1.0") etc. The reason for + %% this is that one don't have to re-write a large chunk of IDL- and + %% application-code. + scan(G, BE, S, Line, [{'<identifier>', Line, lists:reverse(Accum)} | Out]); +scan_name(G, BE, S, Accum, _, Line, Out) -> + L = lists:reverse(Accum), + X = case is_reserved(L, BE) of + undefined -> + {'<identifier>', Line, L}; + Yes -> + {Yes, Line} + end, + scan(G, BE, S, Line, [X | Out]). + +%% Shall scan a constant +scan_const(G, BE, string, [$" | Rest], Accum, Line, [{'<string_literal>', _, Str}|Out]) -> + scan(G, BE, Rest, Line, + [{'<string_literal>', Line, Str ++ lists:reverse(Accum)} | Out]); +scan_const(G, BE, string, [$" | Rest], Accum, Line, Out) -> + scan(G, BE, Rest, Line, + [{'<string_literal>', Line, lists:reverse(Accum)} | Out]); +scan_const(G, BE, wstring, [$" | Rest], Accum, Line, [{'<wstring_literal>', _,Wstr}|Out]) -> %% WSTRING + scan(G, BE, Rest, Line, + [{'<wstring_literal>', Line, Wstr ++ lists:reverse(Accum)} | Out]); +scan_const(G, BE, wstring, [$" | Rest], Accum, Line, Out) -> %% WSTRING + scan(G, BE, Rest, Line, + [{'<wstring_literal>', Line, lists:reverse(Accum)} | Out]); +scan_const(G, _BE, string, [], _Accum, Line, Out) -> %% Bad string + ic_error:error(G, {bad_string, Line}), + Out; +scan_const(G, _BE, wstring, [], _Accum, Line, Out) -> %% Bad WSTRING + ic_error:error(G, {bad_string, Line}), + Out; +scan_const(G, BE, char, [$' | Rest], Accum, Line, Out) -> + scan(G, BE, Rest, Line, + [{'<character_literal>', Line, lists:reverse(Accum)} | Out]); +scan_const(G, BE, wchar, [$' | Rest], Accum, Line, Out) -> %% WCHAR + scan(G, BE, Rest, Line, + [{'<wcharacter_literal>', Line, lists:reverse(Accum)} | Out]); +scan_const(G, BE, Mode, [$\\, C | Rest], Accum, Line, Out) -> + case escaped_char(C) of + error -> + ic_error:error(G, {bad_escape_character, Line, C}), %% Bad escape character + scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); + octal -> + {Num,Rest2} = scan_octal_number([C|Rest], 0), + scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out); + hexadecimal -> + {Num,Rest2} = scan_hex_number(Rest, 0), + if + Num > 255 -> %% 16#FF + ic_error:error(G, {bad_escape_character, Line, C}), + scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); + true -> + scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) + end; + unicode -> + {Num,Rest2} = scan_hex_number(Rest, 0), + if + Num > 65535 -> %% 16#FFFF + ic_error:error(G, {bad_escape_character, Line, C}), + scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); + true -> + scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) + end; + EC -> + scan_const(G, BE, Mode, Rest, [EC | Accum], Line, Out) + end; +scan_const(G, BE, Mode, [C | Rest], Accum, Line, Out) -> + scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out). + + +%% +%% Preprocessor output handling +%% +%% gcc outputs a line with line number, file name (within \") and +%% one or more integer flags. The scanner scans the line number, +%% the id and all integers up to nl. +%% +%% NOTE: This will have to be enhanced in order to eat #pragma +%% +scan_preproc(G, BE, Str, Line, Out) -> + {List, Rest} = scan_to_nl(strip(Str), []), + NewLine = get_new_line_nr(strip(List), Line+1, []), + case scan_number(G, BE, List, [], Line, [{'#', Line} | Out]) of + L when is_list(L) -> + scan(G, BE, Rest, NewLine, [{'#', Line} | L]) + end. + +get_new_line_nr([C|R], Line, Acc) when C>=$0, C=<$9 -> + get_new_line_nr(R, Line, [C|Acc]); +get_new_line_nr(_, Line, []) -> Line; % No line nr found +get_new_line_nr(_, _, Acc) -> list_to_integer(reverse(Acc)). + +scan_to_nl([], Acc) -> {reverse(Acc), []}; +scan_to_nl([$\n|Str], Acc) -> {reverse(Acc), Str}; +scan_to_nl([$\r|R], Acc) -> scan_to_nl(R, Acc); +scan_to_nl([C|R], Acc) -> scan_to_nl(R, [C|Acc]). + +strip([$ |R]) -> strip(R); +strip(L) -> L. + +%% Escaped character. Escaped chars are repr as two characters in the +%% input list of letters and this is translated into one char. +escaped_char($n) -> $\n; +escaped_char($t) -> $\t; +escaped_char($v) -> $\v; +escaped_char($b) -> $\b; +escaped_char($r) -> $ ; +escaped_char($f) -> $\f; +escaped_char($a) -> $\a; +escaped_char($\\) -> $\\; +escaped_char($?) -> $?; +escaped_char($') -> $'; +escaped_char($") -> $"; +escaped_char($x) -> hexadecimal; +escaped_char($u) -> unicode; +escaped_char(X) when ?is_octal(X) -> octal; +%% Error +escaped_char(_Other) -> error. + +skip_to_nl([]) -> []; +skip_to_nl([$\n | Str]) ->[$\n | Str]; +skip_to_nl([_|Str]) -> + skip_to_nl(Str). + +skip_comment([$\\, _ | Str]) -> + skip_comment(Str); +skip_comment([$*, $/ | Str]) -> Str; +skip_comment([_|Str]) -> + skip_comment(Str). + + +%%---------------------------------------------------------------------- +%% Shall separate keywords from identifiers and numbers + +%% Fill in the ets of reserved words +is_reserved("Object", _) -> 'Object'; +is_reserved("in", _) -> in; +is_reserved("interface", _) -> interface; +is_reserved("case", _) -> 'case'; +is_reserved("union", _) -> union; +is_reserved("struct", _) -> struct; +is_reserved("any", _) -> any; +is_reserved("long", _) -> long; +is_reserved("float", _) -> float; +is_reserved("out", _) -> out; +is_reserved("enum", _) -> enum; +is_reserved("double", _) -> double; +is_reserved("context", _) -> context; +is_reserved("oneway", _) -> oneway; +is_reserved("sequence", _) -> sequence; +is_reserved("FALSE", _) -> 'FALSE'; +is_reserved("readonly", _) -> readonly; +is_reserved("char", _) -> char; +is_reserved("wchar", _) -> wchar; +is_reserved("void", _) -> void; +is_reserved("inout", _) -> inout; +is_reserved("attribute", _) -> attribute; +is_reserved("octet", _) -> octet; +is_reserved("TRUE", _) -> 'TRUE'; +is_reserved("switch", _) -> switch; +is_reserved("unsigned", _) -> unsigned; +is_reserved("typedef", _) -> typedef; +is_reserved("const", _) -> const; +is_reserved("raises", _) -> raises; +is_reserved("string", _) -> string; +is_reserved("wstring", _) -> wstring; +is_reserved("default", _) -> default; +is_reserved("short", _) -> short; +is_reserved("module", _) -> module; +is_reserved("exception", _) -> exception; +is_reserved("boolean", _) -> boolean; +%% --- New keywords Introduced in CORBA-2.3.1 --- +%% For now we cannot add these for all backends right now since it would cause +%% some problems for at least one customer. +is_reserved("fixed", BE) -> check_be(BE, fixed); +%is_reserved("abstract", BE) -> check_be(BE, abstract); +%is_reserved("custom", BE) -> check_be(BE, custom); +%is_reserved("factory", BE) -> check_be(BE, factory); +%is_reserved("local", BE) -> check_be(BE, local); +%is_reserved("native", BE) -> check_be(BE, native); +%is_reserved("private", BE) -> check_be(BE, private); +%is_reserved("public", BE) -> check_be(BE, public); +%is_reserved("supports", BE) -> check_be(BE, supports); +%is_reserved("truncatable", BE) -> check_be(BE, truncatable); +%is_reserved("ValueBase", BE) -> check_be(BE, 'ValueBase'); +%is_reserved("valuetype", BE) -> check_be(BE, valuetype); +is_reserved(_, _) -> undefined. + +check_be(erl_corba, KeyWord) -> + KeyWord; +check_be(_, _) -> + undefined. + diff --git a/lib/ic/src/icstruct.erl b/lib/ic/src/icstruct.erl new file mode 100644 index 0000000000..6058b3c455 --- /dev/null +++ b/lib/ic/src/icstruct.erl @@ -0,0 +1,1916 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(icstruct). + + +-export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]). + +%%------------------------------------------------------------ +%% +%% Internal stuff +%% +%%------------------------------------------------------------ +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). + +-include("icforms.hrl"). +-include("ic.hrl"). + + + +%%------------------------------------------------------------ + +%%------------------------------------------------------------ +%% +%% File handling stuff +%% +%%------------------------------------------------------------ + + + +%%------------------------------------------------------------ +%% +%% Generation loop +%% +%% The idea is to traverse everything and find every struct that +%% may be hiding down in nested types. All structs that are found +%% are generated to a hrl file. +%% +%% struct_gen is entry point for structs and types, except_gen is +%% for exceptions +%% +%%------------------------------------------------------------ + + +except_gen(G, N, X, L) when is_record(X, except) -> + N2 = [ic_forms:get_id2(X) | N], + if + L == c -> + io:format("Warning : Exception not defined for c mapping\n", []); + true -> + emit_struct(G, N, X, L) + end, + struct_gen_list(G, N2, ic_forms:get_body(X), L). + +struct_gen(G, N, X, L) when is_record(X, struct) -> + N2 = [ic_forms:get_id2(X) | N], + struct_gen_list(G, N2, ic_forms:get_body(X), L), + emit_struct(G, N, X, L); +struct_gen(G, N, X, L) when is_record(X, union) -> + N2 = [ic_forms:get_id2(X) | N], + if + L == c -> + %% Produce the "body" first + struct_gen_list(G, N2, ic_forms:get_body(X), L), + icunion:union_gen(G, N, X, c); + true -> + struct_gen(G, N, ic_forms:get_type(X), L), + struct_gen_list(G, N2, ic_forms:get_body(X), L) + end, + emit_union(G, N, X, L); +struct_gen(G, N, X, L) when is_record(X, member) -> + struct_gen(G, N, ic_forms:get_type(X), L); +struct_gen(G, N, X, L) when is_record(X, typedef) -> + struct_gen(G, N, ic_forms:get_body(X), L), + emit_typedef(G, N, X, L); +struct_gen(G, N, X, L) when is_record(X, type_dcl) -> + struct_gen_list(G, N, ic_forms:get_type(X), L); +struct_gen(G, N, X, L) when is_record(X, case_dcl) -> + struct_gen(G, N, ic_forms:get_type(X), L); +struct_gen(G, N, X, L) when is_record(X, sequence) -> + struct_gen(G, N, ic_forms:get_type(X), L), + X; +struct_gen(G, N, X, L) when is_record(X, enum) -> + icenum:enum_gen(G, N, X, L); +struct_gen(_G, _N, _X, _L) -> + ok. + +%% List clause for struct_gen +struct_gen_list(G, N, Xs, L) -> + lists:foreach( + fun(X) -> + R = struct_gen(G, N, X, L), + if + L == c -> + if + is_record(R,sequence) -> + emit_sequence_head_def(G,N,X,R,L); + true -> + ok + end; + true -> + ok + end + end, Xs). + + +%% emit primitive for structs. +emit_struct(G, N, X, erlang) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + %% Make a straight list of all member ids (this is a + %% variant of flatten) + EList = lists:map( + fun(XX) -> + lists:map( + fun(XXX) -> + ic_util:to_atom(ic_forms:get_id2(XXX)) + end, + ic_forms:get_idlist(XX)) + end, + ic_forms:get_body(X)), + ic_codegen:record(G, X, + ic_util:to_undersc([ic_forms:get_id2(X) | N]), + ictk:get_IR_ID(G, N, X), lists:flatten(EList)), + mkFileRecObj(G,N,X,erlang); + false -> + ok + end; +emit_struct(G, N, X, c) -> + + N1 = [ic_forms:get_id2(X) | N], + case ic_pragma:is_local(G,N1) of + true -> + emit_c_struct(G, N, X,local); + false -> + emit_c_struct(G, N, X,included) + end. + + +emit_c_struct(_G, _N, _X, included) -> + %% Do not generate included types att all. + ok; +emit_c_struct(G, N, X, local) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + + N1 = [ic_forms:get_id2(X) | N], + StructName = ic_util:to_undersc(N1), + + %% Make a straight list of all member ids (this is a + %% variant of flatten) + M = lists:map( + fun(XX) -> + lists:map( + fun(XXX) -> + if + is_record(XXX, array) -> + Type = ic_forms:get_type(XX), + Name = element(3,element(2,XXX)), + {_, _, StructTK, _} = + ic_symtab:get_full_scoped_name( + G, + N, + ic_symtab:scoped_id_new( + ic_forms:get_id2(X))), + ArrayTK = + get_structelement_tk(StructTK, + Name), + Dim = extract_dim(ArrayTK), + %% emit array file + emit(Fd, "\n#ifndef __~s__\n", + [ic_util:to_uppercase( + StructName ++ "_" + ++ Name)]), + emit(Fd, "#define __~s__\n\n", + [ic_util:to_uppercase( + StructName ++ "_" + ++ Name)]), + create_c_array_coding_file( + G, + N, + {StructName ++ "_" ++ Name, Dim}, + Type, + no_typedef), + emit(Fd, "\n#endif\n\n"), + {{Type, XXX}, + ic_forms:get_id2(XXX)}; + true -> + %% Ugly work around to fix the ETO + %% return patch problem + Name = + case ic_forms:get_id2(XXX) of + "return" -> + "return1"; + Other -> + Other + end, + {ic_forms:get_type(XX), Name} + end + end, + ic_forms:get_idlist(XX)) + end, + ic_forms:get_body(X)), + EList = lists:flatten(M), + %%io:format("Elist = ~p~n",[EList]), + + emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]), + emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]), + ic_codegen:mcomment_light(Fd, + [io_lib:format("Struct definition: ~s", + [StructName])], + c), + emit(Fd, "typedef struct {\n"), + lists:foreach( + fun({Type, Name}) -> + emit_struct_member(Fd, G, N1, X, Name, Type) + end, + EList), + emit(Fd, "} ~s;\n\n", [StructName]), + create_c_struct_coding_file(G, N, X, nil, StructName, + EList, struct), + emit(Fd, "\n#endif\n\n"); + false -> + ok + end. + +%% Extracts array dimention(s) + +get_structelement_tk({tk_struct, _, _, EList}, EN) -> + {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList), + ArrayTK. + +extract_dim({tk_array, {tk_array, T, D1}, D}) -> + [integer_to_list(D) | extract_dim({tk_array, T, D1})]; +extract_dim({tk_array, _, D}) -> + [integer_to_list(D)]. + +%% Makes the array name +mk_array_name(Name,Dim) -> + Name ++ mk_array_name(Dim). + +mk_array_name([]) -> + ""; +mk_array_name([Dim|Dims]) -> + "[" ++ Dim ++ "]" ++ mk_array_name(Dims). + + +emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)-> + {_, _, StructTK, _} = + ic_symtab:get_full_scoped_name( + G, + N, + ic_symtab:scoped_id_new(ic_forms:get_id2(X))), + ArrayTK = get_structelement_tk(StructTK, Name), + Dim = extract_dim(ArrayTK), + emit(Fd, " ~s ~s;\n", + [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]); +emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)-> + emit(Fd, " ~s ~s;\n", + [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]); +emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) -> + emit(Fd, " CORBA_char *~s;\n", + [Name]); +emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) -> + %% Sequence used as struct + emit(Fd, " ~s ~s;\n", + [ic_util:to_undersc([Name | N]), Name]); +emit_struct_member(Fd, G, N, X, Name, Type) + when element(1, Type) == scoped_id -> + CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not), + emit_struct_member(Fd, G, N, X, Name, CType); +emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) -> + emit(Fd, " ~s ~s;\n", + [ic_cbe:mk_c_type(G, N, Type), + Name]); +emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") -> + emit(Fd, " ETERM* ~s;\n", + [Name]); +emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) -> + emit(Fd, " ~s ~s;\n", + [Type, Name]); +emit_struct_member(Fd, G, N, _X, Name, Type) -> + emit(Fd, " ~s ~s;\n", + [ic_cbe:mk_c_type(G, N, Type), + Name]). + + +emit_typedef(G, N, X, erlang) -> + case X of + {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of + %% an array definition + case ic_options:get_opt(G, be) of + noc -> + mkFileArrObj(G,N,X,erlang); + _ -> + %% Search the table to see if the type is local or + %% inherited. + PTab = ic_genobj:pragmatab(G), + Id = ic_forms:get_id2(X), + case ets:match(PTab,{file_data_local,'_','_', + typedef,N,Id, + ic_util:to_undersc([Id | N]), + '_','_'}) of + [[]] -> + %% Local, create erlang file for the array + mkFileArrObj(G,N,X,erlang); + _ -> + %% Inherited, do nothing + ok + end + end; + + {typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> + %% Sequence but not a typedef of + %% a typedef of a sequence definition + case ic_options:get_opt(G, be) of + noc -> + mkFileRecObj(G,N,X,erlang); + _ -> + %% Search the table to see if the type is local or + %% inherited. + PTab = ic_genobj:pragmatab(G), + Id = ic_forms:get_id2(X), + case ets:match(PTab,{file_data_local,'_','_',typedef, + N,Id, + ic_util:to_undersc([Id | N]), + '_','_'}) of + [[]] -> + %% Local, create erlang file for the sequence + mkFileRecObj(G,N,X,erlang); + _ -> + %% Inherited, do nothing + ok + end + end; + _ -> + ok + end; +emit_typedef(G, N, X, c) -> + B = ic_forms:get_body(X), + if + is_record(B, sequence) -> + emit_sequence_head_def(G, N, X, B, c); + true -> + lists:foreach(fun(D) -> + emit_typedef(G, N, D, B, c) + end, + ic_forms:get_idlist(X)) + end. + +emit_typedef(G, N, D, Type, c) when is_record(D, array) -> + emit_array(G, N, D, Type); +emit_typedef(G, N, D, Type, c) -> + Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), + CType = ic_cbe:mk_c_type(G, N, Type), + TDType = mk_base_type(G, N, Type), + ic_code:insert_typedef(G, Name, TDType), + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), + emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), + ic_codegen:mcomment_light(Fd, + [io_lib:format("Type definition ~s " + "for type ~s", + [Name, CType])], + c), + emit(Fd, "typedef ~s ~s;\n", + [CType, Name]), + emit(Fd, "\n#endif\n\n"), + ic_codegen:nl(Fd); + false -> + ok + end. + + +mk_base_type(G, N, S) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + Type -> + Type + end; +mk_base_type(_G, _N, S) -> + S. + +emit_array(G, N, D, Type) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), + {_, _, ArrayTK, _} = + ic_symtab:get_full_scoped_name(G, N, + ic_symtab:scoped_id_new( + ic_forms:get_id(D))), + Dim = extract_dim(ArrayTK), + CType = ic_cbe:mk_c_type(G, N, Type), + emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), + emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), + ic_codegen:mcomment_light(Fd, + [io_lib:format("Array definition ~s " + "for type ~s", + [Name, CType])], + c), + emit(Fd, "typedef ~s ~s~s;\n", + [CType, Name, ic_cbe:mk_dim(Dim)]), + emit(Fd, "typedef ~s ~s_slice~s;\n", + [CType, Name, ic_cbe:mk_slice_dim(Dim)]), + ic_codegen:nl(Fd), + create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef), + emit(Fd, "\n#endif\n\n"); + false -> + ok + end. + +open_c_coding_file(G, Name) -> + SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), + FName = + ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), + case file:open(FName, [write]) of + {ok, Fd} -> + {Fd, SName}; + Other -> + exit(Other) + end. + + + +create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) -> + + {Fd , SName} = open_c_coding_file(G, Name), + HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + HrlFName = filename:basename(ic_genobj:include_file(G)), + ic_codegen:emit_stub_head(G, Fd, SName, c), + emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile + %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + %% HrlFName = filename:basename(ic_genobj:include_file(G)), + %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + put(op_variable_count, 0), + put(tmp_declarations, []), + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", + [ic_util:mk_oe_name(G, "sizecalc_"), Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, " + "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), + + emit(Fd, " int oe_malloc_size = 0;\n",[]), + emit(Fd, " int oe_error_code = 0;\n",[]), + emit(Fd, " int oe_type = 0;\n",[]), + emit(Fd, " int oe_array_size = 0;\n",[]), + + {ok, RamFd} = ram_file:open([], [binary, write]), + + emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type), + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data} = ram_file:get_file(RamFd), + emit(Fd, Data), + ram_file:close(RamFd), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n",[]), + + put(op_variable_count, 0), + put(tmp_declarations, []), + + RefStr = get_refStr(Dim), + + case TypeDefFlag of + typedef -> + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", + [ic_util:mk_oe_name(G, "encode_"), Name, Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", + [ic_util:mk_oe_name(G, "encode_"), Name, Name]); + no_typedef -> + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n", + [ic_util:mk_oe_name(G, "encode_"), + Name, + ic_cbe:mk_c_type(G, N, Type), + RefStr]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n", + [ic_util:mk_oe_name(G, "encode_"), + Name, + ic_cbe:mk_c_type(G, N, Type), + RefStr]) + end, + + emit(Fd, " int oe_error_code = 0;\n",[]), + + {ok, RamFd1} = ram_file:open([], [binary, write]), + + case TypeDefFlag of + typedef -> + emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type); + no_typedef -> + emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type) + end, + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data1} = ram_file:get_file(RamFd1), + emit(Fd, Data1), + ram_file:close(RamFd1), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n",[]), + + put(op_variable_count, 0), + put(tmp_declarations, []), + + case TypeDefFlag of + typedef -> + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, " + "int*, ~s);\n", + [ic_util:mk_oe_name(G, "decode_"), Name, Name]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " + "int* oe_outindex, ~s oe_out) {\n", + [ic_util:mk_oe_name(G, "decode_"), Name, Name]); + no_typedef -> + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, " + "~s oe_rec~s);\n", + [ic_util:mk_oe_name(G, "decode_"), + Name, + ic_cbe:mk_c_type(G, N, Type), + RefStr]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " + "int* oe_outindex, ~s oe_out~s) {\n", + [ic_util:mk_oe_name(G, "decode_"), + Name, + ic_cbe:mk_c_type(G, N, Type), + RefStr]) + end, + + emit(Fd, " int oe_error_code = 0;\n",[]), + emit(Fd, " int oe_array_size = 0;\n",[]), + + {ok, RamFd2} = ram_file:open([], [binary, write]), + + case TypeDefFlag of + typedef -> + emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type); + no_typedef -> + emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type) + end, + + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data2} = ram_file:get_file(RamFd2), + emit(Fd, Data2), + ram_file:close(RamFd2), + + emit(Fd, " *oe_outindex = ~s;\n\n",[align("*oe_outindex")]), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n",[]), + file:close(Fd). + + +get_refStr([]) -> + ""; +get_refStr([X|Xs]) -> + "[" ++ X ++ "]" ++ get_refStr(Xs). + + +emit_sequence_head_def(G, N, X, T, c) -> + %% T is the sequence + case ic_genobj:is_hrlfile_open(G) of + true -> + Fd = ic_genobj:hrlfiled(G), + SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]), + emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]), + ic_codegen:mcomment_light(Fd, + [io_lib:format("Struct definition: ~s", + [SeqName])], + c), + emit(Fd, "typedef struct {\n"), + emit(Fd, " CORBA_unsigned_long _maximum;\n"), + emit(Fd, " CORBA_unsigned_long _length;\n"), + emit_seq_buffer(Fd, G, N, T#sequence.type), + emit(Fd, "} ~s;\n\n", [SeqName]), + create_c_struct_coding_file(G, N, X, T, SeqName, + T#sequence.type, sequence_head), + emit(Fd, "\n#endif\n\n"); + + false -> + ok + end. + +emit_seq_buffer(Fd, G, N, Type) -> + emit(Fd, " ~s* _buffer;\n", + [ic_cbe:mk_c_type(G, N, Type)]). + +%%------------------------------------------------------------ +%% +%% Emit decode bodies for functions in C for array, sequences and +%% structs. +%% +%%------------------------------------------------------------ +emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> + emit(Fd, " if((char*) oe_out == oe_first)\n",[]), + AlignName = + lists:concat(["*oe_outindex + ", dim_multiplication(Dim), + " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), + emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), + array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array); +emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> + emit(Fd, " if((char*) oe_out == oe_first)\n",[]), + AlignName = + lists:concat(["*oe_outindex + ", dim_multiplication(Dim), + " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), + emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), + array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef); +emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) -> + ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), + ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), + ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []), + + TmpBuf = + case ictype:isBasicTypeOrEterm(G, N, ElType) of + true -> + Tmp = "oe_seq_tmpbuf", + ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]), + Tmp; + false -> + "NOT USED" + end, + + MaxSize = get_seq_max(T), + emit(Fd, " if((char*) oe_out == oe_first)\n",[]), + emit(Fd, " *oe_outindex = ~s;\n\n", + [align(["*oe_outindex + sizeof(", SeqName, ")"])]), + + Ctype = ic_cbe:mk_c_type(G, N, ElType), + emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " + "&oe_env->_iin, &oe_seq_len)) < 0) {\n"), + case ictype:isBasicTypeOrEterm(G, N, ElType) of + true -> + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, " + "&oe_type, &oe_seq_len);\n\n"), + + if + MaxSize == infinity -> + ok; + true -> + emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " + "\"Length of sequence `~s' out of bound\");\n" + " return -1;\n }\n", [SeqName]) + end, + emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), + emit(Fd, " oe_out->_length = oe_seq_len;\n"), + emit(Fd, " oe_out->_buffer = (void *) (oe_first + " + "*oe_outindex);\n"), + emit(Fd, " *oe_outindex = ~s;\n", + [align(["*oe_outindex + (sizeof(", Ctype, ") * " + "oe_out->_length)"])]), + emit(Fd, + " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n" + " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "NO_MEMORY, \"Cannot malloc\");\n" + " return -1;\n" + " }\n", [TmpBuf]), + emit(Fd, " if ((oe_error_code = ei_decode_string(" + "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]), + emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]), + emit_c_dec_rpt(Fd, " ", "string1", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " for (oe_seq_count = 0; " + "oe_seq_count < oe_out->_length; oe_seq_count++)\n"), + case ictype:isBasicType(G, N, ElType) of + true -> + emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) " + "~s[oe_seq_count];\n\n", [TmpBuf]); + false -> %% Term + emit(Fd, " oe_out->_buffer[oe_seq_count] = " + "erl_mk_int(~s[oe_seq_count]);\n\n",[TmpBuf]) % XXXX What? + end, + emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]); + false -> + emit(Fd, " return oe_error_code;\n") + end, + + emit(Fd, " } else {\n"), + + if + MaxSize == infinity -> + ok; + true -> + emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), + emit(Fd, " CORBA_exc_set(oe_env, " + "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " + "\"Length of sequence `~s' out of bound\");\n" + " return -1;\n }\n", [SeqName]) + end, + + emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), + emit(Fd, " oe_out->_length = oe_seq_len;\n"), + emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"), + emit(Fd, " *oe_outindex = ~s;\n\n", + [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]), + + if + Ctype == "CORBA_char *" -> + emit(Fd, " for (oe_seq_count = 0; " + "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), + emit(Fd, " oe_out->_buffer[oe_seq_count] = " + "(void*) (oe_first + *oe_outindex);\n\n"), + ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, + "oe_out->_buffer[oe_seq_count]", + "", + "oe_env->_inbuf", 0, "", caller_dyn), + emit(Fd, " *oe_outindex = ~s;", + [align(["*oe_outindex + strlen(oe_out->_buffer[" + "oe_seq_count]) + 1"])]); + true -> + emit(Fd, " for (oe_seq_count = 0; " + "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), + case ictype:isArray(G, N, ElType) of + %% XXX Silly. There is no real difference between the + %% C statements produced by the following calls. + true -> + ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, + "oe_out->_buffer[oe_seq_count]", + "", + "oe_env->_inbuf", + 0, "oe_outindex", generator); + false -> + ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, + "oe_out->_buffer + oe_seq_count", + "", + "oe_env->_inbuf", + 0, "oe_outindex", generator) + end + end, + emit(Fd, " }\n"), + emit(Fd, " if (oe_out->_length != 0) {\n"), + emit(Fd, " if ((oe_error_code = ei_decode_list_header(" + "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " } else\n"), + emit(Fd, " oe_out->_buffer = NULL;\n"), + emit(Fd, " }\n"); + +emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) -> + Length = length(ElTypes) + 1, + Tname = ic_cbe:mk_variable_name(op_variable_count), + Tname1 = ic_cbe:mk_variable_name(op_variable_count), + + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]), + + emit(Fd, " if((char*) oe_out == oe_first)\n",[]), + AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]), + emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " + "&oe_env->_iin, &~s)) < 0) {\n", [Tname]), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), + emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]), + emit(Fd, " return -1;\n }\n"), + + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " + "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]), + emit(Fd, " return -1;\n\n"), + lists:foreach( + fun({ET, EN}) -> + case ic_cbe:is_variable_size(G, N, ET) of + true -> + case ET of + + {struct, _, _, _} -> + %% Sequence member = a struct + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_out->" ++ EN, + "", "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {sequence, _, _} -> + %% Sequence member = a struct XXX ?? + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + EN, + "&oe_out->" ++ EN, + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + {_,{array, _, _}} -> + emit(Fd, " oe_out->~s = (void *) " + "(oe_first+*oe_outindex);\n\n",[EN]), + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + EN, "oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {union, _, _, _, _} -> + %% Sequence member = a union + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_out->" ++ EN, + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {string,_} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator_malloc); + + {scoped_id,_,_,_} -> + case ictype:member2type(G,StructName,EN) of + array -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + struct -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN , + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + sequence -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + union -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + _ -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator) + end; + + _ -> + emit(Fd, " oe_out->~s = (void *) " + "(oe_first+*oe_outindex);\n\n",[EN]), + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, "oe_outindex", + generator) + end; + false -> + case ET of + + {struct, _, _, _} -> + %% A struct member + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {_,{array, _, _}} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + EN, + "oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {union, _, _, _, _} -> + %% Sequence member = a union + ic_cbe:emit_decoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + + {_,_} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ EN , + "", + "oe_env->_inbuf", + 0, + "oe_outindex", + generator); + {scoped_id,_,_,_} -> + case ic_symtab:get_full_scoped_name(G, N, ET) of + {_FullScopedName, _, {tk_array,_,_}, _} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + {_FullScopedName, _, {tk_string,_}, _} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + {_FullScopedName, _, {tk_struct,_,_,_}, _} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + + {_FullScopedName, _, + {tk_union,_,_,_,_,_}, _} -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator); + + _ -> + ic_cbe:emit_decoding_stmt(G, N, Fd, + ET, + "&oe_out->" ++ + EN, + "", + "oe_env->" + "_inbuf", + 0, + "oe_outindex", + generator) + end + end + end + end, + ElTypes). + + +ref_array_static_dec(array, true) -> + %% Typedef, Static, Basic Type + "&(oe_out)"; +ref_array_static_dec(array, false) -> + %% Typedef, Static, Constr Type + "&(oe_out)"; +ref_array_static_dec(array_no_typedef, true) -> + %% No Typedef, Static, Basic Type + "&oe_out"; +ref_array_static_dec(array_no_typedef, false) -> + %% No Typedef, Static, Constr Type + "&oe_out". + + +ref_array_dynamic_dec(G, N, T, array) -> + case ictype:isString(G, N, T) of + true -> % Typedef, Dynamic, String + "oe_out"; + false -> % Typedef, Dynamic, No String + "&(oe_out)" + end; +ref_array_dynamic_dec(G, N, T, array_no_typedef) -> + case ictype:isString(G, N, T) of + true -> % No Typedef, Dynamic, String + "oe_out"; + false -> % No Typedef, Dynamic, No String + "&oe_out" + end. + + + +array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " + "&oe_env->_iin, &oe_array_size)) < 0) {\n", + []), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + %% This is disabled due to a bug in erl_interface : + %% tuples inside tuples hae no correct data about the size + %% of the tuple........( allways = 0 ) + %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), + %%emit(Fd, " return -1;\n\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + + + ArrAccess = + case ic_cbe:is_variable_size(G, N, Type) of + true -> + ref_array_dynamic_dec(G, N, Type, TDFlag) ++ + Dimstr ++ "[" ++ Tname ++ "]"; + false -> + ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++ + Dimstr ++ "[" ++ Tname ++ "]" + end, + + ic_cbe:emit_decoding_stmt(G, N, Fd, Type, + ArrAccess, + "", "oe_env->_inbuf", 0, + "oe_outindex", generator), + + %% emit(Fd, "\n *oe_outindex += + %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]), + emit(Fd, " }\n"); +array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " + "&oe_env->_iin, &oe_array_size)) < 0) {\n", + []), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + %% This is disabled due to a bug in erl_interface : + %% tuples inside tuples hae no correct data about the size + %% of the tuple........( allways = 0 ) + %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), + %%emit(Fd, " return -1;\n\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type, + TDFlag), + + emit(Fd, " }\n"). + +dim_multiplication([D]) -> + D; +dim_multiplication([D |Ds]) -> + D ++ "*" ++ dim_multiplication(Ds). + +emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> + array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array); +emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> + array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, + array_no_typedef); +emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), + + MaxSize = get_seq_max(T), + if + MaxSize == infinity -> + ok; + true -> + emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "DATA_CONVERSION, \"Length of sequence `~s' " + "out of bound\");\n" + " return -1;\n }\n", [SeqName]) + end, + + emit(Fd, " if (oe_rec->_length != 0) {\n"), + + emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, " + "oe_rec->_length)) < 0) {\n", + []), + emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n", + [Tname, Tname, Tname]), + case ElType of + {_,_} -> %% ElType = elementary type or pointer type + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ + Tname ++ "]", "oe_env->_outbuf"); + + {scoped_id,local,_,["term","erlang"]} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ + Tname ++ "]", "oe_env->_outbuf"); + + {scoped_id,_,_,_} -> + case ic_symtab:get_full_scoped_name(G, N, ElType) of + {_, typedef, TDef, _} -> + case TDef of + {tk_struct,_,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "&oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf"); + {tk_sequence,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "&oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf"); + {tk_union,_,_,_,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "&oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf"); + _ -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf") + end; + {_,enum,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf"); + _ -> + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "&oe_rec->_buffer[" ++ + Tname ++ "]", + "oe_env->_outbuf") + end; + + _ -> %% ElType = structure + ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, + "&oe_rec->_buffer[" ++ Tname ++ "]", + "oe_env->_outbuf") + end, + emit(Fd, " }\n"), + emit(Fd, " }\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) -> + Length = length(ElTypes) + 1, + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + lists:foreach( + fun({ET, EN}) -> + case ET of + {sequence, _, _} -> + %% Sequence = struct + ic_cbe:emit_encoding_stmt(G, N, Fd, + StructName ++ "_" ++ EN, + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + {_,{array, _, _Dims}} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + StructName ++ "_" ++ EN, + "oe_rec->" ++ EN, + "oe_env->_outbuf"); + + {union,_,_,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + + {struct,_,_,_} -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + StructName ++ "_" ++ + ic_forms:get_id2(ET), + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + + {scoped_id,_,_,_} -> + case ictype:member2type(G,StructName,EN) of + struct -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + sequence -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + union -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "&oe_rec->" ++ EN, + "oe_env->_outbuf"); + array -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "oe_rec->" ++ EN, + "oe_env->_outbuf"); + _ -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "oe_rec->" ++ EN, + "oe_env->_outbuf") + end; + _ -> + ic_cbe:emit_encoding_stmt(G, N, Fd, + ET, + "oe_rec->" ++ EN, + "oe_env->_outbuf") + end + end, + ElTypes). + +ref_array_static_enc(array, true) -> + %% Typedef, Static, Basic Type + "oe_rec"; +ref_array_static_enc(array, false) -> + %% Typedef, Static, Constr Type + "&(oe_rec)"; +ref_array_static_enc(array_no_typedef, true) -> + %% No Typedef, Static, Basic Type + "oe_rec"; +ref_array_static_enc(array_no_typedef, false) -> + %% No Typedef, Static, Constr Type + "&oe_rec". + + +ref_array_dynamic_enc(G, N, T, array) -> + case ictype:isString(G, N, T) of + true -> % Typedef, Dynamic, String + "oe_rec"; + false -> % Typedef, Dynamic, No String + "&(oe_rec)" + end; +ref_array_dynamic_enc(G, N, T, array_no_typedef) -> + case ictype:isString(G, N, T) of + true -> % No Typedef, Dynamic, String + "oe_rec"; + false -> % No Typedef, Dynamic, No String + "&oe_rec" + end. + + + +array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + + ArrAccess = + case ic_cbe:is_variable_size(G, N, Type) of + true -> + ref_array_dynamic_enc(G, N, Type, TDFlag) ++ + Str1 ++ "[" ++ Tname ++ "]"; + false -> + ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++ + Str1 ++ "[" ++ Tname ++ "]" + end, + + ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"), + emit(Fd, " }\n"); +array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + array_encode_dimension_loop(G, N, Fd, Ds, + {Str1 ++ "[" ++ Tname ++ "]", Str2}, + Type, TDFlag), + emit(Fd, " }\n"). + + +emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) -> + emit(Fd, " if(*oe_size == 0)\n",[]), + AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim), + " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), + emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]), + array_size_dimension_loop(G, N, Fd, Dim, Type), + emit(Fd, " *oe_size = ~s;\n\n", + [align("*oe_size + oe_malloc_size")]), + ic_codegen:nl(Fd); + +emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) -> + ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), + ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), + + emit(Fd, " if(*oe_size == 0)\n",[]), + emit(Fd, " *oe_size = ~s;\n\n", + [align(["*oe_size + sizeof(", SeqName, ")"])]), + + MaxSize = get_seq_max(T), + + emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, " + "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + + if + MaxSize == infinity -> + ok; + true -> + emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), + emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " + "DATA_CONVERSION, \"Length of sequence `~s' " + "out of bound\");\n" + " return -1;\n }\n", [SeqName]) + end, + + CType = ic_cbe:mk_c_type(G, N, ElType), + + emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " + "oe_size_count_index, NULL)) < 0) {\n"), + + case ictype:isBasicTypeOrEterm(G, N, ElType) of + true -> + emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->" + "_inbuf, oe_size_count_index, NULL)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " oe_malloc_size = ~s;\n\n", + [align(["sizeof(", CType, ") * oe_seq_len"])]); + false -> + emit_c_dec_rpt(Fd, " ", "non mea culpa", []), + emit(Fd, " return oe_error_code;\n\n") + end, + + emit(Fd, " } else {\n"), + + emit(Fd, " oe_malloc_size = ~s;\n\n", + [align(["sizeof(", CType, ") * oe_seq_len"])]), + + emit(Fd, " for (oe_seq_count = 0; oe_seq_count < oe_seq_len; " + "oe_seq_count++) {\n"), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType, + "oe_env->_inbuf", 0, generator), + emit(Fd, " }\n"), + + emit(Fd, " if (oe_seq_len != 0) \n"), + emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf," + "oe_size_count_index, NULL)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " }\n"), + emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]); + +emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) -> + Length = length(ElTypes) + 1, + Tname = ic_cbe:mk_variable_name(op_variable_count), + ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), + + emit(Fd, " if(*oe_size == 0)\n",[]), + AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]), + emit(Fd, " *oe_size = ~s;\n\n", [align(AlignName)]), + ic_codegen:nl(Fd), + + emit(Fd, " if ((oe_error_code = " + "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, " + "&~s)) < 0) {\n", [Tname]), + emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), + emit_c_dec_rpt(Fd, " ", "~s != ~p", [Tname, Length]), + emit(Fd, " return -1;\n }\n"), + + + emit(Fd, " if ((oe_error_code = " + "ei_decode_tuple_header(oe_env->_inbuf, " + "oe_size_count_index, 0)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if ((oe_error_code = " + "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + lists:foreach( + fun({ET, EN}) -> + case ic_cbe:is_variable_size(G, N, ET) of + true -> + case ET of + {sequence, _, _} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ EN, + "oe_env->_inbuf", + 0, + generator); + {_,{array, _, _}} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ EN, + "oe_env->_inbuf", + 0, + generator); + {union,_,_,_,_} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ ic_forms:get_id2(ET), + "oe_env->_inbuf", + 0, + generator); + + {struct,_,_,_} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ ic_forms:get_id2(ET), + "oe_env->_inbuf", + 0, + generator); + + _ -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + ET, + "oe_env->_inbuf", + 0, + generator) + end; + false -> + case ET of + {_,{array, _, _}} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ EN, + "oe_env->_inbuf", + 0, + generator); + + {union,_,_,_,_} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ ic_forms:get_id2(ET), + "oe_env->_inbuf", + 0, + generator); + + {struct,_,_,_} -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + StructName ++ "_" ++ ic_forms:get_id2(ET), + "oe_env->_inbuf", + 0, + generator); + _ -> + ic_cbe:emit_malloc_size_stmt( + G, N, Fd, + ET, + "oe_env->_inbuf", + 1, + generator) + end + end + end, + ElTypes), + + emit(Fd, " *oe_size = ~s;\n\n", + [align("*oe_size + oe_malloc_size")]). + + +array_size_dimension_loop(G, N, Fd, [Dim], Type) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + emit(Fd, " if ((oe_error_code = " + "ei_get_type(oe_env->_inbuf, oe_size_count_index, " + "&oe_type, &oe_array_size)) < 0) {\n", + []), + emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), + emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), + emit(Fd, " return -1;\n }\n"), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " + "oe_size_count_index, 0)) < 0) {\n", []), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + ic_cbe:emit_malloc_size_stmt(G, N, Fd, + Type, "oe_env->_inbuf", 0, generator), + emit(Fd, " }\n"); +array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) -> + Tname = ic_cbe:mk_variable_name(op_variable_count), + + ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), + emit(Fd, " if ((oe_error_code = " + "ei_get_type(oe_env->_inbuf, oe_size_count_index, " + "&oe_type, &oe_array_size)) < 0) {\n", []), + emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), + emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), + emit(Fd, " return -1;\n }\n"), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " + "oe_size_count_index, 0)) < 0) {\n", + []), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", + [Tname, Tname, Dim, Tname]), + array_size_dimension_loop(G, N, Fd, Ds, Type), + emit(Fd, " }\n"). + + +create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) -> + + {Fd , SName} = open_c_coding_file(G, StructName), % stub file + HFd = ic_genobj:hrlfiled(G), % stub header file + HrlFName = filename:basename(ic_genobj:include_file(G)), + + ic_codegen:emit_stub_head(G, Fd, SName, c), + HrlFName = filename:basename(ic_genobj:include_file(G)), + emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + + %% Size count + + put(op_variable_count, 0), + put(tmp_declarations, []), + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", + [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, " + "int* oe_size_count_index, int* oe_size)\n{\n", + [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), + + emit(Fd, " int oe_malloc_size = 0;\n",[]), + emit(Fd, " int oe_error_code = 0;\n",[]), + emit(Fd, " int oe_type = 0;\n",[]), + + {ok, RamFd} = ram_file:open([], [binary, write]), + + emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes), + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data} = ram_file:get_file(RamFd), + emit(Fd, Data), + ram_file:close(RamFd), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n\n",[]), + + %% Encode + + put(op_variable_count, 0), + put(tmp_declarations, []), + + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", + [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n", + [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), + + emit(Fd, " int oe_error_code = 0;\n",[]), + + {ok, RamFd1} = ram_file:open([], [binary, write]), + + emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes), + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data1} = ram_file:get_file(RamFd1), + emit(Fd, Data1), + ram_file:close(RamFd1), + + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n\n",[]), + + %% Decode + + put(op_variable_count, 0), + put(tmp_declarations, []), + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", + [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), + + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " + "int* oe_outindex, " + "~s *oe_out)\n{\n", + [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), + + emit(Fd, " int oe_error_code = 0;\n",[]), + + {ok, RamFd2} = ram_file:open([], [binary, write]), + + emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes), + + ic_cbe:emit_tmp_variables(Fd), + ic_codegen:nl(Fd), + %% Move data from ram file to output file. + {ok, Data2} = ram_file:get_file(RamFd2), + emit(Fd, Data2), + ram_file:close(RamFd2), + + emit(Fd, " *oe_outindex = ~s;\n",[align("*oe_outindex")]), + emit(Fd, " return 0;\n\n",[]), + emit(Fd, "}\n\n",[]), + file:close(Fd). + + +%%------------------------------------------------------------ +%% +%% emit primitive for unions. +%% +%%------------------------------------------------------------ +emit_union(G, N, X, erlang) -> + case ic_genobj:is_hrlfile_open(G) of + true -> + ic_codegen:record(G, X, + ic_util:to_undersc([ic_forms:get_id2(X) | N]), + nil,nil), + mkFileRecObj(G,N,X,erlang); + false -> ok + end; +emit_union(_G, _N, _X, c) -> %% Not supported in c backend + true. + + +%%------------------------------------------------------------ +%% +%% emit erlang modules for objects with record definitions +%% (such as unions or structs), or sequences +%% +%% The record files, other than headers are only generated +%% for CORBA...... If wished an option could allows even +%% for other backends ( not necessary anyway ) +%% +%%------------------------------------------------------------ +mkFileRecObj(G,N,X,erlang) -> + case ic_options:get_opt(G, be) of + erl_corba -> + SName = + ic_util:to_undersc([ic_forms:get_id2(X) | N]), + FName = + ic_file:join(ic_options:get_opt(G, stubdir), + ic_file:add_dot_erl(SName)), + + case file:open(FName, [write]) of + {ok, Fd} -> + HrlFName = filename:basename(ic_genobj:include_file(G)), + + ic_codegen:emit_stub_head(G, Fd, SName, erlang), + emit(Fd, "-include(~p).\n\n",[HrlFName]), + emit_exports(G,Fd), + emit_rec_methods(G,N,X,SName,Fd), + ic_codegen:nl(Fd), + ic_codegen:nl(Fd), + file:close(Fd); + Other -> + exit(Other) + end; + _ -> + true + end. + + +%%------------------------------------------------------------ +%% +%% emit erlang modules for objects with array definitions.. +%% +%%------------------------------------------------------------ +mkFileArrObj(G,N,X,erlang) -> + SName = + ic_util:to_undersc([ic_forms:get_id2(X) | N]), + FName = + ic_file:join(ic_options:get_opt(G, stubdir), + ic_file:add_dot_erl(SName)), + + case file:open(FName, [write]) of + {ok, Fd} -> + HrlFName = filename:basename(ic_genobj:include_file(G)), + + ic_codegen:emit_stub_head(G, Fd, SName, erlang), + emit(Fd, "-include(~p).\n\n",[HrlFName]), + emit_exports(G,Fd), + emit_arr_methods(G,N,X,SName,Fd), + ic_codegen:nl(Fd), + ic_codegen:nl(Fd), + file:close(Fd); + Other -> + exit(Other) + end. + + + + +%%------------------------------------------------------------ +%% +%% emit exports for erlang modules which represent records. +%% +%%------------------------------------------------------------ +emit_exports(G,Fd) -> + case ic_options:get_opt(G, be) of + erl_corba -> + emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]); + _ -> + emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[]) + end. + + +%%------------------------------------------------------------ +%% +%% emit erlang module functions which represent records, yields +%% record information such as type code, identity and name. +%% +%%------------------------------------------------------------ +emit_rec_methods(G,N,X,Name,Fd) -> + + IR_ID = ictk:get_IR_ID(G, N, X), + + case ic_options:get_opt(G, be) of + + erl_corba -> + TK = ic_forms:get_tk(X), + + case TK of + undefined -> + STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)), + emit(Fd, "%% returns type code\n",[]), + emit(Fd, "tc() -> ~p.\n\n",[STK]), + emit(Fd, "%% returns id\n",[]), + emit(Fd, "id() -> ~p.\n\n",[IR_ID]), + emit(Fd, "%% returns name\n",[]), + emit(Fd, "name() -> ~p.\n\n",[Name]); + _ -> + emit(Fd, "%% returns type code\n",[]), + emit(Fd, "tc() -> ~p.\n\n",[TK]), + emit(Fd, "%% returns id\n",[]), + emit(Fd, "id() -> ~p.\n\n",[IR_ID]), + emit(Fd, "%% returns name\n",[]), + emit(Fd, "name() -> ~p.\n\n",[Name]) + end; + + _ -> + emit(Fd, "%% returns id\n",[]), + emit(Fd, "id() -> ~p.\n\n",[IR_ID]), + emit(Fd, "%% returns name\n",[]), + emit(Fd, "name() -> ~p.\n\n",[Name]) + end. + + + +%%------------------------------------------------------------ +%% +%% emit erlang module functions which represent arrays, yields +%% record information such as type code, identity and name. +%% +%%------------------------------------------------------------ +emit_arr_methods(G,N,X,Name,Fd) -> + + IR_ID = ictk:get_IR_ID(G, N, X), + + case ic_options:get_opt(G, be) of + + erl_corba -> + + TK = ic_forms:get_type_code(G, N, X), + + emit(Fd, "%% returns type code\n",[]), + emit(Fd, "tc() -> ~p.\n\n",[TK]), + emit(Fd, "%% returns id\n",[]), + emit(Fd, "id() -> ~p.\n\n",[IR_ID]), + emit(Fd, "%% returns name\n",[]), + emit(Fd, "name() -> ~p.\n\n",[Name]); + + _ -> + + emit(Fd, "%% returns id\n",[]), + emit(Fd, "id() -> ~p.\n\n",[IR_ID]), + emit(Fd, "%% returns name\n",[]), + emit(Fd, "name() -> ~p.\n\n",[Name]) + end. + +get_seq_max(T) when is_record(T, sequence) andalso T#sequence.length == 0 -> + infinity; +get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) -> + list_to_integer(element(3, T#sequence.length)). + + +align(Cs) -> + ic_util:mk_align(Cs). + diff --git a/lib/ic/src/ictk.erl b/lib/ic/src/ictk.erl new file mode 100644 index 0000000000..63a7705699 --- /dev/null +++ b/lib/ic/src/ictk.erl @@ -0,0 +1,873 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ictk). + + +%% Toplevel generation functions +-export([reg_gen/3, unreg_gen/3]). + + +%% Utilities +-export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]). + +-import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]). +-import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]). +-import(ic_codegen, [emit/2, emit/3, nl/1]). + +-include("icforms.hrl"). +-include("ic.hrl"). + +%%-------------------------------------------------------------------- +%% +%% IFR Registration Generation +%% +%% +%%-------------------------------------------------------------------- + +-define(IFRID(G), mk_name(G, "IFR")). +-define(VARID(G), mk_name(G, "VAR")). +-define(IFRMOD, orber_ifr). + +reg_gen(G, N, X) -> + S = ic_genobj:tktab(G), + Light = ic_options:get_opt(G, light_ifr), + init_var(), + case ic_genobj:is_stubfile_open(G) of + true when Light == false -> + Var = ?IFRID(G), + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), nl(Fd), + emit(Fd, "~p() ->\n", [to_atom(register_name(G))]), + emit(Fd, " ~s = ~p:find_repository(),\n", + [Var, ?IFRMOD]), + nl(Fd), + + %% Write call function that checks if included + %% modules and interfaces are created. + emit(Fd, " register_tests(~s),\n",[?IFRID(G)]), + + reg2(G, S, N, Var, X), + nl(Fd), + emit(Fd, " ok.\n"), + + %% Write general register test function. + register_tests(Fd,G), + + %% Write functopn that registers modules only if + %% they are not registered. + register_if_unregistered(Fd); + true when Light == true -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), nl(Fd), + Regname = to_atom(register_name(G)), + emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]), + emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", + [Regname, ?IFRMOD]), + reg_light(G, N, X), + emit(Fd, "ok]),\n\tok.\n"); + false -> + ok + end. + +reg_light(G, N, X) when is_list(X) -> + reg_light_list(G, N, X); +reg_light(G, N, X) when is_record(X, module) -> + reg_light_list(G, [get_id2(X) | N], get_body(X)); +reg_light(G, N, X) when is_record(X, struct) -> + emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", + [get_IR_ID(G, N, X), get_module(X, N)]); +reg_light(G, N, X) when is_record(X, except) -> + emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", + [get_IR_ID(G, N, X), get_module(X, N)]); +reg_light(G, N, X) when is_record(X, union) -> + emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", + [get_IR_ID(G, N, X), get_module(X, N)]); +reg_light(G, N, X) when is_record(X, interface) -> + emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", + [get_IR_ID(G, N, X), get_module(X, N)]), + reg_light_list(G, [get_id2(X)|N], get_body(X)); +reg_light(_G, _N, _X) -> + ok. + +get_module(X, N) -> + List = [get_id2(X) | N], + list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, + hd(List), tl(List))). + +%% This function filters off all "#include <FileName>.idl" code that +%% come along from preprocessor and scanner. Produces code ONLY for +%% the actuall file. See ticket OTP-2133 +reg_light_list(_G, _N, []) -> []; +reg_light_list(G, N, List ) -> + CurrentFileName = ic_genobj:idlfile(G), + reg_light_list(G, N, {CurrentFileName,true}, List). + +%% The filter function + loop +reg_light_list(_G, _N, {_CFN, _Status}, []) -> []; +reg_light_list(G, N, {CFN,Status}, [X | Xs]) -> + case Status of + true -> + case X of + {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> + reg_light_list(G, N, {CFN,false}, Xs); + _ -> + reg_light(G, N, X), + reg_light_list(G, N, {CFN,Status}, Xs) + end; + false -> + case X of + {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> + reg_light(G, N, X), + reg_light_list(G, N, {CFN,true}, Xs); + _ -> + reg_light_list(G, N, {CFN,Status}, Xs) + end + end. + + +%% reg2 is top level registration + +reg2(G, S, N, Var, X) -> + reg2(G, S, N, "Repository_create_", Var, X). + +reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X); + +reg2(G, S, N, C, V, X) when is_record(X, module) -> + NewV = r_emit2(G, S, N, C, V, X, "", []), + reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X)); + +reg2(G, S, N, C, V, X) when is_record(X, const) -> + r_emit2(G, S, N, C, V, X, ", ~s, ~p", + [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]); + +reg2(G, S, N, C, V, X) when is_record(X, struct) -> + do_struct(G, S, N, C, V, X, ic_forms:get_tk(X)); + +reg2(G, S, N, C, V, X) when is_record(X, except) -> + do_except(G, S, N, C, V, X, ic_forms:get_tk(X)); + +reg2(G, S, N, C, V, X) when is_record(X, union) -> + do_union(G, S, N, C, V, X, ic_forms:get_tk(X)); + +reg2(G, S, N, C, V, X) when is_record(X, enum) -> + r_emit2(G, S, N, C, V, X, ", ~p", + [get_enum_member_list(G, S, N, get_body(X))]); + +reg2(G, S, N, C, V, X) when is_record(X, typedef) -> + do_typedef(G, S, N, C, V, X), + look_for_types(G, S, N, C, V, get_body(X)); + +reg2(G, S, N, C, V, X) when is_record(X, attr) -> + XX = #id_of{type=X}, + lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p", + [get_idltype(G, S, N, X), get_mode(G, N, X)]) + end, + get_idlist(X)); + +reg2(G, S, N, C, V, X) when is_record(X, interface) -> + N2 = [get_id2(X) | N], + Body = get_body(X), + BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance + NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]), + reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body); + + +reg2(G, S, N, C, V, X) when is_record(X, op) -> + r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p", + [get_idltype(G, S, N, X), get_mode(G, N, X), + get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X), + get_context(G, S, N, X)]); + +reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok; + +reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok; + +reg2(_G, _S, _N, _C, _V, _X) -> ok. + + +%% This function filters off all "#include <FileName>.idl" code that +%% come along from preprocessor and scanner. Produces code ONLY for +%% the actuall file. See ticket OTP-2133 +reg2_list(_G, _S, _N, _C, _V, []) -> []; +reg2_list(G, S, N, C, V, List ) -> + CurrentFileName = ic_genobj:idlfile(G), + reg2_list(G, S, N, C, V, {CurrentFileName,true}, List). + +%% The filter function + loop +reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> []; +reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) -> + case Status of + true -> + case X of + {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> + reg2_list(G, S, N, C, V, {CFN,false}, Xs); + _ -> + F = reg2(G, S, N, C, V, X), + [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)] + end; + false -> + case X of + {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> + F = reg2(G, S, N, C, V, X), + [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)]; + _ -> + reg2_list(G, S, N, C, V, {CFN,Status}, Xs) + end + end. + + + + + +%% General registration tests +register_tests(Fd,G) -> + IfrId = ?IFRID(G), + emit(Fd,"\n\n%% General IFR registration checks.\n", []), + emit(Fd,"register_tests(~s)->\n",[IfrId]), + emit(Fd," re_register_test(~s),\n",[IfrId]), + emit(Fd," include_reg_test(~s).\n\n",[IfrId]), + + emit(Fd,"\n%% IFR type Re-registration checks.\n", []), + case ic_pragma:fetchRandomLocalType(G) of + {ok,TypeId} -> + emit(Fd,"re_register_test(~s)->\n",[IfrId]), + emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]), + emit(Fd," [] ->\n true;\n",[]), + emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]); + false -> + emit(Fd,"re_register_test(_)-> true.\n",[]) + end, + + emit(Fd,"~s",[check_include_regs(G)]). + + + + +%% This function produces code for existance check over +%% top level included modules and interfaces +check_include_regs(G) -> + IfrId = ?IFRID(G), + case ic_pragma:get_incl_refs(G) of + none -> + io_lib:format("\n%% No included idl-files detected.\n", []) ++ + io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]); + IMs -> + io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++ + io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++ + check_incl_refs(G,IfrId,IMs) + end. + + + +check_incl_refs(_,_,[]) -> + io_lib:format(" true.\n",[]); +check_incl_refs(G,IfrId,[[First]|Rest]) -> + ModId = ic_pragma:scope2id(G,First), + io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++ + io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++ + io_lib:format(" _ ->~n true~n end,~n",[]) ++ + check_incl_refs(G,IfrId,Rest). + + + +%% This function will return module ref, it will +%% also register module if not registered. +register_if_unregistered(Fd) -> + emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"), + emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"), + emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), + emit(Fd, " [] ->\n"), + emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"), + emit(Fd, " Mod ->\n"), + emit(Fd, " Mod\n",[]), + emit(Fd, " end.\n\n"), + emit(Fd, "%% Fetch module reference, register if unregistered.\n"), + emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"), + emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), + emit(Fd, " [] ->\n"), + emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"), + emit(Fd, " Mod ->\n"), + emit(Fd, " Mod\n",[]), + emit(Fd, " end.\n"). + + + +do_typedef(G, S, N, C, V, X) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + Fd = ic_genobj:stubfiled(G), + Thing = get_thing_name(X), + IR_VSN = get_IR_VSN(G, N, X), + TK = ic_forms:get_tk(X), + + lists:foreach( + fun(Id) -> + r_emit_raw(G, X, Fd, "", C, Thing, V, + get_IR_ID(G, N, Id), get_id2(Id), + IR_VSN, ", ~s", + [get_idltype_tk(G, S, N, + ictype:maybe_array(G, S, N, + Id, TK))]) + end, get_idlist(X)) + end. + + +do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) -> + N2 = [get_id2(X) | N], + r_emit2(G, S, N, C, V, X, ", ~s, [~s]", + [get_idltype_tk(G, S, N, DiscrTK), + get_union_member_def(G, S, N2, L)]), + look_for_types(G, S, N2, C, V, get_body(X)). + +do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) -> + N2 = [get_id2(X) | N], + r_emit2(G, S, N, C, V, X, ", [~s]", + [get_member_def(G, S, N, ElemList)]), + look_for_types(G, S, N2, C, V, get_body(X)). + +do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) -> + N2 = [get_id2(X) | N], + r_emit2(G, S, N, C, V, X, ", [~s]", + [get_member_def(G, S, N, ElemList)]), + look_for_types(G, S, N2, C, V, get_body(X)). + + +%% new_var finds an unused Erlang variable name by increasing a +%% counter. +new_var(_G) -> + lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]). +init_var() -> + put(var_count, 1). + +%% Public interface. The name of the register function. +register_name(G) -> + mk_oe_name(G, "register"). +unregister_name(G) -> + mk_oe_name(G, "unregister"). + + + +look_for_types(G, S, N, C, V, L) when is_list(L) -> + lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L); +look_for_types(G, S, N, C, V, {_Name, TK}) -> % member + look_for_types(G, S, N, C, V, TK); +look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) -> + ok; +look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl + look_for_types(G, S, N, C, V, TK); +look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) -> + ok; +look_for_types(_G, _S, _N, _C, _V, _X) -> + ok. + + + + +%% This function produces code for the interface inheritance registration. +%% It produces a string that represents a list of function calls. +%% This list becomes a list of object references when the main function +%% "orber_ifr:ModuleDef_create_interface" is called. + +get_base_interfaces(G,X) -> + case element(3,X) of + [] -> + "[]"; + L -> + "[" ++ + lists:flatten( + lists:foldl( + fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, + call_fun_str(G,hd(L)), + tl(L) + ) + ) ++ "]" + end. + +call_fun_str(G,S) -> + lists:flatten( + io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", + [ ?IFRID(G), + ic_pragma:scope2id(G,S)] )). + + + + + +%%-------------------------------------------------------------------- +%% +%% r_emit emits an IFR register function call. It returns a new +%% variable (if further defs should be added to that one) +%% +%% G is genobj +%% +%% S is symbol table (ets) +%% +%% N is list of ids describing scope +%% +%% C is create stub (eg. "Repository_create_") +%% +%% V is variable name where current def should be added, +%% +%% X is the current def item, +%% +%% F and A is auxillary format and args that will be io_lib +%% formatted and inserted as a string (don't forget to start with +%% ", ") +%% +r_emit2(G, _S, N, C, V, X, F, A) -> + case ic_genobj:is_stubfile_open(G) of + false -> ok; + true -> + {NewV, Str} = get_assign(G, V, X), + r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, + C, get_thing_name(X), V, + get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), + F, A), + NewV + end. + + +%%-------------------------------------------------------------------- +%% +%% An IFR register line registers an entity (Thing) into the IFR. The +%% thing is registered INTO something, an type is registered into a +%% module for instance, and this is reflected in the Var parameter +%% below. The var parameter is the name of the parent IFR object. The +%% Thing parameter is the name of the thing we're trying to register, +%% a typdef is called an alias and an interface is called an +%% interface. Sometimes we need to store the thing we're registering +%% into a variable because we're going to add other things to it +%% later, modules and interfaces are such containers, so we must +%% remember that variable for later use. +%% +%% All parameters shall be strings unless otherwise noted +%% +%% Fd - File descriptor +%% AssignStr - Assign or not, empty except for interfaces and modules +%% Create - Create has diff. names dep. on into what we register +%% Thing - WHAT is registered, interface +%% Var - The name of the variable we register into +%% IR_ID - The IFR identifier (may be "") +%% Id - The identifier (name) of the object +%% IR_VSN - The IFR version as a string +%% AuxStr - An auxillary string +%% +%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) -> +%% r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []). +r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) + when is_record(X, module) -> + emit(Fd, "~n ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", + [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, + IR_VSN, io_lib:format(F, A)]); +r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) + when is_record(X, module) -> + emit(Fd, "~n ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", + [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, + IR_VSN, io_lib:format(F, A)]); +r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) -> + emit(Fd, "~n ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", + [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, + IR_VSN, io_lib:format(F, A)]). + + + + +%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting +%% output var (if any, otherwise same as input arg) and Str is a +%% string of the assignment if any ("" or "Var = ") +get_assign(G, _V, X) when is_record(X, module) -> + mk_assign(G); +get_assign(G, _V, X) when is_record(X, interface) -> + mk_assign(G); +get_assign(_G, V, _X) -> {V, ""}. +mk_assign(G) -> + V = new_var(G), + {V, io_lib:format("~s = ", [V])}. + +%% Returns a list of strings of all enum members (suitable for ~p) +get_enum_member_list(_G, _S, _N, L) -> + lists:map(fun(M) -> get_id2(M) end, L). + +%% Will output a string of the union members. +get_union_member_def(_G, _S, _N, []) -> []; +get_union_member_def(G, S, N, L) -> + [union_member2str(G, S, N, hd(L)) | + lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))]. +%% lists:foldl(fun(M, Acc) -> +%% [union_member2str(G, S, N, M),", " | Acc] end, +%% union_member2str(G, S, N, hd(L)), tl(L)). + +union_member2str(G, S, N, {Label, Name, TK}) -> + io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}", + ["#unionmember", Name, Label, TK, + get_idltype_tk(G, S, N, TK)]). + + +%% Will output a string of the struct members. Works for exceptions +%% and structs +%% +get_member_def(_G, _S, _N, []) -> []; +get_member_def(G, S, N, L) -> + [member2str(G, S, N, hd(L)) | + lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))]. + +member2str(G, S, N, {Id, TK}) -> + io_lib:format("~s{name=~p, type=~p, type_def=~s}", + ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]). + +%% Translates between record names and create operation names. +get_thing_name(X) when is_record(X, op) -> "operation"; +get_thing_name(X) when is_record(X, const) -> "constant"; +get_thing_name(X) when is_record(X, typedef) -> "alias"; +get_thing_name(X) when is_record(X, attr) -> "attribute"; +get_thing_name(X) when is_record(X, except) -> "exception"; +get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type); +get_thing_name(X) -> to_list(element(1,X)). + + +%% Returns the mode (in, out, oneway etc) of ops and params. Return +%% value is an atom. +get_mode(_G, _N, X) when is_record(X, op) -> + case X#op.oneway of + {oneway, _} -> 'OP_ONEWAY'; + _ -> 'OP_NORMAL' + end; +get_mode(_G, _N, X) when is_record(X, attr) -> + case X#attr.readonly of + {readonly, _} -> 'ATTR_READONLY'; + _ -> 'ATTR_NORMAL' + end; +get_mode(_G, _N, X) when is_record(X, param) -> + case X#param.inout of + {in, _} -> 'PARAM_IN'; + {inout, _} -> 'PARAM_INOUT'; + {out, _} -> 'PARAM_OUT' + end. + + +%% Returns a string form of idltype creation. +%%get_idltype_id(G, S, N, X, Id) -> +%% TK = ictype:tk_lookup(G, S, N, Id), +%% get_idltype_tk(G, S, N, TK). +get_idltype(G, S, N, X) -> + get_idltype_tk(G, S, N, ic_forms:get_tk(X)). +get_idltype_tk(G, _S, _N, TK) -> + io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype', + ?IFRID(G), TK]). + +%% Returns a string form of typecode creation. This shall be found in +%% the type code symbol table. +%%get_typecode(G, S, N, X) -> typecode. +%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)). + + +%% Returns the string form of a list of parameters. +get_params(_G, _S, _N, []) -> ""; +get_params(G, S, N, L) -> + lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end, + param2str(G, S, N, hd(L)), tl(L)). + + +%% Converts a parameter to a string. +param2str(G, S, N, X) -> + io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", + ["#parameterdescription", get_id2(X), + ic_forms:get_tk(X), + %%tk_lookup(G, S, N, get_type(X)), + get_idltype(G, S, N, X), + get_mode(G, N, X)]). + + + + +%% Public interface. Returns the IFR ID of an object. This +%% is updated to comply with CORBA 2.0 pragma directives. +get_IR_ID(G, N, X) -> + ScopedId = [get_id2(X) | N], + case ic_pragma:get_alias(G,ScopedId) of + none -> + case ic_pragma:pragma_id(G, N, X) of + none -> + case ic_pragma:pragma_prefix(G, N, X) of + none -> + IR_ID = lists:flatten( + io_lib:format("IDL:~s:~s", + [slashify(ScopedId), + get_IR_VSN(G, N, X)])), + ic_pragma:mk_alias(G,IR_ID,ScopedId), + IR_ID; + PF -> + IR_ID = lists:flatten( + io_lib:format("IDL:~s:~s", + [ PF ++ "/" ++ + get_id2(X), + get_IR_VSN(G, N, X)])), + ic_pragma:mk_alias(G,IR_ID,ScopedId), + IR_ID + end; + PI -> + ic_pragma:mk_alias(G,PI,ScopedId), + PI + end; + Alias -> + Alias + end. + + +%% Public interface. Returns the IFR Version of an object. This +%% is updated to comply with CORBA 2.0 pragma directives. +get_IR_VSN(G, N, X) -> + ic_pragma:pragma_version(G,N,X). + + + + + +%% Returns a slashified name, [I1, M1] becomes "M1/I1" +%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, +% hd(List), tl(List)). + +%% Returns a slashified name, [I1, M1] becomes "M1/I1" +slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, + hd(List), tl(List)). + + +%% Returns the context literals of an op +get_context(_G, _S, _N, X) -> + lists:map(fun(C) -> element(3, C) end, X#op.ctx). + + + +%% Returns the list of the exceptions of an operation +get_exceptions(G, S, N, X) -> + case X#op.raises of + [] -> + ""; + L -> + lists:flatten( + lists:foldl( + fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, + excdef(G, S, N, X, hd(L)), + tl(L) + ) + ) + end. + + +%% Returns the definition of an exception of an operation +excdef(G, S, N, X, L) -> + io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", + [ ?IFRID(G), + get_EXC_ID(G, S, N, X, L) ] ). + + + + + + +%% This function produces code for the exception registration. +%% It produces a string that represents a list of function calls. +%% This list becomes a list of object references when the main function +%% "orber_ifr:InterfaceDef_create_operation" is called. + +get_EXC_ID(G, _S, N, X, ScopedId) -> + case ic_pragma:get_alias(G,ScopedId) of + none -> + case ic_pragma:pragma_id(G, N, X) of + none -> + case ic_pragma:pragma_prefix(G, N, X) of + none -> + EXC_ID = lists:flatten( + io_lib:format("IDL:~s:~s", [slashify(ScopedId), + get_IR_VSN(G, N, X)])), + ic_pragma:mk_alias(G,EXC_ID,ScopedId), + EXC_ID; + PF -> + EXC_ID = lists:flatten( + io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ + hd(ScopedId), + get_IR_VSN(G, N, X)])), + ic_pragma:mk_alias(G,EXC_ID,ScopedId), + EXC_ID + end; + PI -> + ic_pragma:mk_alias(G,PI,ScopedId), + PI + end; + Alias -> + Alias + end. + + + + + +%% unreg_gen/1 uses the information stored in pragma table +%% to decide which modules are to be unregistered +unreg_gen(G, N, X) -> + Light = ic_options:get_opt(G, light_ifr), + case ic_genobj:is_stubfile_open(G) of + true when Light == false -> + Var = ?IFRID(G), + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), nl(Fd), + emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]), + emit(Fd, " ~s = ~p:find_repository(),\n", + [Var, ?IFRMOD]), + nl(Fd), + + unreg2(G, N, X), + emit(Fd, " ok.\n\n"), + destroy(Fd); + true -> + Fd = ic_genobj:stubfiled(G), + nl(Fd), nl(Fd), + Unregname = to_atom(unregister_name(G)), + emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", + [Unregname, Unregname, Unregname]), + emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]); + false -> ok + end. + + +destroy(Fd) -> +emit(Fd," +oe_destroy_if_empty(OE_IFR,IFR_ID) -> + case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of + [] -> + ok; + Ref -> + case orber_ifr:contents(Ref, \'dk_All\', \'true\') of + [] -> + orber_ifr:destroy(Ref), + ok; + _ -> + ok + end + end. + +oe_destroy(OE_IFR,IFR_ID) -> + case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of + [] -> + ok; + Ref -> + orber_ifr:destroy(Ref), + ok + end. + +",[]). + + + + + + + + + + +%% unreg2 is top level registration + +unreg2(G, N, X) -> + emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]). + +unreg3(G, N, X) when is_list(X) -> + unreg3_list(G, N, X, []); + +unreg3(G, N, X) when is_record(X, module) -> + unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]); + +unreg3(G, N, X) when is_record(X, const) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, struct) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, except) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, union) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, enum) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, typedef) -> + unreg_collect(G, N, X); + +unreg3(G, N, X) when is_record(X, interface) -> + unreg_collect(G, N, X); + +unreg3(_G, _N, X) when is_record(X, op) -> []; + +unreg3(_G, _N, X) when is_record(X, attr) -> []; + +unreg3(_G, _N, X) when is_record(X, preproc) -> []; + +unreg3(_G, _N, X) when is_record(X, pragma) -> []; + +unreg3(_G, _N, _X) -> []. + + +unreg3_list(_G, _N, [], Found) -> + Found; +unreg3_list(G, N, List, Found) -> + CurrentFileName = ic_genobj:idlfile(G), + unreg3_list(G, N, {CurrentFileName,true}, List, Found). + +%% The filter function + loop +unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> + Found; +unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) -> + case Status of + true -> + case X of + {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> + unreg3_list(G, N, {CFN,false}, Xs, Found); + _ -> + unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found]) + end; + false -> + case X of + {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> + unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]); + _ -> + unreg3_list(G, N, {CFN,Status}, Xs, Found) + end + end. + + + +unreg_collect(G, N, X) when is_record(X, module) -> + io_lib:format(" oe_destroy_if_empty(OE_IFR, ~p),\n", + [get_IR_ID(G, N, X)]); +unreg_collect(G, N, X) when is_record(X, typedef) -> + lists:map(fun(Id) -> + io_lib:format(" oe_destroy(OE_IFR, ~p),\n", + [get_IR_ID(G, N, Id)]) + end, + ic_forms:get_idlist(X)); +unreg_collect(G, N, X) -> + io_lib:format(" oe_destroy(OE_IFR, ~p),\n", + [get_IR_ID(G, N, X)]). + + + diff --git a/lib/ic/src/ictype.erl b/lib/ic/src/ictype.erl new file mode 100644 index 0000000000..4704191bee --- /dev/null +++ b/lib/ic/src/ictype.erl @@ -0,0 +1,1413 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(ictype). + + +-include("ic.hrl"). +-include("icforms.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]). + +-export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]). +-export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3, + isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]). +-export([fetchTk/3, fetchType/1, tk/4]). +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% Macros +%%----------------------------------------------------------------- +%%-define(DBG(F,A), io:format(F,A)). +-define(DBG(F,A), true). +-define(STDDBG, ?DBG(" dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- + +type_check(G, Forms) -> + S = ic_genobj:tktab(G), + check_list(G, S, [], Forms). + +scoped_lookup(G, S, N, X) -> + Id = ic_symtab:scoped_id_strip(X), + case ic_symtab:scoped_id_is_global(X) of + true -> + lookup(G, S, [], X, Id); + false -> + lookup(G, S, N, X, Id) + end. + + +%%-------------------------------------------------------------------- +%% maybe_array +%% +%% Array declarators are indicated on the declarator and not on +%% the type, therefore the declarator decides if the array type +%% kind is added or not. +%% +maybe_array(G, S, N, X, TK) when is_record(X, array) -> + mk_array(G, S, N, X#array.size, TK); +maybe_array(_G, _S, _N, _, TK) -> TK. + + + +name2type(G, Name) -> + S = ic_genobj:tktab(G), + ScopedName = lists:reverse(string:tokens(Name, "_")), + InfoList = ets:lookup(S, ScopedName ), + filter( InfoList ). + + +%% This is en overloaded function, +%% differs in input on unions +member2type(_G, X, I) when is_record(X, union)-> + Name = ic_forms:get_id2(I), + case lists:keysearch(Name,2,element(6,X#union.tk)) of + false -> + error; + {value,Rec} -> + fetchType(element(3,Rec)) + end; +member2type( G, SName, MName ) -> + + S = ic_genobj:tktab( G ), + SNList = lists:reverse(string:tokens(SName,"_")), + ScopedName = [MName | SNList], + InfoList = ets:lookup( S, ScopedName ), + + case filter( InfoList ) of + error -> + %% Try a little harder, seeking inside tktab + case lookup_member_type_in_tktab(S, ScopedName, MName) of + error -> + %% Check if this is the "return to return1" case + case MName of + "return1" -> + %% Do it all over again ! + ScopedName2 = ["return" | SNList], + InfoList2 = ets:lookup( S, ScopedName2 ), + case filter( InfoList2 ) of + error -> + %% Last resort: seek in pragma table + lookup_type_in_pragmatab(G, SName); + + Other -> + Other + end; + _ -> + %% Last resort: seek in pragma table + lookup_type_in_pragmatab(G, SName) + end; + Other -> + Other + end; + Other -> + Other + end. + + +lookup_member_type_in_tktab(S, ScopedName, MName) -> + case ets:match_object(S, {'_',member,{MName,'_'},nil}) of + [] -> + error; + [{_FullScopedName,member,{MName,TKInfo},nil}]-> + fetchType( TKInfo ); + List -> + lookup_member_type_in_tktab(List,ScopedName) + end. + +lookup_member_type_in_tktab([], _ScopedName) -> + error; +lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> + case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of + ScopedName -> + fetchType(TKInfo); + _ -> + lookup_member_type_in_tktab(Rest,ScopedName) + end. + + +lookup_type_in_pragmatab(G, SName) -> + S = ic_genobj:pragmatab(G), + + %% Look locally first + case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of + [] -> + %% No match, seek included + case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of + + [] -> + error; + [[Type]] -> + io:format("1 Found(~p) : ~p~n",[SName,Type]), + Type + end; + + [[Type]] -> + io:format("2 Found(~p) : ~p~n",[SName,Type]), + Type + end. + + + + +isString(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_string',_}, _} -> + true; + _ -> + false + end; +isString(_G, _N, T) when is_record(T, string) -> + true; +isString(_G, _N, _Other) -> + false. + + +isWString(G, N, T) when element(1, T) == scoped_id -> %% WSTRING + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_wstring',_}, _} -> + true; + _ -> + false + end; +isWString(_G, _N, T) when is_record(T, wstring) -> + true; +isWString(_G, _N, _Other) -> + false. + + +isArray(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_array', _, _}, _} -> + true; + _ -> + false + end; +isArray(_G, _N, T) when is_record(T, array) -> + true; +isArray(_G, _N, _Other) -> + false. + + +isSequence(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_sequence', _, _}, _} -> + true; + _ -> + false + end; +isSequence(_G, _N, T) when is_record(T, sequence) -> + true; +isSequence(_G, _N, _Other) -> + false. + + +isStruct(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> + true; + _ -> + false + end; +isStruct(_G, _N, T) when is_record(T, struct) -> + true; +isStruct(_G, _N, _Other) -> + false. + + +isUnion(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> + true; + _Other -> + false + end; +isUnion(_G, _N, T) when is_record(T, union) -> + true; +isUnion(_G, _N, _Other) -> + false. + + + +isEnum(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, {'tk_enum',_,_,_}, _} -> + true; + _Other -> + false + end; +isEnum(_G, _N, T) when is_record(T, enum) -> + true; +isEnum(_G, _N, _Other) -> + false. + + + +isBoolean(G, N, T) when element(1, T) == scoped_id -> + {_, _, TK, _} = + ic_symtab:get_full_scoped_name(G, N, T), + case fetchType(TK) of + 'boolean' -> + true; + _ -> + false + end; +isBoolean(_, _, {'tk_boolean',_}) -> + true; +isBoolean(_, _, {'boolean',_}) -> + true; +isBoolean(_, _, _) -> + false. + + +%%% Just used for C + +isBasicTypeOrEterm(G, N, S) -> + case isBasicType(G, N, S) of + true -> + true; + false -> + isEterm(G, N, S) + end. + +isEterm(G, N, S) when element(1, S) == scoped_id -> + {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of + "erlang_term" -> + true; + "ETERM*" -> + true; + _X -> + false + end; +isEterm(_G, _Ni, _X) -> + false. + +isBasicType(_G, _N, {scoped_id,_,_,["term","erlang"]}) -> + false; +isBasicType(G, N, S) when element(1, S) == scoped_id -> + {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + isBasicType(fetchType(TK)); +isBasicType(_G, _N, {string, _} ) -> + false; +isBasicType(_G, _N, {wstring, _} ) -> %% WSTRING + false; +isBasicType(_G, _N, {unsigned, {long, _}} ) -> + true; +isBasicType(_G, _N, {unsigned, {short, _}} ) -> + true; +isBasicType(_G, _N, {Type, _} ) -> + isBasicType(Type); +isBasicType(_G, _N, _X) -> + false. + + +isBasicType( G, Name ) -> + isBasicType( name2type( G, Name ) ). + + +isBasicType( Type ) -> + lists:member(Type, + [tk_short,short, + tk_long,long, + tk_longlong,longlong, %% LLONG + tk_ushort,ushort, + tk_ulong,ulong, + tk_ulonglong,ulonglong, %% ULLONG + tk_float,float, + tk_double,double, + tk_boolean,boolean, + tk_char,char, + tk_wchar,wchar, %% WCHAR + tk_octet,octet, + tk_any,any]). %% Fix for any + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +check(G, _S, N, X) when is_record(X, preproc) -> + handle_preproc(G, N, X#preproc.cat, X), + X; + +check(G, S, N, X) when is_record(X, op) -> + ?STDDBG, + TK = tk_base(G, S, N, ic_forms:get_type(X)), + tktab_add(G, S, N, X), + N2 = [ic_forms:get_id2(X) | N], + Ps = lists:map(fun(P) -> + tktab_add(G, S, N2, P), + P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end, + X#op.params), + %% Check for exception defs. + Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end, + X#op.raises), + case ic_forms:is_oneway(X) of + true -> + if TK /= tk_void -> + ic_error:error(G, {bad_oneway_type, X, TK}); + true -> ok + end, + case ic:filter_params([inout, out], X#op.params) of + [] -> ok; % No out parameters! + _ -> + ic_error:error(G, {oneway_outparams, X}) + end, + case X#op.raises of + [] -> ok; + _ -> + ic_error:error(G, {oneway_raises, X}) + end; + false -> + ok + end, + X#op{params=Ps, tk=TK, raises=Raises}; + +check(G, S, N, X) when is_record(X, interface) -> + ?STDDBG, + N2 = [ic_forms:get_id2(X) | N], + TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}, + Inherit = inherit_resolve(G, S, N, X#interface.inherit, []), + tktab_add(G, S, N, X, TK, Inherit), + CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)), + InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []), + X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody, + inherit_body=InhBody}, + ic_symtab:store(G, N, X2), + X2; + +check(G, S, N, X) when is_record(X, forward) -> + ?STDDBG, + tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}), + X; + + +check(G, S, N, X) when is_record(X, const) -> + ?STDDBG, + case tk_base(G, S, N, ic_forms:get_type(X)) of + Err when element(1, Err) == error -> X; + TK -> + check_const_tk(G, S, N, X, TK), + case iceval:eval_const(G, S, N, TK, X#const.val) of + Err when element(1, Err) == error -> X; + {ok, NewTK, Val} -> + V = iceval:get_val(Val), + tktab_add(G, S, N, X, NewTK, V), + X#const{val=V, tk=NewTK}; + Val -> + V = iceval:get_val(Val), + tktab_add(G, S, N, X, TK, V), + X#const{val=V, tk=TK} + end + end; + +check(G, S, N, X) when is_record(X, const) -> + ?STDDBG, + case tk_base(G, S, N, ic_forms:get_type(X)) of + Err when element(1, Err) == error -> X; + TK -> + check_const_tk(G, S, N, X, TK), + case iceval:eval_const(G, S, N, TK, X#const.val) of + Err when element(1, Err) == error -> X; + Val -> + V = iceval:get_val(Val), + tktab_add(G, S, N, X, TK, V), + X#const{val=V, tk=TK} + end + end; + +check(G, S, N, X) when is_record(X, except) -> + ?STDDBG, + TK = tk(G, S, N, X), + X#except{tk=TK}; + +check(G, S, N, X) when is_record(X, struct) -> + ?STDDBG, + TK = tk(G, S, N, X), + X#struct{tk=TK}; + +check(G, S, N, X) when is_record(X, enum) -> + ?STDDBG, + TK = tk(G, S, N, X), + X#enum{tk=TK}; + +check(G, S, N, X) when is_record(X, union) -> + ?STDDBG, + TK = tk(G, S, N, X), + X#union{tk=TK}; + +check(G, S, N, X) when is_record(X, attr) -> + ?STDDBG, + TK = tk_base(G, S, N, ic_forms:get_type(X)), + XX = #id_of{type=X}, + lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end, + ic_forms:get_idlist(X)), + X#attr{tk=TK}; + +check(G, S, N, X) when is_record(X, module) -> + ?STDDBG, + tktab_add(G, S, N, X), + X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))}; + +check(G, S, N, X) when is_record(X, typedef) -> + ?STDDBG, + TKbase = tk(G, S, N, X), + X#typedef{tk=TKbase}; + +check(_G, _S, _N, X) -> + ?DBG(" dbg: ~p~n", [element(1,X)]), + X. + +handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X)); +handle_preproc(_G, _N, _C, _X) -> ok. + + +%%-------------------------------------------------------------------- +%% +%% TK calculation +%% +%%-------------------------------------------------------------------- + +tk(G, S, N, X) when is_record(X, union) -> + N2 = [ic_forms:get_id2(X) | N], + DisrcTK = tk(G, S, N, ic_forms:get_type(X)), + case check_switch_tk(G, S, N, X, DisrcTK) of + true -> + do_special_enum(G, S, N2, ic_forms:get_type(X)), + BodyTK = lists:reverse( + tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))), + tktab_add(G, S, N, X, + {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), + DisrcTK, default_count(ic_forms:get_body(X)), BodyTK}); + false -> + tk_void + end; + +tk(G, S, N, X) when is_record(X, enum) -> + N2 = [ic_forms:get_id2(X) | N], + tktab_add(G, S, N, X, + {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), + enum_body(G, S, N2, ic_forms:get_body(X))}); + + +%% Note that the TK returned from this function is the base TK. It +%% must be modified for each of the identifiers in the idlist (for +%% array reasons). +tk(G, S, N, X) when is_record(X, typedef) -> + case X of + %% Special case only for term and java backend ! + {typedef,{any,_},[{'<identifier>',_,"term"}],undefined} -> + case ic_options:get_opt(G, be) of + java -> + tktab_add(G, S, N, X, tk_term), + tk_term; + _ -> + TK = tk(G, S, N, ic_forms:get_body(X)), + lists:foreach(fun(Id) -> + tktab_add(G, S, N, #id_of{id=Id, type=X}, + maybe_array(G, S, N, Id, TK)) + end, + X#typedef.id), + TK + end; + _ -> + TK = tk(G, S, N, ic_forms:get_body(X)), + lists:foreach(fun(Id) -> + tktab_add(G, S, N, #id_of{id=Id, type=X}, + maybe_array(G, S, N, Id, TK)) + end, + X#typedef.id), + TK + end; + +tk(G, S, N, X) when is_record(X, struct) -> + N2 = [ic_forms:get_id2(X) | N], + tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), + tk_memberlist(G, S, N2, ic_forms:get_body(X))}); + +tk(G, S, N, X) when is_record(X, except) -> + N2 = [ic_forms:get_id2(X) | N], + tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), + tk_memberlist(G, S, N2, ic_forms:get_body(X))}); + +tk(G, S, N, X) -> tk_base(G, S, N, X). + + +tk_base(G, S, N, X) when is_record(X, sequence) -> + {tk_sequence, tk(G, S, N, X#sequence.type), + len_eval(G, S, N, X#sequence.length)}; + +tk_base(G, S, N, X) when is_record(X, string) -> + {tk_string, len_eval(G, S, N, X#string.length)}; + +tk_base(G, S, N, X) when is_record(X, wstring) -> %% WSTRING + {tk_wstring, len_eval(G, S, N, X#wstring.length)}; + +%% Fixed constants can be declared as: +%% (1) const fixed pi = 3.14D; or +%% (2) typedef fixed<3,2> f32; +%% const f32 pi = 3.14D; +tk_base(G, S, N, X) when is_record(X, fixed) -> + %% Case 2 + {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)}; +tk_base(_G, _S, _N, {fixed, _}) -> + %% Case 1 + tk_fixed; + + +%% Special case, here CORBA::TypeCode is built in +%% ONLY when erl_corba is the backend of choice +tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) -> + case ic_options:get_opt(G, be) of + false -> + tk_TypeCode; + erl_corba -> + tk_TypeCode; + erl_template -> + tk_TypeCode; + _ -> + case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of + T when element(1, T) == error -> T; + T when is_tuple(T) -> element(3, T) + end + end; + +tk_base(G, S, N, X) when element(1, X) == scoped_id -> + case scoped_lookup(G, S, N, X) of + T when element(1, T) == error -> T; + T when is_tuple(T) -> element(3, T) + end; +tk_base(_G, _S, _N, {long, _}) -> tk_long; +tk_base(_G, _S, _N, {'long long', _}) -> tk_longlong; %% LLONG +tk_base(_G, _S, _N, {short, _}) -> tk_short; +tk_base(_G, _S, _N, {'unsigned', {short, _}}) -> tk_ushort; +tk_base(_G, _S, _N, {'unsigned', {long, _}}) -> tk_ulong; +tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong; %% ULLONG +tk_base(_G, _S, _N, {float, _}) -> tk_float; +tk_base(_G, _S, _N, {double, _}) -> tk_double; +tk_base(_G, _S, _N, {boolean, _}) -> tk_boolean; +tk_base(_G, _S, _N, {char, _}) -> tk_char; +tk_base(_G, _S, _N, {wchar, _}) -> tk_wchar; %% WCHAR +tk_base(_G, _S, _N, {octet, _}) -> tk_octet; +tk_base(_G, _S, _N, {null, _}) -> tk_null; +tk_base(_G, _S, _N, {void, _}) -> tk_void; +tk_base(_G, _S, _N, {any, _}) -> tk_any; +tk_base(_G, _S, _N, {'Object', _}) -> {tk_objref, "", "Object"}. + + +%%-------------------------------------------------------------------- +%% +%% Special handling of idlists. Note that the recursion case is given +%% as accumulator to foldr. Idlists are those lists of identifiers +%% that share the same definition, i.e. multiple cases, multiple type +%% declarations, multiple member names. +%% +tk_memberlist(G, S, N, [X | Xs]) -> + BaseTK = tk(G, S, N, ic_forms:get_type(X)), + + XX = #id_of{type=X}, + lists:foldr(fun(Id, Acc) -> + [tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end, + tk_memberlist(G, S, N, Xs), + ic_forms:get_idlist(X)); +tk_memberlist(_G, _S, _N, []) -> []. + +%% same as above but for case dcls +tk_caselist(G, S, N, DiscrTK, Xs) -> + lists:foldl(fun(Case, Acc) -> + BaseTK = tk(G, S, N, ic_forms:get_type(Case)), + %% tktab_add for the uniqueness check of the declarator + tktab_add(G, S, N, Case), + lists:foldl(fun(Id, Acc2) -> + case tk_case(G, S, N, Case, BaseTK, + DiscrTK, Id) of + Err when element(1, Err)==error -> + Acc2; + TK -> + unique_add_case_label(G, S, N, Id, + TK, Acc2) + end + end, + Acc, + ic_forms:get_idlist(Case)) + end, + [], + Xs). + + +%% Handling of the things that can be in an idlist or caselist +tk_member(G, S, N, X, BaseTK) -> + tktab_add(G, S, N, X, + {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}). + + +get_case_id_and_check(G, _S, _N, _X, ScopedId) -> + case ic_symtab:scoped_id_is_global(ScopedId) of + true -> ic_error:error(G, {bad_scope_enum_case, ScopedId}); + false -> ok + end, + case ic_symtab:scoped_id_strip(ScopedId) of + [Id] -> Id; + _List -> + ic_error:error(G, {bad_scope_enum_case, ScopedId}), + "" + end. + + +tk_case(G, S, N, X, BaseTK, DiscrTK, Id) -> + case case_eval(G, S, N, DiscrTK, Id) of + Err when element(1, Err) == error -> Err; + Val -> + case iceval:check_tk(G, DiscrTK, Val) of + true -> + {iceval:get_val(Val), ic_forms:get_id2(X), + maybe_array(G, S, N, X#case_dcl.id, BaseTK)}; + false -> + ic_error:error(G, {bad_case_type, DiscrTK, X, + iceval:get_val(Val)}) + end + end. + +tktab_add(G, S, N, X) -> + tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil). +tktab_add(G, S, N, X, TK) -> + tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil). +tktab_add(G, S, N, X, TK, Aux) -> + tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux). + + +tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) -> + + %% Check if the "scl" flag is set to true + %% if so, allow old semantics ( errornous ) + %% Warning, this is for compatibility reasons only. + Name = case ic_options:get_opt(G, scl) of + true -> + [Id | N]; + false -> + [Id | tl(N)] + end, + + UName = mk_uppercase(Name), + case ets:lookup(S, Name) of + [_] -> ic_error:error(G, {multiply_defined, X}); + [] -> + case ets:lookup(S, UName) of + [] -> ok; + [_] -> ic_error:error(G, {illegal_spelling, X}) + end + end, + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; +%% +%% Fixes the multiple file module definition check +%% but ONLY for Corba backend +%% +tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) -> + case ic_options:get_opt(G, be) of + erl_template -> + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + erl_corba -> + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + false -> %% default == erl_corba + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + java -> + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + erl_genserv -> + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + erl_plain -> + Name = [Id | N], + UName = mk_uppercase(Name), + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK; + _Be -> + Name = [Id | N], + UName = mk_uppercase(Name), + case ets:lookup(S, Name) of + [_] -> ic_error:error(G, {multiply_defined, X}); + [] -> + case ets:lookup(S, UName) of + [] -> ok; + [_] -> ic_error:error(G, {illegal_spelling, X}) + end + end, + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK + end; +tktab_add_id(G, S, N, X, Id, TK, Aux) -> + Name = [Id | N], + UName = mk_uppercase(Name), + case ets:lookup(S, Name) of + [{_, forward, _, _}] when is_record(X, interface) -> ok; + [XX] when is_record(X, forward) andalso element(2, XX)==interface -> ok; + [_] -> ic_error:error(G, {multiply_defined, X}); + [] -> + case ets:lookup(S, UName) of + [] -> ok; + [_] -> ic_error:error(G, {illegal_spelling, X}) + end + end, + ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), + if UName =/= Name -> ets:insert(S, {UName, spellcheck}); + true -> true end, + TK. + + + + +%%-------------------------------------------------------------------- +%% enum_body +%% +%% Special because ids are treated different than usual. +%% +enum_body(G, S, N, [Enum | EnumList]) -> + tktab_add(G, S, N, Enum), %%%, enum_val, Enum), + %% tktab_add(G, S, N, X, TK, V), + [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)]; +enum_body(_G, _S, _N, []) -> []. + + +%%-------------------------------------------------------------------- +%% mk_array +%% +%% Multi dimensional arrays are written as nested tk_array +%% +mk_array(G, S, N, [Sz | Szs], TK) -> + case iceval:eval_const(G, S, N, positive_int, Sz) of + Err when element(1, Err) == error -> TK; + Val -> + {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)} + end; +mk_array(_G, _S, _N, [], TK) -> TK. + + +%%-------------------------------------------------------------------- +%% len_eval +%% +%% Evaluates the length, which in case it has been left out is a +%% plain 0 (zero) +%% +len_eval(_G, _S, _N, 0) -> 0; +len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X). + case iceval:eval_const(G, S, N, positive_int, X) of + Err when element(1, Err) == error -> 0; + Val -> iceval:get_val(Val) + end. + + +%%-------------------------------------------------------------------- +%% case_eval +%% +%% Evaluates the case label. +%% + +case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum, + element(1, X) == scoped_id -> + {tk_enum, _, _, Cases} = DiscrTK, + Id = get_case_id_and_check(G, S, N, X, X), + %%io:format("Matching: ~p to ~p~n", [Id, Cases]), + case lists:member(Id, Cases) of + true -> + {enum_id, Id}; + false -> + iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error + end; + +case_eval(G, S, N, DiscrTK, X) -> + iceval:eval_e(G, S, N, DiscrTK, X). + + +%% The enum declarator is in the union scope. +do_special_enum(G, S, N, X) when is_record(X, enum) -> + tktab_add(G, S, N, #id_of{id=X#enum.id, type=X}); +do_special_enum(_G, _S, _N, _X) -> + ok. + + +unique_add_case_label(G, _S, _N, Id, TK, TKList) -> +%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]), + if element(1, TK) == error -> + TKList; + true -> + case lists:keysearch(element(1, TK), 1, TKList) of + {value, _} -> + ic_error:error(G, {multiple_cases, Id}), + TKList; + false -> + [TK | TKList] + end + end. + + +%%-------------------------------------------------------------------- +%% default_count +%% +%% Returns the position of the default case. +%% +%% Modified for OTP-2007 +%% +default_count(Xs) -> + default_count2(Xs, 0). + +default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N); +default_count2([], _) -> -1. + +default_count3([{default, _} | _Ys], _Xs, N) -> N; +default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1); +default_count3([], Xs, N) -> default_count2(Xs, N). + + + + +%% +%% Type checks. +%% +%% Check constant type references (only for the scoped id case, others +%% are caught by the BNF) +%% +check_const_tk(_G, _S, _N, _X, tk_long) -> true; +check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG +check_const_tk(_G, _S, _N, _X, tk_short) -> true; +check_const_tk(_G, _S, _N, _X, tk_ushort) -> true; +check_const_tk(_G, _S, _N, _X, tk_ulong) -> true; +check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG +check_const_tk(_G, _S, _N, _X, tk_float) -> true; +check_const_tk(_G, _S, _N, _X, tk_double) -> true; +check_const_tk(_G, _S, _N, _X, tk_boolean) -> true; +check_const_tk(_G, _S, _N, _X, tk_char) -> true; +check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR +check_const_tk(_G, _S, _N, _X, tk_octet) -> true; +check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true; +check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING +check_const_tk(_G, _S, _N, _X, tk_fixed) -> true; +check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true; +check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}). + + +check_switch_tk(_G, _S, _N, _X, tk_long) -> true; +check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG +check_switch_tk(_G, _S, _N, _X, tk_short) -> true; +check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true; +check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true; +check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG +check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true; +check_switch_tk(_G, _S, _N, _X, tk_char) -> true; +check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR +check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true; +check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}), + false. + + + +%% Lookup a name +name_lookup(G, S, N, X) -> + case scoped_lookup(G, S, N, X) of + T when is_tuple(T) -> element(1, T) + end. + + +lookup(G, S, N, X, Id) -> + N2 = Id ++ N, + ?DBG(" Trying ~p ...~n", [N2]), + case ets:lookup(S, N2) of + [] -> + case look_for_interface(G, S, [hd(N2)], tl(N2)) of + + %% First attempt: filtering inherited members ! + [{_, member, _, _}] -> + case look_for_interface(G, S, [hd(N)], tl(N2)) of + [T] -> + ?DBG(" -- found ~p~n", [T]), + T; + _ -> + lookup(G, S, tl(N), X, Id) + end; + %% + + [T] -> + ?DBG(" -- found ~p~n", [T]), + T; + + _ -> + if N == [] -> + ic_error:error(G, {tk_not_found, X}); + true -> + lookup(G, S, tl(N), X, Id) + end + + end; + + %% Second attempt: filtering members ! + [{_, member, _, _}] -> + case look_for_interface(G, S, [hd(N2)], tl(N2)) of + [T] -> + ?DBG(" -- found ~p~n", [T]), + T; + _ -> + if N == [] -> + ic_error:error(G, {tk_not_found, X}); + true -> + lookup(G, S, tl(N), X, Id) + end + end; + %% + [T] -> + ?DBG(" -- found ~p~n", [T]), + T + end. + + +look_for_interface(_G, _S, _Hd, []) -> + false; +look_for_interface(G, S, Hd, Tl) -> + case ets:lookup(S, Tl) of + [{_, interface, _TK, Inh}] -> + case look_in_inherit(G, S, Hd, Inh) of + %% gather_inherit(G, S, Inh, [])) of + [X] when is_tuple(X) -> + [X]; + _ -> + look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) + end; + _ -> + look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) + end. + +look_in_inherit(G, S, Id, [I | Is]) -> + case ets:lookup(S, Id ++ I) of + [X] when is_tuple(X) -> + [X]; + [] -> + look_in_inherit(G, S, Id, Is) + end; +look_in_inherit(_G, _S, _Id, []) -> + false. + + +%% L is a list of names +mk_uppercase(L) -> + lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; + (X) -> X end, Z) end, L). + + +%%-------------------------------------------------------------------- +%% +%% Inheritance stuff +%% +%% +%%-------------------------------------------------------------------- + +%% InhBody is an accumulating parameter + +calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) -> + case ic_symtab:retrieve(G, X) of + Intf when is_record(Intf, interface) -> + Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody), + calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]); + XXX -> + io:format("Oops, not found ~p~n", [XXX]), + calc_inherit_body(G, N, OrigBody, Xs, InhBody) + end; +calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody). + + +filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) -> + case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of + true -> + %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]), + filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody); + {false, NewX} -> % For those with idlist + %%io:format("Adding from idlist~n", []), + [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]; + false -> + %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]), + [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)] + end; +filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> []. + + +complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> + case has_idlist(X) of + true -> + idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody); + false -> + straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) + end. + + +idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> + XX = #id_of{type=X}, + F = fun(Id) -> + not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath, + OrigBody, InhBody)) + end, + case lists:filter(F, ic_forms:get_idlist(X)) of + [] -> + true; + IdList -> +%%% io:format("Idlist added: ~p~n",[IdList]), + {false, replace_idlist(X, IdList)} + end. + + +straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> + %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]), + case body_member(G, XPath, X, OrigPath, OrigBody) of + true -> + true; + false -> + inh_body_member(G, XPath, X, InhBody) + end. + + +inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) -> + case body_member(G, XPath, X, Name, Body) of + true -> + true; + false -> + inh_body_member(G, XPath, X, InhBody) + end; +inh_body_member(_G, _XPath, _X, []) -> false. + + +body_member(G, XPath, X, YPath, [Y|Ys]) -> + case has_idlist(Y) of + true -> + YY = #id_of{type=Y}, + case list_and(fun(Y2) -> + not(is_equal(G, XPath, X, YPath, + YY#id_of{id=Y2})) end, + ic_forms:get_idlist(Y)) of + true -> + body_member(G, XPath, X, YPath, Ys); + false -> + true + end; + false -> + case is_equal(G, XPath, X, YPath, Y) of + false -> + body_member(G, XPath, X, YPath, Ys); + true -> + true + end + end; +body_member(_G, _XPath, _X, _YPath, []) -> false. + + +is_equal(G, XPath, X, YPath, Y) -> + case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of + {ID, ID} -> + collision(G, XPath, X, YPath, Y), + true; + _ -> + false + end. + + +%% X is the new item, Y is the old one. So it is X that collides with +%% Y and Y shadows X. +collision(G, XPath, X, YPath, Y) -> + I1 = get_beef(X), + % I2 = get_beef(Y), + if is_record(I1, op) -> %%, record(I2, op) -> + ic_error:error(G, {inherit_name_collision, + {YPath, Y}, {XPath, X}}); + is_record(I1, attr) -> %%, record(I2, attr) -> + ic_error:error(G, {inherit_name_collision, + {YPath, Y}, {XPath, X}}); + true -> + ?ifopt(G, warn_name_shadow, + ic_error:warn(G, {inherit_name_shadow, + {YPath, Y}, {XPath, X}})) + end. + +has_idlist(X) when is_record(X, typedef) -> true; +has_idlist(X) when is_record(X, member) -> true; +has_idlist(X) when is_record(X, case_dcl) -> true; +has_idlist(X) when is_record(X, attr) -> true; +has_idlist(_) -> false. + +replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList}; +replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}. + +get_beef(X) when is_record(X, id_of) -> X#id_of.type; +get_beef(X) -> X. + + +%% And among all elements in list +list_and(F, [X|Xs]) -> + case F(X) of + true -> list_and(F, Xs); + false -> false + end; +list_and(_F, []) -> true. + + + + + +%%-------------------------------------------------------------------- +%% +%% resolve_inherit shall return a list of resolved inheritances, +%% that is all names replaced with their global names. +%% + +inherit_resolve(G, S, N, [X|Rest], Out) -> + case scoped_lookup(G, S, N, X) of + {Name, _T, _TK, Inh} -> + case lists:member(Name, Out) of + true -> + inherit_resolve(G, S, N, Rest, Out); + false -> + case unique_append(Inh, [Name|Out]) of + error -> + ic_error:error(G, {inherit_resolve, X, Name}), + inherit_resolve(G, S, N, Rest, []); + UA -> + inherit_resolve(G, S, N, Rest, UA) + end + end; + _ -> inherit_resolve(G, S, N, Rest, Out) + end; +inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out). + +unique_append([X|Xs], L) -> + case lists:member(X, L) of + true -> unique_append(Xs, L); + false -> unique_append(Xs, [X|L]) + end; +unique_append([], L) -> L; +%% Error +unique_append(_, _L) -> error. + + + + +%%-------------------------------------------------------------------- +%% +%% Utilities +%% + +%% Must preserve order, therefore had to write my own (instead of lists:map) +check_list(G, S, N, [X|Xs]) -> + X1 = check(G, S, N, X), + [X1 | check_list(G, S, N, Xs)]; +check_list(_G, _S, _N, []) -> []. + + + +filter( [] ) -> + error; +filter( [I | Is ] ) -> + case I of + { _, member, { _, TKINFO }, _ } -> + fetchType( TKINFO ); + + { _, struct, _, _ } -> + struct; + + { _, typedef, TKINFO, _ } -> + fetchType( TKINFO ); + + { _, module, _, _ } -> + module; + + { _, interface, _, _ } -> + interface; + + { _, op, _, _ } -> + op; + + { _,enum, _, _ } -> + enum; + + { _, spellcheck } -> + filter( Is ); + + _ -> + error + end. + + +fetchType( { tk_sequence, _, _ } ) -> + sequence; +fetchType( { tk_array, _, _ } ) -> + array; +fetchType( { tk_struct, _, _, _} ) -> + struct; +fetchType( { tk_string, _} ) -> + string; +fetchType( { tk_wstring, _} ) -> %% WSTRING + wstring; +fetchType( { tk_fixed, _, _} ) -> + fixed; +fetchType( tk_short ) -> + short; +fetchType( tk_long ) -> + long; +fetchType( tk_longlong ) -> %% LLONG + longlong; +fetchType( tk_ushort ) -> + ushort; +fetchType( tk_ulong ) -> + ulong; +fetchType( tk_ulonglong ) -> %% ULLONG + ulonglong; +fetchType( tk_float ) -> + float; +fetchType( tk_double ) -> + double; +fetchType( tk_boolean ) -> + boolean; +fetchType( tk_char ) -> + char; +fetchType( tk_wchar ) -> %% WCHAR + wchar; +fetchType( tk_octet ) -> + octet; +fetchType( { tk_enum, _, _, _ } ) -> + enum; +fetchType( { tk_union, _, _, _, _, _ } ) -> + union; +fetchType( tk_any ) -> + any; +fetchType( _ ) -> + error. + +%% Z is a single name +to_uppercase(Z) -> + lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; + (X) -> X end, Z). + + +%%------------------------------------------------------------ +%% +%% Always fetchs TK of a record. +%% +%%------------------------------------------------------------ +fetchTk(G,N,X) -> + case ic_forms:get_tk(X) of + undefined -> + searchTk(G,ictk:get_IR_ID(G, N, X)); + TK -> + TK + end. + + +%%------------------------------------------------------------ +%% +%% seek type code when not accessible by get_tk/1 +%% +%%------------------------------------------------------------ +searchTk(G,IR_ID) -> + S = ic_genobj:tktab(G), + case catch searchTk(S,IR_ID,typedef) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch searchTk(S,IR_ID,struct) of + {value,TK} -> + TK; + _ -> %% false / exit + case catch searchTk(S,IR_ID,union) of + {value,TK} -> + TK; + _ -> + undefined + end + end + end. + + +searchTk(S,IR_ID,Type) -> + L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), + case lists:keysearch(IR_ID,2,L) of + {value,TK} -> + {value,TK}; + false -> + searchInsideTks(L,IR_ID) + end. + + +searchInsideTks([],_IR_ID) -> + false; +searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> + case searchIncludedTk(TK,IR_ID) of + {value,TK} -> + {value,TK}; + false -> + searchInsideTks(Xs,IR_ID) + end. + + +searchIncludedTk({tk_array,TK,_},IR_ID) -> + searchIncludedTk(TK,IR_ID); +searchIncludedTk({tk_sequence,TK,_},IR_ID) -> + searchIncludedTk(TK,IR_ID); +searchIncludedTk(TK, _IR_ID) when is_atom(TK) -> + false; +searchIncludedTk(TK,IR_ID) -> + case element(2,TK) == IR_ID of + true -> + {value,TK}; + false -> + false + end. + diff --git a/lib/ic/src/icunion.erl b/lib/ic/src/icunion.erl new file mode 100644 index 0000000000..38a2d14913 --- /dev/null +++ b/lib/ic/src/icunion.erl @@ -0,0 +1,1490 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(icunion). + +-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). +-import(ic_cbe, [mk_c_type/3, mk_c_type/4]). + +-include("icforms.hrl"). +-include("ic.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([union_gen/4]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +union_gen(G, N, X, c) when is_record(X, union) -> + emit_c_union(G, N, X); +union_gen(_G, _N, _X, _L) -> + ok. + + +%% Emits the union +emit_c_union(G, N, X) -> + %%io:format("Rec = ~p\n",[X]), + case ic_genobj:is_hrlfile_open(G) of + true -> + + %% Sort Union Default = put it last in case list + NewX = #union{ id = X#union.id, + type = X#union.type, + body = mvDefaultToTail(X#union.body), + tk = X#union.tk }, + + UnionScope = [ic_forms:get_id2(NewX) | N], + + case ic_pragma:is_local(G,UnionScope) of + + true -> + + HFd = ic_genobj:hrlfiled(G), + emit_c_union_values(G, N, NewX, HFd), + UnionName = ic_util:to_undersc(UnionScope), + + emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(UnionName)]), + emit(HFd, "#define __~s__\n",[ictype:to_uppercase(UnionName)]), + ic_codegen:mcomment_light(HFd, + [io_lib:format("Union definition: ~s", + [UnionName])], + c), + emit(HFd, "typedef struct {\n"), + emit(HFd, " ~s _d;\n", [get_c_union_discriminator(G, N, NewX)]), + emit(HFd, " union {\n"), + emit_c_union_values_decl(G, N, NewX, HFd), + emit(HFd, " } _u;\n"), + emit(HFd, "} ~s;\n\n", [UnionName]), + + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", + [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]), + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", + [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), + emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s*);\n", + [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), + emit(HFd, "\n#endif\n\n"), + create_c_union_file(G, N, NewX, UnionName); + + false -> %% Do not generate included types att all. + ok + end; + false -> + ok + end. + + + +%% Loops over union members and creates members typedefs +emit_c_union_values(G, N, X, Fd) -> + emit_c_union_values_loop(G, N, X, Fd, X#union.body). + +emit_c_union_values_loop(G, N, X, Fd, [CU]) -> + case CU of + {case_dcl,_,Id,Type} -> + case Id of + {array, _AID, _SZ} -> % Check for arrays + mk_array_file(G,N,X,Id,Type,Fd); + _ -> % Elementary types or seq/struct + ok + end; + _ -> + error + end; +emit_c_union_values_loop(G, N, X, Fd, [CU |CUs]) -> + case CU of + {case_dcl,_,Id,Type} -> + case Id of + {array, _AID, _SZ} -> % Check for arrays + mk_array_file(G,N,X,Id,Type,Fd); + _ -> % Elementary types or seq/struct + emit_c_union_values_loop(G, N, X, Fd, CUs) + end; + _ -> + error + end. + + +%% Loops over union members and declares members inside union structure +emit_c_union_values_decl(G, N, X, Fd) -> + emit_c_union_values_decl_loop(G, N, X, Fd, X#union.body). + +emit_c_union_values_decl_loop(G, N, X, Fd, [CU]) -> + case CU of + {case_dcl,_,Id,Type} -> + case Id of + {array, _AID, _SZ} -> % Check for arrays + mk_array_decl(G,N,X,Id,Type,Fd); + _ -> % Elementary types or seq/struct + mk_union_member_decl(G,N,X,Id,Type,Fd), + ok + end; + _ -> + error + end; +emit_c_union_values_decl_loop(G, N, X, Fd, [CU |CUs]) -> + case CU of + {case_dcl,_,Id,Type} -> + case Id of + {array, _AID, _SZ} -> % Check for arrays + mk_array_decl(G,N,X,Id,Type,Fd), + emit_c_union_values_decl_loop(G, N, X, Fd, CUs); + _ -> % Elementary types or seq/struct + mk_union_member_decl(G,N,X,Id,Type,Fd), + emit_c_union_values_decl_loop(G, N, X, Fd, CUs) + end; + _ -> + error + end. + + +%% Makes the declaration for the array in union +mk_array_decl(G,N,X,Id,Type,Fd) -> + emit(Fd, " ~s ~s;\n", + [getCaseTypeStr(G,N,X,Id,Type), + mk_array_name(Id)]). + +mk_array_name({array,Id,D}) -> + ic_forms:get_id2(Id) ++ mk_array_dim(D). + +mk_array_dim([]) -> + ""; +mk_array_dim([{_,_,Dim}|Dims]) -> + "[" ++ Dim ++ "]" ++ mk_array_dim(Dims). + + +%% Creates the array file +mk_array_file(G,N,X,{array,AID,SZ},Type,HFd) -> + ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), + ArrayDim = extract_array_dim(SZ), + emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(ArrayName)]), + emit(HFd, "#define __~s__\n\n",[ictype:to_uppercase(ArrayName)]), + icstruct:create_c_array_coding_file(G, + N, + {ArrayName,ArrayDim}, + Type, + no_typedef), + emit(HFd, "\n#endif\n\n"). + +extract_array_dim([{_,_,Dim}]) -> + [Dim]; +extract_array_dim([{_,_,Dim}|Dims]) -> + [Dim | extract_array_dim(Dims)]. + + +%% Makes the declaration for the member in union +mk_union_member_decl(G,N,X,Id,Type,Fd) -> + emit(Fd, " ~s ~s;\n", + [getCaseTypeStr(G,N,X,Id,Type), + ic_forms:get_id2(Id)]). + + + + +%% File utilities +create_c_union_file(G, N, X, UnionName) -> + + {Fd , SName} = open_c_coding_file(G, UnionName), + _HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + HrlFName = filename:basename(ic_genobj:include_file(G)), + ic_codegen:emit_stub_head(G, Fd, SName, c), + emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile + %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header + %% HrlFName = filename:basename(ic_genobj:include_file(G)), + %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + put(op_variable_count, 0), + put(tmp_declarations, []), + + %% Write generated code on file + emit_union_sizecount(G, N, X, Fd, UnionName), + emit_union_encode(G, N, X, Fd, UnionName), + emit_union_decode(G, N, X, Fd, UnionName), + file:close(Fd). + +open_c_coding_file(G, Name) -> + SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), + FName = + ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), + case file:open(FName, [write]) of + {ok, Fd} -> + {Fd, SName}; + Other -> + exit(Other) + end. + + + + +get_c_union_discriminator(G, N, X) -> + case getDiscrStr(G, N, X#union.type) of + error -> + ic_error:fatal_error(G, {illegal_typecode_for_c, X#union.type, N}); + DiscrStr -> + case ic_code:get_basetype(G, DiscrStr) of + {short, _} -> + "CORBA_short"; + {unsigned,{short, _}} -> + "CORBA_unsigned_short"; + {long, _} -> + "CORBA_long"; + {unsigned,{long, _}} -> + "CORBA_unsigned_long"; + {boolean,_} -> + "CORBA_boolean"; + {char,_} -> + "CORBA_char"; + {enum, EnumType} -> + EnumType; + _ -> + DiscrStr + end + end. + +getDiscrStr(G, N, S) when element(1, S) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, S) of + {FSN, _, tk_short, _} -> + ic_util:to_undersc(FSN); + {FSN, _, tk_ushort, _} -> + ic_util:to_undersc(FSN); + {FSN, _, tk_long, _} -> + ic_util:to_undersc(FSN); + {FSN, _, tk_ulong, _} -> + ic_util:to_undersc(FSN); + {FSN, _, tk_boolean, _} -> + ic_util:to_undersc(FSN); + {FSN, _, tk_char, _} -> + ic_util:to_undersc(FSN); + {FSN, _, {tk_enum,_,_,_}, _} -> + ic_util:to_undersc(FSN); + _ -> + error + end; +getDiscrStr(_G, N, X) -> + case X of + {short,_} -> + "CORBA_short"; + {unsigned,{short,_}} -> + "CORBA_unsigned_short"; + {long, _} -> + "CORBA_long"; + {unsigned,{long,_}} -> + "CORBA_unsigned_long"; + {boolean,_} -> + "CORBA_boolean"; + {char,_} -> + "CORBA_char"; + {enum,TID,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(TID) | N]); + _ -> + error + end. + + + + +getCaseTypeStr(G, N, X, I, T) when element(1, T) == scoped_id -> + case catch ic_symtab:get_full_scoped_name(G, N, T) of + {FSN, _, _, _} -> + BT = ic_code:get_basetype(G, ic_util:to_undersc(FSN)), + case isList(BT) of + true -> + BT; + false -> + case BT of + {short,_} -> + "CORBA_short"; + {unsigned,{short,_}} -> + "CORBA_unsigned_short"; + {long, _} -> + "CORBA_long"; + {unsigned,{long,_}} -> + "CORBA_unsigned_long"; + {float,_} -> + "CORBA_float"; + {double,_} -> + "CORBA_double"; + {boolean,_} -> + "CORBA_boolean"; + {char,_} -> + "CORBA_char"; + {wchar,_} -> + "CORBA_wchar"; + {octet,_} -> + "CORBA_octet"; + {string,_} -> + "CORBA_char*"; + {wstring,_} -> + "CORBA_wchar*"; + {sequence,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); + {struct,SID,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); + {enum,EID} -> + EID; + {any, _} -> %% Fix for any type + "CORBA_long"; + _ -> + %%io:format("BT = ~p~n",[BT]), + error + end + end + end; +getCaseTypeStr(_G, N, X, I, T) -> + case T of + {short,_} -> + "CORBA_short"; + {unsigned,{short,_}} -> + "CORBA_unsigned_short"; + {long, _} -> + "CORBA_long"; + {unsigned,{long,_}} -> + "CORBA_unsigned_long"; + {float,_} -> + "CORBA_float"; + {double,_} -> + "CORBA_double"; + {boolean,_} -> + "CORBA_boolean"; + {char,_} -> + "CORBA_char"; + {wchar,_} -> + "CORBA_wchar"; + {octet,_} -> + "CORBA_octet"; + {string,_} -> + "CORBA_char*"; + {wstring,_} -> + "CORBA_wchar*"; + {sequence,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); + {struct,SID,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); + {union,UID,_,_,_} -> + ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]); + {any, _} -> %% Fix for any type + "CORBA_long"; + _ -> + error + end. + +isList(L) when is_list(L) -> + true; +isList(_) -> + false. + +%% +%% Sizecount facilities +%% +emit_union_sizecount(G, N, X, Fd, UnionName) -> + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size) {\n\n", + [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]), + + emit(Fd, " int oe_malloc_size = 0;\n"), + emit(Fd, " int oe_error_code = 0;\n"), + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_tmp = 0;\n"), + emit_union_discr_var_decl(G, N, X, Fd), + + ic_codegen:nl(Fd), + emit(Fd, " if(*oe_size == 0)\n",[]), + AlignName = lists:concat(["*oe_size + sizeof(",UnionName,")"]), + emit(Fd, " *oe_size = ~s;\n\n", [ic_util:mk_align(AlignName)]), + + emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + + %%emit(Fd, " if (oe_tmp != 3)\n"), + %%emit(Fd, " return -1;\n\n"), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit_c_union_discr_sizecount(G, N, X, Fd), + emit(Fd, " /* Calculate union size */\n"), + emit(Fd, " switch(oe_discr) {\n"), + + emit_c_union_loop(G, N, X, Fd, X#union.body, sizecalc), + emit(Fd, " }\n\n"), + + emit(Fd, " *oe_size = ~s;\n",[ic_util:mk_align("*oe_size+oe_malloc_size")]), + emit(Fd, " return 0;\n"), + emit(Fd, "}\n\n\n"). + + +emit_union_discr_var_decl(G, N, X, Fd) -> + UD = get_c_union_discriminator(G, N, X), + case UD of + "CORBA_short" -> + emit(Fd, " long oe_discr = 0;\n"); + "CORBA_unsigned_short" -> + emit(Fd, " unsigned long oe_discr = 0;\n"); + "CORBA_long" -> + emit(Fd, " long oe_discr = 0;\n"); + "CORBA_unsigned_long" -> + emit(Fd, " unsigned long oe_discr = 0;\n"); + "CORBA_boolean" -> + emit(Fd, " int oe_discr = 0;\n"), + emit(Fd, " char oe_bool[256];\n"); + "CORBA_char" -> + emit(Fd, " char oe_discr = 0;\n"); + _T -> + emit(Fd, " int oe_dummy = 0;\n"), + emit(Fd, " ~s oe_discr = 0;\n",[UD]) + end. + + +emit_c_union_discr_sizecount(G, N, X, Fd) -> + emit(Fd, " /* Calculate discriminator size */\n"), + UD = get_c_union_discriminator(G, N, X), + case UD of + "CORBA_short" -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_unsigned_short" -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_long" -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_unsigned_long" -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_boolean" -> + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, oe_bool)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " oe_discr = 0;\n"), + emit(Fd, " }\n"), + emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), + emit(Fd, " oe_discr = 1;\n"), + emit(Fd, " }\n"), + emit(Fd, " else {\n"), + emit_c_dec_rpt(Fd, " ", "not boolean", []), + emit(Fd, " return -1;\n }\n"); + + "CORBA_char" -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + T -> + emit(Fd, " oe_tmp = *oe_size_count_index;\n"), + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", [T]), + ?emit_c_dec_rpt(Fd, " ", "oe_size_calc_~s", [T]), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " *oe_size_count_index = oe_tmp;\n"), + emit(Fd, " oe_tmp = oe_env->_iin;\n"), + emit(Fd, " oe_env->_iin = *oe_size_count_index;\n"), + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, NULL, &oe_dummy, &oe_discr)) < 0) {\n", [T]), + ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " *oe_size_count_index = oe_env->_iin;\n"), + emit(Fd, " oe_env->_iin = oe_tmp;\n\n") + end. + + + +emit_c_union_loop(G, N, X, Fd, CaseList, Case) -> + emit_c_union_loop(G, N, X, Fd, CaseList, false, Case). + +emit_c_union_loop(G, N, X, Fd, [], GotDefaultCase, Case) -> + case GotDefaultCase of + false -> + emit_c_union_valueless_discriminator(G, N, X, Fd, Case) + end; +emit_c_union_loop(G, N, X, Fd, [CU|CUs], GotDefaultCase, Case) -> + case CU of + {case_dcl,CaseList,I,T} -> + GotDefaultCase = emit_c_union_case(G, N, X, Fd, I, T, CaseList, Case), + emit_c_union_loop(G, N, X, Fd, CUs, GotDefaultCase, Case); + _ -> + error + end. + +emit_c_union_valueless_discriminator(_G, _N, _X, Fd, Case) -> + emit(Fd, " default:\n"), + case Case of + sizecalc -> + emit(Fd, " {\n"), + emit(Fd, " char oe_undefined[15];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " + "oe_size_count_index, oe_undefined)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " }\n"); + encode -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"undefined\")) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"); + decode -> + emit(Fd, " {\n"), + emit(Fd, " char oe_undefined[15];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, " + "oe_undefined)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(oe_undefined, \"undefined\") != 0) {\n"), + emit_c_dec_rpt(Fd, " ", "undefined", []), + emit(Fd, " return -1;\n }\n"), + emit(Fd, " }\n") + end. + + +emit_c_union_case(G, N, X, Fd, I, T, [{default,_}], Case) -> + emit(Fd, " default:\n"), + case Case of + sizecalc -> + getCaseTypeSizecalc(G, N, X, Fd, I, T); + encode -> + getCaseTypeEncode(G, N, X, Fd, I, T); + decode -> + getCaseTypeDecode(G, N, X, Fd, I, T) + end, + true; +emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}], Case) -> %% Boolean discriminator + case Bool of + 'TRUE' -> + emit(Fd, " case 1:\n"); + 'FALSE' -> + emit(Fd, " case 0:\n") + end, + case Case of + sizecalc -> + getCaseTypeSizecalc(G, N, X, Fd, I, T); + encode -> + getCaseTypeEncode(G, N, X, Fd, I, T); + decode -> + getCaseTypeDecode(G, N, X, Fd, I, T) + end, + emit(Fd, " break;\n\n"), + false; +emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}|Rest], Case) -> %% Boolean discriminator + case Bool of + 'TRUE' -> + emit(Fd, " case 1:\n"); + 'FALSE' -> + emit(Fd, " case 0:\n") + end, + emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), + false; +emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}], Case) -> %% Integer type discriminator + case get_c_union_discriminator(G, N, X) of + "CORBA_char" -> + emit(Fd, " case \'~s\':\n",[NrStr]); + _ -> + emit(Fd, " case ~s:\n",[NrStr]) + end, + case Case of + sizecalc -> + getCaseTypeSizecalc(G, N, X, Fd, I, T); + encode -> + getCaseTypeEncode(G, N, X, Fd, I, T); + decode -> + getCaseTypeDecode(G, N, X, Fd, I, T) + end, + emit(Fd, " break;\n\n"), + false; +emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}|Rest], Case) -> %% Integer type discriminator + emit(Fd, " case ~s:\n",[NrStr]), + emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), + false; +emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}], Case) -> %% Enumerant type discriminator + SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), + %%io:format("SID = ~p~n",[SID]), + emit(Fd, " case ~s:\n",[SID]), + case Case of + sizecalc -> + getCaseTypeSizecalc(G, N, X, Fd, I, T); + encode -> + getCaseTypeEncode(G, N, X, Fd, I, T); + decode -> + getCaseTypeDecode(G, N, X, Fd, I, T) + end, + emit(Fd, " break;\n\n"), + false; +emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}|Rest], Case) -> %% Enumerant type discriminator + SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), + %%io:format("SID = ~p~n",[SID]), + emit(Fd, " case ~s:\n",[SID]), + emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), + false. + + +%% +%% Returns the enumerant discriminator scope +%% +get_c_union_discriminator_scope(G, N, X) -> + {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, X#union.type), + BT = case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of + {enum,ST} -> + ST; + Other -> + Other + end, + tl(lists:reverse(string:tokens(BT,"_"))). %% Ugly work arround + + + + + +getCaseTypeSizecalc(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> + case ic_fetch:member2type(G,X,I) of + ushort -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + ulong -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + short -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + long -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + float -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + double -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + boolean -> + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"); + char -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + octet -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + string -> + emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); + any -> %% Fix for any type + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + + _ -> + case getCaseTypeStr(G, N, X, I, T) of + "erlang_pid" -> + emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", + []), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", + []), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", + []), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_term" -> + emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", + []), + ?emit_c_dec_rpt(Fd, " ", "ei_deoce_term", []), + emit(Fd, " return oe_error_code;\n }\n"); + + Other -> + + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [Other]), + ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [Other]), + emit(Fd, " return oe_error_code;\n }\n") + end + end; +getCaseTypeSizecalc(G, N, X, Fd, I, T) -> + case I of + {array,_,_} -> + ArrayName = ic_util:to_undersc([ic_forms:get_id2(I),ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ArrayName]), + ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [ArrayName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + case T of + {short,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + {unsigned,{short,_}} -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + {long, _} -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + {unsigned,{long,_}} -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + {float,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }"); + {double,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + {boolean,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"); + {char,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + {octet,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + {string,_} -> + emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); + {sequence,_,_} -> + SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [SeqName]), + ?emit_c_dec_rpt(Fd, " ", "sequence:oe_sizecalc_~s", [SeqName]), + emit(Fd, " return oe_error_code;\n }\n"); + {struct,SID,_,_} -> + StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [StructName]), + ?emit_c_dec_rpt(Fd, " ", "struct:oe_sizecalc_~s", [StructName]), + emit(Fd, " return oe_error_code;\n }\n"); + {union,UID,_,_,_} -> + UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [UnionName]), + ?emit_c_dec_rpt(Fd, " ", "union:oe_sizecalce_~s", [UnionName]), + emit(Fd, " return oe_error_code;\n }\n"); + {any, _} -> %% Fix for any type + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "any:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end + end. + + + + + +%% +%% Encode facilities +%% +emit_union_encode(G, N, X, Fd, UnionName) -> + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec) {\n\n", + [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), + + emit(Fd, " int oe_error_code = 0;\n\n"), + + emit(Fd, " if ((oe_error_code = oe_ei_encode_tuple_header(oe_env, 3)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"~s\")) < 0) {\n", + [UnionName]), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit_c_union_discr_encode(G, N, X, Fd), + emit(Fd, " /* Encode union */\n"), + emit(Fd, " switch(oe_rec->_d) {\n"), + emit_c_union_loop(G, N, X, Fd, X#union.body, encode), + emit(Fd, " }\n\n"), + emit(Fd, " return 0;\n"), + emit(Fd, "}\n\n\n"). + + +emit_c_union_discr_encode(G, N, X, Fd) -> + emit(Fd, " /* Encode descriminator */\n"), + UD = get_c_union_discriminator(G, N, X), + case UD of + "CORBA_short" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_unsigned_short" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_long" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_unsigned_long" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_boolean" -> + emit(Fd, " switch(oe_rec->_d) {\n"), + emit(Fd, " case 0:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default:\n"), + emit_c_enc_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n\n"); + "CORBA_char" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_d)) < 0) {\n"), + emit_c_enc_rpt(Fd, " ", "oe_ei_encode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + T -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_d)) < 0) {\n", [T]), + ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", [T]), + emit(Fd, " return oe_error_code;\n }\n") + end. + + +getCaseTypeEncode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> + case ic_fetch:member2type(G,X,I) of + ushort -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + ulong -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + short -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + long -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + float -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + double -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + boolean -> + emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), + emit(Fd, " case 0:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default:\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"); + char -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + octet -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + string -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), + emit(Fd, " return oe_error_code;\n }\n"); + struct -> + case ic_cbe:mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_pid(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_port(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ref(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_term(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T), ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n") + end; + sequence -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + array -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + union -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + enum -> + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "enum:oe_encode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + any -> %% Fix for any type + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "enum:oe_ei_encodelong", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end; +getCaseTypeEncode(G, N, X, Fd, I, T) -> + case I of + {array,AID,_} -> + ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ArrayName,ic_forms:get_id2(AID)]), + ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", [ArrayName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + case T of + {short,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + {unsigned,{short,_}} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + {long, _} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + {unsigned,{long,_}} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + {float,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + {double,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + {boolean,_} -> + emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), + emit(Fd, " case 0:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1:\n"), + emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default:\n"), + ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"); + {char,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + {octet,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + {string,_} -> + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), + emit(Fd, " return oe_error_code;\n }\n"); + {sequence,_,_} -> + SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [SeqName,ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", [SeqName]), + emit(Fd, " return oe_error_code;\n }\n"); + {struct,SID,_,_} -> + StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [StructName,ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "struct:oe_encode_~s", [StructName]), + emit(Fd, " return oe_error_code;\n }\n"); + {union,UID,_,_,_} -> + UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", + [UnionName,ic_forms:get_id2(I)]), + ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", [UnionName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end + end. + + + + +%% +%% Decode facilities +%% +emit_union_decode(G, N, X, Fd, UnionName) -> + emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_index, ~s* oe_rec) {\n\n", + [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), + + emit(Fd, " int oe_error_code = 0;\n"), + emit(Fd, " int oe_tmp = 0;\n"), + emit(Fd, " char oe_union_name[256];\n\n"), + + emit(Fd, " if((char*) oe_rec == oe_first)\n",[]), + AlignName = lists:concat(["*oe_index + sizeof(",UnionName,")"]), + emit(Fd, " *oe_index = ~s;\n\n", [ic_util:mk_align(AlignName)]), + + emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, &oe_env->_iin, &oe_tmp)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_union_name)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit_c_union_discr_decode(G, N, X, Fd), + emit(Fd, " /* Decode union */\n"), + emit(Fd, " switch(oe_rec->_d) {\n"), + emit_c_union_loop(G, N, X, Fd, X#union.body, decode), + emit(Fd, " }\n\n"), + + emit(Fd, " *oe_index = ~s;\n", [ic_util:mk_align("*oe_index")]), + emit(Fd, " return 0;\n"), + emit(Fd, "}\n\n\n"). + + +emit_c_union_discr_decode(G, N, X, Fd) -> + emit(Fd, " /* Decode descriminator */\n"), + UD = get_c_union_discriminator(G, N, X), + case UD of + "CORBA_short" -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_d = (short) oe_long;\n\n"), + emit(Fd, " if (oe_rec->_d != oe_long)\n return -1;\n"), + emit(Fd, " }\n\n"); + "CORBA_unsigned_short" -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "unshort:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_d = (unsigned short) oe_ulong;\n\n"), + emit(Fd, " if (oe_rec->_d != oe_ulong)\n return -1;\n"), + emit(Fd, " }\n\n"); + "CORBA_long" -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_unsigned_long" -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + "CORBA_boolean" -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " oe_rec->_d = 0;\n"), + emit(Fd, " }else if (strcmp(oe_bool, \"true\") == 0) {\n"), + emit(Fd, " oe_rec->_d = 1;\n"), + emit(Fd, " } else {\n"), + emit_c_dec_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n }\n"), + emit(Fd, " }\n\n"); + "CORBA_char" -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), + emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + T -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_d)) < 0) {\n", + [T]), + ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), + emit(Fd, " return oe_error_code;\n }\n") + end. + + + +getCaseTypeDecode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> + case ic_fetch:member2type(G,X,I) of + ushort -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), + emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + ulong -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + short -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), + emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + long -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + float -> + emit(Fd, " {\n"), + emit(Fd, " double oe_double;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + double -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + boolean -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), + emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), + emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " } else {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n }\n"), + emit(Fd, " }\n"); + char -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + octet -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + string -> + emit(Fd, " {\n"), + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_string_ctr = 0;\n\n"), + + emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), + + emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), + + emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), + emit(Fd, " }\n"); + struct -> + case ic_cbe:mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, &oe_env->_iin, (void **)&oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_term", []), + emit(Fd, " return oe_error_code;\n }\n"); + + _ -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n") + end; + sequence -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", + [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + array -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + union -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + enum -> + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "enum:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), + emit(Fd, " return oe_error_code;\n }\n"); + any -> %% Fix for any type + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "any:ei_decodelong", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end; +getCaseTypeDecode(G, N, X, Fd, I, T) -> + case I of + {array,AID,_} -> + ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", + [ArrayName,ic_forms:get_id2(AID)]), + ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [ArrayName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + case T of + {short,_} -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), + emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + {unsigned,{short,_}} -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), + emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + {long, _} -> + emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), + emit(Fd, " return oe_error_code;\n }\n"); + {unsigned,{long,_}} -> + emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), + emit(Fd, " return oe_error_code;\n }\n"); + {float,_} -> + emit(Fd, " {\n"), + emit(Fd, " double oe_double;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), + emit(Fd, " }\n"); + {double,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "dobule:ei_decode_double", []), + emit(Fd, " return oe_error_code;\n }\n"); + {boolean,_} -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), + emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), + emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), + emit(Fd, " } else {\n"), + ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), + emit(Fd, " return -1;\n }\n"), + emit(Fd, " }\n"); + {char,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), + emit(Fd, " return oe_error_code;\n }\n"); + {octet,_} -> + emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + emit(Fd, " return oe_error_code;\n }\n"); + {string,_} -> + emit(Fd, " {\n"), + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_string_ctr = 0;\n\n"), + + emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), + + emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), + + emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", + [ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + + emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), + emit(Fd, " }\n"); + {sequence,_,_} -> + SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [SeqName,ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", [SeqName]), + emit(Fd, " return oe_error_code;\n }\n"); + {struct,SID,_,_} -> + StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [StructName,ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "struct:oe_decode_~s", [StructName]), + emit(Fd, " return oe_error_code;\n }\n"); + {union,UID,_,_,_} -> + UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), + emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", + [UnionName,ic_forms:get_id2(I)]), + ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [UnionName]), + emit(Fd, " return oe_error_code;\n }"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end + end. + +mvDefaultToTail(CDclL) -> + mvDefaultToTail(CDclL,[],[]). + + +mvDefaultToTail([], F, FD) -> + lists:reverse(F) ++ FD; +mvDefaultToTail([{case_dcl,CaseList,I,T}|Rest], Found, FoundDefault) -> + case lists:keysearch(default, 1, CaseList) of + {value,Default} -> + NewCaseList = lists:delete(Default, CaseList) ++ [Default], + mvDefaultToTail(Rest, Found, [{case_dcl,NewCaseList,I,T}|FoundDefault]); + false -> + mvDefaultToTail(Rest, [{case_dcl,CaseList,I,T}|Found], FoundDefault) + end. + + diff --git a/lib/ic/src/icyeccpre.hrl b/lib/ic/src/icyeccpre.hrl new file mode 100644 index 0000000000..71b02b784b --- /dev/null +++ b/lib/ic/src/icyeccpre.hrl @@ -0,0 +1,124 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + + +-export([parse/1, parse_and_scan/1, format_error/1]). + +-import(lists, [reverse/1]). + +-ifdef(JAM). +-compile([{parse_transform,jam_yecc_pj},pj]). +-endif. + + +-include("icforms.hrl"). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% The parser generator will insert appropriate declarations before this line.% + +parse(Tokens) -> + case catch yeccpars1(Tokens, false, 0, [], []) of + error -> + Errorline = + if Tokens == [] -> 0; true -> element(2, hd(Tokens)) end, + {error, + {Errorline, ?MODULE, "syntax error at or after this line."}}; + Other -> + Other + end. + +parse_and_scan({Mod, Fun, Args}) -> + case apply(Mod, Fun, Args) of + {eof, _} -> + {ok, eof}; + {error, Descriptor, _} -> + {error, Descriptor}; + {ok, Tokens, _} -> + yeccpars1(Tokens, {Mod, Fun, Args}, 0, [], []) + end. + +format_error(Message) -> + case io_lib:deep_char_list(Message) of + true -> + Message; + _ -> + io_lib:write(Message) + end. + +% To be used in grammar files to throw an error message to the parser toplevel. +% Doesn't have to be exported! +return_error(Line, Message) -> + throw({error, {Line, ?MODULE, Message}}). + + +% Don't change yeccpars1/6 too much, it is called recursively by yeccpars2/8! +yeccpars1([Token | Tokens], Tokenizer, State, States, Vstack) -> + yeccpars2(State, element(1, Token), States, Vstack, Token, Tokens, + Tokenizer); +yeccpars1([], {M, F, A}, State, States, Vstack) -> + case catch apply(M, F, A) of + {eof, Endline} -> + {error, {Endline, ?MODULE, "end_of_file"}}; + {error, Descriptor, _Endline} -> + {error, Descriptor}; + {'EXIT', Reason} -> + {error, {0, ?MODULE, Reason}}; + {ok, Tokens, _Endline} -> + case catch yeccpars1(Tokens, {M, F, A}, State, States, Vstack) of + error -> + Errorline = element(2, hd(Tokens)), + {error, {Errorline, ?MODULE, + "syntax error at or after this line."}}; + Other -> + Other + end + end; +yeccpars1([], false, State, States, Vstack) -> + yeccpars2(State, '$end', States, Vstack, {'$end', 999999}, [], false). + +% For internal use only. +yeccerror(Token) -> + {error, + {element(2, Token), ?MODULE, + ["syntax error before: ", yecctoken2string(Token)]}}. + +yecctoken2string({atom, _, A}) -> io_lib:write(A); +yecctoken2string({integer,_,N}) -> io_lib:write(N); +yecctoken2string({float,_,F}) -> io_lib:write(F); +yecctoken2string({char,_,C}) -> io_lib:write_char(C); +yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); +yecctoken2string({string,_,S}) -> io_lib:write_string(S); +yecctoken2string({reserved_symbol, _, A}) -> io_lib:format("~w", [A]); +yecctoken2string({'dot', _}) -> "'.'"; +yecctoken2string({'$end', _}) -> + []; +yecctoken2string({Other, _}) when is_atom(Other) -> + io_lib:format("~w", [Other]); +yecctoken2string({_, _, Other}) when is_list(Other) andalso is_number(hd(Other)) -> + Other; +yecctoken2string({_, _, Other}) -> + io_lib:format("~p", [Other]); +yecctoken2string(Other) -> + io_lib:write(Other). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk new file mode 100644 index 0000000000..6f973e3db4 --- /dev/null +++ b/lib/ic/vsn.mk @@ -0,0 +1,13 @@ +IC_VSN = 4.2.23 + +TICKETS = OTP-8201 + +TICKETS_4.2.22 = OTP-8088 + +TICKETS_4.2.21 = OTP-7982 + +TICKETS_4.2.20 = OTP-7837 + +TICKETS_4.2.19 = OTP-7595 + +TICKETS_4.2.18 = OTP-7313 |
