![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to procedures.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / new / xns / compiler|
Return to procedures.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / xns / compiler |
1.1 root 1: #ifndef lint
2: static char RCSid[] = "$Header: procedures.c,v 2.2 86/11/11 09:49:06 jqj Exp $";
3: #endif
4:
5: /* $Log: procedures.c,v $
6: * Revision 2.2 86/11/11 09:49:06 jqj
7: * Per Ed Flint, if a Courier procedure returns void, the server should still
8: * do a SendReturnMessage(0,0), so generate the proper code for this case.
9: * Note that this eventually implies (in xnslib/readwrite.c) that a writev()
10: * has an iovec with 0 length, which might tickle a kernel bug in some
11: * implementations.
12: *
13: * Revision 2.1 86/06/06 07:28:49 jqj
14: * many mods for better symbol table management: added CurrentModule,
15: * made check_dependency, make_symbol, check_def set/use/use a symbol
16: * table instead of a module name string, etc. Result is that we can
17: * now handle DEPENDS UPON 2 versions of same program.
18: *
19: * Revision 2.0 85/11/21 07:21:43 jqj
20: * 4.3BSD standard release
21: *
22: * Revision 1.5 85/05/06 08:13:31 jqj
23: * *** empty log message ***
24: *
25: * Revision 1.5 85/05/06 08:13:31 jqj
26: * Almost Beta-test version.
27: *
28: * Revision 1.4 85/03/26 06:10:21 jqj
29: * Revised public alpha-test version, released 26 March 1985
30: *
31: * Revision 1.3 85/03/11 16:39:55 jqj
32: * Public alpha-test version, released 11 March 1985
33: *
34: * Revision 1.2 85/02/21 11:05:39 jqj
35: * alpha test version
36: *
37: * Revision 1.1 85/02/15 13:55:36 jqj
38: * Initial revision
39: *
40: */
41:
42: #define argname(p) ((char *) car(caar(p)))
43: #define argtype(p) ((struct type *) cdar(p))
44:
45: /*
46: * routines for generating procedures and errors
47: */
48:
49: #include "compiler.h"
50:
51: /*
52: * Generate client and server functions for procedure declarations.
53: */
54: define_procedure_constant(symbol,typtr,value)
55: struct object *symbol;
56: struct type *typtr;
57: struct constant *value;
58: {
59: struct type *resulttype;
60: char *procvalue;
61: char * resultname;
62: char buf[MAXSTR];
63: list p, q;
64:
65: if (recursive_flag) /* don't bother to do anything for procs */
66: return; /* in DEPENDS UPON modules */
67: if (typtr->type_constr != C_PROCEDURE)
68: error(FATAL, "internal error (define_procedure): not a procedure");
69: if (value->cn_constr != C_NUMERIC) {
70: error(ERROR,"Values of procedure constants must be numeric");
71: procvalue = "-1";
72: }
73: else
74: procvalue = value->cn_value;
75: /*
76: * RETURNS stuff: coerce the result to be a single record
77: */
78: if (length(typtr->type_results) > 0) {
79: struct object *resultobj;
80:
81: resulttype = record_type(typtr->type_results);
82: sprintf(buf,"%sResults",name_of(symbol));
83: resultname = copy(buf);
84: resultobj = make_symbol(resultname,CurrentModule);
85: define_type(resultobj, resulttype);
86: /* replaces define_record_type(resulttype); */
87: typtr->type_results = cons( cons( cons((list)resultname, NIL),
88: (list)resulttype),
89: NIL);
90: }
91: /*
92: * REPORTS stuff: check here to make sure the errors are all defined
93: */
94: for (p = typtr->type_errors, q = NIL; p != NIL; q = p, p = cdr(p)) {
95: struct object *sym;
96: sym = check_def((char *)car(p),CurrentModule);
97: if (sym == (struct object *)0) {
98: error(ERROR,"Error constant %s not defined",
99: (char*)car(p));
100: if (q == NIL) typtr->type_errors = cdr(p);
101: else cdr(q) = cdr(p);
102: }
103: else if (sym->o_class != O_CONSTANT
104: || sym->o_constant->cn_constr != C_ERROR) {
105: error(ERROR,"Symbol %s is not of appropriate type",
106: name_of(sym));
107: if (q == NIL) typtr->type_errors = cdr(p);
108: else cdr(q) = cdr(p);
109: }
110: }
111: /*
112: * Argument stuff: make sure all the argument types are defined
113: */
114: for (p = typtr->type_args; p != NIL; p = cdr(p)) {
115: if (typename(argtype(p)) == NULL) {
116: struct object *name;
117: name = make_symbol(gensym("T_p"),CurrentModule);
118: define_type(name,argtype(p));
119: }
120: }
121: /*
122: * Actually generate code for this procedure
123: */
124: proc_functions(symbol->o_constant->cn_name, typtr, procvalue);
125: /*
126: * Save this procedure on the global procs for wrapup (server
127: * dispatch code)
128: */
129: Procedures = cons(cons( (list)symbol->o_constant->cn_name,
130: (list)procvalue ),
131: Procedures);
132: }
133:
134:
135: /*
136: * Generate funcions for client and server calls to a procedure.
137: */
138: proc_functions(proc_name, type, proc_number)
139: char *proc_name;
140: struct type *type;
141: char *proc_number;
142: {
143: list p;
144: int nresults, fixed_size, variable_size;
145: struct type *t, *bt, *result_type;
146: char *result_name, *ref, *rtname;
147:
148: /*
149: * Make sure there is at most one result returned.
150: */
151: nresults = length(type->type_results);
152: if (nresults > 1) {
153: error(ERROR, "procedures that return multiple results are not supported");
154: return;
155: }
156: if (nresults) {
157: result_name = "_Results";
158: result_type = argtype(type->type_results);
159: rtname = typename(result_type);
160: } else {
161: rtname = "void";
162: }
163:
164: /*
165: * Server routine.
166: */
167:
168: fprintf(server, "\nextern %s %s();\n", rtname, proc_name);
169: fprintf(server,
170: "\nserver_%s(_buf)\n\
171: \tregister Unspecified *_buf;\n\
172: {\n\
173: \tregister Unspecified *_bp = _buf;\n\
174: \tregister LongCardinal _n;\n",
175: proc_name);
176: for (p = type->type_args; p != NIL; p = cdr(p)) {
177: t = argtype(p);
178: fprintf(server, "\t%s %s;\n", typename(t), argname(p));
179: }
180: if (nresults)
181: fprintf(server, "\t%s %s;\n", rtname, result_name);
182: fprintf(server, "\n");
183: /*
184: * Generate code to internalize the arguments.
185: */
186: for (p = type->type_args; p != NIL; p = cdr(p)) {
187: t = argtype(p);
188: ref = refstr(t);
189: fprintf(server, "\t_bp += %s(%s%s, _bp);\n",
190: xfn(INTERNALIZE, t), ref, argname(p));
191: }
192: /*
193: * Generate code to call the procedure.
194: */
195: if (nresults)
196: fprintf(server, "\t%s = %s(_serverConnection, 0",
197: result_name, proc_name);
198: else
199: fprintf(server, "\t%s(_serverConnection, 0", proc_name);
200: for (p = type->type_args; p != NIL; p = cdr(p)) {
201: fprintf(server, ", %s", argname(p));
202: }
203: fprintf(server, ");\n");
204: /*
205: * Generate code to externalize the result.
206: */
207: if (nresults) {
208: ref = refstr(result_type);
209: fprintf(server,
210: "\t_n = sizeof_%s(%s%s);\n\
211: \t_bp = Allocate(_n);\n\
212: \t%s(%s%s, _bp);\n\
213: \tSendReturnMessage(_n, _bp);\n\
214: \tDeallocate(_bp);\n\
215: }\n",
216: rtname, ref, result_name,
217: xfn(EXTERNALIZE, result_type), ref, result_name);
218: } else
219: fprintf(server,
220: "\tSendReturnMessage( 0, _bp);\n\
221: }\n"
222: );
223:
224: /*
225: * Stub routine for client.
226: */
227:
228: fprintf(header, "\nextern %s %s();\n",
229: rtname, proc_name);
230: fprintf(client,
231: "\n\
232: %s\n\
233: %s(_Connection, _BDTprocptr",
234: rtname, proc_name);
235: for (p = type->type_args; p != NIL; p = cdr(p))
236: fprintf(client, ", %s", argname(p));
237: fprintf(client, ")\n\
238: \tCourierConnection *_Connection;\n\
239: \tint (*_BDTprocptr)();\n\
240: "
241: );
242: for (p = type->type_args; p != NIL; p = cdr(p)) {
243: t = argtype(p);
244: fprintf(client, "\t%s %s;\n", typename(t), argname(p));
245: }
246: fprintf(client, "{\n");
247: if (nresults)
248: fprintf(client, "\t%s %s;\n", rtname, result_name);
249: fprintf(client,
250: "\tregister Unspecified *_buf, *_bp;\n\
251: \tBoolean _errorflag;\n\
252: \tCardinal _errtype;\n"
253: );
254: /*
255: * Determine the size of the arguments.
256: * This is like the code in record_type().
257: */
258: fixed_size = 0;
259: variable_size = 0;
260: for (p = type->type_args; p != NIL; p = cdr(p)) {
261: bt = argtype(p);
262: if (bt->type_xsize == -1) {
263: variable_size = 1;
264: } else {
265: fixed_size += bt->type_xsize;
266: }
267: }
268: if (!variable_size) {
269: /*
270: * The argument list is fixed-size.
271: */
272: fprintf(client,
273: "\n\
274: \t_buf = Allocate(%d);\n",
275: fixed_size);
276: } else {
277: /*
278: * There are some variable-size arguments.
279: */
280: fprintf(client,
281: "\tregister LongCardinal _n = %d;\n\
282: \n",
283: fixed_size);
284: for (p = type->type_args; p != NIL; p = cdr(p)) {
285: t = argtype(p);
286: bt = t;
287: if (bt->type_xsize != -1)
288: continue;
289: ref = refstr(bt);
290: fprintf(client,
291: "\t_n += sizeof_%s(%s%s);\n",
292: typename(t), ref, argname(p));
293: }
294: fprintf(client,
295: "\t_buf = Allocate(_n);\n"
296: );
297: }
298: fprintf(client,
299: "\t_bp = _buf;\n"
300: );
301: /*
302: * Generate code to externalize the arguments.
303: */
304: for (p = type->type_args; p != NIL; p = cdr(p)) {
305: t = argtype(p);
306: ref = refstr(t);
307: fprintf(client, "\t_bp += %s(%s%s, _bp);\n",
308: xfn(EXTERNALIZE, t), ref, argname(p));
309: }
310: if (!variable_size) {
311: fprintf(client,
312: "\tSendCallMessage(_Connection, %d, %d, %s, %d, _buf);\n",
313: CurrentNumber, CurrentVersion,
314: proc_number, fixed_size);
315: } else {
316: fprintf(client,
317: "\tSendCallMessage(_Connection, %d, %d, %s, _n, _buf);\n",
318: CurrentNumber, CurrentVersion,
319: proc_number);
320: }
321: fprintf(client,
322: "\tDeallocate(_buf);\n\
323: \tMaybeCallBDTHandler(_Connection, _BDTprocptr);\n"
324: );
325: /*
326: * Generate code to receive the results and interpret them
327: * as errors
328: */
329: fprintf(client,
330: "\t_bp = ReceiveReturnMessage(_Connection, &_errorflag);\n\
331: \t_buf = _bp;\n\
332: \tif (_errorflag) {\n\
333: \t\t_bp += %s(&_errtype, _bp);\n\
334: \t\tswitch (ERROR_OFFSET+_errtype) {\n",
335: xfn(INTERNALIZE, Cardinal_type)
336: );
337: for (p = type->type_errors; p != NIL; p = cdr(p)) {
338: struct constant *errconst;
339: struct type *errtype;
340: errconst = (check_def((char *)car(p),CurrentModule))->o_constant;
341: errtype = (struct type *) cdr(errconst->cn_list);
342: if (errtype == TNIL)
343: fprintf(client,
344: "\t\tcase %s:\n\
345: \t\t\traise(ERROR_OFFSET+_errtype, 0);\n\
346: \t\t\t/*NOTREACHED*/\n",
347: errconst->cn_name);
348: else
349: fprintf(client,
350: "\t\tcase %s: {\n\
351: \t\t\tstatic %s _result;\n\
352: \t\t\t_bp += %s(%s_result, _bp);\n\
353: \t\t\traise(ERROR_OFFSET+_errtype, (char *) &_result);\n\
354: \t\t\t/*NOTREACHED*/\n\
355: \t\t\t}\n",
356: errconst->cn_name,
357: typename(errtype),
358: xfn(INTERNALIZE, errtype), refstr(errtype)
359: );
360: }
361: fprintf(client,
362: "\t\tdefault:\n\
363: \t\t\t/* don't know how to unpack this */\n\
364: \t\t\traise(ERROR_OFFSET+_errtype, 0);\n\
365: \t\t\t/*NOTREACHED*/\n\
366: \t\t}\n"
367: );
368: /*
369: * Code to unpack results and return
370: */
371: if (nresults)
372: fprintf(client,
373: "\t} else\n\
374: \t\t_bp += %s(%s%s, _bp);\n\
375: \tDeallocate(_buf);\n\
376: \treturn (%s);\n\
377: }\n",
378: xfn(INTERNALIZE, result_type),
379: refstr(result_type), result_name, result_name);
380: else
381: fprintf(client,
382: "\t}\n\
383: \tDeallocate(_buf);\n\
384: }\n");
385: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.