4.3BSD - /usr/src/new/courier/compiler/code1.c

   1: #ifndef lint
   2: static char sccsid[] = "@(#)code1.c	4.2 (Berkeley) 9/27/83";
   3: #endif
   4: 
   5: #include "Courier.h"
   6: 
   7: char *program_name = "Unknown";
   8: int print_level;        /* for pretty-printing C code */
   9: 
  10: /*
  11:  * Return a printable representation of an object (number or string).
  12:  */
  13: char *
  14: obj_rep(o)
  15:     struct object *o;
  16: {
  17:     static char rep[MAXSTR];
  18: 
  19:     switch (class_of(o)) {
  20:     case O_CONSTANT:
  21:         sprintf(rep, "%d", o->o_value);
  22:         return (rep);
  23:     case O_SYMBOL:
  24:         return(o->o_name);
  25:     default:
  26:         yyerror("Internal error in obj_rep: bad object class");
  27:         exit(1);
  28:         /* NOTREACHED */
  29:     }
  30: }
  31: 
  32: program_header(symbol)
  33:     struct object *symbol;
  34: {
  35:     program_name = symbol->o_name;
  36:     fprintf(hf,
  37: "/*\n\
  38:  * Declarations for Courier program %s.\n\
  39:  */\n\
  40: #include <courier.h>\n",
  41:         program_name);
  42: 
  43:     fprintf(cf1,
  44: "/*\n\
  45:  * Routines for Courier program %s.\n\
  46:  */\n\
  47: #include \"%s.h\"\n",
  48:         program_name, program_name);
  49: 
  50:     fprintf(uf,
  51: "/*\n\
  52:  * User access to Courier program %s.\n\
  53:  */\n\
  54: #include \"%s_stubs.c\"\n",
  55:         program_name, program_name);
  56: 
  57:     fprintf(sf,
  58: "/*\n\
  59:  * Server for Courier program %s.\n\
  60:  */\n\
  61: #include \"%s_stubs.c\"\n",
  62:         program_name, program_name);
  63: 
  64:     if (! explicit)
  65:         generate_binding_functions();
  66: }
  67: 
  68: char *
  69: pack_function(type)
  70:     struct object *type;
  71: {
  72:     static char buf[MAXSTR];
  73: 
  74:     if (class_of(type) == O_TYPE)
  75:         return (type->t_pfname);
  76:     sprintf(buf, "Pack%s", type->o_name);
  77:     return (buf);
  78: }
  79: 
  80: char *
  81: unpack_function(type)
  82:     struct object *type;
  83: {
  84:     static char buf[MAXSTR];
  85: 
  86:     if (class_of(type) == O_TYPE)
  87:         return (type->t_ufname);
  88:     sprintf(buf, "Unpack%s", type->o_name);
  89:     return (buf);
  90: }
  91: 
  92: /*
  93:  * Generate definitions for types.
  94:  */
  95: compile_type(symbol, type)
  96:     struct object *symbol, *type;
  97: {
  98:     char *name;
  99: 
 100:     if (type->t_constr == C_PROCEDURE || type->t_constr == C_ERROR)
 101:         return;
 102:     name = symbol->o_name;
 103:     fprintf(hf, "\ntypedef ");
 104:     print_decl(hf, name, type, 0);
 105:     fprintf(cf1, "\n#define Pack%s %s\n#define Unpack%s %s\n",
 106:         name, pack_function(type), name, unpack_function(type));
 107:     declare(&Values, symbol, type);
 108: }
 109: 
 110: /*
 111:  * Generate definitions corresponding to constant declarations.
 112:  */
 113: compile_def(name, type, value)
 114:     struct object *name, *type, *value;
 115: {
 116:     struct object *t;
 117: 
 118:     t = basetype(type);
 119:     if (t->t_constr == C_PROCEDURE)
 120:         proc_functions(name->o_name, t, value);
 121:     else
 122:         fprintf(hf, "\n#define %s %s\n", name->o_name, obj_rep(value));
 123:     declare(&Values, name, value);
 124:     declare(&Types, name, type);
 125: }
 126: 
 127: /*
 128:  * Print a C type declaration for a Courier type.
 129:  *
 130:  * If the nonewline flag is on, don't follow the declaration
 131:  * by ";\n" (used for declaring the return value of a function.)
 132:  */
 133: print_decl(f, name, type, nonewline)
 134:     FILE *f;
 135:     char *name;
 136:     struct object *type;
 137:     int nonewline;
 138: {
 139:     list p, q;
 140:     struct object *t;
 141:     char *member;
 142:     char newname[MAXSTR];
 143: 
 144:     if (class_of(type) == O_SYMBOL) {
 145:         tab(f); fprintf(f, "%s %s", type->o_name, name);
 146:         goto ret;
 147:     }
 148:     if (class_of(type) != O_TYPE) {
 149:         yyerror("Internal error in print_decl: bad object class for %s",
 150:             name);
 151:         exit(1);
 152:     }
 153:     switch (type->t_constr) {
 154: 
 155:     case C_ENUMERATION:
 156:         tab(f); fprintf(f, "enum {\n");
 157:         print_level++;
 158:         for (p = type->t_list; p != NIL; p = cdr(p)) {
 159:             q = car(p);
 160:             member = name_of(car(q));
 161:             tab(f); fprintf(f, "%s = %s", member, obj_rep(cdr(q)));
 162:             if (cdr(p) != NIL)
 163:                 fprintf(f, ",\n");
 164:             else
 165:                 fprintf(f, "\n");
 166:         }
 167:         print_level--;
 168:         tab(f); fprintf(f, "} %s", name);
 169:         goto ret;
 170: 
 171:     case C_ARRAY:
 172:         sprintf(newname, "%s[%s]", name, obj_rep(type->t_size));
 173:         print_decl(f, newname, type->t_basetype, nonewline);
 174:         return;
 175: 
 176:     case C_SEQUENCE:
 177:         tab(f); fprintf(f, "struct {\n");
 178:         print_level++;
 179:         print_decl(f, "length", Cardinal_type, 0);
 180:         print_decl(f, "*sequence", type->t_basetype, 0);
 181:         print_level--;
 182:         tab(f); fprintf(f, "} %s", name);
 183:         goto ret;
 184: 
 185:     case C_RECORD:
 186:         if (type->t_list == NIL) {
 187:             /* C complains about this, but accepts it */
 188:             tab(f); fprintf(f, "int %s[0]", name);
 189:             goto ret;
 190:         }
 191:         tab(f); fprintf(f, "struct {\n");
 192:         print_level++;
 193:         for (p = type->t_list; p != NIL; p = cdr(p)) {
 194:             t = (struct object *) cdr(car(p));
 195:             for (q = car(car(p)); q != NIL; q = cdr(q))
 196:                 print_decl(f, name_of(car(q)), t, 0);
 197:         }
 198:         print_level--;
 199:         tab(f); fprintf(f, "} %s", name);
 200:         goto ret;
 201: 
 202:     case C_CHOICE:
 203:         tab(f); fprintf(f, "struct {\n");
 204:         print_level++;
 205:         print_decl(f, "designator", type->t_designator, 0);
 206:         tab(f); fprintf(f, "union {\n");
 207:         print_level++;
 208:         for (p = type->t_candidates; p != NIL; p = cdr(p)) {
 209:             t = (struct object *) cdr(car(p));
 210:             for (q = car(car(p)); q != NIL; q = cdr(q)) {
 211:                 member = name_of(car(car(q)));
 212:                 sprintf(newname, "u_%s", member);
 213:                 print_decl(f, newname, t, 0);
 214:                 fprintf(f, "#define %s_case u.u_%s\n",
 215:                     member, member);
 216:             }
 217:         }
 218:         print_level--;
 219:         tab(f); fprintf(f, "} u;\n");
 220:         print_level--;
 221:         tab(f); fprintf(f, "} %s", name);
 222:         goto ret;
 223: 
 224:     default:
 225:         yyerror("Internal error in print_decl: bad type constructor for %s",
 226:             name);
 227:         exit(1);
 228:     }
 229: ret:
 230:     if (! nonewline)
 231:         fprintf(f, ";\n");
 232: }
 233: 
 234: char *
 235: gensym(prefix)
 236:     char *prefix;
 237: {
 238:     static int n = 0;
 239:     char buf[MAXSTR];
 240: 
 241:     sprintf(buf, "%s%d", prefix, n);
 242:     n++;
 243:     return (copy(buf));
 244: }
 245: 
 246: /*
 247:  * Generate C functions to pack and unpack a Courier type.
 248:  * Put their names in the type structure.
 249:  */
 250: type_functions(type)
 251:     struct object *type;
 252: {
 253:     list p, q;
 254:     struct object *t;
 255:     char *pname, *uname, *format, *ref, *member, *value;
 256: 
 257:     if (class_of(type) != O_TYPE || type->t_constr == C_PREDEF)
 258:         return;
 259:     if (type->t_constr != C_ENUMERATION) {
 260:         type->t_pfname = pname = gensym("Pack");
 261:         type->t_ufname = uname = gensym("Unpack");
 262:     }
 263: 
 264:     switch (type->t_constr) {
 265: 
 266:     case C_ENUMERATION:
 267:         type->t_pfname = "PackCardinal";
 268:         type->t_ufname = "UnpackCardinal";
 269:         return;
 270: 
 271:     case C_ARRAY:
 272:         function_heading(cf1, pname, type->t_basetype, 1);
 273:         function_heading(cf2, uname, type->t_basetype, 0);
 274:         format =
 275: "{\n\
 276: \tregister Unspecified *bp;\n\
 277: \tregister Cardinal i;\n\
 278: \n\
 279: \tbp = buf;\n\
 280: \tfor (i = 0; i < %s; i++)\n\
 281: \t\tbp += %s(%sp[i], bp%s);\n";
 282: 
 283:         ref = refstr(type->t_basetype);
 284:         fprintf(cf1, format, obj_rep(type->t_size),
 285:             pack_function(type->t_basetype), ref, ", flag");
 286:         fprintf(cf2, format, obj_rep(type->t_size),
 287:             unpack_function(type->t_basetype), ref, "");
 288:         break;
 289: 
 290:     case C_SEQUENCE:
 291:         function_heading(cf1, pname, type, 1);
 292:         function_heading(cf2, uname, type, 0);
 293:         format =
 294: "{\n\
 295: \tregister Unspecified *bp;\n\
 296: \tregister Cardinal i;\n\
 297: \n\
 298: \tbp = buf;\n\
 299: \tbp += %sCardinal(&p->length, bp%s);\n";
 300: 
 301:         fprintf(cf1, format, "Pack", ", flag");
 302:         fprintf(cf2, format, "Unpack", "");
 303: 
 304:         /*
 305: 		 * The unpack function needs to dynamically
 306: 		 * allocate space for the sequence elements.
 307: 		 */
 308:         fprintf(cf2, "\tp->sequence = (");
 309:         print_decl(cf2, "*", type->t_basetype);
 310:         fprintf(cf2, ")\n\t\tAllocate(p->length * sizeof(");
 311:         print_decl(cf2, "", type->t_basetype);
 312:         fprintf(cf2, ")/sizeof(Unspecified));\n");
 313: 
 314:         format =
 315: "\tfor (i = 0; i < p->length; i++)\n\
 316: \t\tbp += %s(%sp->sequence[i], bp%s);\n";
 317: 
 318:         ref = refstr(type->t_basetype);
 319:         fprintf(cf1, format, pack_function(type->t_basetype),
 320:             ref, ", flag");
 321:         fprintf(cf2, format, unpack_function(type->t_basetype),
 322:             ref, "");
 323:         break;
 324: 
 325:     case C_RECORD:
 326:         function_heading(cf1, pname, type, 1);
 327:         function_heading(cf2, uname, type, 0);
 328:         format =
 329: "{\n\
 330: \tregister Unspecified *bp;\n\
 331: \n\
 332: \tbp = buf;\n";
 333:         fprintf(cf1, format);
 334:         fprintf(cf2, format);
 335: 
 336:         format = "\tbp += %s(%sp->%s, bp%s);\n";
 337:         for (p = type->t_list; p != NIL; p = cdr(p)) {
 338:             t = (struct object *) cdr(car(p));
 339:             ref = refstr(t);
 340:             for (q = car(car(p)); q != NIL; q = cdr(q)) {
 341:                 member = name_of(car(q));
 342:                 fprintf(cf1, format, pack_function(t),
 343:                     ref, member, ", flag");
 344:                 fprintf(cf2, format, unpack_function(t),
 345:                     ref, member, "");
 346:             }
 347:         }
 348:         break;
 349: 
 350:     case C_CHOICE:
 351:         function_heading(cf1, pname, type, 1);
 352:         function_heading(cf2, uname, type, 0);
 353:         format =
 354: "{\n\
 355: \tregister Unspecified *bp;\n\
 356: \n\
 357: \tbp = buf;\n\
 358: \tbp += %sCardinal(&p->designator, bp%s);\n\
 359: \tswitch (p->designator) {\n";
 360:         fprintf(cf1, format, "Pack", ", flag");
 361:         fprintf(cf2, format, "Unpack", "");
 362: 
 363:         format =
 364: "\tcase %s:\n\
 365: \t\tbp += %s(%sp->%s_case, bp%s);\n\
 366: \t\tbreak;\n";
 367:         for (p = type->t_candidates; p != NIL; p = cdr(p)) {
 368:             t = (struct object *) cdr(car(p));
 369:             ref = refstr(t);
 370:             for (q = car(car(p)); q != NIL; q = cdr(q)) {
 371:                 member = name_of(car(car(q)));
 372:                 fprintf(cf1, format, member, pack_function(t),
 373:                     ref, member, ", flag");
 374:                 fprintf(cf2, format, member, unpack_function(t),
 375:                     ref, member, "");
 376:             }
 377:         }
 378:         fprintf(cf1, "\t}\n");
 379:         fprintf(cf2, "\t}\n");
 380:         break;
 381: 
 382:     case C_PROCEDURE:
 383:     case C_ERROR:
 384:         return;
 385: 
 386:     default:
 387:         yyerror("Internal error in type_functions: bad type constructor");
 388:         exit(1);
 389:     }
 390: 
 391:     format =
 392: "\treturn (bp - buf);\n\
 393: }\n";
 394:     fprintf(cf1, format);
 395:     fprintf(cf2, format);
 396: }
 397: 
 398: /*
 399:  * Print the heading for a type packing or unpacking function.
 400:  */
 401: function_heading(f, name, type, flag)
 402:     FILE *f;
 403:     char *name;
 404:     struct object *type;
 405:     int flag;
 406: {
 407:     fprintf(f, "\nstatic %s(p, buf%s)\n", name, flag ? ", flag" : "");
 408:     print_level++; print_decl(f, "*p", type, 0); print_level--;
 409:     fprintf(f, "\tregister Unspecified *buf;\n%s",
 410:         flag ? "\tBoolean flag;\n" : "");
 411: }
 412: 
 413: tab(f)
 414:     FILE *f;
 415: {
 416:     int n;
 417: 
 418:     for (n = print_level; n > 0; n--)
 419:         putc('\t', f);
 420: }

Defined functions

Defined variables