|
|
1.1 root 1: # include "r.h"
2:
3: char *keyword [] = {
4: "do",
5: "if",
6: "else",
7: "for",
8: "repeat",
9: "until",
10: "while",
11: "break",
12: "next",
13: "define",
14: "include",
15: "return",
16: "switch",
17: "case",
18: "default",
19: 0};
20:
21: int keytran[] = {
22: DO,
23: IF,
24: ELSE,
25: FOR,
26: REPEAT,
27: UNTIL,
28: WHILE,
29: BREAK,
30: NEXT,
31: DEFINE,
32: INCLUDE,
33: RETURN,
34: SWITCH,
35: CASE,
36: DEFAULT,
37: 0};
38:
39: char *fcnloc; /* spot for "function" */
40:
41: int svargc;
42: char **svargv;
43: char *curfile[10] = { "" };
44: int infptr = 0;
45: FILE *outfil = { stdout };
46: FILE *infile[10] = { stdin };
47: int linect[10];
48:
49: int contfld = CONTFLD; /* place to put continuation char */
50: int printcom = 0; /* print comments if on */
51: int hollerith = 0; /* convert "..." to 27H... if on */
52:
53: #ifdef gcos
54: char *ratfor "tssrat";
55: int bcdrat[2];
56: char *bwkmeter ". bwkmeter ";
57: int bcdbwk[5];
58: #endif
59:
60: main(argc,argv) int argc; char **argv; {
61: int i;
62: while(argc>1 && argv[1][0]=='-') {
63: if(argv[1][1]=='6') {
64: contfld=6;
65: if (argv[1][2]!='\0')
66: contchar = argv[1][2];
67: } else if (argv[1][1] == 'C')
68: printcom++;
69: else if (argv[1][1] == 'h')
70: hollerith++;
71: argc--;
72: argv++;
73: }
74:
75: #ifdef gcos
76: if (!intss()) {
77: _fixup();
78: ratfor = "batrat";
79: }
80: ascbcd(ratfor,bcdrat,6);
81: ascbcd(bwkmeter,bcdbwk,24);
82: acdata(bcdrat[0],1);
83: acupdt(bcdbwk[0]);
84: if (!intss()) {
85: if ((infile[infptr]=fopen("s*", "r")) == NULL)
86: cant("s*");
87: if ((outfil=fopen("*s", "w")) == NULL)
88: cant("*s");
89: }
90: #endif
91:
92: svargc = argc;
93: svargv = argv;
94: if (svargc > 1)
95: putbak('\0');
96: for (i=0; keyword[i]; i++)
97: install(keyword[i], "", keytran[i]);
98: fcnloc = install("function", "", 0);
99: yyparse();
100: #ifdef gcos
101: if (!intss())
102: bexit(errorflag);
103: #endif
104: exit(errorflag);
105: }
106:
107: #ifdef gcos
108: bexit(status) {
109: /* this is the batch version of exit for gcos tss */
110: FILE *inf, *outf;
111: char c;
112:
113: fclose(stderr); /* make sure diagnostics get flushed */
114: if (status) /* abort */
115: _nogud();
116:
117: /* good: copy output back to s*, call forty */
118:
119: fclose(outfil,"r");
120: fclose(infile[0],"r");
121: inf = fopen("*s", "r");
122: outf = fopen("s*", "w");
123: while ((c=getc(inf)) != EOF)
124: putc(c, outf);
125: fclose(inf,"r");
126: fclose(outf,"r");
127: __imok();
128: }
129: #endif
130:
131: cant(s) char *s; {
132: linect[infptr] = 0;
133: curfile[infptr] = s;
134: error("can't open");
135: exit(1);
136: }
137:
138: inclstat() {
139: int c;
140: char *ps;
141: char fname[100];
142: while ((c = getchr()) == ' ' || c == '\t');
143: if (c == '(') {
144: for (ps=fname; (*ps=getchr()) != ')'; ps++);
145: *ps = '\0';
146: } else if (c == '"' || c == '\'') {
147: for (ps=fname; (*ps=getchr()) != c; ps++);
148: *ps = '\0';
149: } else {
150: putbak(c);
151: for (ps=fname; (*ps=getchr()) != ' ' &&*ps!='\t' && *ps!='\n' && *ps!=';'; ps++);
152: *ps = '\0';
153: }
154: if ((infile[++infptr] = fopen(fname,"r")) == NULL) {
155: cant(fname);
156: exit(1);
157: }
158: linect[infptr] = 0;
159: curfile[infptr] = fname;
160: }
161:
162: char str[500];
163: int nstr;
164:
165: yylex() {
166: int c, t;
167: for (;;) {
168: while ((c=gtok(str))==' ' || c=='\n' || c=='\t')
169: ;
170: yylval = c;
171: if (c==';' || c=='{' || c=='}')
172: return(c);
173: if (c==EOF)
174: return(0);
175: yylval = (int) str;
176: if (c == DIG)
177: return(DIGITS);
178: t = lookup(str)->ydef;
179: if (t==DEFINE)
180: defstat();
181: else if (t==INCLUDE)
182: inclstat();
183: else if (t > 0)
184: return(t);
185: else
186: return(GOK);
187: }
188: }
189:
190: int dbg = 0;
191:
192: yyerror(p) char *p; {;}
193:
194:
195: defstat() {
196: int c,i,val,t,nlp;
197: extern int nstr;
198: extern char str[];
199: while ((c=getchr())==' ' || c=='\t');
200: if (c == '(') {
201: t = '(';
202: while ((c=getchr())==' ' || c=='\t');
203: putbak(c);
204: }
205: else {
206: t = ' ';
207: putbak(c);
208: }
209: for (nstr=0; c=getchr(); nstr++) {
210: if (type[c] != LET && type[c] != DIG)
211: break;
212: str[nstr] = c;
213: }
214: putbak(c);
215: str[nstr] = '\0';
216: if (c != ' ' && c != '\t' && c != '\n' && c != ',') {
217: error("illegal define statement");
218: return;
219: }
220: val = nstr+1;
221: if (t == ' ') {
222: while ((c=getchr())==' ' || c=='\t');
223: putbak(c);
224: for (i=val; (c=getchr())!='\n' && c!='#' && c!='\0'; i++)
225: str[i] = c;
226: putbak(c);
227: } else {
228: while ((c=getchr())==' ' || c=='\t' || c==',' || c=='\n');
229: putbak(c);
230: nlp = 0;
231: for (i=val; nlp>=0 && (c=str[i]=getchr()); i++)
232: if (c == '(')
233: nlp++;
234: else if (c == ')')
235: nlp--;
236: i--;
237: }
238: for ( ; i>0; i--)
239: if (str[i-1] != ' ' && str[i-1] != '\t')
240: break;
241: str[i] = '\0';
242: install(str, &str[val], 0);
243: }
244:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.