|
|
1.1 root 1: /* Copyright Bell Telephone Laboratories Whippany, N.J.
2:
3: * /////////////////////////////////////
4: * /////////////////////////////////////
5: * /////////////// evals ///////////////
6: * /// J. P. Hawkins WH X4610 8C-001 ///
7: * ///// Mon Feb 2 07:33:54 1981 //////
8: * /////////////////////////////////////
9: * /////////////////////////////////////
10: * @(#) evals.c: V1.7 3/5/81
11:
12: * This is the string expression "evaluator". It's purpose is to
13: * concatinate combinations of literals and expanded string variables
14: * as they are fetched from memory. The only legal operation is '+'
15: *
16: * MOD,J.P.Hawkins,17-FEB-81 added string function handling
17: * MOD,J.P.Hawkins,28-FEB-81 added string array handling
18: */
19:
20: #include "bas.h"
21: extern int stpflg;
22: extern char *eoexpr;
23: evals(exps,result)
24: char exps[];
25: char *result;
26: {
27: int type; /* field classification */
28: char *objadr; /* string object pointer */
29: char cat[512]; /* concatination buffer */
30: char *expptr; /* expression string pointer */
31: char field[80];
32:
33: expptr = exps;
34: cat[0] = '\0'; /* initialize buffer */
35: /*
36: *
37: * The only ways out of this loop are string terminator or
38: * expression terminator (null char)
39: * the codes 1 through 37(8) represent encoded keywords (defined in bed.c)
40: * those being:
41: * goto,go to,then,to,step,<=,=<,<,>=,=>,>, =, or <>
42: *
43: * This "while" loop is
44: * not indented so "all this stuff" fits across standard page
45: */
46: while(!(*expptr >= '\0' && *expptr <= '\37'))
47: {
48: if((type=class(&expptr,field)) < 0) /* get field and type */
49: {
50: error(inst.thing.linno, 8); /* EXPR SYNTAX */
51: error(inst.thing.linno, 15); /* FATAL ERROR */
52: stpflg = 1;
53: result[0] = '\0'; /* leave null string */
54: return(0);/* return zero on error */
55: }
56:
57: switch(type)
58: {
59: case SVCLASS:
60: sgetvar(field,&objadr); /* expand variable into
61: object pointer */
62: strcat(cat,objadr);
63: break;
64: case STCLASS:
65: strcat(cat,field); /* copy literal into
66: object pointer */
67: break;
68: case SFCLASS: /* STRING FUNCTION */
69: strcall(field,&objadr);
70: strcat(cat,objadr);
71: break;
72: case SACLASS: /* STRING ARRAY CLASS */
73: sagetvar(field,&objadr); /* expand variable into
74: object pointer */
75: strcat(cat,objadr);
76: break;
77: case VRCLASS: /* VARIABLE CLASS */
78: case VACLASS: /* SUBSCRIPTED VARIABLE */
79: case NMCLASS: /* NUMERIC FIELD */
80: case FNCLASS: /* FUNCTION REFERENCE */
81: error(inst.thing.linno, 51); /* NUM in ST. */
82: stpflg = 1;
83: return(0);
84: break;
85: case OPCLASS: /* OPERATOR */
86: switch(*field) {
87: case '+':
88: case ')':
89: break;
90: default:
91: error2(inst.thing.linno, 52, ' ');
92: printf("- '%c'\n",*field);
93: break;
94: }
95: break;
96: default:
97: printf("WHAT HAPPENED? TYPE = %d\n", type);
98: break;
99: }
100: } /* END OF WHILE LOOP */
101: eoexpr = expptr;
102: strcpy(result,cat); /* put string in output */
103: return 0;
104: }
105: /*
106: *
107: * ////// CALL STRING FUNCTION ////////
108: *
109: *
110: *
111: * calling format:
112: * value = strcall(strexp,&result);
113: *
114: * where: strexp = string expression
115: * result = pointer to a expanded null terminated string
116: */
117:
118: /*
119: *
120: * //////// BASIC INTERPRETER STRING FUNCTION TABLE ////////
121: *
122: */
123: char *chr(); /* convert integer to ascii char */
124: char *left(); /* left$(string,n) return first n chars of string */
125: char *ext(); /* ext$(string,p,n) ret substr. of string start at p length n */
126: char *right(); /* right$(string,n) ret last n chars of string */
127: char *str(); /* str$(expr) converts numeric expression to string */
128: char *string(); /* string$(n,char) repeats char n times */
129: char *loc(); /* loc$(str) change upper case to lower case chars */
130: char *upc(); /* upc$(str) change lower case to upper case chars */
131:
132:
133: /*
134: *
135: * This is the BASIC interpreter string function
136: * dispatch table.
137: *
138: */
139:
140: /*
141: * each entry contains the text for the STRING FUNCTION
142: * in question and the address of the routine which services it
143: */
144: struct tbl
145: {
146: char *cmdtxt;
147: char *(*func)();
148: };
149: struct tbl sfuntbl[] = {
150: {"chr", chr},
151: {"left", left},
152: {"ext", ext}, /* GE MNEMONIC */
153: {"mid", ext}, /* For TRS-80 FANS */
154: {"right", right},
155: {"str", str},
156: {"string", string},
157: {"upc", upc},
158: {"loc", loc},
159: {0, 0}
160: };
161: /*
162: *
163: */
164: strcall(strexp,result)
165: char strexp[];
166: char **result;
167: {
168: char resbuf[132]; /* result buffer */
169: char funnam[20]; /* func name copied from 's'
170: used for string search */
171: register char *x; /* pointer to paren enclosed expression */
172: register int i; /* index reg. for expediency */
173: x = strexp; /* set pointer to func string */
174: /*
175: * copy the func name part up to the '$'
176: * to use for a string search in the table of names
177: */
178: for(i=0; *x != '$' ;)
179: {
180: funnam[i++] = *x++;
181: }
182: *x++; /* skip ( */
183: funnam[i] = '\0'; /* null terminate */
184: /*
185: * compare each string in table with funnam
186: * when match is found, call using offset code
187: * if end-of-table (null) encountered return 0
188: */
189: for(i=0; sfuntbl[i].cmdtxt != 0 ; i++)
190: {
191: if(!(strcmp(funnam, sfuntbl[i].cmdtxt)))
192: {
193: x++;
194: strcpy(resbuf,(*sfuntbl[i].func)(x));
195: *result = resbuf;
196: return(0);
197: }
198: }
199: error(inst.thing.linno, 54); /* unknown string function */
200: return(0); /* oops not in this table, pal */
201: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.