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