xref: /csrg-svn/old/ratfor/r2.c (revision 14503)
1*14503Ssam #ifndef lint
2*14503Ssam static char sccsid[] = "@(#)r2.c	1.2 (Berkeley) 08/11/83";
3*14503Ssam #endif
4*14503Ssam 
59727Sclemc #include "r.h"
69727Sclemc 
79727Sclemc extern int hollerith;
89727Sclemc 
99727Sclemc char	outbuf[80];
109727Sclemc int	outp	= 0;
119727Sclemc int	cont	= 0;
129727Sclemc int	contchar	= '&';
139727Sclemc 
149727Sclemc char	comment[320];
159727Sclemc int	comptr	= 0;
169727Sclemc int	indent	= 0;
179727Sclemc 
189727Sclemc outdon() {
199727Sclemc 	outbuf[outp] = '\0';
209727Sclemc 	if (outp > 0)
219727Sclemc 		fprintf(outfil, "%s\n", outbuf);
229727Sclemc 	outp = cont = 0;
239727Sclemc }
249727Sclemc 
259727Sclemc putcom(s) char *s; {
269727Sclemc 	if (printcom) {
279727Sclemc 		ptc('c');
289727Sclemc 		outtab();
299727Sclemc 		pts(s);
309727Sclemc 		outdon();
319727Sclemc 	}
329727Sclemc }
339727Sclemc 
349727Sclemc outcode(xp) char *xp; {
359727Sclemc 	register c, c1, j;
369727Sclemc 	char *q, *p;
379727Sclemc 
389727Sclemc 	p = (char *) xp;	/* shut lint up */
399727Sclemc 	if (cont == 0 && comptr > 0)	/* flush comment if not on continuation */
409727Sclemc 		flushcom();
419727Sclemc 	while( (c = *p++) ){
429727Sclemc 		c1 = *p;
439727Sclemc 		if (type[c] == LET || type[c] == DIG) {
449727Sclemc 			pts(p-1);
459727Sclemc 			break;
469727Sclemc 		}
479727Sclemc 		switch(c){
489727Sclemc 
499727Sclemc 		case '"': case '\'':
509727Sclemc 			j = 0;
519727Sclemc 			for (q=p; *q; q++) {
529727Sclemc 				if (*q == '\\')
539727Sclemc 					q++;
549727Sclemc 				j++;
559727Sclemc 			}
569727Sclemc 			if (outp+j+2 > 71)
579727Sclemc 				contcard();
589727Sclemc 			if (hollerith) {
599727Sclemc 				outnum(--j);
609727Sclemc 				ptc('h');
619727Sclemc 			} else
629727Sclemc 				ptc(c);
639727Sclemc 			while (*p != c) {
649727Sclemc 				if (*p == '\\')
659727Sclemc 					p++;
669727Sclemc 				ptc(*p++);
679727Sclemc 			}
689727Sclemc 			if (!hollerith)
699727Sclemc 				ptc(c);
709727Sclemc 			p++;
719727Sclemc 			break;
729727Sclemc 		case '$': case '\\':
739727Sclemc 			if (strlen(p-1)+outp > 71)
749727Sclemc 				contcard();
759727Sclemc 			if (c1 == '"' || c1 == '\'') {
769727Sclemc 				ptc(c1);
779727Sclemc 				p++;
789727Sclemc 			} else
799727Sclemc 				for (p--; *p; p++)
809727Sclemc 					ptc(*p);
819727Sclemc 			break;
829727Sclemc 		case '%':
839727Sclemc 			outp = 0;
849727Sclemc 			while (*p)
859727Sclemc 				ptc(*p++);
869727Sclemc 			break;
879727Sclemc 		case '>':
889727Sclemc 			if( c1=='=' ){
899727Sclemc 				pts(".ge."); p++;
909727Sclemc 			} else
919727Sclemc 				pts(".gt.");
929727Sclemc 			break;
939727Sclemc 		case '<':
949727Sclemc 			if( c1=='=' ){
959727Sclemc 				pts(".le."); p++;
969727Sclemc 			} else if( c1=='>' ){
979727Sclemc 				pts(".ne."); p++;
989727Sclemc 			} else
999727Sclemc 				pts(".lt.");
1009727Sclemc 			break;
1019727Sclemc 		case '=':
1029727Sclemc 			if( c1=='=' ){
1039727Sclemc 				pts(".eq."); p++;
1049727Sclemc 			} else
1059727Sclemc 				ptc('=');
1069727Sclemc 			break;
1079727Sclemc 		case '!': case '^':
1089727Sclemc 			if( c1=='=' ){
1099727Sclemc 				pts(".ne."); p++;
1109727Sclemc 			} else
1119727Sclemc 				pts(".not.");
1129727Sclemc 			break;
1139727Sclemc 		case '&':
1149727Sclemc 			if( c1=='&' )
1159727Sclemc 				p++;
1169727Sclemc 			pts(".and.");
1179727Sclemc 			break;
1189727Sclemc 		case '|':
1199727Sclemc 			if( c1=='|' )
1209727Sclemc 				p++;
1219727Sclemc 			pts(".or.");
1229727Sclemc 			break;
1239727Sclemc 		case '\t':
1249727Sclemc 			outtab();
1259727Sclemc 			break;
1269727Sclemc 		case '\n':
1279727Sclemc 			ptc(' ');
1289727Sclemc 			break;
1299727Sclemc 		default:
1309727Sclemc 			ptc(c);
1319727Sclemc 			break;
1329727Sclemc 		}
1339727Sclemc 	}
1349727Sclemc }
1359727Sclemc 
1369727Sclemc ptc(c) char c; {
1379727Sclemc 	if( outp > 71 )
1389727Sclemc 		contcard();
1399727Sclemc 	outbuf[outp++] = c;
1409727Sclemc }
1419727Sclemc 
1429727Sclemc pts(s) char *s; {
1439727Sclemc 	if (strlen(s)+outp > 71)
1449727Sclemc 		contcard();
1459727Sclemc 	while(*s)
1469727Sclemc 		ptc(*s++);
1479727Sclemc }
1489727Sclemc 
1499727Sclemc contcard(){
1509727Sclemc 	int n;
1519727Sclemc 	outbuf[outp] = '\0';
1529727Sclemc 	fprintf(outfil, "%s\n", outbuf);
1539727Sclemc 	n = 6;
1549727Sclemc 	if (printcom) {
1559727Sclemc 		n += INDENT * indent + 1;
1569727Sclemc 		if (n > 35) n = 35;
1579727Sclemc 	}
1589727Sclemc 	for( outp=0; outp<n; outbuf[outp++] = ' ' );
1599727Sclemc 	outbuf[contfld-1] = contchar;
1609727Sclemc 	cont++;
1619727Sclemc 	if (cont > 19)
1629727Sclemc 		error("more than 19 continuation cards");
1639727Sclemc }
1649727Sclemc 
1659727Sclemc outtab(){
1669727Sclemc 	int n;
1679727Sclemc 	n = 6;
1689727Sclemc 	if (printcom) {
1699727Sclemc 		n += INDENT * indent;
1709727Sclemc 		if (n > 35) n = 35;
1719727Sclemc 	}
1729727Sclemc 	while (outp < n)
1739727Sclemc 		ptc(' ');
1749727Sclemc }
1759727Sclemc 
1769727Sclemc outnum(n) int n; {
1779727Sclemc 	int a;
1789727Sclemc 	if( a = n/10 )
1799727Sclemc 		outnum(a);
1809727Sclemc 	ptc(n%10 + '0');
1819727Sclemc }
1829727Sclemc 
1839727Sclemc outcont(n) int n; {
1849727Sclemc 	transfer = 0;
1859727Sclemc 	if (n == 0 && outp == 0)
1869727Sclemc 		return;
1879727Sclemc 	if( n > 0 )
1889727Sclemc 		outnum(n);
1899727Sclemc 	outcode("\tcontinue");
1909727Sclemc 	outdon();
1919727Sclemc }
1929727Sclemc 
1939727Sclemc outgoto(n) int n; {
1949727Sclemc 	if (transfer != 0)
1959727Sclemc 		return;
1969727Sclemc 	outcode("\tgoto ");
1979727Sclemc 	outnum(n);
1989727Sclemc 	outdon();
1999727Sclemc }
2009727Sclemc 
2019727Sclemc flushcom() {
2029727Sclemc 	int i, j;
2039727Sclemc 	if (printcom == 0)
2049727Sclemc 		comptr = 0;
2059727Sclemc 	else if (cont == 0 && comptr > 0) {
2069727Sclemc 		for (i=j=0; i < comptr; i++)
2079727Sclemc 			if (comment[i] == '\n') {
2089727Sclemc 				comment[i] = '\0';
2099727Sclemc 				fprintf(outfil, "%s\n", &comment[j]);
2109727Sclemc 				j = i + 1;
2119727Sclemc 			}
2129727Sclemc 		comptr = 0;
2139727Sclemc 	}
2149727Sclemc }
215