2.9BSD - /usr/src/lib/ape/fortran.c

   1: #include "lint.h"
   2: #ifndef lint
   3: static char sccs_id[] = "@(#)fortran.c	2.1	7/6/82";
   4: #endif lint
   5:     /* These routines mediate linkage of the ape
   6: 	 * routines by f77 programs. */
   7: #include <ape.h>
   8: 
   9: #ifdef  I2
  10: typedef fortint short;
  11: #else
  12: #ifdef  I4
  13: typedef fortint long;
  14: #endif
  15: #endif
  16: typedef fortlen long;
  17:     /* initialization: */
  18: 
  19: new_(n)
  20: fortint *n;
  21: {
  22:     PMINT local;
  23: 
  24:     new(&local);
  25:     *n = (fortint)local;
  26: }
  27: 
  28: itom_(n,a)
  29: fortint *n, *a;
  30: {   *a = (fortint) ltom(*n);    }
  31: 
  32: stom_(str,a,strlength)
  33: char *str;
  34: fortint *a;
  35: fortlen strlength;
  36: {   *(str+(int)strlength) = '\0'; /* Is this necessary? */
  37:     *a = (fortint) stom(str);
  38: }
  39: 
  40: 
  41:     /* removal: */
  42: 
  43: xfree_(a)
  44: fortint *a;
  45: {   xfree((PMINT)(*a)); }
  46: 
  47: afree_(a)
  48: fortint *a;
  49: {   afree((PMINT)(*a)); }
  50: 
  51: 
  52:     /* operations: */
  53: 
  54: madd_(a,b,c)
  55: fortint *a, *b, *c;
  56: {   madd((PMINT)(*a),(PMINT)(*b),(PMINT)(*c));  }
  57: 
  58: msub_(a,b,c)
  59: fortint *a, *b, *c;
  60: {   msub((PMINT)(*a),(PMINT)(*b),(PMINT)(*c));  }
  61: 
  62: mult_(a,b,c)
  63: fortint *a, *b, *c;
  64: {   mult((PMINT)(*a),(PMINT)(*b),(PMINT)(*c));  }
  65: 
  66: mdiv_(a,b,c,d)
  67: fortint *a, *b, *c, *d;
  68: {   mdiv((PMINT)(*a),(PMINT)(*b),(PMINT)(*c),(PMINT)(*d));  }
  69: 
  70: sdiv_(a,b,c,d)
  71: fortint *a, *b, *c, *d;
  72: {   sdiv((PMINT)(*a),(int)*b,(PMINT)(*c),(short *)*d);  }
  73: 
  74: gcd_(a,b,c)
  75: fortint *a, *b, *c;
  76: {   gcd((PMINT)(*a),(PMINT)(*b),(PMINT)(*c));   }
  77: 
  78: pow_(a,b,c,d)
  79: fortint *a, *b, *c, *d;
  80: {   pow((PMINT)(*a),(PMINT)(*b),(PMINT)(*c),(PMINT)(*d));   }
  81: 
  82: rpow_(a,b,c)
  83: fortint *a, *b, *c;
  84: {   rpow((PMINT)(*a),(int)(*b),(PMINT)(*c));    }
  85: 
  86: 
  87:     /* Input and output:
  88: 	 * Because I don't feel up to worrying
  89: 	 * about how f77 does file manipulations,
  90: 	 * I'm only providing I/O from std(in/out),
  91: 	 * for bases 10 and 8. */
  92: #include <stdio.h>
  93: 
  94: minput_(a,i)    /* Name can't be "min" because of Fortran min function! */
  95: fortint *a, *i;
  96: {   *i = m_in((PMINT)(*a),10,stdin);    }
  97: 
  98: omin_(a,i)
  99: fortint *a,*i;
 100: {   *i = m_in((PMINT)(*a),8,stdin); }
 101: 
 102: mout_(a)
 103: fortint *a;
 104: {   m_out((PMINT)(*a),10,stdout);   }
 105: 
 106: omout_(a)
 107: fortint *a;
 108: {   om_out((PMINT)(*a),stdout); }
 109: 
 110:     /* conversions: */
 111: 
 112: mtovec_(a,length,vect)
 113: fortint *a, *length;
 114: short *vect;
 115: {
 116:     int abslen, i;
 117:     PMINT local;
 118: 
 119:     local = (PMINT)*a;
 120:     *length = local->len;
 121:     abslen = (*length >= 0 ? *length : -*length);
 122:     for (i=0; i<abslen; ++i)
 123:         vect[i] = local->val[i];
 124: }
 125: 
 126: vectom_(length,vect,a)
 127: fortint *length, *a;
 128: short *vect;
 129: {
 130:     int abslen, i;
 131:     PMINT local;
 132: 
 133:     new(&local);
 134:     if ((local->len = (int)*length) == 0)
 135:         {
 136:         *a = (fortint)local;
 137:         return;
 138:         }
 139:     abslen = (*length >= 0 ? *length : *length);
 140:     local->val = xalloc(abslen, "vec-to-m");
 141:     for (i=0; i < abslen; ++i)
 142:         local->val[i] = vect[i];
 143:     mcan(local);
 144:     *a = (fortint) local;
 145:     return;
 146: }

Defined functions

Defined variables