Return to constantcode.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / xns / compiler

Annotation of 43BSD/contrib/xns/compiler/constantcode.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char RCSid[] = "$Header: constantcode.c,v 2.0 85/11/21 07:21:32 jqj Exp $";
        !             3: #endif
        !             4: 
        !             5: /* $Log:       constantcode.c,v $
        !             6:  * Revision 2.0  85/11/21  07:21:32  jqj
        !             7:  * 4.3BSD standard release
        !             8:  * 
        !             9:  * Revision 1.4  85/05/23  06:19:32  jqj
        !            10:  * *** empty log message ***
        !            11:  * 
        !            12:  * Revision 1.4  85/05/23  06:19:32  jqj
        !            13:  * Public Beta-test version, released 24 May 1985
        !            14:  * 
        !            15:  * Revision 1.3  85/03/26  06:09:41  jqj
        !            16:  * Revised public alpha-test version, released 26 March 1985
        !            17:  * 
        !            18:  * Revision 1.2  85/03/11  16:38:56  jqj
        !            19:  * Public alpha-test version, released 11 March 1985
        !            20:  * 
        !            21:  * Revision 1.1  85/02/15  13:55:18  jqj
        !            22:  * Initial revision
        !            23:  * 
        !            24:  */
        !            25: 
        !            26: /*
        !            27:  * Generate code for constant declarations.
        !            28:  */
        !            29: 
        !            30: #include "compiler.h"
        !            31: 
        !            32: /*
        !            33:  * Generate code for constant declarations
        !            34:  */
        !            35: define_constant(name, typtr, value)
        !            36:        struct object *name;
        !            37:        struct type *typtr;
        !            38:        struct constant *value;
        !            39: {
        !            40:        char *fullname;
        !            41: 
        !            42:        name->o_class = O_CONSTANT;
        !            43:        name->o_constant = value;
        !            44:        fullname = make_full_name( name->o_module,
        !            45:                                name->o_modversion, name_of(name));
        !            46:        /*
        !            47:         * Check for simple case of Foo: TypeBaz = Mumble;
        !            48:         * where Mumble is another constant.  In this case,
        !            49:         * just use the existing declaration
        !            50:         */
        !            51:        if (value->cn_name != NULL) {
        !            52:                if (!recursive_flag) {
        !            53:                        fprintf(header,"#define %s %s\n",
        !            54:                                fullname, value->cn_name);
        !            55:                        /* open scope */
        !            56:                        fprintf(header1,"#define %s %s\n",
        !            57:                                name_of(name), value->cn_name);
        !            58:                }
        !            59:                return;
        !            60:        }
        !            61:        /*
        !            62:         * We have to generate some code for this one.  We'll generate
        !            63:         * the declaration in the header file of a static variable
        !            64:         * initialized to the appropriate values.
        !            65:         */
        !            66:        value->cn_name = fullname;
        !            67:        if (recursive_flag)
        !            68:                return;         /* it's already been expanded elsewhere */
        !            69:        /* open scope */
        !            70:        fprintf(header1,"#define %s %s\n", name_of(name), fullname);
        !            71:        /* make sure the type is defined */
        !            72:        if (typename(typtr) == NULL) {
        !            73:                /* create an anonymous (not in symboltable) type and subtypes */
        !            74:                char * typenam;
        !            75:                typenam = gensym("T_cn");
        !            76:                code_type(typenam, typtr);
        !            77:                typename(typtr) = typenam;
        !            78:                }
        !            79:        /* depending on the type, generate appropriate initializer */
        !            80:        switch (typtr->type_constr) {
        !            81:        case C_PROCEDURE:
        !            82:                define_procedure_constant(name, typtr, value);
        !            83:                break;
        !            84:        case C_ERROR:
        !            85:                define_error_constant(name, typtr, value);
        !            86:                break;
        !            87:        case C_NUMERIC:
        !            88:        case C_BOOLEAN:
        !            89:        case C_STRING:
        !            90:        case C_ENUMERATION:
        !            91:                /* these are simple, since they can't include sequences */
        !            92:                fprintf(header, "\nstatic %s %s = {%s};\n",
        !            93:                        typename(typtr), value->cn_name, value->cn_value);
        !            94:                break;
        !            95:        default:
        !            96:                /* the general case */
        !            97:                scan_for_sequences(typtr, value);       /* kludge */
        !            98:                fprintf(header, "\nstatic %s %s = ",
        !            99:                                typename(typtr), value->cn_name);
        !           100:                code_constant(typtr, value);
        !           101:                fprintf(header,";\n");
        !           102:                break;
        !           103:        }
        !           104:        return;
        !           105: }
        !           106: 
        !           107: 
        !           108: /*
        !           109:  * Generate client and server code for error constants
        !           110:  */
        !           111: define_error_constant(symbol,typtr,value)
        !           112:        struct object *symbol;
        !           113:        struct type *typtr;
        !           114:        struct constant *value;
        !           115: {
        !           116:        char *errvalue;
        !           117: 
        !           118:        if (recursive_flag)
        !           119:                return;         /* can't happen */
        !           120:        if (typtr->type_constr != C_ERROR)
        !           121:                error(FATAL, "internal error (define_error_constant): not an error");
        !           122:        if (value->cn_constr != C_NUMERIC) {
        !           123:                error(ERROR,"Values of ERRORs must be numeric");
        !           124:                errvalue = "-1";
        !           125:        }
        !           126:        else
        !           127:                errvalue = value->cn_value;
        !           128:        fprintf(header,"\n#define %s (ERROR_OFFSET+%s)\n\
        !           129: #define %sArgs %s\n",
        !           130:                        value->cn_name, errvalue,
        !           131:                        value->cn_name, typename(typtr));
        !           132:        fprintf(header1,"#define %sArgs %sArgs\n",
        !           133:                        symbol->o_name, value->cn_name);
        !           134:        value->cn_constr = C_ERROR;
        !           135:        /* put this error in the constant's data structure */
        !           136:        /* also store this error on the global list */
        !           137:        if (typtr->type_list == NIL) {
        !           138:                value->cn_list = cons((list) errvalue, NIL);
        !           139:                Errors = cons( cons((list) value, NIL), Errors);
        !           140:        }
        !           141:        else {
        !           142:                value->cn_list = cons((list) errvalue, (list) typtr);
        !           143:                Errors = cons( cons((list) value, (list) typtr), Errors);
        !           144:        }
        !           145: }
        !           146: 
        !           147: /*
        !           148:  * recursively generate the code for a constant
        !           149:  */
        !           150: code_constant(typtr, value)
        !           151:        struct type *typtr;
        !           152:        struct constant *value;
        !           153: {
        !           154:        switch (typtr->type_constr) {
        !           155:        case C_NUMERIC:
        !           156:        case C_BOOLEAN:
        !           157:        case C_STRING:
        !           158:        case C_ENUMERATION:
        !           159:                if (value == (struct constant*) 0)
        !           160:                  fprintf(header, "0");
        !           161:                else
        !           162:                  fprintf(header, "%s", value->cn_value);
        !           163:                break;
        !           164:        case C_ARRAY:
        !           165:                code_array_constant(typtr,value);
        !           166:                break;
        !           167:        case C_SEQUENCE:
        !           168:                code_sequence_constant(typtr,value);
        !           169:                break;
        !           170:        case C_RECORD:
        !           171:                code_record_constant(typtr,value);
        !           172:                break;
        !           173:        case C_CHOICE:
        !           174:                code_choice_constant(typtr,value);
        !           175:                break;
        !           176:        case C_ERROR:
        !           177:                error(ERROR,"Error constants may not be part of a structure");
        !           178:                break;
        !           179:        case C_PROCEDURE:
        !           180:                error(ERROR,"Procedures may not be part of a structure");
        !           181:        }
        !           182: }
        !           183: 
        !           184: /*
        !           185:  * Given the name of a record field and a record constant, return
        !           186:  * the corresponding component of the record constant.
        !           187:  */
        !           188: static struct constant *
        !           189: findcomponent(name,recvalue)
        !           190:        char *name;
        !           191:        struct constant *recvalue;
        !           192: {
        !           193:        list p;
        !           194: 
        !           195:        if (recvalue->cn_constr != C_RECORD)
        !           196:                error(FATAL,"internal error (findcomponent): constant is of type %d",
        !           197:                        recvalue->cn_constr);
        !           198:        for (p = recvalue->cn_list; p != NIL; p = cdr(p))
        !           199:                if (streq((char *) caar(p), name))
        !           200:                        return((struct constant *) cdar(p));
        !           201:        return((struct constant *) 0);
        !           202: }
        !           203: 
        !           204: 
        !           205: /*
        !           206:  * kludge since PCC doesn't like initializations of the form
        !           207:  *   struct {int length; Seqtype *sequence} seq = {3,{1,2,3}};
        !           208:  * instead, use:
        !           209:  *   Seqtype anonymous[3] = {1,2,3};
        !           210:  *   struct {int length; Seqtype *sequence} seq = {3,anonymous};
        !           211:  * We have to generate the sequence value before we walk the constant.
        !           212:  */
        !           213: scan_for_sequences(typtr, value)
        !           214:        struct type *typtr;
        !           215:        struct constant *value;
        !           216: {
        !           217:        list p;
        !           218: 
        !           219:        switch (typtr->type_constr) {
        !           220:        case C_ARRAY:
        !           221:                for (p = value->cn_list; p != NIL; p = cdr(p))
        !           222:                        scan_for_sequences(typtr->type_basetype, 
        !           223:                                           (struct constant *) car(p));
        !           224:                break;
        !           225:        case C_RECORD:
        !           226:                scan_record_for_sequences(typtr, value);
        !           227:                break;
        !           228:        case C_CHOICE:
        !           229:                scan_choice_for_sequences(typtr, value);
        !           230:                break;
        !           231:        case C_SEQUENCE:
        !           232:                for (p = value->cn_list; p != NIL; p = cdr(p))
        !           233:                        scan_for_sequences(typtr->type_basetype, 
        !           234:                                           (struct constant *) car(p));
        !           235:                value->cn_seqvalname = gensym("S_v");
        !           236:                fprintf(header,"\nstatic %s %s[%d] = {\n\t",
        !           237:                        typename(typtr->type_basetype), value->cn_seqvalname,
        !           238:                        length(value->cn_list));
        !           239:                for (p = value->cn_list ; p != NIL ; p = cdr(p)) {
        !           240:                        code_constant(typtr->type_basetype,
        !           241:                                      (struct constant *) car(p));
        !           242:                        if (cdr(p) != NIL)
        !           243:                                fprintf(header,",\n\t");
        !           244:                }
        !           245:                fprintf(header,"\n};\n");
        !           246:                break;
        !           247:        default:        /* other types don't have embedded sequences */
        !           248:                break;
        !           249:        }
        !           250: }
        !           251: 
        !           252: scan_record_for_sequences(typtr, value)
        !           253:        struct type *typtr;
        !           254:        struct constant *value;
        !           255: {
        !           256:        list p, q;
        !           257:        struct constant *component;
        !           258: 
        !           259:        for (p = typtr->type_list; p != NIL; p = cdr(p)) {
        !           260:                q = car(p);
        !           261:                component = findcomponent((char *) caar(q),value);
        !           262:                if (component != (struct constant *) 0)
        !           263:                        scan_for_sequences((struct type *) cdr(q), component);
        !           264:        }
        !           265: }
        !           266: 
        !           267: /*ARGSUSED*/
        !           268: scan_choice_for_sequences(typtr, value)
        !           269:        struct type *typtr;
        !           270:        struct constant *value;
        !           271: {
        !           272:        /* constants of type CHOICE are not implemented */
        !           273: }
        !           274: 
        !           275: 
        !           276: code_array_constant(typtr, value)
        !           277:        struct type *typtr;
        !           278:        struct constant *value;
        !           279: {
        !           280:        list p;
        !           281:        int i;
        !           282: 
        !           283:        if (value == (struct constant *) 0) {
        !           284:                fprintf(header,"{0");
        !           285:                for (i = 1; i < typtr->type_size; i++)
        !           286:                  fprintf(header,",0");
        !           287:                fprintf(header,"}");
        !           288:                return;
        !           289:        }
        !           290:        if (typtr->type_size != length(value->cn_list))
        !           291:                error(WARNING,"wrong number of constant elements specified for array");
        !           292:        fprintf(header,"\n\t{");
        !           293:        for (p = value->cn_list; p != NIL; p = cdr(p)) {
        !           294:                code_constant(typtr->type_basetype,(struct constant *) car(p));
        !           295:                if (cdr(p) != NIL)
        !           296:                        fprintf(header,",");
        !           297:        }
        !           298:        fprintf(header,"}");
        !           299: }
        !           300: 
        !           301: code_choice_constant(typtr, value)
        !           302:        struct type *typtr;
        !           303:        struct constant *value;
        !           304: {
        !           305:        list p,q;
        !           306:        struct type *bt;
        !           307:        char *desigval;
        !           308:        struct object *name;
        !           309: 
        !           310:        if (value == (struct constant *)0)
        !           311:          desigval = "?";       /* caar(typtr->type_designator->type_list); */
        !           312:        else
        !           313:          desigval = (char *) car(value->cn_list);
        !           314:        fprintf(header,"\n\t{ %s", desigval);
        !           315:        /* find the corresponding arm of the choice */
        !           316:        bt = TNIL;
        !           317:        for (p = typtr->type_candidates; bt==TNIL && p!=NIL; p = cdr(p)) {
        !           318:                for (q = caar(p); bt==TNIL && q!=NIL; q = cdr(q)) {
        !           319:                        name = (struct object *) caar(q);
        !           320:                        if (streq(name->o_enum->en_name,desigval))
        !           321:                                bt = (struct type *) cdar(p);
        !           322:                }
        !           323:        }
        !           324:        if (bt == TNIL)
        !           325:                error(WARNING,"CHOICE designator %s is invalid here",desigval);
        !           326:        else if (bt != NilRecord_type)
        !           327:                error(WARNING,"Constants of type CHOICE are not supported");
        !           328: 
        !           329:        fprintf(header,"\n\t}");
        !           330: }
        !           331: 
        !           332: code_sequence_constant(typtr, value)
        !           333:        struct type *typtr;
        !           334:        struct constant *value;
        !           335: {
        !           336:        list p;
        !           337:        int l;
        !           338: 
        !           339:        if (value == (struct constant *)0 ||
        !           340:            (p = value->cn_list) == NIL) {
        !           341:                fprintf(header,"{0, 0}");
        !           342:                return;
        !           343:        }
        !           344:        l = length(p);
        !           345:        if (typtr->type_size < l)
        !           346:                error(WARNING,"too many constant elements specified for sequence");
        !           347:        fprintf(header,"{%d, %s}",l,value->cn_seqvalname);
        !           348: }
        !           349: 
        !           350: code_record_constant(typtr, value)
        !           351:        struct type *typtr;
        !           352:        struct constant *value;
        !           353: {
        !           354:        list p, q;
        !           355:        struct constant *component;
        !           356: 
        !           357:        fprintf(header,"{");
        !           358:        for (p = typtr->type_list; p != NIL; p = cdr(p)) {
        !           359:                q = car(p);
        !           360:                if (value == (struct constant *) 0)
        !           361:                  component = value;
        !           362:                else
        !           363:                  component = findcomponent((char *) caar(q), value);
        !           364:                code_constant((struct type *) cdr(q), component);
        !           365:                if (cdr(p) != NIL)
        !           366:                        fprintf(header,",");
        !           367:        }
        !           368:        fprintf(header,"\n\t}");
        !           369: }
        !           370: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.