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