From: Mark Friedman Date: Thu, 30 Apr 1992 18:29:21 +0000 (+0000) Subject: Initial revision X-Git-Tag: 20090517-FFI~9447 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=75d4c7814c00ef10589c8986df39b6bc4187229a;p=mit-scheme.git Initial revision --- diff --git a/v7/src/microcode/foreign.c b/v7/src/microcode/foreign.c new file mode 100644 index 000000000..93bf39281 --- /dev/null +++ b/v7/src/microcode/foreign.c @@ -0,0 +1,543 @@ +/* -*-C-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/foreign.c,v 1.1 1992/04/30 18:28:31 markf Exp $ + +Copyright (c) 1992 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* This file contains the primitive support for the foreign function */ +/* interface. */ + +#include +#include +#include "scheme.h" +#include "prims.h" +#include "ux.h" +#include "osfs.h" +#include "foreign.h" + +static int initialization_done = 0; + +#define INITIALIZE_ONCE() \ +{ \ + if (!initialization_done) \ + initialize_once (); \ +} + +static void EXFUN (initialize_once, (void)); + +/* Allocation table stuff stolen from x11base.c */ + +PTR +DEFUN (foreign_malloc, (size), unsigned int size) +{ + PTR result = (UX_malloc (size)); + if (result == 0) + error_external_return (); + return (result); +} + +PTR +DEFUN (foreign_realloc, (ptr, size), PTR ptr AND unsigned int size) +{ + PTR result = (UX_realloc (ptr, size)); + if (result == 0) + error_external_return (); + return (result); +} + +struct allocation_table +{ + PTR * items; + int length; +}; + +static struct allocation_table foreign_object_table; +static struct allocation_table foreign_function_table; + +static void +DEFUN (allocation_table_initialize, (table), struct allocation_table * table) +{ + (table -> length) = 0; +} + +static unsigned int +DEFUN (allocate_table_index, (table, item), + struct allocation_table * table AND + PTR item) +{ + unsigned int length = (table -> length); + unsigned int new_length; + PTR * items = (table -> items); + PTR * new_items; + PTR * scan; + PTR * end; + if (length == 0) + { + new_length = 4; + new_items = (foreign_malloc ((sizeof (PTR)) * new_length)); + } + else + { + scan = items; + end = (scan + length); + while (scan < end) + if ((*scan++) == 0) + { + (*--scan) = item; + return (scan - items); + } + new_length = (length * 2); + new_items = (foreign_realloc (items, ((sizeof (PTR)) * new_length))); + } + scan = (new_items + length); + end = (new_items + new_length); + (*scan++) = item; + while (scan < end) + (*scan++) = 0; + (table -> items) = new_items; + (table -> length) = new_length; + return (length); +} + +static PTR +DEFUN (allocation_item_arg, (arg, table), + unsigned int arg AND + struct allocation_table * table) +{ + unsigned int index = (arg_index_integer (arg, (table -> length))); + PTR item = ((table -> items) [index]); + if (item == 0) + error_bad_range_arg (arg); + return (item); +} + +/* Helper functions */ +HANDLE +DEFUN (arg_handle, (arg_number), unsigned int arg_number) +{ + SCHEME_OBJECT arg; + + return (index_to_handle (arg_index_integer (arg_number, + foreign_object_table . length))); +} + +HANDLE +DEFUN (foreign_pointer_to_handle, (ptr), PTR ptr) +{ + unsigned int index; + HANDLE handle; + FOREIGN_OBJECT *ptr_object; + + INITIALIZE_ONCE (); + ptr_object = (FOREIGN_OBJECT *) foreign_malloc (sizeof (FOREIGN_OBJECT)); + ptr_object -> ptr = ptr; + ptr_object -> handle = handle; + index = allocate_table_index (&foreign_object_table, (PTR) ptr_object); + handle = index_to_handle (index); + ((FOREIGN_OBJECT *) ((foreign_object_table . items) [index])) -> handle = + handle; + return (handle_to_integer (handle)); +} + +PTR +DEFUN (handle_to_foreign_pointer, (handle), HANDLE handle) +{ + unsigned int index; + + index = handle_to_index (handle); + if (index >= foreign_object_table . length) { + error_external_return (); + } + return + (((FOREIGN_OBJECT *) ((foreign_object_table . items) [index])) -> ptr); +} + +int +DEFUN (find_foreign_function, (func_name), char *func_name) +{ + int i; + FOREIGN_FUNCTION *func_item; + + for (i=0; i < foreign_function_table . length; i++) { + func_item = (foreign_function_table . items) [i]; + if (func_item == 0) continue; + if (! strcmp (func_item -> name, func_name)) { + return (i); + } + } + return (-1); +} + +unsigned int +DEFUN (register_foreign_function, (name, applicable_function), + char * name AND + PTR applicable_function) +{ + FOREIGN_FUNCTION *func_item; + char * name_copy; + + INITIALIZE_ONCE (); + func_item = (FOREIGN_FUNCTION *) foreign_malloc (sizeof (FOREIGN_FUNCTION)); + name_copy = (char *) foreign_malloc (1 + strlen (name)); + strcpy (name_copy, name); + func_item -> name = name_copy; + func_item -> applicable_function = applicable_function; + return (allocate_table_index (&foreign_function_table, (PTR) func_item)); +} + +unsigned int +DEFUN (list_length, (list), SCHEME_OBJECT list) +{ + unsigned int i; + + i = 0; + TOUCH_IN_PRIMITIVE (list, list); + while (PAIR_P (list)) { + i += 1; + TOUCH_IN_PRIMITIVE ((PAIR_CDR (list)), list); + } + return (i); +} + +PTR +DEFUN (apply_foreign_function, (func, arg_list), + PTR (*func)() AND + SCHEME_OBJECT arg_list) +{ + unsigned int arg_list_length; + PTR * arg_vec; + PTR result; + unsigned int i; + + arg_list_length = list_length (arg_list); + arg_vec = (PTR *) foreign_malloc (arg_list_length); + for (i = 0; i < arg_list_length; i++, arg_list = PAIR_CDR (arg_list)) { + arg_vec [i] = handle_to_foreign_pointer (PAIR_CAR (arg_list)); + } + result = (*func) (arg_vec); + free (arg_vec); + return (result); +} + +SCHEME_OBJECT +DEFUN (foreign_pointer_to_scheme_object, (ptr, type_translator), + PTR ptr AND + SCHEME_OBJECT (*type_translator) ()) +{ + return (type_translator (ptr)); +} + +/* old version of foreign_pointer_to_scheme_object */ +#if 0 +/* Note that foreign_pointer_to_scheme_object takes a pointer to pointer + (i.e. a call by reference to a pointer) so that it can increment the + pointer according to its type. This is used by the code which builds + the composite objects. */ + +SCHEME_OBJECT +DEFUN (foreign_pointer_to_scheme_object, (ptr_to_ptr, type), + PTR ptr_to_ptr AND + SCHEME_OBJECT type) +{ + long type_enum; + + if (foreign_primtive_type_p (type)) { + long long_val; + double double_val; + PTR temp_ptr; + type_enum = integer_to_long (type); + switch (type_enum) { + case FOREIGN_INT: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_INT); + *ptr_to_ptr = (((int *) temp_ptr) + 1); + long_val = (long) ((int) *temp_ptr); + case FOREIGN_SHORT: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_SHORT); + *ptr_to_ptr = (((short *) temp_ptr) + 1); + long_val = (long) ((short) *temp_ptr); + case FOREIGN_LONG: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_INT); + *ptr_to_ptr = (((long *) temp_ptr) + 1); + long_val = (long) *temp_ptr; + return (long_to_integer (long_val)); + case FOREIGN_CHAR: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_CHAR); + *ptr_to_ptr = (((char *) temp_ptr) + 1); + return (ASCII_TO_CHAR ((char) *temp_ptr)); + case FOREIGN_FLOAT: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_FLOAT); + *ptr_to_ptr = (((float *) temp_ptr) + 1); + double_val = (double) ((float) *temp_ptr); + case FOREIGN_DOUBLE: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_DOUBLE); + *ptr_to_ptr = (((double *) temp_ptr) + 1); + double_val = (double) *temp_ptr; + return (double_to_flonum (double_val)); + case FOREIGN_STRING: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_STRING); + *ptr_to_ptr = (((unsigned char *) temp_ptr) + 1); + return (char_pointer_to_string ((unsigned char *) temp_ptr; + case FOREIGN_PTR: + temp_ptr = ALIGN_FOREIGN_POINTER (*ptr_to_ptr, FOREIGN_PTR); + *ptr_to_ptr = (((PTR) temp_ptr) + 1); + return (long_to_integer ((long) *temp_ptr)); + default: + error_external_return (); + } + } else if (foreign_composite_type_p (type)) { + /* We should probably tag the result vector. */ + type_enum = integer_to_long (which_composite_type (type)); + switch (type_enum) { + case FOREIGN_STRUCT: + case FOREIGN_UNION: + { + int num_fields; + SCHEME_OBJECT field_types; + SCHEME_OBJECT result_vector; + unsigned int i; + + field_types = composite_type_field_types (type); + num_fields = list_length (field_types); + result_vector = allocate_marked_vector (TC_VECTOR, num_fields, true); + for (i = 0; i < num_fields; ++i) { + if (!(PAIR_P (field_types))) { + error_external_return (); + } + FAST_VECTOR_SET (result_vector, + i, + foreign_pointer_to_scheme_object ( + ptr_to_ptr, PAIR_CAR (field_types))); + TOUCH_IN_PRIMITIVE ((PAIR_CDR (field_types)), field_types); + } + return (result_vector); + } + default: + error_external_return (); + } + } else { + error_external_return (); + } +} +#endif /* if 0 */ + +static void +DEFUN_VOID (initialize_once) +{ + allocation_table_initialize (&foreign_object_table); + allocation_table_initialize (&foreign_function_table); + + initialization_done = 1; +} + +/* Functions to go in osxx.c */ + +#include + +char * +DEFUN_VOID (OS_create_temporary_file_name) +{ + char * name_string; + + name_string = (char *) foreign_malloc (1 + TEMP_FILE_NAME_MAX_LEN); + (void) UX_tmpnam (name_string); + return (name_string); +} + +#ifdef HAVE_DYNAMIC_LOADING +#ifdef _HPUX +#include + +LOAD_INFO * +DEFUN (OS_load_object_file, (load_file_name), char * load_file_name) +{ + shl_t shl_handle; + int result; + struct shl_descriptor *shl_desc; + LOAD_INFO *info; + + shl_handle = shl_load (load_file_name, BIND_DEFERRED, 0L); + + if (shl_handle == NULL) { + error_external_return (); + } + + result = shl_gethandle (shl_handle, &shl_desc); + + if (result == -1) { + error_external_return (); + } + + info = foreign_malloc (sizeof (LOAD_INFO)); + info -> load_module_descriptor = shl_handle; + info -> program_start = shl_desc -> tstart; + info -> program_end = shl_desc -> tend; + info -> data_start = shl_desc -> dstart; + info -> data_end = shl_desc -> dend; + return (info); +} + +PTR +DEFUN (OS_find_function, (load_info, func_name), + LOAD_INFO * load_info AND + char * func_name) +{ + int return_code; + PTR (* test_proc)(); + LOAD_DESCRIPTOR desc; + + desc = (load_info -> load_module_descriptor); + return_code = shl_findsym (&desc , + func_name, + TYPE_PROCEDURE, + (long *) &test_proc); + + return ((return_code == 0) ? + test_proc : + NULL); +} + +#endif /* _HPUX */ +#endif /* HAVE_DYNAMIC_LOADING */ + +/* Definitions of primitives */ + +DEFINE_PRIMITIVE ("CALL-FOREIGN-FUNCTION", + Prim_call_foreign_function, 2, 2, +"Calls the foreign function referenced by HANDLE with the ARG-LIST \n\ +arguments. \n\ +Returns a handle to the return value; \n\ +The foreign function should have been created by \n\ +CREATE_PRIMITIVE_FOREIGN_FUNCTION. \n\ +The elements of the ARG-LIST must be handles to foreign objects. \n\ +Type and arity checking on the arguments should already have been done.") +{ + PRIMITIVE_HEADER (2); + { + SCHEME_OBJECT arg_list; + PTR result; + + CHECK_ARG (2, APPARENT_LIST_P); + arg_list = ARG_REF (2); + result = apply_foreign_function (handle_to_foreign_pointer + (arg_handle (1)), arg_list); + PRIMITIVE_RETURN (foreign_pointer_to_handle (result)); + } +} + +DEFINE_PRIMITIVE ("&CALL-FOREIGN-FUNCTION-RETURNING-SCHEME-OBJECT", + Prim_call_foreign_function_returning_scheme_object, 2, 2, +"Calls the foreign function referenced by HANDLE with the ARG-LIST \n\ +arguments. \n\ +Returns the result of the foreign function (which better be a scheme \n\ +object. \n\ +The foreign function should have been created by \n\ +CREATE_PRIMITIVE_FOREIGN_FUNCTION. \n\ +The elements of the ARG-LIST must be handles to foreign objects. \n\ +Type and arity checking on the arguments should already have been done.") +{ + PRIMITIVE_HEADER (2); + { + SCHEME_OBJECT arg_list; + PTR result; + + CHECK_ARG (2, APPARENT_LIST_P); + arg_list = ARG_REF (2); + result = apply_foreign_function (handle_to_foreign_pointer + (arg_handle (1)), arg_list); + PRIMITIVE_RETURN (result); + } +} + +DEFINE_PRIMITIVE ("FOREIGN-HANDLE-TO-SCHEME-OBJECT", + Prim_foreign_handle_to_scheme_object, 2, 2, +"Returns the Scheme object corresponding to the foreign HANDLE \n\ +interpreted as the foreign type TYPE. \n\ +A type is either an integer which enumerates the various foreign types \n\ +(i.e. FOREIGN_INT, FOREIGN_CHAR, FOREIGN_SHORT, FOREIGN_LONG, \n\ +(FOREIGN_PTR, FOREIGN_DOUBLE, FOREIGN_STRING) or a list whose car is \n\ +an integer representing FOREIGN_STRUCT or FOREIGN_UNION and whose cdr \n\ +is a list of types.") +{ + PRIMITIVE_HEADER (2); + { + SCHEME_OBJECT arg2; + PTR arg1_ptr; + + arg1_ptr = handle_to_foreign_pointer (arg_handle (1)); + arg2 = ARG_REF (2); + if (! (INTEGER_P (arg2) || PAIR_P (arg2))) { + error_wrong_type_arg (2); + } + PRIMITIVE_RETURN (foreign_pointer_to_scheme_object (&arg1_ptr, arg2)); + } +} + +DEFINE_PRIMITIVE (LOAD-FOREIGN-FILE, Prim_load_foreign_file, 1, 1, +"Load the foreign object file FILENAME. \n\ +Returns a handle to a LOAD_INFO data structure.") +{ + PRIMITIVE_HEADER (1); + PRIMITIVE_RETURN (foreign_pointer_to_handle + (OS_load_object_file (STRING_ARG (1)))); +} + +DEFINE_PRIMITIVE (CREATE-TEMPORARY-FILE-NAME, Prim_get_temporary_file_name, + 0, 0, +"Return a temporary file name.") +{ + PRIMITIVE_HEADER (0); + PRIMITIVE_RETURN (char_pointer_to_string (OS_create_temporary_file_name ())); +} + +DEFINE_PRIMITIVE (FIND-FOREIGN-FUNCTION, Prim_find_foreign_function, 2, 2, +"Returns a handle to a foreign function. \n\ +Takes the FUNCTION_NAME as a string and LOAD_INFO \n\ +which is a handle to a load_info structure returned by LOAD-FOREIGN-FILE. \n\ +If LOAD_INFO is not #F then we search for FUNCTION_NAME in the code which \n\ +was loaded to yield LOAD_INFO. \n\ +If LOAD_INFO is #F then we search over all the dynamically loaded files.") +{ + PRIMITIVE_HEADER (2); + { + PTR func_ptr; + LOAD_INFO * load_info; + + load_info = ((ARG_REF (2) == EMPTY_LIST) ? + ((LOAD_INFO *) NULL) : + ((LOAD_INFO *) handle_to_foreign_pointer (arg_handle (2)))); + + func_ptr = OS_find_function (load_info, STRING_ARG (1)); + + PRIMITIVE_RETURN ((func_ptr == NULL) ? + SHARP_F : + foreign_pointer_to_handle (func_ptr)); + } +} diff --git a/v7/src/microcode/foreign.h b/v7/src/microcode/foreign.h new file mode 100644 index 000000000..506a1a1e5 --- /dev/null +++ b/v7/src/microcode/foreign.h @@ -0,0 +1,220 @@ +/* -*-C-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/foreign.h,v 1.1 1992/04/30 18:29:21 markf Exp $ + +Copyright (c) 1992 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* This file contains the primitive support for the foreign function */ +/* interface. */ + +struct foreign_function { + char * name; + PTR applicable_function; +}; + +typedef unsigned int HANDLE; + +typedef struct foreign_function FOREIGN_FUNCTION; + +struct foreign_object { + PTR ptr; + HANDLE handle; +}; + +typedef struct foreign_object FOREIGN_OBJECT; + +#ifdef _HPUX +typedef shl_t LOAD_DESCRIPTOR; +typedef unsigned long LOAD_ADDRESS; +#endif + +struct load_info { + LOAD_DESCRIPTOR load_module_descriptor; + LOAD_ADDRESS program_start; + LOAD_ADDRESS program_end; + LOAD_ADDRESS data_start; + LOAD_ADDRESS data_end; +}; + +typedef struct load_info LOAD_INFO; + +#define index_to_handle(index) ((HANDLE) index) +#define handle_to_index(handle) ((unsigned int) handle) +#define handle_to_integer(handle) (long_to_integer ((unsigned long) handle)) +#define foreign_primtive_type_p(object) (FIXNUM_P (object)) +#define foreign_composite_type_p(object) (PAIR_P (object)) +#define which_composite_type(type) (PAIR_CAR (type)) +#define composite_type_field_types(type) (PAIR_CDR (type)) + +/* the following define should be in some other .h file */ +#define TEMP_FILE_NAME_MAX_LEN L_tmpnam /* in stdio.h */ + +/* The following should be ifdef'ed up the wazoo for different machines */ +#define DYNAMIC_COMPILE_SWITCHES "+z" + +/* These need to match the appropriate enumerations in foreign.scm */ +#define FOREIGN_FIRST_TYPE 0 +#define FOREIGN_INT 0 +#define FOREIGN_SHORT 1 +#define FOREIGN_LONG 2 +#define FOREIGN_CHAR 3 +#define FOREIGN_FLOAT 4 +#define FOREIGN_DOUBLE 5 +#define FOREIGN_STRING 6 +#define FOREIGN_PTR 7 +#define FOREIGN_STRUCT 8 +#define FOREIGN_UNION 9 +#define FOREIGN_LAST_TYPE 9 + +/* This is a bunch of stuff to figure out the alignment of fields in + structures */ + +/* This defines a union which is guaranteed to have the most restrictive + possible alignment constraint */ +union greatest_alignment { + int my_int; + short my_short; + long my_long; + char my_char; + float my_float; + double my_double; + char * my_string; + void * my_ptr; +} + +/* We hope that char's are the smallest sized objects */ +typedef char smallest_size; + +struct int_field { + union greatest_alignment foo; + smallest_size bar; + int int_item; +} +#define INT_ALIGNMENT_MASK \ + ((long) ((sizeof (int_field) - sizeof (int)) - 1)) + +struct short_field { + union greatest_alignment foo; + smallest_size bar; + short short_item; +} +#define SHORT_ALIGNMENT_MASK \ + ((long) ((sizeof (short_field) - sizeof (short)) - 1)) + +struct long_field { + union greatest_alignment foo; + smallest_size bar; + long long_item; +} +#define LONG_ALIGNMENT_MASK \ + ((long) ((sizeof (long_field) - sizeof (long)) - 1)) + +struct char_field { + union greatest_alignment foo; + smallest_size bar; + char char_item; +} +#define CHAR_ALIGNMENT_MASK \ + ((long) ((sizeof (char_field) - sizeof (char)) - 1)) + +struct float_field { + union greatest_alignment foo; + smallest_size bar; + float float_item; +} +#define FLOAT_ALIGNMENT_MASK \ + ((long) ((sizeof (float_field) - sizeof (float)) - 1)) + +struct double_field { + union greatest_alignment foo; + smallest_size bar; + double double_item; +} +#define DOUBLE_ALIGNMENT_MASK \ + ((long) ((sizeof (double_field) - sizeof (double)) - 1)) + +struct string_field { + union greatest_alignment foo; + smallest_size bar; + char * string_item; +} +#define STRING_ALIGNMENT_MASK \ + ((long) ((sizeof (string_field) - sizeof (char *)) - 1)) + +struct ptr_field { + union greatest_alignment foo; + smallest_size bar; + PTR ptr_item; +} +#define PTR_ALIGNMENT_MASK \ + ((long) ((sizeof (ptr_field) - sizeof (PTR)) - 1)) + +struct struct_field { + union greatest_alignment foo; + smallest_size bar; + struct greatest_alignment2 struct_item; +} + +#define ALIGN_FOREIGN_POINTER(ptr,type) \ +# if (type == FOREIGN_INT) \ + (((int *) (ptr & INT_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_SHORT) \ + (((short *) (ptr & SHORT_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_LONG) \ + (((long *) (ptr & LONG_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_CHAR) \ + (((char *) (ptr & CHAR_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_FLOAT) \ + (((float *) (ptr & FLOAT_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_DOUBLE) \ + (((double *) (ptr & DOUBLE_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_STRING) \ + (((unsigned char *) (ptr & STRING_ALIGNMENT_MASK)) + 1) \ +# else \ +# if (type == FOREIGN_PTR) \ + (((PTR) (ptr & PTR_ALIGNMENT_MASK)) + 1) \ +# endif \ +# endif \ +# endif \ +# endif \ +# endif \ +# endif \ +# endif \ +# endif + + +/* End of alignment junk */