--- /dev/null
+/* -*-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 <stdio.h>
+#include <dl.h>
+#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));
+\f
+/* 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);
+}
+\f
+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);
+}
+\f
+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);
+}
+\f
+/* 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;
+}
+\f
+/* Functions to go in osxx.c */
+
+#include <dl.h>
+
+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 <dl.h>
+
+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 */
+\f
+/* 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));
+ }
+}
--- /dev/null
+/* -*-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 */
projects / mit-scheme.git / commitdiff