|
|
1.1 root 1: /* Copyright Bell Telephone Laboratories Whippany, N.J.
2:
3: * /////////////////////////////////////
4: * /////////////////////////////////////
5: * /////////////// if.c ////////////////
6: * /// J. P. Hawkins WH X4610 8C-001 ///
7: * ///// Sun Aug 26 07:52:59 1979 //////
8: * /////////////////////////////////////
9: * /////////////////////////////////////
10:
11: *
12: * BASIC IF routine
13: *
14: * MOD,J.P.Hawkins,2-FEB-81, Added string variable comparison capability.
15: */
16: /* "@(#) if.c: V 1.5 9/9/81" */
17:
18: #include "bas.h"
19: extern int esle,fidne; /* codes for "else" and "endif" */
20: extern char *eoexpr; /* pointer to char after eval expr */
21: /*
22: #define skip00() {while(*eoexpr == ' ' || *eoexpr == '\t') *eoexpr++;}
23: */
24: #define skip00() {} /* skip00 does nothing */
25: extern struct FILTBL filtbl[];
26: __if()
27: {
28: #ifdef STRINGS
29: char strbuf1[80]; /* pointer to string 1 */
30: char strbuf2[80]; /* pointer to string 2 */
31: int typflg; /* 0 if numerical 1 if string */
32: char field[40];
33: #endif
34: int fnum;
35: char *savptr;
36: double evalx();
37: int true; /* set if relation is true */
38: int elsflg; /* set if structured "if" expected */
39: char relate; /* relation code */
40: char ch;
41: double val1,val2;
42:
43: val1 = val2 = 0.0; /* ini comparison values to zero */
44: true = 0; /* preset to false */
45: elsflg = 0; /* preset to non-structured "if" */
46: savptr = expr;
47: if(*savptr == '\17') /* "more"? EOF CHECK */
48: {
49: savptr++;
50: if(*savptr == '_') *savptr++;
51: fnum = *savptr++ - '1';
52: val1 = (double)more(fnum);
53: relate = 6; /* force '<>' relation check */
54: eoexpr = savptr;
55: }
56: else
57: {
58: #ifdef STRINGS
59: if(class(&savptr,field) < STCLASS)
60: {
61: typflg = 0;
62: #endif
63: val1 = evalx(expr); /* get first expression */
64: #ifdef STRINGS
65: }
66: else
67: {
68: typflg = 1;
69: evals(expr,strbuf1);
70: }
71:
72: #endif
73: skip00(); /* skip spaces and tabs */
74: relate = *eoexpr++; /* get relational operator */
75: if(!(relate >= 6 && relate <= 13))
76: {
77: error(inst.thing.linno, 10); /* bad relational */
78: return(-1);
79: }
80: skip00(); /* skip spaces and tabs */
81: #ifdef STRINGS
82: savptr = eoexpr;
83: if(class(&savptr,field) < STCLASS)
84: {
85: if(typflg == 1)
86: {
87: error(inst.thing.linno, 53); /* MIXED TYPES */
88: return(-1);
89: }
90: #endif
91: val2 = evalx(eoexpr); /* get second expression */
92: #ifdef STRINGS
93: }
94: else
95: {
96: if(typflg == 0)
97: {
98: error(inst.thing.linno, 53); /* MIXED TYPES */
99: return(-1);
100: }
101: evals(eoexpr,strbuf2);
102: val1 = (double)strcmp(strbuf1,strbuf2); /* form numerical
103: comarison base */
104: }
105: #endif
106: }
107: skip00(); /* skip spaces and tabs */
108: /*
109: * Check for keyword "goto", "go to" or "then"
110: */
111: ch = *eoexpr;
112: if(ch < '\0' || (ch > '\3') && ch != '\16')
113: {
114: error(inst.thing.linno, 9); /* missing keyword in "if" */
115: return(-1);
116: }
117: *eoexpr++; /* bump past keyword */
118: skip00(); /* skip to line num field */
119: if(*eoexpr == '\0') /* if nothing follows "then" we expect
120: structured "if" */
121: {
122: elsflg = 1;
123: }
124:
125: /*
126: * Perform relational test in accordance
127: * with relate keyword.
128: * Set true to 1 if test passes or 0 if test fails
129: */
130: switch(relate)
131: {
132: case 7:
133: case 8:
134: true = ((val1 <= val2)? 1 : 0);
135: break;
136: case 10:
137: case 11:
138: true = ((val1 >= val2)? 1 : 0);
139: break;
140: case 9:
141: true = ((val1 < val2)? 1 : 0);
142: break;
143: case 12:
144: true = ((val1 > val2)? 1 : 0);
145: break;
146: case 13:
147: true = ((val1 == val2)? 1 : 0);
148: break;
149: case 6:
150: true = ((val1 != val2)? 1 : 0);
151: break;
152: default:
153: /* bad news */
154: break;
155: }
156: if(elsflg == 0) /* IF NORMAL BASIC "if" */
157: {
158: if(true)
159: {
160: expr = eoexpr; /* goto wants to see the line num */
161: if(ch < '\3' || (ch == '\3' && num(*expr)))
162: {
163: if(__goto()<0) /* goto the linnum */
164: return(-1); /* if no error */
165: return(0);
166: }
167: if(ch == '\3')
168: {
169: if(let() < 0) return(-1);
170: return(0);
171: }
172: if(gosub()<0) /* gosub the linnum */
173: return(-1); /* unless error */
174: return(0);
175: }
176: return(0); /* no action taken */
177: }
178: else /* ELSE IF STRUCTURED "if" */
179: {
180: /* EXEC or SKIP until "else" */
181:
182: if(untilcod(esle,true) < 0)
183: return(-1); /* FATAL ERROR RET. FROM BASCALL */
184:
185: /* if endif was encountered with no else,
186: * don't call untilcod again.
187: */
188:
189: if(inst.thing.opcode.lobyte == fidne)
190: return(0);
191: /* EXEC or SKIP until "endif" */
192:
193: return(untilcod(fidne,!(true)));
194: }
195: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.