|
|
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: char *FCN1loc; /* spot for "FUNCTION"; kludge */
41:
42: int svargc;
43: char **svargv;
44: char *curfile[10] = { "" };
45: int infptr = 0;
46: FILE *outfil = { stdout };
47: FILE *infile[10] = { stdin };
48: int linect[10];
49:
50: int contfld = CONTFLD; /* place to put continuation char */
51: int printcom = 0; /* print comments if on */
52: int hollerith = 0; /* convert "..." to 27H... if on */
53: int uppercase = 0; /* produce output in upper case (except for "...") */
54: int f77 = 0; /* output in fortran 77 (if-then-else-endif) */
55:
56: main(argc,argv) int argc; char **argv; {
57: int i;
58: while(argc>1 && argv[1][0]=='-' && (i = argv[1][1]) != '\0') {
59: if (isdigit(i)) {
60: contfld = i - '0';
61: if (argv[1][2]!='\0')
62: contchar = argv[1][2];
63: } else if (i == 'C')
64: printcom++;
65: else if (i == 'h')
66: hollerith++;
67: else if (i == 'u' && (argv[1][2] == 'c' || argv[1][2] == 'C'))
68: uppercase++;
69: else if (strcmp(argv[1], "-f77") == 0)
70: f77 = 1;
71: else if (strcmp(argv[1], "-f66") == 0)
72: f77 = 0;
73: argc--;
74: argv++;
75: }
76:
77:
78: svargc = argc;
79: svargv = argv;
80: if (svargc > 1)
81: putbak('\0');
82: for (i=0; keyword[i]; i++)
83: install(keyword[i], "", keytran[i]);
84: fcnloc = install("function", "", 0);
85: FCN1loc = install("FUNCTION", "", 0);
86: yyparse();
87: exit(errorflag);
88: }
89:
90: cant(s) char *s; {
91: linect[infptr] = 0;
92: curfile[infptr] = s;
93: error("can't open");
94: exit(1);
95: }
96:
97: inclstat() {
98: int c;
99: char *ps;
100: char fname[100];
101: while ((c = getchr()) == ' ' || c == '\t');
102: if (c == '(') {
103: for (ps=fname; (*ps=getchr()) != ')'; ps++);
104: *ps = '\0';
105: } else if (c == '"' || c == '\'') {
106: for (ps=fname; (*ps=getchr()) != c; ps++);
107: *ps = '\0';
108: } else {
109: putbak(c);
110: for (ps=fname; (*ps=getchr()) != ' ' &&*ps!='\t' && *ps!='\n' && *ps!=';'; ps++);
111: *ps = '\0';
112: }
113: if ((infile[++infptr] = fopen(fname,"r")) == NULL) {
114: cant(fname);
115: exit(1);
116: }
117: linect[infptr] = 0;
118: curfile[infptr] = fname;
119: }
120:
121: char str[5000];
122: int nstr;
123:
124: yylex() {
125: int c, t;
126: for (;;) {
127: while ((c=gtok(str))==' ' || c=='\n' || c=='\t')
128: ;
129: yylval = c;
130: if (c==';' || c=='{' || c=='}')
131: return(c);
132: if (c==EOF)
133: return(0);
134: yylval = (int) str;
135: if (c == DIG)
136: return(DIGITS);
137: t = lookup(str)->ydef;
138: if (t==DEFINE)
139: defstat();
140: else if (t==INCLUDE)
141: inclstat();
142: else if (t > 0)
143: return(t);
144: else
145: return(GOK);
146: }
147: }
148:
149: int dbg = 0;
150:
151: yyerror(p) char *p; {;}
152:
153:
154: defstat() {
155: int c,i,val,t,nlp;
156: extern int nstr;
157: extern char str[];
158: while ((c=getchr())==' ' || c=='\t');
159: if (c == '(') {
160: t = '(';
161: while ((c=getchr())==' ' || c=='\t');
162: putbak(c);
163: }
164: else {
165: t = ' ';
166: putbak(c);
167: }
168: for (nstr=0; c=getchr(); nstr++) {
169: if (!isalpha(c) && !isdigit(c))
170: break;
171: str[nstr] = c;
172: }
173: putbak(c);
174: str[nstr] = '\0';
175: if (c != ' ' && c != '\t' && c != '\n' && c != ',') {
176: error("illegal define statement");
177: return;
178: }
179: val = nstr+1;
180: if (t == ' ') {
181: while ((c=getchr())==' ' || c=='\t');
182: putbak(c);
183: for (i=val; (c=getchr())!='\n' && c!='#' && c!='\0'; i++)
184: str[i] = c;
185: putbak(c);
186: } else {
187: while ((c=getchr())==' ' || c=='\t' || c==',' || c=='\n');
188: putbak(c);
189: nlp = 0;
190: for (i=val; nlp>=0 && (c=str[i]=getchr()); i++)
191: if (c == '(')
192: nlp++;
193: else if (c == ')')
194: nlp--;
195: i--;
196: }
197: for ( ; i>0; i--)
198: if (str[i-1] != ' ' && str[i-1] != '\t')
199: break;
200: str[i] = '\0';
201: install(str, &str[val], 0);
202: }
203:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.