|
|
1.1 root 1: #include "r.h"
2:
3: extern int hollerith;
4: extern int uppercase;
5:
6: char outbuf[80];
7: int outp = 0;
8: int cont = 0;
9: int contchar = '&';
10:
11: char comment[320];
12: int comptr = 0;
13: int indent = 0;
14:
15: outdon() {
16: outbuf[outp] = '\0';
17: if (outp > 0)
18: fprintf(outfil, "%s\n", outbuf);
19: outp = cont = 0;
20: }
21:
22: putcom(s) char *s; {
23: if (printcom) {
24: ptc(uppercase? 'C' : 'c');
25: outtab();
26: pts(s);
27: outdon();
28: }
29: }
30:
31: outcode(xp) char *xp; {
32: register c, c1, j;
33: char *q, *p, *s;
34:
35: p = (char *) xp; /* shut lint up */
36: if (cont == 0 && comptr > 0) /* flush comment if not on continuation */
37: flushcom();
38: while( (c = *p++) ){
39: c1 = *p;
40: if (isalpha(c) || isdigit(c)) {
41: if (uppercase)
42: foldup(p-1);
43: pts(p-1);
44: break;
45: }
46: s = NULL; /* generally set to something like .ge. */
47: switch(c){
48:
49: case '"': case '\'':
50: j = 0;
51: for (q=p; *q; q++) {
52: if (*q == '\\')
53: q++;
54: j++;
55: }
56: if (outp+j+2 > 71)
57: contcard();
58: if (hollerith) {
59: outnum(--j);
60: ptc(uppercase ? 'H' : 'h');
61: } else
62: ptc(c);
63: while (*p != c) {
64: if (*p == '\\')
65: p++;
66: ptc(*p++);
67: }
68: if (!hollerith)
69: ptc(c);
70: p++;
71: break;
72: case '$': case '\\':
73: if (strlen(p-1)+outp > 71)
74: contcard();
75: if (c1 == '"' || c1 == '\'') {
76: ptc(c1);
77: p++;
78: } else
79: for (p--; *p; p++)
80: ptc(*p);
81: break;
82: case '%':
83: outp = 0;
84: while (*p)
85: ptc(*p++);
86: break;
87: case '>':
88: if( c1=='=' ){
89: s = ".ge."; p++;
90: } else
91: s = ".gt.";
92: break;
93: case '<':
94: if( c1=='=' ){
95: s = ".le."; p++;
96: } else if( c1=='>' ){
97: s = ".ne."; p++;
98: } else
99: s = ".lt.";
100: break;
101: case '=':
102: if( c1=='=' ){
103: s = ".eq."; p++;
104: } else
105: s = "=";
106: break;
107: case '!': case '^':
108: if( c1=='=' ){
109: s = ".ne."; p++;
110: } else
111: s = ".not.";
112: break;
113: case '&':
114: if( c1=='&' )
115: p++;
116: s = ".and.";
117: break;
118: case '|':
119: if( c1=='|' )
120: p++;
121: s = ".or.";
122: break;
123: case '\t':
124: outtab();
125: break;
126: case '\n':
127: ptc(' ');
128: break;
129: default:
130: ptc(c);
131: break;
132: }
133: if (s != NULL) {
134: if (uppercase)
135: foldup(s);
136: pts(s);
137: }
138: }
139: }
140:
141: foldup(s) /* convert s to upper case */
142: char *s;
143: {
144: while (*s) {
145: if (islower(*s))
146: *s = toupper(*s);
147: s++;
148: }
149: }
150:
151: ptc(c) char c; {
152: if( outp > 71 )
153: contcard();
154: outbuf[outp++] = c;
155: }
156:
157: pts(s) char *s; {
158: if (strlen(s)+outp > 71)
159: contcard();
160: while(*s)
161: ptc(*s++);
162: }
163:
164: contcard(){
165: int n;
166: outbuf[outp] = '\0';
167: fprintf(outfil, "%s\n", outbuf);
168: n = 6;
169: if (printcom) {
170: n += INDENT * indent + 1;
171: if (n > 35) n = 35;
172: }
173: for( outp=0; outp<n; outbuf[outp++] = ' ' );
174: outbuf[contfld-1] = contchar;
175: cont++;
176: if (cont > 19)
177: error("more than 19 continuation cards");
178: }
179:
180: outtab(){
181: int n;
182: n = 6;
183: if (printcom) {
184: n += INDENT * indent;
185: if (n > 35) n = 35;
186: }
187: while (outp < n)
188: ptc(' ');
189: }
190:
191: outnum(n) int n; {
192: int a;
193: if( a = n/10 )
194: outnum(a);
195: ptc(n%10 + '0');
196: }
197:
198: outcont(n) int n; {
199: transfer = 0;
200: if (n == 0 && outp == 0)
201: return;
202: if( n > 0 )
203: outnum(n);
204: outcode("\tcontinue");
205: outdon();
206: }
207:
208: outgoto(n) int n; {
209: if (transfer != 0)
210: return;
211: outcode("\tgoto ");
212: outnum(n);
213: outdon();
214: }
215:
216: flushcom() {
217: int i, j;
218: if (printcom == 0)
219: comptr = 0;
220: else if (cont == 0 && comptr > 0) {
221: for (i=j=0; i < comptr; i++)
222: if (comment[i] == '\n') {
223: comment[i] = '\0';
224: fprintf(outfil, "%s\n", &comment[j]);
225: j = i + 1;
226: }
227: comptr = 0;
228: }
229: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.