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

Defined functions

Defined variables