guile18/qt/md/axp.c

   1 /*
   2  * QuickThreads -- Threads-building toolkit.
   3  * Copyright (c) 1993 by David Keppel
   4  *
   5  * Permission to use, copy, modify and distribute this software and
   6  * its documentation for any purpose and without fee is hereby
   7  * granted, provided that the above copyright notice and this notice
   8  * appear in all copies.  This software is provided as a
   9  * proof-of-concept and for demonstration purposes; there is no
  10  * representation about the suitability of this software for any
  11  * purpose.
  12  */
  13
  14 #include <stdarg.h>
  15 #include "qt.h"
  16
  17
  18 /* Varargs is harder on the AXP.  Parameters are saved on the stack as
  19    something like (stack grows down to low memory; low at bottom of
  20    picture):
  21
  22         |  :
  23         | arg6
  24         +---
  25         | iarg5
  26         |  :
  27         | iarg3         <-- va_list._a0 + va_list._offset
  28         |  :
  29         | iarg0         <-- va_list._a0
  30         +---
  31         | farg5
  32         |  :
  33         | farg0
  34         +---
  35
  36    When some of the arguments have known type, there is no need to
  37    save all of them in the struct.  So, for example, if the routine is
  38    called
  39
  40         zork (int a0, float a1, int a2, ...)
  41         {
  42           va_list ap;
  43           va_start (ap, a2);
  44           qt_vargs (... &ap ...);
  45         }
  46
  47    then offset is set to 3 * 8 (8 === sizeof machine word) = 24.
  48
  49    What this means for us is that the user's routine needs to be
  50    called with an arg list where some of the words in the `any type'
  51    parameter list have to be split and moved up in to the int/fp
  52    region.
  53
  54    Ways in which this can fail:
  55     - The user might not know the size of the pushed arguments anyway.
  56     - Structures have funny promotion rules.
  57     - Probably lots of other things.
  58
  59    All in all, we never promised varargs would work reliably. */
  60
  61
  62
  63 #define QT_VADJ(sp)     (((char *)sp) - QT_VSTKBASE)
  64
  65 #define QT_VARGS_MD0(sp, vabytes) \
  66    ((qt_t *)(((char *)(sp)) - 6*2*8 - QT_STKROUNDUP(vabytes)))
  67
  68 extern void qt_vstart(void);
  69 #define QT_VARGS_MD1(sp)        (QT_SPUT (sp, QT_R26, qt_vstart))
  70
  71
  72 /* Different machines use different implementations for varargs.
  73    Unfortunately, the code below ``looks in to'' the varargs
  74    structure, `va_list', and thus depends on the conventions.
  75    The following #defines try to deal with it but don't catch
  76    everything. */
  77
  78 #ifdef __GNUC__
  79 #define _a0             __base
  80 #define _offset         __offset
  81 #else
  82 #ifdef __OSF1__
  83 #define _a0             a0
  84 #define _offset         offset
  85 #endif
  86 #endif /* def __GNUC__ */
  87
  88
  89   struct qt_t *
  90 qt_vargs (struct qt_t *qsp, int nbytes, struct va_list *vargs,
  91           void *pt, qt_function_t *startup,
  92           qt_function_t *vuserf, qt_function_t *cleanup)
  93 {
  94   va_list ap;
  95   int i;
  96   int max;              /* Maximum *words* of args to copy. */
  97   int tmove;            /* *Words* of args moved typed->typed. */
  98   qt_word_t *sp;
  99
 100   ap = *(va_list *)vargs;
 101   qsp = QT_VARGS_MD0 (qsp, nbytes);
 102   sp = (qt_word_t *)qsp;
 103
 104   tmove = 6 - ap._offset/sizeof(qt_word_t);
 105
 106   /* Copy from one typed area to the other. */
 107   for (i=0; i<tmove; ++i) {
 108     /* Integer args: */
 109     sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i];
 110     /* Fp args: */
 111     sp[i] = ((qt_word_t *)(ap._a0 + ap._offset))[i-6];
 112   }
 113
 114   max = nbytes/sizeof(qt_word_t);
 115
 116   /* Copy from the untyped area to the typed area.  Split each arg.
 117      in to integer and floating-point save areas. */
 118   for (; i<6 && i<max; ++i) {
 119     sp[i] = sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i];
 120   }
 121
 122   /* Copy from the untyped area to the other untyped area. */
 123   for (; i<max; ++i) {
 124     sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i];
 125   }
 126
 127   QT_VARGS_MD1 (QT_VADJ(sp));
 128   QT_SPUT (QT_VADJ(sp), QT_VARGT_INDEX, pt);
 129   QT_SPUT (QT_VADJ(sp), QT_VSTARTUP_INDEX, startup);
 130   QT_SPUT (QT_VADJ(sp), QT_VUSERF_INDEX, vuserf);
 131   QT_SPUT (QT_VADJ(sp), QT_VCLEANUP_INDEX, cleanup);
 132   return ((qt_t *)QT_VADJ(sp));
 133 }