00001 #include "machine.h"
00002 #include <math.h>
00003 #include <string.h>
00004 #include <stdio.h>
00005
00006 typedef signed char integer1;
00007 typedef short integer2;
00008 #define Abs(x) ( ( (x) >= 0) ? (x) : -( x) )
00009 #define Max(x,y) (((x)>(y))?(x):(y))
00010
00011 #define DSP(Type,Fmt) {\
00012 Type *X;\
00013 Type a;\
00014 double aa;\
00015 X=(Type *)x;\
00016 --iw;\
00017 --X;\
00018 m = Abs(*mm); n = Abs(*nn);\
00019 dl = ' '; if (m * n > 1) dl = ' ';\
00020 lbloc = n; nbloc = 1;\
00021 iw[lbloc + nbloc] = n;\
00022 lp = -(*nx);s = 0;\
00023 for (k = 1; k <= n; ++k) {\
00024 iw[k] = 0;\
00025 lp += *nx;\
00026 for (l = 1; l <= m; ++l) {\
00027 aa = Abs((double)X[lp + l]);\
00028 if (aa == 0) {\
00029 fl = 0;\
00030 } else {\
00031 fl = (int)(log(aa)/log(10.)) ;\
00032 }\
00033 iw[k] = Max(iw[k],fl + 2);\
00034 }\
00035 s += iw[k];\
00036 if (s > *ll - 2) {\
00037 iw[lbloc + nbloc] = k - 1;\
00038 ++nbloc;\
00039 iw[lbloc + nbloc] = n;\
00040 s = iw[k];\
00041 }\
00042 }\
00043 if (*mm < 0) {\
00044 cw[0] = '\0';\
00045 strcpy(&(cw[0]), "(eye *)");\
00046 C2F(basout)(&io, lunit, cw, 7L);\
00047 C2F(basout)(&io, lunit, " ", 1L);\
00048 if (io == -1) return 0;\
00049 }\
00050 k1 = 1;\
00051 for (ib = 1; ib <= nbloc; ++ib) {\
00052 k2 = iw[lbloc + ib];\
00053 if (nbloc != 1) {\
00054 C2F(blktit)(lunit, &k1, &k2, &io);\
00055 if (io == -1) return 0;\
00056 }\
00057 for (l = 1; l <= m; ++l) {\
00058 cw[0] = dl;l1 = 1;\
00059 for (k = k1; k <= k2; ++k) {\
00060 a = X[l + (k - 1) * *nx];\
00061 sprintf((char *)&(cw[l1]),Fmt,iw[k],a);\
00062 l1 += iw[k]+1;\
00063 }\
00064 cw[l1] = dl;\
00065 C2F(basout)(&io, lunit, cw, l1+1);\
00066 if (io == -1) return 0;\
00067 }\
00068 k1 = k2 + 1;\
00069 }\
00070 }
00071
00072 int C2F(genmdsp)(typ, x, nx, mm, nn, ll, lunit, cw, iw, cw_len)
00073 integer *typ;
00074 integer *x;
00075 integer *nx, *mm, *nn, *ll, *lunit,*iw;
00076 char cw[];
00077 int cw_len;
00078 {
00079 static integer k, l, m, n, s, lbloc, nbloc, k1, l1, k2, ib;
00080 static char dl;
00081 static integer fl, io, lp;
00082 extern int C2F(blktit)(), C2F(basout)();
00083
00084 switch (*typ) {
00085 case 1:
00086 DSP(integer1,"%*i ");
00087 break;
00088 case 2:
00089 DSP(integer2,"%*i ");
00090 break;
00091 case 4:
00092 DSP(integer,"%*i ");
00093 break;
00094 case 11:
00095 DSP(unsigned char,"%*u ");
00096 break;
00097 case 12:
00098 DSP(unsigned short,"%*u ");
00099 break;
00100 case 14:
00101 DSP(unsigned int,"%*u ");
00102 break;
00103 }
00104 return 0;
00105 }