Return to mwm.changes CVS log

Up to [Research Unix] / researchv10no / cmd / f2c

Annotation of researchv10no/cmd/f2c/mwm.changes, revision 1.1

1.1     ! root        1: #From arpa!NSFnet-Relay.AC.UK!NAGIST%vax.oxford.ac.uk Fri Jun 30 13:02 BST 1989
        !             2: #Received: from vax.oxford.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
        !             3: #           id aa05326; 30 Jun 89 12:59 BST
        !             4: #Date:           Fri, 30 Jun 89  13:02 BST
        !             5: #From:           NAG Software Engineering Group <NAGIST%[email protected]>
        !             6: #To:             DMG <@NSFnet-Relay.AC.UK:[email protected]>
        !             7: #Subject:        
        !             8: #
        !             9: #!/bin/sh
        !            10: # to extract, remove the header and type "sh filename"
        !            11: if `test ! -s ./data.c.ed`
        !            12: then
        !            13: echo "writting ./data.c.ed"
        !            14: cat > ./data.c.ed << '\Rogue\Monster\'
        !            15: 378a
        !            16: 
        !            17:  void
        !            18: make_param(p, e)
        !            19:  register struct Paramblock *p;
        !            20:  expptr e;
        !            21: {
        !            22:        p->vclass = CLPARAM;
        !            23:        impldcl(p);
        !            24:        p->paramval = mkconv(p->vtype, e);
        !            25:        }
        !            26: .
        !            27: 3c
        !            28: /* ROUTINES CALLED DURING DATA AND PARAMETER STATEMENT PROCESSING */
        !            29: .
        !            30: \Rogue\Monster\
        !            31: else
        !            32:   echo "will not over write ./data.c.ed"
        !            33: fi
        !            34: if `test ! -s ./defines.h.ed`
        !            35: then
        !            36: echo "writting ./defines.h.ed"
        !            37: cat > ./defines.h.ed << '\Rogue\Monster\'
        !            38: 204c
        !            39: #define OPASSIGNI 56           /* assignment for inquire stmt */
        !            40: #define OPIDENTITY 57          /* for turning TADDR into TEXPR */
        !            41: .
        !            42: 16,27d
        !            43: \Rogue\Monster\
        !            44: else
        !            45:   echo "will not over write ./defines.h.ed"
        !            46: fi
        !            47: if `test ! -s ./defs.h.ed`
        !            48: then
        !            49: echo "writting ./defs.h.ed"
        !            50: cat > ./defs.h.ed << '\Rogue\Monster\'
        !            51: 635,637d
        !            52: 294a
        !            53:        chainp init_values;     /* list of sorted block data init values */
        !            54: .
        !            55: 202,207d
        !            56: \Rogue\Monster\
        !            57: else
        !            58:   echo "will not over write ./defs.h.ed"
        !            59: fi
        !            60: if `test ! -s ./equiv.c.ed`
        !            61: then
        !            62: echo "writting ./equiv.c.ed"
        !            63: cat > ./equiv.c.ed << '\Rogue\Monster\'
        !            64: 308,312d
        !            65: 275,278d
        !            66: 261d
        !            67: 256,259d
        !            68: 223,226c
        !            69:                freqchain(equivdecl);
        !            70: .
        !            71: 216,221d
        !            72: 214a
        !            73:                        if (x == 0) {
        !            74:                            x = 1;
        !            75:                            k = TYCHAR;
        !            76:                        } /* if */
        !            77: .
        !            78: 210,213d
        !            79: 204,207c
        !            80: 
        !            81: /* Only want TYLOGICAL if ALL the init values are logical.  Otherwise, all
        !            82:    non-zero values get mapped onto TRUE_ */
        !            83: 
        !            84:                                if ((x < t && (np -> vtype != TYLOGICAL || x == 0))
        !            85:                                        || k == TYLOGICAL) {
        !            86:                                    x = t;
        !            87:                                    k = np->vtype;
        !            88:                                }
        !            89: .
        !            90: 198c
        !            91:                        x = 0;
        !            92: .
        !            93: 192,196d
        !            94: 136,139d
        !            95: 2,8d
        !            96: \Rogue\Monster\
        !            97: else
        !            98:   echo "will not over write ./equiv.c.ed"
        !            99: fi
        !           100: if `test ! -s ./exec.c.ed`
        !           101: then
        !           102: echo "writting ./exec.c.ed"
        !           103: cat > ./exec.c.ed << '\Rogue\Monster\'
        !           104: 633,637c
        !           105:                        vname -> vis_assigned = 1;
        !           106:                        }
        !           107: 
        !           108:                /* don't duplicate labels... */
        !           109: 
        !           110:                stno = labelval->stateno;
        !           111:                for(cp = vname->varxptr.assigned_values; cp; cp = cp->nextp)
        !           112:                        if ((ftnint)cp->datap == stno)
        !           113:                                break;
        !           114:                if (!cp)
        !           115:                        vname->varxptr.assigned_values =
        !           116:                                mkchain(stno, vname->varxptr.assigned_values);
        !           117:                }
        !           118: 
        !           119:        /* Code for FORMAT label... */
        !           120: 
        !           121:        fs = labelval->fmtstring;
        !           122:        if (!labelval->labdefined || fs && fs != nullstr) {
        !           123:                if (!fs)
        !           124:                        labelval->fmtstring = nullstr;
        !           125:                labelval->labused = 1;
        !           126:                vname = asg_name(vname->varname);
        !           127:                q = ALLOC(Addrblock);
        !           128:                q->tag = TADDR;
        !           129:                q->vtype = TYCHAR;
        !           130:                q->vstg = STGAUTO;
        !           131:                q->ntempelt = 1;
        !           132:                q->memoffset = ICON(0);
        !           133:                q->uname_tag = UNAM_IDENT;
        !           134:                sprintf(q->user.ident, "fmt_%ld", labelval->stateno);
        !           135:                putout(mkexpr(OPASSIGN, vname, q));
        !           136:                }
        !           137: 
        !           138: .
        !           139: 631c
        !           140:        if (!labelval->labdefined || !labelval->fmtstring) {
        !           141: 
        !           142:                putout(mkexpr(OPASSIGN, p, mkintcon(labelval->stateno)));
        !           143: 
        !           144:                if (vname -> vis_assigned == 0) {
        !           145: .
        !           146: 627d
        !           147: 625c
        !           148:        /* code for executable label... */
        !           149: .
        !           150: 623c
        !           151:        /* If the label hasn't been defined, then we do things twice:
        !           152:         * once for an executable stmt label, once for a format
        !           153:         */
        !           154: .
        !           155: 621c
        !           156:                return;
        !           157:                }
        !           158: .
        !           159: 619c
        !           160:        if( ! ONEOF(p->vtype, MSKINT|MSKADDR) ) {
        !           161: .
        !           162: 616a
        !           163:        register Addrp q;
        !           164:        static char nullstr[] = "";
        !           165:        char *fs;
        !           166:        register chainp cp;
        !           167:        register ftnint stno;
        !           168: .
        !           169: 612c
        !           170:  register Namep vname;
        !           171: .
        !           172: 610a
        !           173:  Namep
        !           174: asg_name(s1)
        !           175:  register char *s1;
        !           176: {
        !           177:        char buf[VL], *s, *se;
        !           178:        register Namep vn;
        !           179:        extern chainp assigned_fmts;
        !           180: 
        !           181:        /* Use Upper-case first letter for corresponding format variable */
        !           182:        buf[0] = *s1 + 'A' - 'a';
        !           183:        s = buf + 1;
        !           184:        se = buf + VL;
        !           185:        while(s < se && (*s = *++s1) != ' ')
        !           186:                s++;
        !           187:        vn = mkname(s-buf, buf);
        !           188:        if (!vn->vis_assigned) {
        !           189:                vn->vis_assigned = 1;
        !           190:                vn->vstg = STGAUTO;
        !           191:                vn->vprocclass = CLVAR;
        !           192:                vn->vtype = TYCHAR;
        !           193:                vn->vleng = ICON(-1);   /* kludge used in list_decls */
        !           194:                assigned_fmts = mkchain((tagptr) vn, assigned_fmts);
        !           195:                }
        !           196:        return vn;
        !           197:        }
        !           198: 
        !           199: .
        !           200: 393c
        !           201: /* putx added 6-29-89 (mwm), not sure if fixtype is required, but I doubt it
        !           202:    since mkconv is called just before */
        !           203:                doinit = putx (mkconv (dotype, DOINIT));
        !           204: .
        !           205: \Rogue\Monster\
        !           206: else
        !           207:   echo "will not over write ./exec.c.ed"
        !           208: fi
        !           209: if `test ! -s ./expr.c.ed`
        !           210: then
        !           211: echo "writting ./expr.c.ed"
        !           212: cat > ./expr.c.ed << '\Rogue\Monster\'
        !           213: 2590,2591c
        !           214:                        if (doing_setbound)
        !           215:                                lp = p->exprblock.leftp = make_int_expr(lp);
        !           216:                        else {
        !           217:                                p->exprblock.vtype = ltype;
        !           218:                                return(p);
        !           219:                                }
        !           220: .
        !           221: 2551a
        !           222:        extern expptr make_int_expr();
        !           223: .
        !           224: 2545a
        !           225: int doing_setbound;
        !           226: .
        !           227: 1991a
        !           228:        case OPASSIGNI:
        !           229: .
        !           230: 1980a
        !           231:        case OPIDENTITY:
        !           232: .
        !           233: 1865a
        !           234:        case OPIDENTITY:
        !           235: .
        !           236: 1843a
        !           237:        case OPASSIGNI:
        !           238: .
        !           239: 1405c
        !           240:                    return (Addrp) cpexpr ((expptr) retslot);
        !           241: .
        !           242: 1282,1284d
        !           243: 1279d
        !           244: 1128c
        !           245:        if (!replaced)
        !           246:                s->memoffset = mkexpr(OPPLUS, s->memoffset, suboffset(p) );
        !           247: .
        !           248: 1118a
        !           249:        replaced = 0;
        !           250: .
        !           251: 1082c
        !           252:                        return((Addrp) errnode() );
        !           253: .
        !           254: 1068a
        !           255:                        replaced = 1;
        !           256: .
        !           257: 1052d
        !           258: 1050a
        !           259: static int replaced;
        !           260: .
        !           261: 1003c
        !           262:                        if((rp->rpltag = rp->rplvp->tag) == TERROR)
        !           263: .
        !           264: 871a
        !           265: #endif
        !           266: .
        !           267: 869a
        !           268: #if 0
        !           269: /* erroneous error msg */
        !           270: .
        !           271: 822d
        !           272: 806d
        !           273: 561,563d
        !           274: 559d
        !           275: 549a
        !           276:                if (rtype == TYREAL)
        !           277:                        break;
        !           278: .
        !           279: 363a
        !           280:                if (p->addrblock.vtype > TYERROR)       /* i/o block */
        !           281:                        break;
        !           282: .
        !           283: 209c
        !           284: #if PDP11_option
        !           285: .
        !           286: 99a
        !           287:        p -> vtype = (p -> const.ci >> typesize[TYSHORT]) ? TYLONG : TYSHORT;
        !           288: .
        !           289: \Rogue\Monster\
        !           290: else
        !           291:   echo "will not over write ./expr.c.ed"
        !           292: fi
        !           293: if `test ! -s ./f2c.h.ed`
        !           294: then
        !           295: echo "writting ./f2c.h.ed"
        !           296: cat > ./f2c.h.ed << '\Rogue\Monster\'
        !           297: 102a
        !           298:        /* fix up name clashes */
        !           299: 
        !           300: #define acos__ acos_
        !           301: #define asin__ asin_
        !           302: #define asm__ asm_
        !           303: #define auto__ auto_
        !           304: #define break__ break_
        !           305: #define case__ case_
        !           306: #define char__ char_
        !           307: #define const__ const_
        !           308: #define cos__ cos_
        !           309: #define cosh__ cosh_
        !           310: #define do__ do_
        !           311: #define double__ double_
        !           312: #define else__ else_
        !           313: #define entry__ entry_
        !           314: #define enum__ enum_
        !           315: #define exp__ exp_
        !           316: #define extern__ extern_
        !           317: #define float__ float_
        !           318: #define for__ for_
        !           319: #define int__ int_
        !           320: #define log__ log_
        !           321: #define long__ long_
        !           322: #define short__ short_
        !           323: #define signed__ signed_
        !           324: #define sin__ sin_
        !           325: #define sinh__ sinh_
        !           326: #define sizeof__ sizeof_
        !           327: #define sqrt__ sqrt_
        !           328: #define static__ static_
        !           329: #define struct__ struct_
        !           330: #define switch__ switch_
        !           331: #define tan__ tan_
        !           332: #define tanh__ tanh_
        !           333: #define union__ union_
        !           334: #define void__ void_
        !           335: #define while__ while_
        !           336: #define pow_ii_ pow_ii
        !           337: #define pow_ri_ pow_ri
        !           338: #define pow_di_ pow_di
        !           339: #define pow_ci_ pow_ci
        !           340: #define pow_zi_ pow_zi
        !           341: #define pow_hh_ pow_hh
        !           342: #define pow_dd_ pow_dd
        !           343: #define pow_zz_ pow_zz
        !           344: .
        !           345: \Rogue\Monster\
        !           346: else
        !           347:   echo "will not over write ./f2c.h.ed"
        !           348: fi
        !           349: if `test ! -s ./format.c.ed`
        !           350: then
        !           351: echo "writting ./format.c.ed"
        !           352: cat > ./format.c.ed << '\Rogue\Monster\'
        !           353: 1319c
        !           354:            sprintf(buf+k, "[%d]", this_size -> constblock.const.ci);
        !           355:            k += strlen (buf + k);
        !           356: .
        !           357: 1310c
        !           358:     sprintf (buf, "\t/* was ");
        !           359:     k = strlen (buf);
        !           360: .
        !           361: 1304c
        !           362:     int i, k;
        !           363: .
        !           364: 1302a
        !           365: int size;
        !           366: .
        !           367: 1300c
        !           368: char *write_array_decls(outfile, dimp, size)
        !           369: .
        !           370: 1260a
        !           371:     else if (write_header == 2)
        !           372:        nice_printf(outfile, "\n");
        !           373: 
        !           374: /* Finally, ioblocks (which may reference equivs) */
        !           375:     if (iob_list)
        !           376:        write_ioblocks(outfile);
        !           377:     if (assigned_fmts)
        !           378:        write_assigned_fmts(outfile);
        !           379: 
        !           380: .
        !           381: 1249a
        !           382:                if (Define) {
        !           383:                        indent_printf(0, outfile, ")\n");
        !           384:                        write_header = 2;
        !           385:                        }
        !           386: .
        !           387: 1200c
        !           388:                if (!Define)
        !           389:                        nice_printf (outfile, " = ");
        !           390: .
        !           391: 1178c
        !           392:  Alias1:
        !           393:            if (Alias) {
        !           394: .
        !           395: 1175d
        !           396: 1173c
        !           397:                        comment = write_array_decls(outfile, var->vdim, 1);
        !           398:                }
        !           399: .
        !           400: 1160,1171c
        !           401:                    !ISICON (var -> vleng)
        !           402:            || oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON)))
        !           403:                nice_printf (outfile, "*%s", storage);
        !           404:            else {
        !           405:                nice_printf (outfile, "%s", storage);
        !           406:                if (var -> vclass == CLPROC)
        !           407:                        nice_printf (outfile, "()");
        !           408:                else if (var -> vtype == TYCHAR && ISICON ((var -> vleng)))
        !           409:                        write_char_len(outfile, var->vdim,
        !           410:                                var -> vleng -> constblock.const.ci, 0);
        !           411:                else if (var -> vdim &&
        !           412: .
        !           413: 1115c
        !           414:            Alias = oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON));
        !           415:            if (Define = Alias && define_equivs) {
        !           416:                if (!write_header)
        !           417:                        nice_printf(outfile, ";\n");
        !           418:                define_start(outfile, storage, CNULL, "(");
        !           419:                goto Alias1;
        !           420:                }
        !           421:            else if (type == last_type && class == last_class &&
        !           422: .
        !           423: 1104a
        !           424:                write_header = 2;
        !           425:                }
        !           426: .
        !           427: 1103c
        !           428:                    M(STGBSS)|M(STGEXT)|M(STGAUTO)|M(STGCOMMON)|M(STGEQUIV))) {
        !           429: .
        !           430: 1101c
        !           431:            if (write_header == 1 && (new_vars || nequiv || used_builtins)
        !           432: .
        !           433: 999,1001c
        !           434:                    ISICON ((var -> vleng))
        !           435:                        && (i = var->vleng->constblock.const.ci) > 0)
        !           436:                nice_printf (outfile, "[%d]", i);
        !           437: .
        !           438: 957a
        !           439: /* Next come formats */
        !           440:     write_formats(outfile);
        !           441: 
        !           442: .
        !           443: 951c
        !           444:     int Alias, Define, did_one, i, last_type, type;
        !           445:     extern int define_equivs;
        !           446: .
        !           447: 939a
        !           448:  static void
        !           449: write_formats(outfile)
        !           450:  FILE *outfile;
        !           451: {
        !           452:        register struct Labelblock *lp;
        !           453:        int first = 1;
        !           454:        extern int in_string;
        !           455:        char *fs;
        !           456: 
        !           457:        for(lp = labeltab ; lp < highlabtab ; ++lp)
        !           458:                if (lp->labused) {
        !           459:                        if (first) {
        !           460:                                first = 0;
        !           461:                                nice_printf(outfile, "/* Format strings */\n");
        !           462:                                }
        !           463:                        nice_printf(outfile, "static char fmt_%ld[] = \"",
        !           464:                                lp->stateno);
        !           465:                        in_string = 1;
        !           466:                        if (!(fs = lp->fmtstring))
        !           467:                                fs = "";
        !           468:                        nice_printf(outfile, "%s\"", fs);
        !           469:                        in_string = 0;
        !           470:                        nice_printf(outfile, ";\n");
        !           471:                        }
        !           472:        if (!first)
        !           473:                nice_printf(outfile, "\n");
        !           474:        }
        !           475: 
        !           476:  static void
        !           477: write_ioblocks(outfile)
        !           478:  FILE *outfile;
        !           479: {
        !           480:        register iob_data *L;
        !           481:        register char *f, **s, *sep;
        !           482: 
        !           483:        nice_printf(outfile, "/* Fortran I/O blocks */\n");
        !           484:        L = iob_list = (iob_data *)revchain((chainp)iob_list);
        !           485:        do {
        !           486:                nice_printf(outfile, "static %s %s = { ",
        !           487:                        L->type, L->name);
        !           488:                indent += tab_size;
        !           489:                sep = 0;
        !           490:                for(s = L->fields; f = *s; s++) {
        !           491:                        if (sep)
        !           492:                                nice_printf(outfile, sep);
        !           493:                        sep = ", ";
        !           494:                        if (*f == '"') {        /* kludge */
        !           495:                                nice_printf(outfile, "\"");
        !           496:                                in_string = 1;
        !           497:                                nice_printf(outfile, "%s\"", f+1);
        !           498:                                in_string = 0;
        !           499:                                }
        !           500:                        else
        !           501:                                nice_printf(outfile, "%s", f);
        !           502:                        }
        !           503:                nice_printf(outfile, " };\n");
        !           504:                indent -= tab_size;
        !           505:                }
        !           506:                while(L = L->next);
        !           507:        nice_printf(outfile, "\n\n");
        !           508:        }
        !           509: 
        !           510:  static void
        !           511: write_assigned_fmts(outfile)
        !           512:  FILE *outfile;
        !           513: {
        !           514:        register chainp cp;
        !           515:        Namep np;
        !           516:        int did_one = 0;
        !           517: 
        !           518:        cp = assigned_fmts = revchain(assigned_fmts);
        !           519:        nice_printf(outfile, "/* Assigned format variables */\nchar ");
        !           520:        do {
        !           521:                np = (Namep)cp->datap;
        !           522:                if (did_one)
        !           523:                        nice_printf(outfile, ", ");
        !           524:                did_one = 1;
        !           525:                nice_printf(outfile, "*%s", varstr(VL, np->varname));
        !           526:                }
        !           527:                while(cp = cp->nextp);
        !           528:        nice_printf(outfile, ";\n\n");
        !           529:        }
        !           530: 
        !           531: .
        !           532: 747c
        !           533:         next_tab (outfile);
        !           534: .
        !           535: 742a
        !           536: 
        !           537: .
        !           538: 98a
        !           539:     other_undefs(c_file);
        !           540: .
        !           541: 40c
        !           542:     extern FILE *fopen ();
        !           543: .
        !           544: 31a
        !           545: extern chainp assigned_fmts;
        !           546: .
        !           547: 20a
        !           548: static int p1get_const (), p1getn ();
        !           549: .
        !           550: 12c
        !           551: int c_output_line_length = DEF_C_LINE_LENGTH;
        !           552: .
        !           553: 10a
        !           554: #include "iob.h"
        !           555: .
        !           556: \Rogue\Monster\
        !           557: else
        !           558:   echo "will not over write ./format.c.ed"
        !           559: fi
        !           560: if `test ! -s ./format_d.c.ed`
        !           561: then
        !           562: echo "writting ./format_d.c.ed"
        !           563: cat > ./format_d.c.ed << '\Rogue\Monster\'
        !           564: 821a
        !           565: 
        !           566: save_block_data (comname, values)
        !           567: char *comname;
        !           568: chainp values;
        !           569: {
        !           570:     struct Extsym *ext = mkext (varunder (XL, comname));
        !           571: 
        !           572:     if (ext && ext -> extp)
        !           573:        if (ext -> init_values)
        !           574:            errstr ("Two block data for %s common block", comname);
        !           575:        else
        !           576:            ext -> init_values = values;
        !           577:     else
        !           578:         errstr ("Bad common block '%s' with BLOCK DATA", comname);
        !           579: } /* save_block_data */
        !           580: .
        !           581: 802,820c
        !           582:     type = eqv -> eqvtype;
        !           583:     nice_printf (outfile, "static %s %s", c_type_decl (type, NULL),
        !           584:            equiv_name (memno, NULL));
        !           585:     nice_printf (outfile, "[%d] = ", (eqv -> eqvtop - eqv -> eqvbottom) /
        !           586:             typesize[type]);
        !           587:     reshape_values (type, values, '\0');
        !           588:     write_array_init (outfile, type, values);
        !           589:     nice_printf (outfile, ";\n");
        !           590: .
        !           591: 799,800d
        !           592: 792a
        !           593:     int type;
        !           594: .
        !           595: 622a
        !           596:            int index = (int) (((chainp) values -> datap) -> datap);
        !           597: 
        !           598:            while (index - main_index++ > 0)
        !           599:                *str_ptr++ = ' ';
        !           600: 
        !           601: .
        !           602: 620c
        !           603: /* Find the max length of init string, by finding the highest offset
        !           604:    value stored in the list of initial values */
        !           605: 
        !           606:        for(k = 1, prev = CHNULL, v = values; v; prev = v, v = v->nextp) 
        !           607:            ;
        !           608:        if (prev != CHNULL)
        !           609:            k = ((int) (((chainp) prev -> datap) -> datap)) + 1;
        !           610: .
        !           611: 617,618c
        !           612:        chainp v, prev;
        !           613:        int b = 0, k = 0, main_index = 0;
        !           614: .
        !           615: 611a
        !           616: int str_start;         /* offset at which character storage starts. If type
        !           617:                           is not TYCHAR, this value is ignored */
        !           618: .
        !           619: 608c
        !           620: union Constant *make_one_const (type, storage, values, str_start)
        !           621: .
        !           622: 583c
        !           623:                const = make_one_const (type, storage, values, 0);
        !           624: .
        !           625: 574c
        !           626:                const = make_one_const (type, storage, values, 0);
        !           627: .
        !           628: 511a
        !           629: if (stddbg)fprintf (stddbg, "format_data: index %d, main %d\n", index, main_index);
        !           630: .
        !           631: 455c
        !           632:        (tagptr) mkchain ((tagptr) offset, mkchain ((tagptr) dest, val)), CHNULL));
        !           633: .
        !           634: 434c
        !           635:                        res.c[i] = pad_char;
        !           636:                        if (i == 0)
        !           637:                            offset = 0;
        !           638: .
        !           639: 418c
        !           640:                            c = pad_char;
        !           641: .
        !           642: 414c
        !           643:                        make_one_const (TYLONG, &c, cp, 0);
        !           644: .
        !           645: 409a
        !           646: 
        !           647: /* Now this is a little weird.  Until June 20, 1989, we didn't need to store
        !           648:    any offset information.  But it seems the equiv init process requires it.
        !           649:    So, instead of zeroing it out, we'll keep it in, BUT the offset is in
        !           650:    terms of characters, whereas the reshaped data is of the proper type. */
        !           651: 
        !           652:                        offset = ((int) this -> datap);
        !           653: .
        !           654: 400a
        !           655:                int offset = 0;
        !           656: .
        !           657: 349a
        !           658: char pad_char;         /* value used for padding.  ' ' for most, but
        !           659:                           '\0' for equivalenced data  */
        !           660: .
        !           661: 347c
        !           662: static reshape_values (dest, data, pad_char)
        !           663: .
        !           664: 339c
        !           665:        const = make_one_const (type, temp, values, 0);
        !           666: .
        !           667: 330c
        !           668:     reshape_values (type, values, ' ');
        !           669: .
        !           670: 216,219d
        !           671: 213,214c
        !           672:                ? 0 : write_array_decls (outfile, namep -> vdim, 1);
        !           673: .
        !           674: 173c
        !           675: 
        !           676: /* I don't know why eqvstart needs to be subtracted, but Dave Gay thinks
        !           677:    it's necessary 28-June-89 (mwm)
        !           678: */
        !           679:        write_equiv_init (outfile, memno - eqvstart, values);
        !           680: .
        !           681: 139c
        !           682:  static int ch_ar_dim = -1; /* length of each element of char string array,
        !           683:                               used to break up long init strings for ansi
        !           684:                               compilers  */
        !           685: .
        !           686: 78a
        !           687: /* Save the COMMON block data initializations for later */
        !           688:                save_block_data (ovarname, values);
        !           689: 
        !           690: .
        !           691: 77a
        !           692:            else
        !           693: .
        !           694: \Rogue\Monster\
        !           695: else
        !           696:   echo "will not over write ./format_d.c.ed"
        !           697: fi
        !           698: if `test ! -s ./gram.dcl.ed`
        !           699: then
        !           700: echo "writting ./gram.dcl.ed"
        !           701: cat > ./gram.dcl.ed << '\Rogue\Monster\'
        !           702: 197,199c
        !           703:                        make_param($1, $3);
        !           704: .
        !           705: 173d
        !           706: \Rogue\Monster\
        !           707: else
        !           708:   echo "will not over write ./gram.dcl.ed"
        !           709: fi
        !           710: if `test ! -s ./gram.exec.ed`
        !           711: then
        !           712: echo "writting ./gram.exec.ed"
        !           713: cat > ./gram.exec.ed << '\Rogue\Monster\'
        !           714: \Rogue\Monster\
        !           715: else
        !           716:   echo "will not over write ./gram.exec.ed"
        !           717: fi
        !           718: if `test ! -s ./gram.expr.ed`
        !           719: then
        !           720: echo "writting ./gram.expr.ed"
        !           721: cat > ./gram.expr.ed << '\Rogue\Monster\'
        !           722: 98a
        !           723:        | bit_const
        !           724: .
        !           725: \Rogue\Monster\
        !           726: else
        !           727:   echo "will not over write ./gram.expr.ed"
        !           728: fi
        !           729: if `test ! -s ./gram.head.ed`
        !           730: then
        !           731: echo "writting ./gram.head.ed"
        !           732: cat > ./gram.head.ed << '\Rogue\Monster\'
        !           733: 136,149d
        !           734: 5,16d
        !           735: \Rogue\Monster\
        !           736: else
        !           737:   echo "will not over write ./gram.head.ed"
        !           738: fi
        !           739: if `test ! -s ./init.c.ed`
        !           740: then
        !           741: echo "writting ./init.c.ed"
        !           742: cat > ./init.c.ed << '\Rogue\Monster\'
        !           743: 318d
        !           744: 302a
        !           745:        frchain(&assigned_fmts);
        !           746: .
        !           747: 270d
        !           748: 266,268d
        !           749: 242d
        !           750: 240d
        !           751: 237a
        !           752:        iob_list = 0;
        !           753:        for(i = 0; i < 9; i++)
        !           754:                io_structs[i] = 0;
        !           755: .
        !           756: 168,172d
        !           757: 161d
        !           758: 23a
        !           759: chainp assigned_fmts = CHNULL; /* assigned formats */
        !           760: .
        !           761: 3a
        !           762: #include "iob.h"
        !           763: .
        !           764: \Rogue\Monster\
        !           765: else
        !           766:   echo "will not over write ./init.c.ed"
        !           767: fi
        !           768: if `test ! -s ./intr.c.ed`
        !           769: then
        !           770: echo "writting ./intr.c.ed"
        !           771: cat > ./intr.c.ed << '\Rogue\Monster\'
        !           772: 672c
        !           773:                return((Addrp) errnode() );
        !           774: .
        !           775: 26c
        !           776:        char intrfname[VL+1];   /* "+1" added 19 June 89 (mwm) */
        !           777: .
        !           778: \Rogue\Monster\
        !           779: else
        !           780:   echo "will not over write ./intr.c.ed"
        !           781: fi
        !           782: if `test ! -s ./io.c.ed`
        !           783: then
        !           784: echo "writting ./io.c.ed"
        !           785: cat > ./io.c.ed << '\Rogue\Monster\'
        !           786: 963a
        !           787:                        ioset_assign = OPASSIGN;
        !           788:                        }
        !           789: .
        !           790: 962c
        !           791:                    ONEOF(p->addrblock.vtype, M(TYLONG)|M(TYLOGICAL)) ) {
        !           792:                        ioset_assign = OPASSIGNI;
        !           793: .
        !           794: 940,946c
        !           795:                if (!p)
        !           796:                        return;
        !           797:                if (p->tag != TADDR)
        !           798:                        badtag(who, p->tag);
        !           799:                if (p->vtype != TYCHAR
        !           800:                && p->vtype != TYLONG
        !           801:                && p->vtype != TYSHORT)
        !           802:                        badtype(who, p->vtype);
        !           803:                offset /= SZLONG;
        !           804:                switch(p->uname_tag) {
        !           805:                    case UNAM_NAME:
        !           806:                        mo = p->memoffset;
        !           807:                        if (mo->tag != TCONST)
        !           808:                                badtag("ioseta/memoffset", mo->tag);
        !           809:                        if (mo->constblock.const.ci)
        !           810:                                sprintf(s = mem(VL+20,0), "%s+%ld",
        !           811:                                        varstr(VL, p->user.name->varname),
        !           812:                                        mo->constblock.const.ci);
        !           813:                        else
        !           814:                                s = cpstring(varstr(VL, p->user.name->varname));
        !           815:                        break;
        !           816:                    case UNAM_CONST:
        !           817:                        s = tostring(p->user.const.ccp1.ccp0,
        !           818:                                p->vleng->constblock.const.ci);
        !           819:                        break;
        !           820:                    default:
        !           821:                        badthing("uname_tag", who, p->uname_tag);
        !           822:                    }
        !           823:                /* kludge for Hollerith */
        !           824:                if (p->vtype != TYCHAR) {
        !           825:                        s1 = mem(strlen(s)+10,0);
        !           826:                        sprintf(s1, "(char *)%s%s", p->isarray ? "" : "&", s);
        !           827:                        s = s1;
        !           828:                        }
        !           829:                iob_list->fields[offset] = s;
        !           830: .
        !           831: 936c
        !           832:        char *s, *s1;
        !           833:        static char who[] = "ioseta";
        !           834:        expptr mo;
        !           835: .
        !           836: 910,912c
        !           837:                }
        !           838:        else {
        !           839:                register Addrp q;
        !           840: 
        !           841:                q = ALLOC(Addrblock);
        !           842:                q->tag = TADDR;
        !           843:                q->vtype = type;
        !           844:                q->vstg = STGAUTO;
        !           845:                q->ntempelt = 1;
        !           846:                q->isarray = 0;
        !           847:                q->memoffset = ICON(0);
        !           848:                q->uname_tag = UNAM_IDENT;
        !           849:                sprintf(q->user.ident, "%s.%s",
        !           850:                        statstruct ? iob_list->name : ioblkp->user.ident,
        !           851:                        io_fields[offset + 1]);
        !           852:                if (type == TYADDR && p->tag == TCONST
        !           853:                                   && p->constblock.vtype == TYADDR) {
        !           854:                        /* kludge */
        !           855:                        register Addrp p1;
        !           856:                        p1 = ALLOC(Addrblock);
        !           857:                        p1->tag = TADDR;
        !           858:                        p1->vtype = type;
        !           859:                        p1->vstg = STGAUTO;     /* wrong, but who cares? */
        !           860:                        p1->ntempelt = 1;
        !           861:                        p1->isarray = 0;
        !           862:                        p1->memoffset = ICON(0);
        !           863:                        p1->uname_tag = UNAM_IDENT;
        !           864:                        sprintf(p1->user.ident, "fmt_%ld",
        !           865:                                p->constblock.const.ci);
        !           866:                        frexpr(p);
        !           867:                        p = (expptr)p1;
        !           868:                        }
        !           869:                putexpr(mkexpr(ioset_assign, q, p));
        !           870:                }
        !           871: .
        !           872: 900,908c
        !           873:        offset /= SZLONG;
        !           874:        if(statstruct && ISCONST(p)) {
        !           875:                register char *s;
        !           876:                switch(type) {
        !           877:                        case TYADDR:    /* stmt label */
        !           878:                                s = IO_FMT_NAME;
        !           879:                                break;
        !           880:                        case TYIOINT:
        !           881:                                s = "";
        !           882:                                break;
        !           883:                        default:
        !           884:                                badtype("ioset", type);
        !           885:                        }
        !           886:                iob_list->fields[offset] =
        !           887:                        string_num(s, p->constblock.const.ci);
        !           888: .
        !           889: 895d
        !           890: 893a
        !           891: static int ioset_assign = OPASSIGN;
        !           892: .
        !           893: 794a
        !           894:                ioblkp = 0;     /* unnecessary */
        !           895: .
        !           896: 793d
        !           897: 746,758d
        !           898: 744c
        !           899:                new_iob_data(ios,
        !           900:                        temp_name(IO_YAIN_NAME, lastvarno,
        !           901:                        ioblkp->user.ident));
        !           902:        } else if(!(ioblkp = io_structs[iostmt1]))
        !           903:                io_structs[iostmt1] = ioblkp =
        !           904:                        autovar(1, ios->type, PNULL, IO_BLOCK_NAME);
        !           905: .
        !           906: 738c
        !           907:                ioblkp->vtype = ios->type;
        !           908: .
        !           909: 732,735c
        !           910:                iob_data *iod;
        !           911:                char *s, *se;
        !           912: .
        !           913: 729a
        !           914:        if (intfile) {
        !           915:                ios = io_stuff + iostmt;
        !           916:                iostmt1 = IOREAD;
        !           917:                }
        !           918:        else {
        !           919:                ios = io_stuff;
        !           920:                iostmt1 = 0;
        !           921:                }
        !           922:        io_fields = ios->fields;
        !           923: .
        !           924: 690c
        !           925:                                fmtp = (Addrp)mkaddcon(lp->stateno);
        !           926:                                /* lp->stateno for names fmt_nnn */
        !           927:                                lp->labused = 1;
        !           928: .
        !           929: 688c
        !           930:                        struct Labelblock *lp;
        !           931:                        lp = mklabel(p->constblock.const.ci);
        !           932:                        if( (k = fmtstmt(lp)) > 0 )
        !           933: .
        !           934: 674,675c
        !           935:                                varfmt = YES;
        !           936:                                fmtp = asg_addr(p);
        !           937: .
        !           938: 588a
        !           939:        struct io_setup *ios;
        !           940: .
        !           941: 587c
        !           942:        int iostmt1, k;
        !           943: .
        !           944: 583c
        !           945:        register Addrp unitp, fmtp, recp;
        !           946: .
        !           947: 577a
        !           948: 
        !           949: LOCAL Addrp asg_addr(p)
        !           950:  union Expression *p;
        !           951: {
        !           952:        extern Namep asg_name();
        !           953:        register Addrp q;
        !           954: 
        !           955:        if (p->tag != TPRIM)
        !           956:                badtag("asg_addr", p->tag);
        !           957:        q = ALLOC(Addrblock);
        !           958:        q->tag = TADDR;
        !           959:        q->vtype = TYCHAR;
        !           960:        q->vstg = STGAUTO;
        !           961:        q->ntempelt = 1;
        !           962:        q->isarray = 0;
        !           963:        q->memoffset = ICON(0);
        !           964:        q->uname_tag = UNAM_NAME;
        !           965:        q->user.name = asg_name(p->primblock.namep->varname);
        !           966:        return q;
        !           967:        }
        !           968: .
        !           969: 571,576c
        !           970:        putexpr(q);
        !           971:        if(ioendlab) {
        !           972:                exif(mkexpr(OPLT, cpexpr(zork), ICON(0)));
        !           973:                exgoto(execlab(ioendlab));
        !           974:                exendif();
        !           975:                }
        !           976:        if(ioerrlab) {
        !           977:                exif(mkexpr(iostmt==IOREAD||iostmt==IOWRITE ? OPGT : OPNE,
        !           978:                        cpexpr(zork), ICON(0)));
        !           979:                exgoto(execlab(ioerrlab));
        !           980:                exendif();
        !           981:                }
        !           982:        if (zorkf)
        !           983:                templist = mkchain(zorkf, templist);
        !           984: .
        !           985: 569c
        !           986:                q = fixexpr( mkexpr(OPASSIGN, cpexpr(zork), q));
        !           987: .
        !           988: 566c
        !           989:        expptr zork, zorkf;
        !           990: 
        !           991:        if (!(zork = IOSTP) && (ioendlab || ioerrlab))
        !           992:                zork = zorkf = (expptr)mktemp(tyint, PNULL, IO_RESRC_NAME);
        !           993:        else
        !           994:                zorkf = 0;
        !           995:        if(zork)
        !           996: .
        !           997: 546,556d
        !           998: 533,537c
        !           999:                expptr mc = mkconv(TYLONG, ICON(type));
        !          1000:                q = c   ? call4(TYINT, "do_lio", mc, nelt, addr, c)
        !          1001:                        : call3(TYINT, "do_lio", mc, nelt, addr);
        !          1002:                }
        !          1003:        else {
        !          1004:                char *s = ioformatted==FORMATTED ? "do_fio" : "do_uio";
        !          1005:                q = c   ? call3(TYINT, s, nelt, addr, c)
        !          1006:                        : call2(TYINT, s, nelt, addr);
        !          1007:                }
        !          1008: .
        !          1009: 528a
        !          1010: #endif
        !          1011:                c = ALLOC(Addrblock);
        !          1012:                c->tag = TADDR;
        !          1013:                c->vtype = type;
        !          1014:                c->vstg = STGAUTO;
        !          1015:                c->ntempelt = 1;
        !          1016:                c->isarray = 1;
        !          1017:                c->memoffset = ICON(0);
        !          1018:                c->uname_tag = UNAM_IDENT;
        !          1019:                sprintf(c->user.ident, "sizeof(%s)", c_type_decl ((type
        !          1020:                        == TYCHAR ? TYADDR : type), NULL));
        !          1021: .
        !          1022: 519c
        !          1023: #if 0
        !          1024: .
        !          1025: 515a
        !          1026:                char *c_type_decl ();
        !          1027: .
        !          1028: 514d
        !          1029: 502a
        !          1030:        extern Constp mkconst();
        !          1031:        register Addrp c = 0;
        !          1032: .
        !          1033: 494,496d
        !          1034: 457c
        !          1035:                        } 
        !          1036:                        else if(qe->headblock.vtype != TYERROR)
        !          1037: .
        !          1038: 283c
        !          1039:        
        !          1040: .
        !          1041: 279,280c
        !          1042:                        io_structs[iostmt] = ioblkp =
        !          1043:                                autovar(1, ios->type, PNULL, IO_BLOCK_NAME);
        !          1044: .
        !          1045: 277a
        !          1046:                ios = io_stuff + iostmt;
        !          1047:                io_fields = ios->fields;
        !          1048:                ioblkp = io_structs[iostmt];
        !          1049: .
        !          1050: 244,272c
        !          1051:        else if(iostmt == IOREAD && ioerrlab && ioendlab && ioerrlab!=ioendlab)
        !          1052:                IOSTP = (expptr) mktemp(TYINT, PNULL, IO_START_NAME);
        !          1053: .
        !          1054: 232c
        !          1055:                        execlab(ioerrlab = p->constblock.const.ci);
        !          1056: .
        !          1057: 226c
        !          1058:                        execlab(ioendlab = p->constblock.const.ci);
        !          1059: .
        !          1060: 222c
        !          1061:        ioerrlab = ioendlab = 0;
        !          1062: .
        !          1063: 216a
        !          1064:        struct io_setup *ios;
        !          1065: .
        !          1066: 193,194c
        !          1067:        s0 = s = lexline(&n);
        !          1068:        se = t = s + n;
        !          1069: 
        !          1070:        /* fix MYQUOTES (\002's) and \\'s */
        !          1071: 
        !          1072:        while(s < se)
        !          1073:                switch(*s++) {
        !          1074:                        case 2:
        !          1075:                                t += 3; break;
        !          1076:                        case '"':
        !          1077:                        case '\\':
        !          1078:                                t++; break;
        !          1079:                        }
        !          1080:        s = s0;
        !          1081:        lp->fmtstring = t = mem(t - s + 1, 0);
        !          1082:        while(s < se)
        !          1083:                switch(k = *s++) {
        !          1084:                        case 2:
        !          1085:                                t[0] = '\\';
        !          1086:                                t[1] = '0';
        !          1087:                                t[2] = '0';
        !          1088:                                t[3] = '2';
        !          1089:                                t += 4;
        !          1090:                                break;
        !          1091:                        case '"':
        !          1092:                        case '\\':
        !          1093:                                *t++ = '\\';
        !          1094:                                /* no break */
        !          1095:                        default:
        !          1096:                                *t++ = k;
        !          1097:                        }
        !          1098:        *t = 0;
        !          1099: .
        !          1100: 189,191c
        !          1101:        char *s0, *lexline();
        !          1102:        register char *s, *se, *t;
        !          1103:        register k;
        !          1104: .
        !          1105: 184d
        !          1106: 160a
        !          1107: 
        !          1108: LOCAL char _0[] = "0";
        !          1109: LOCAL char *cilist_names[] = {
        !          1110:        "cilist",
        !          1111:        "cierr",
        !          1112:        "ciunit",
        !          1113:        "ciend",
        !          1114:        "cifmt",
        !          1115:        "cirec"
        !          1116:        };
        !          1117: LOCAL char *icilist_names[] = {
        !          1118:        "icilist",
        !          1119:        "icierr",
        !          1120:        "iciunit",
        !          1121:        "iciend",
        !          1122:        "icifmt",
        !          1123:        "icirlen",
        !          1124:        "icirnum"
        !          1125:        };
        !          1126: LOCAL char *olist_names[] = {
        !          1127:        "olist",
        !          1128:        "oerr",
        !          1129:        "ounit",
        !          1130:        "ofnm",
        !          1131:        "ofnmlen",
        !          1132:        "osta",
        !          1133:        "oacc",
        !          1134:        "ofm",
        !          1135:        "orl",
        !          1136:        "oblnk"
        !          1137:        };
        !          1138: LOCAL char *cllist_names[] = {
        !          1139:        "cllist",
        !          1140:        "cerr",
        !          1141:        "cunit",
        !          1142:        "csta"
        !          1143:        };
        !          1144: LOCAL char *alist_names[] = {
        !          1145:        "alist",
        !          1146:        "aerr",
        !          1147:        "aunit"
        !          1148:        };
        !          1149: LOCAL char *inlist_names[] = {
        !          1150:        "inlist",
        !          1151:        "inerr",
        !          1152:        "inunit",
        !          1153:        "infile",
        !          1154:        "infilen",
        !          1155:        "inex",
        !          1156:        "inopen",
        !          1157:        "innum",
        !          1158:        "innamed",
        !          1159:        "inname",
        !          1160:        "innamlen",
        !          1161:        "inacc",
        !          1162:        "inacclen",
        !          1163:        "inseq",
        !          1164:        "inseqlen",
        !          1165:        "indir",
        !          1166:        "indirlen",
        !          1167:        "infmt",
        !          1168:        "infmtlen",
        !          1169:        "inform",
        !          1170:        "informlen",
        !          1171:        "inunf",
        !          1172:        "inunflen",
        !          1173:        "inrecl",
        !          1174:        "innrec",
        !          1175:        "inblank",
        !          1176:        "inblanklen"
        !          1177:        };
        !          1178: 
        !          1179: LOCAL char **io_fields;
        !          1180: 
        !          1181: #define zork(n,t) n, sizeof(n)/sizeof(char *) - 1, t
        !          1182: 
        !          1183: LOCAL io_setup io_stuff[] = {
        !          1184:        zork(cilist_names, TYCILIST),   /* external read/write */
        !          1185:        zork(inlist_names, TYINLIST),   /* inquire */
        !          1186:        zork(olist_names,  TYOLIST),    /* open */
        !          1187:        zork(cllist_names, TYCLLIST),   /* close */
        !          1188:        zork(alist_names,  TYALIST),    /* rewind */
        !          1189:        zork(alist_names,  TYALIST),    /* backspace */
        !          1190:        zork(alist_names,  TYALIST),    /* endfile */
        !          1191:        zork(icilist_names,TYICILIST),  /* internal read */
        !          1192:        zork(icilist_names,TYICILIST)   /* internal write */
        !          1193:        };
        !          1194: 
        !          1195: #undef zork
        !          1196:                
        !          1197: .
        !          1198: 24c
        !          1199: Addrp ioblkp;
        !          1200: .
        !          1201: 20,21d
        !          1202: 12c
        !          1203: iob_data *iob_list;
        !          1204: Addrp io_structs[9];
        !          1205: .
        !          1206: 10a
        !          1207: #include "iob.h"
        !          1208: .
        !          1209: \Rogue\Monster\
        !          1210: else
        !          1211:   echo "will not over write ./io.c.ed"
        !          1212: fi
        !          1213: if `test ! -s ./lex.c.ed`
        !          1214: then
        !          1215: echo "writting ./lex.c.ed"
        !          1216: cat > ./lex.c.ed << '\Rogue\Monster\'
        !          1217: 985a
        !          1218: 
        !          1219: /* Check for NAG's special hex constant */
        !          1220: 
        !          1221:        if (isdigit (*nextch) && (*(nextch + 1) == '#' ||
        !          1222:                (isdigit (*(nextch + 1)) && *(nextch + 2) == '#'))) {
        !          1223: 
        !          1224:            radix = atoi (nextch);
        !          1225:            if (*++nextch != '#')
        !          1226:                nextch++;
        !          1227:            if (radix != 2 && radix != 8 && radix != 16) {
        !          1228:                erri ("invalid base for constant, defaulting to hex", radix);
        !          1229:                radix = 16;
        !          1230:            } /* if */
        !          1231:            nextch++;
        !          1232:            for (p = token; hextoi (*nextch) < radix;)
        !          1233:                *p++ = *nextch++;
        !          1234:            toklen = p - token;
        !          1235:            token[toklen] = '\0';
        !          1236:            return (radix == 16) ? SHEXCON : ((radix == 8) ? SOCTCON :
        !          1237:                    SBITCON);
        !          1238:        } /* if */
        !          1239: 
        !          1240: .
        !          1241: 930a
        !          1242: 
        !          1243: /* BUG BUG BUG Why the heck is this a single OR? (mwm 6-20-89) */
        !          1244: 
        !          1245: .
        !          1246: 923a
        !          1247: 
        !          1248: .
        !          1249: 840a
        !          1250: /* gettok -- moves the right amount of text from   nextch   into the   token
        !          1251:    buffer.   token   initially contains garbage (leftovers from the prev token) */
        !          1252: 
        !          1253: .
        !          1254: \Rogue\Monster\
        !          1255: else
        !          1256:   echo "will not over write ./lex.c.ed"
        !          1257: fi
        !          1258: if `test ! -s ./machdefs.h.ed`
        !          1259: then
        !          1260: echo "writting ./machdefs.h.ed"
        !          1261: cat > ./machdefs.h.ed << '\Rogue\Monster\'
        !          1262: 1,15c
        !          1263: /*#define SDB 1*/
        !          1264: .
        !          1265: \Rogue\Monster\
        !          1266: else
        !          1267:   echo "will not over write ./machdefs.h.ed"
        !          1268: fi
        !          1269: if `test ! -s ./main.c.ed`
        !          1270: then
        !          1271: echo "writting ./main.c.ed"
        !          1272: cat > ./main.c.ed << '\Rogue\Monster\'
        !          1273: 378d
        !          1274: 369,376d
        !          1275: 305,318d
        !          1276: 262,265d
        !          1277: 255,258d
        !          1278: 226d
        !          1279: 220,221c
        !          1280: /*     fatal("vax cannot recover from floating exception");*/
        !          1281: .
        !          1282: 99c
        !          1283:     f2c_entry ("Fr", P_ONE_ARG, P_STRING, &fl_fmt_string, 0),
        !          1284:     f2c_entry ("ev", P_NO_ARGS, P_INT, &define_equivs, NO)
        !          1285: .
        !          1286: 67a
        !          1287: int define_equivs = YES;
        !          1288: .
        !          1289: 30d
        !          1290: 8,28d
        !          1291: 1,2c
        !          1292: char xxxvers[] = "\n@(#) FORTRAN to C Translator, VERSION 0.4, June 29, 1989\n";
        !          1293: #define        VER     0x9629  /* for pi; 8YMDD */
        !          1294: .
        !          1295: \Rogue\Monster\
        !          1296: else
        !          1297:   echo "will not over write ./main.c.ed"
        !          1298: fi
        !          1299: if `test ! -s ./mem.c.ed`
        !          1300: then
        !          1301: echo "writting ./mem.c.ed"
        !          1302: cat > ./mem.c.ed << '\Rogue\Monster\'
        !          1303: 59a
        !          1304:        }
        !          1305: 
        !          1306:  void
        !          1307: new_iob_data(ios, name)
        !          1308:  register io_setup *ios;
        !          1309:  char *name;
        !          1310: {
        !          1311:        register iob_data *iod;
        !          1312:        register char **s, **se;
        !          1313: 
        !          1314:        iod = (iob_data *)
        !          1315:                mem(sizeof(iob_data) + ios->nelt*sizeof(char *), 1);
        !          1316:        iod->next = iob_list;
        !          1317:        iob_list = iod;
        !          1318:        iod->type = ios->fields[0];
        !          1319:        iod->name = cpstring(name);
        !          1320:        s = iod->fields;
        !          1321:        se = s + ios->nelt;
        !          1322:        while(s < se)
        !          1323:                *s++ = "0";
        !          1324:        *s = 0;
        !          1325:        }
        !          1326: 
        !          1327:  char *
        !          1328: string_num(pfx, n)
        !          1329:  char *pfx;
        !          1330:  long n;
        !          1331: {
        !          1332:        char buf[32];
        !          1333:        sprintf(buf, "%s%ld", pfx, n);
        !          1334:        /* can't trust return type of sprintf -- BSD gets it wrong */
        !          1335:        return strcpy(mem(strlen(buf)+1,0), buf);
        !          1336:        }
        !          1337: 
        !          1338:  char *
        !          1339: cpstring(s)
        !          1340:  register char *s;
        !          1341: {
        !          1342:        return strcpy(mem(strlen(s)+1,0), s);
        !          1343:        }
        !          1344: 
        !          1345: static defines *define_list;
        !          1346: 
        !          1347:  void
        !          1348: define_start(outfile, s1, s2, post)
        !          1349:  FILE *outfile;
        !          1350:  char *s1, *s2, *post;
        !          1351: {
        !          1352:        defines *d;
        !          1353:        int n, n1;
        !          1354: 
        !          1355:        n = n1 = strlen(s1);
        !          1356:        if (s2)
        !          1357:                n += strlen(s2);
        !          1358:        d = (defines *)mem(sizeof(defines)+n, 1);
        !          1359:        d->next = define_list;
        !          1360:        define_list = d;
        !          1361:        strcpy(d->defname, s1);
        !          1362:        if (s2)
        !          1363:                strcpy(d->defname + n1, s2);
        !          1364:        nice_printf(outfile, "#define %s %s", d->defname, post);
        !          1365:        }
        !          1366: 
        !          1367:  void
        !          1368: other_undefs(outfile)
        !          1369:  FILE *outfile;
        !          1370: {
        !          1371:        defines *d;
        !          1372:        if (d = define_list) {
        !          1373:                define_list = 0;
        !          1374:                nice_printf(outfile, "\n");
        !          1375:                do
        !          1376:                        nice_printf(outfile, "#undef %s\n", d->defname);
        !          1377:                        while(d = d->next);
        !          1378:                nice_printf(outfile, "\n");
        !          1379:                }
        !          1380: .
        !          1381: 57,58c
        !          1382:        register int k = n + 2, L;
        !          1383:        for(L = 0; L < n; L++)
        !          1384:                if (s[L] == '"')
        !          1385:                        k++; 
        !          1386:        rv = s1 = mem(k);
        !          1387:        *s1++ = '"';
        !          1388:        for(L = 0; L < n; L++) {
        !          1389:                if (s[L] == '"')
        !          1390:                        *s1++ = '\\';
        !          1391:                *s1++ = s[L];
        !          1392:                }
        !          1393:        *s1 = 0;
        !          1394: .
        !          1395: 55a
        !          1396:        register char *s1;
        !          1397: .
        !          1398: 53,54c
        !          1399:  register char *s;
        !          1400:  register int n;
        !          1401: .
        !          1402: 48c
        !          1403:        return rv;
        !          1404: .
        !          1405: 44,45c
        !          1406:                rv = b->buf;
        !          1407:                mem_last = rv + sizeof(b->buf);
        !          1408:                s = rv + n;
        !          1409: .
        !          1410: 28c
        !          1411:        if (round)
        !          1412:                mem_next = (char *)(
        !          1413:                        ((long)mem_next + sizeof(char *)-1)
        !          1414:                                & ~(sizeof(char *)-1));
        !          1415:        rv = mem_next;
        !          1416:        s = rv + n;
        !          1417: .
        !          1418: 26c
        !          1419:        register char *rv, *s;
        !          1420: .
        !          1421: 22c
        !          1422: mem(n, round)
        !          1423: .
        !          1424: 1a
        !          1425: #include "iob.h"
        !          1426: #include <string.h>
        !          1427: .
        !          1428: \Rogue\Monster\
        !          1429: else
        !          1430:   echo "will not over write ./mem.c.ed"
        !          1431: fi
        !          1432: if `test ! -s ./misc.c.ed`
        !          1433: then
        !          1434: echo "writting ./misc.c.ed"
        !          1435: cat > ./misc.c.ed << '\Rogue\Monster\'
        !          1436: 1137a
        !          1437: } /* struct_eq */
        !          1438: 
        !          1439: /* biggest_type -- returns the largest type that can be used to output 
        !          1440:    offset   padding bytes. */
        !          1441: 
        !          1442: int biggest_type (offset)
        !          1443: int offset;
        !          1444: {
        !          1445:     if (offset % typesize[TYDCOMPLEX] == 0)
        !          1446:         return TYDCOMPLEX;
        !          1447:     if (offset % typesize[TYDREAL] == 0)
        !          1448:         return TYDREAL;
        !          1449:     if (offset % typesize[TYLONG] == 0)
        !          1450:         return TYLONG;
        !          1451:     if (offset % typesize[TYSHORT] == 0)
        !          1452:        return TYSHORT;
        !          1453:     return TYCHAR;
        !          1454: } /* biggest_type */
        !          1455: .
        !          1456: 888a
        !          1457:                case OPASSIGNI:
        !          1458: .
        !          1459: 745d
        !          1460: 730c
        !          1461: 
        !          1462: .
        !          1463: 559a
        !          1464:        nextext->init_values = CHNULL;
        !          1465: .
        !          1466: 510c
        !          1467: /*             lp->labused = YES; */
        !          1468: .
        !          1469: 485a
        !          1470:        lp->fmtstring = 0;
        !          1471: .
        !          1472: 275,276d
        !          1473: 273d
        !          1474: 247c
        !          1475:        static char name[IDENT_LEN+1];
        !          1476: .
        !          1477: \Rogue\Monster\
        !          1478: else
        !          1479:   echo "will not over write ./misc.c.ed"
        !          1480: fi
        !          1481: if `test ! -s ./names.c.ed`
        !          1482: then
        !          1483: echo "writting ./names.c.ed"
        !          1484: cat > ./names.c.ed << '\Rogue\Monster\'
        !          1485: 605,610c
        !          1486:        "acos", "alist", "asin", "asm", "atan", "atan2", "auto", "break",
        !          1487:        "case", "char", "cilist", "cllist", "const", "continue", "cos", "cosh",
        !          1488:        "default", "do", "double", "else", "entry", "enum", "exp",
        !          1489:        "extern", "flag", "float", "for", "ftnint", "ftnlen", "goto",
        !          1490:        "icilist", "if", "inlist", "int", "log", "long",
        !          1491:        "noalias", "olist", "register", "return",
        !          1492: .
        !          1493: 602a
        !          1494: /* Also includes keywords used for I/O in f2c.h */
        !          1495: .
        !          1496: 545c
        !          1497:     static char buf[USER_LABEL_MAX + 1];
        !          1498: .
        !          1499: 427,429c
        !          1500:                define_start (outfile, varstr (XL, ext -> extname),
        !          1501:                        comm_union_name (count, NULL), CNULL);
        !          1502: .
        !          1503: 264,267c
        !          1504:     sprintf (pointer, "_%d", count);
        !          1505: .
        !          1506: 78a
        !          1507:        case TYCILIST:  strcpy (buff, "cilist");        break;
        !          1508:        case TYICILIST: strcpy (buff, "icilist");       break;
        !          1509:        case TYOLIST:   strcpy (buff, "olist");         break;
        !          1510:        case TYCLLIST:  strcpy (buff, "cllist");        break;
        !          1511:        case TYALIST:   strcpy (buff, "alist");         break;
        !          1512:        case TYINLIST:  strcpy (buff, "inlist");        break;
        !          1513: .
        !          1514: \Rogue\Monster\
        !          1515: else
        !          1516:   echo "will not over write ./names.c.ed"
        !          1517: fi
        !          1518: if `test ! -s ./names.h.ed`
        !          1519: then
        !          1520: echo "writting ./names.h.ed"
        !          1521: cat > ./names.h.ed << '\Rogue\Monster\'
        !          1522: 18a
        !          1523: #define IO_YAIN_NAME "io_"             /* Yet another I/O Name */
        !          1524: #define IO_FMT_NAME "fmt_"             /* IO Format prefix */
        !          1525: #define IO_RESRC_NAME "io_rc"
        !          1526: .
        !          1527: \Rogue\Monster\
        !          1528: else
        !          1529:   echo "will not over write ./names.h.ed"
        !          1530: fi
        !          1531: if `test ! -s ./nice_printf.c.ed`
        !          1532: then
        !          1533: echo "writting ./nice_pf.c.ed"
        !          1534: cat > ./nice_pf.c.ed << '\Rogue\Monster\'
        !          1535: 229c
        !          1536:            cursor_pos = in_string ? 0 : ind +
        !          1537: .
        !          1538: 211a
        !          1539:            (void) safe_strncpy (next_slot, pointer + 1, sizeof(output_buf)-1);
        !          1540: .
        !          1541: 210d
        !          1542: 198,199c
        !          1543:                        pointer = adjust_pointer_in_string(pointer);
        !          1544:                else if (strchr("&*+-/<=>|", *pointer)
        !          1545: .
        !          1546: 167c
        !          1547:                    else if (word_start && isntident(*(unsigned char *)pointer))
        !          1548: .
        !          1549: 164,165c
        !          1550:                    if (!word_start && isident(*(unsigned char *)pointer))
        !          1551: .
        !          1552: 160,162c
        !          1553:    at the same time.  Must check for tokens first, since '-' is considered
        !          1554:    part of an identifier; checking isident first would mean breaking up "->" */
        !          1555: .
        !          1556: 129d
        !          1557: 124c
        !          1558:        if (in_string)
        !          1559:                for (pointer = next_slot; *pointer && *pointer != '\n' &&
        !          1560:                                cursor_pos <= max_line_len; pointer++)
        !          1561:                        cursor_pos++;
        !          1562:        else
        !          1563:           for (pointer = next_slot; *pointer && *pointer != '\n' &&
        !          1564: .
        !          1565: 117,119d
        !          1566: 113a
        !          1567:     ind = indent <= MAX_INDENT
        !          1568:                ? indent
        !          1569:                : MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
        !          1570: 
        !          1571: .
        !          1572: 100a
        !          1573:     extern char tr_tab[];      /* in output.c */
        !          1574:     register char *Tr = tr_tab;
        !          1575:     int ind;
        !          1576: .
        !          1577: 97d
        !          1578: 89c
        !          1579: /* #define isident(x) (isalnum (x) || (x) == '_' || (x) == '.' || (x) == '-') */
        !          1580: #define isident(x) (Tr[x] & 1)
        !          1581: #define isntident(x) (!Tr[x])
        !          1582: .
        !          1583: 81a
        !          1584:  static char *
        !          1585: adjust_pointer_in_string(pointer)
        !          1586:  register char *pointer;
        !          1587: {
        !          1588:        register char *s, *s1, *se, *s0;
        !          1589: 
        !          1590:        if (pointer - next_slot < 20)   /* arbitrary choice */
        !          1591:                return next_slot - 1;
        !          1592:        /* arrange not to break \002 */
        !          1593:        for(s = s1 = next_slot; s < pointer; s++) {
        !          1594:                s0 = s1;
        !          1595:                s1 = s;
        !          1596:                if (*s == '\\') {
        !          1597:                        se = s++ + 4;
        !          1598:                        if (se > pointer)
        !          1599:                                break;
        !          1600:                        if (*s < '0' || *s > '7')
        !          1601:                                continue;
        !          1602:                        while(++s < se)
        !          1603:                                if (*s < '0' || *s > '7')
        !          1604:                                        break;
        !          1605:                        --s;
        !          1606:                        }
        !          1607:                }
        !          1608:        return s0 - 1;
        !          1609:        }
        !          1610: 
        !          1611: .
        !          1612: 22c
        !          1613:        int tab = ind + (use_extra ? TOO_LONG_INDENT : 0);
        !          1614: .
        !          1615: 20a
        !          1616:     ind = indent <= MAX_INDENT
        !          1617:                ? indent
        !          1618:                : MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
        !          1619: 
        !          1620: .
        !          1621: 19c
        !          1622:     int ind;
        !          1623: .
        !          1624: 8a
        !          1625: #define MAX_INDENT 44
        !          1626: #define MIN_INDENT 22
        !          1627: .
        !          1628: 7d
        !          1629: 2d
        !          1630: \Rogue\Monster\
        !          1631: else
        !          1632:   echo "will not over write ./nice_pf.c.ed"
        !          1633: fi
        !          1634: if `test ! -s ./nice_pf.h.ed`
        !          1635: then
        !          1636: echo "writting ./nice_pf.h.ed"
        !          1637: cat > ./nice_pf.h.ed << '\Rogue\Monster\'
        !          1638: 5c
        !          1639: #define MAX_OUTPUT_SIZE 6000   /* Number of chars on one output line PLUS
        !          1640: .
        !          1641: \Rogue\Monster\
        !          1642: else
        !          1643:   echo "will not over write ./nice_pf.h.ed"
        !          1644: fi
        !          1645: if `test ! -s ./output.c.ed`
        !          1646: then
        !          1647: echo "writting ./output.c.ed"
        !          1648: cat > ./output.c.ed << '\Rogue\Monster\'
        !          1649: 1168a
        !          1650:     extern int tab_size;
        !          1651:     register char *s;
        !          1652: 
        !          1653:     s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
        !          1654:     while(*s)
        !          1655:        tr_tab[*s++] = 3;
        !          1656:     tr_tab['>'] = 1;
        !          1657: .
        !          1658: 1157a
        !          1659: char tr_tab[256];      /* machine dependent */
        !          1660: .
        !          1661: 1114,1141d
        !          1662: 1104,1108d
        !          1663: 1096d
        !          1664: 1050,1054c
        !          1665: #endif         
        !          1666:                        ONEOF(q->addrblock.vstg,
        !          1667:                                M(STGARG)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST))
        !          1668:                        || (memoffset && (!ISICON(memoffset)
        !          1669:                                || memoffset->constblock.const.ci)))
        !          1670:                        || ONEOF(q->addrblock.vstg,
        !          1671:                                        M(STGINIT)|M(STGAUTO)|M(STGBSS))
        !          1672:                                && !q->addrblock.isarray)
        !          1673: .
        !          1674: 1047c
        !          1675:                        q -> addrblock.vstg, M(STGARG)|M(STGEQUIV)) ||
        !          1676: .
        !          1677: 1045c
        !          1678:                        !oneof_stg(q -> addrblock.uname_tag == UNAM_NAME ?
        !          1679: .
        !          1680: 1043c
        !          1681:                        !ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
        !          1682:                        && (
        !          1683: #if 0
        !          1684: .
        !          1685: 983a
        !          1686:        if (q->tag == TADDR) {
        !          1687:                if (q->addrblock.vtype > TYERROR) {
        !          1688:                        /* I/O block */
        !          1689:                        nice_printf(outfile, "&%s", q->addrblock.user.ident);
        !          1690:                        continue;
        !          1691:                        }
        !          1692:                if (!byvalue && q->addrblock.isarray
        !          1693:                && q->addrblock.vtype != TYCHAR
        !          1694:                && q->addrblock.memoffset->tag == TCONST
        !          1695:                && q->addrblock.memoffset->constblock.const.ci == 0) {
        !          1696: 
        !          1697:                        /* &x[0] == x */
        !          1698:                        /* This also prevents &sizeof(doublereal)[0] */
        !          1699:                        switch(q->addrblock.uname_tag) {
        !          1700:                            case UNAM_NAME:
        !          1701:                                output_name(outfile, q->addrblock.user.name);
        !          1702:                                continue;
        !          1703:                            case UNAM_IDENT:
        !          1704:                                nice_printf(outfile, "%s",
        !          1705:                                        q->addrblock.user.ident);
        !          1706:                                continue;
        !          1707:                            case UNAM_EXTERN:
        !          1708:                                output_extern(outfile,
        !          1709:                                        &extsymtab[q->addrblock.memno]);
        !          1710:                                continue;
        !          1711:                            }
        !          1712:                        }
        !          1713:                }
        !          1714: 
        !          1715: .
        !          1716: 976,977c
        !          1717:     for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
        !          1718: .
        !          1719: 961c
        !          1720:     nice_printf(outfile, " (");
        !          1721: .
        !          1722: 940,947d
        !          1723: 909a
        !          1724:     register expptr q;
        !          1725: .
        !          1726: 907,908d
        !          1727: 894d
        !          1728: 877,879d
        !          1729: 813a
        !          1730:     /* Fudge character/arithmetic pairs: promote char to int. */
        !          1731:     /* This mainuplation is meant to make ichar() work right. */
        !          1732: 
        !          1733:     if (e->vtype >= TYSHORT && e->vtype <= TYLOGICAL) {
        !          1734:        register union Expression *Offset;
        !          1735: 
        !          1736:        if (e->leftp && e->leftp->tag == TADDR
        !          1737:                        && e->leftp->addrblock.vtype == TYCHAR) {
        !          1738:                e->leftp->addrblock.vtype = tyint;
        !          1739:                Offset = e->leftp->addrblock.memoffset;
        !          1740:                e->leftp->addrblock.memoffset =
        !          1741:                        Offset
        !          1742:                        ? mkexpr(OPSTAR, Offset, ICON(typesize[tyint]))
        !          1743:                        : ICON(0);
        !          1744:                e->leftp->addrblock.isarray = 1;
        !          1745:                }
        !          1746:        if (e->rightp && e->rightp->tag == TADDR
        !          1747:                        && e->rightp->addrblock.vtype == TYCHAR) {
        !          1748:                e->rightp->addrblock.vtype = tyint;
        !          1749:                Offset = e->rightp->addrblock.memoffset;
        !          1750:                e->rightp->addrblock.memoffset =
        !          1751:                        Offset
        !          1752:                        ? mkexpr(OPSTAR, Offset, ICON(typesize[tyint]))
        !          1753:                        : ICON(0);
        !          1754:                e->rightp->addrblock.isarray = 1;
        !          1755:                }
        !          1756:        }
        !          1757: 
        !          1758: .
        !          1759: 754a
        !          1760:        case OPIDENTITY:
        !          1761: .
        !          1762: 110d
        !          1763: 94a
        !          1764:        /* OPASSIGNI 56 */      { BINARY_OP,  2, "%l = &%r" },
        !          1765:        /* OPIDENTITY 57 */     { UNARY_OP, 15, "%l" },
        !          1766: .
        !          1767: 27,28c
        !          1768:        /* OPEQV 9 */           { BINARY_OP,  9, "%l == %r" },
        !          1769:        /* OPNEQV 10 */         { BINARY_OP,  9, "%l != %r" },
        !          1770: .
        !          1771: \Rogue\Monster\
        !          1772: else
        !          1773:   echo "will not over write ./output.c.ed"
        !          1774: fi
        !          1775: if `test ! -s ./p1output.c.ed`
        !          1776: then
        !          1777: echo "writting ./p1output.c.ed"
        !          1778: cat > ./p1output.c.ed << '\Rogue\Monster\'
        !          1779: 359a
        !          1780:        case OPIDENTITY:
        !          1781: .
        !          1782: 209c
        !          1783:            stg, M(STGARG)|M(STGEQUIV)) && addrp->vtype != TYCHAR) {
        !          1784: .
        !          1785: 206c
        !          1786:    Lengths are passed by value, so don't check STGLENG
        !          1787:    28-Jun-89 (dmg)  Added the check for != TYCHAR
        !          1788:  */
        !          1789: .
        !          1790: \Rogue\Monster\
        !          1791: else
        !          1792:   echo "will not over write ./p1output.c.ed"
        !          1793: fi
        !          1794: if `test ! -s ./pccdefs.h.ed`
        !          1795: then
        !          1796: echo "writting ./pccdefs.h.ed"
        !          1797: cat > ./pccdefs.h.ed << '\Rogue\Monster\'
        !          1798: 56,64c
        !          1799: #define P2SHORT 3
        !          1800: #define P2INT 4
        !          1801: #define P2LONG 4
        !          1802: .
        !          1803: 1c
        !          1804: /* The following numbers are strange, and implementation-dependent */
        !          1805: .
        !          1806: \Rogue\Monster\
        !          1807: else
        !          1808:   echo "will not over write ./pccdefs.h.ed"
        !          1809: fi
        !          1810: if `test ! -s ./proc.c.ed`
        !          1811: then
        !          1812: echo "writting ./proc.c.ed"
        !          1813: cat > ./proc.c.ed << '\Rogue\Monster\'
        !          1814: 1522a
        !          1815:        doing_setbound = 0;
        !          1816: .
        !          1817: 1521c
        !          1818:                p->basexpr = make_int_expr (fixtype (q));
        !          1819: .
        !          1820: 1491c
        !          1821:                                p->dims[i].dimexpr = make_int_expr (fixtype (q));
        !          1822: .
        !          1823: 1458a
        !          1824:        doing_setbound = 1;
        !          1825: .
        !          1826: 1445a
        !          1827:        extern expptr make_int_expr ();
        !          1828:        extern int doing_setbound;
        !          1829: .
        !          1830: 1046,1099d
        !          1831: 1003,1007d
        !          1832: 990,993c
        !          1833: 
        !          1834: .
        !          1835: 959,964d
        !          1836: 770,773d
        !          1837: 733,761d
        !          1838: 727,731d
        !          1839: 688,691c
        !          1840:                                (qclass==CLVAR && qstg==STGUNKNOWN) ) {
        !          1841:                            if (! q -> vis_assigned)
        !          1842:                                warn1("local variable %s never used",
        !          1843:                                      varstr(VL,q->varname) );
        !          1844:                        } else if(qclass==CLVAR && qstg==STGBSS) {
        !          1845: .
        !          1846: 658,686d
        !          1847: 597,600d
        !          1848: 565,569d
        !          1849: 536,542d
        !          1850: 519,524d
        !          1851: 451,454d
        !          1852: 439,442d
        !          1853: 404,411d
        !          1854: 402d
        !          1855: 397,399d
        !          1856: 394d
        !          1857: 390,392d
        !          1858: 260,281d
        !          1859: 172,186d
        !          1860: 111,123d
        !          1861: 97d
        !          1862: 87,95d
        !          1863: 41,44d
        !          1864: 18a
        !          1865: char *memname();
        !          1866: .
        !          1867: 4,12d
        !          1868: \Rogue\Monster\
        !          1869: else
        !          1870:   echo "will not over write ./proc.c.ed"
        !          1871: fi
        !          1872: if `test ! -s ./put.c.ed`
        !          1873: then
        !          1874: echo "writting ./put.c.ed"
        !          1875: cat > ./put.c.ed << '\Rogue\Monster\'
        !          1876: 85,86c
        !          1877: /*     templist = hookup(templist, holdtemps);         */
        !          1878: /*     holdtemps = NULL;                               */
        !          1879: 
        !          1880: .
        !          1881: 61d
        !          1882: 57,59d
        !          1883: 50c
        !          1884:        P2BAD, P2BAD, P2BAD, P2BAD,
        !          1885:        1,1,1,1,1 /* OPNEG1, OPQUESTd, OPCOLONd, OPASSIGNI, OPIDENTITY */
        !          1886: .
        !          1887: 9,15d
        !          1888: 7a
        !          1889: #include "pccdefs.h"
        !          1890: .
        !          1891: \Rogue\Monster\
        !          1892: else
        !          1893:   echo "will not over write ./put.c.ed"
        !          1894: fi
        !          1895: if `test ! -s ./putpcc.c.ed`
        !          1896: then
        !          1897: echo "writting ./putpcc.c.ed"
        !          1898: cat > ./putpcc.c.ed << '\Rogue\Monster\'
        !          1899: 1459c
        !          1900:     return (expptr) p;
        !          1901: .
        !          1902: 1447c
        !          1903:        cp -> datap = (tagptr) addrfix(putx( mkconv(TYLENG,cp->datap)));
        !          1904: .
        !          1905: 1327c
        !          1906:            if( ISCHAR(q) &&
        !          1907:                (q->headblock.vclass != CLPROC || q->headblock.vstg == STGARG))
        !          1908: .
        !          1909: 1260a
        !          1910:  LOCAL expptr
        !          1911: addrfix(e)             /* fudge character string length if it's a TADDR */
        !          1912:  expptr e;
        !          1913: {
        !          1914:        return e->tag == TADDR ? mkexpr(OPIDENTITY, e, ENULL) : e;
        !          1915:        }
        !          1916: 
        !          1917: .
        !          1918: 1076c
        !          1919: return (expptr) p;
        !          1920: .
        !          1921: 1070c
        !          1922:                return ENULL;
        !          1923: .
        !          1924: 895c
        !          1925:        return (Addrp) p;
        !          1926: .
        !          1927: 465a
        !          1928:        case OPASSIGNI:
        !          1929: .
        !          1930: 355a
        !          1931:                case OPASSIGNI:
        !          1932:                case OPIDENTITY:
        !          1933: .
        !          1934: \Rogue\Monster\
        !          1935: else
        !          1936:   echo "will not over write ./putpcc.c.ed"
        !          1937: fi
        !          1938: if `test ! -s ./star2s.c.ed`
        !          1939: then
        !          1940: echo "writting ./star2s.c.ed"
        !          1941: cat > ./star2s.c.ed << '\Rogue\Monster\'
        !          1942: 634a
        !          1943: 
        !          1944: char *parstate2s (par, pointer)
        !          1945: int par;
        !          1946: char *pointer;
        !          1947: {
        !          1948:     static char buff[STATIC_STORE_SIZE];
        !          1949: 
        !          1950:     if (pointer == NULL)
        !          1951:         pointer = buff;
        !          1952: 
        !          1953:     switch (par) {
        !          1954:         case OUTSIDE: strcpy (pointer, "OUTSIDE"); break;
        !          1955:        case INSIDE: strcpy (pointer, "INSIDE"); break;
        !          1956:        case INDCL: strcpy (pointer, "INDCL"); break;
        !          1957:        case INDATA: strcpy (pointer, "INDATA"); break;
        !          1958:        case INEXEC: strcpy (pointer, "INEXEC"); break;
        !          1959:        default: strcpy (pointer, "Bad parstate '%d'", par);
        !          1960:     } /* switch */
        !          1961: 
        !          1962:     return pointer;
        !          1963: } /* parstate2s */
        !          1964: .
        !          1965: \Rogue\Monster\
        !          1966: else
        !          1967:   echo "will not over write ./star2s.c.ed"
        !          1968: fi
        !          1969: if `test ! -s ./star2s.h.ed`
        !          1970: then
        !          1971: echo "writting ./star2s.h.ed"
        !          1972: cat > ./star2s.h.ed << '\Rogue\Monster\'
        !          1973: 3a
        !          1974: char *parstate2s ();
        !          1975: .
        !          1976: \Rogue\Monster\
        !          1977: else
        !          1978:   echo "will not over write ./star2s.h.ed"
        !          1979: fi
        !          1980: if `test ! -s ./statics.c.ed`
        !          1981: then
        !          1982: echo "writting ./statics.c.ed"
        !          1983: cat > ./statics.c.ed << '\Rogue\Monster\'
        !          1984: 169a
        !          1985: } /* free_static_inits */
        !          1986: .
        !          1987: 63c
        !          1988:                    type = biggest_type (val);
        !          1989:                    val /= typesize[type];
        !          1990:                    nice_printf (fp, "%s ", c_type_decl (type, 0));
        !          1991: .
        !          1992: 39a
        !          1993:     int type;
        !          1994: .
        !          1995: \Rogue\Monster\
        !          1996: else
        !          1997:   echo "will not over write ./statics.c.ed"
        !          1998: fi
        !          1999: if `test ! -s ./vax.c.ed`
        !          2000: then
        !          2001: echo "writting ./vax.c.ed"
        !          2002: cat > ./vax.c.ed << '\Rogue\Monster\'
        !          2003: 617,840d
        !          2004: 608d
        !          2005: 603d
        !          2006: 497d
        !          2007: 495c
        !          2008:                        expptr expr = (expptr) cpexpr (dp -> dims[i].dimexpr);
        !          2009: .
        !          2010: 170d
        !          2011: 144,153d
        !          2012: 140d
        !          2013: 80,87d
        !          2014: 32,33c
        !          2015: #if 1
        !          2016: .
        !          2017: 2,10d
        !          2018: \Rogue\Monster\
        !          2019: else
        !          2020:   echo "will not over write ./vax.c.ed"
        !          2021: fi
        !          2022: if `test ! -s ./vaxdefs.h.ed`
        !          2023: then
        !          2024: echo "writting ./vaxdefs.h.ed"
        !          2025: cat > ./vaxdefs.h.ed << '\Rogue\Monster\'
        !          2026: 1,15c
        !          2027: /*#define SDB 1*/
        !          2028: .
        !          2029: \Rogue\Monster\
        !          2030: else
        !          2031:   echo "will not over write ./vaxdefs.h.ed"
        !          2032: fi
        !          2033: if `test ! -s ./FINAL_NOTES`
        !          2034: then
        !          2035: echo "writting ./FINAL_NOTES"
        !          2036: cat > ./FINAL_NOTES << '\Rogue\Monster\'
        !          2037:        NOTES AS I PREPARE TO LEAVE NAG ON JUNE 30
        !          2038: ----------------------------------------------------------------------
        !          2039: 
        !          2040:        /user/mark/bin/f2c - translator before I merged the IO stuff
        !          2041:                -- source in /user/mark/f2c/hold
        !          2042:        /user/mark/bin/f2cio - Dave Gay's version, as of June 28
        !          2043:                -- source in /user/mark/update_f2c/new
        !          2044:        /user/mark/f2c/f2c - translator with I/O and bugs
        !          2045:                -- source in /user/mark/f2c
        !          2046: 
        !          2047:        (null)com_ bug -- grep for "null" in all source files, I think
        !          2048: the only one is in star2s.c, stg2s().  Set a breakpoint there, run the
        !          2049: translator and look at the stack trace.
        !          2050: 
        !          2051:        common array init bug -- look at the differences between an
        !          2052: earlier version and the current version.  First run the earlier
        !          2053: version to see if it gets it right (it should).
        !          2054: 
        !          2055:        other bugs -- look at the file /user/mark/mail/dave.  These
        !          2056: are the email messages I've exchanged with David Gay
        !          2057: (cbs%uk.ac.nsfnet-relay::com.att.research::dmg).  I've incorporated
        !          2058: most of his bug fixes except for the last ones (which 1. increase the
        !          2059: default sizee of the statement function table and 2. fix a problem
        !          2060: with a "too many initializers" error message).  There's nothing too
        !          2061: personal in there, I hope!
        !          2062: 
        !          2063:        Look in my .login for the   c and h   aliases.  Most useful at
        !          2064: searching the right files, avoiding gram.c (yacc output) and gram.o,
        !          2065: but looking at the 5 grammar source files.
        !          2066: 
        !          2067:        I want to send Dave Gay my whole directory tree, if possible.
        !          2068: PLEASE delete the .o's, files ending in ~, and the executables (look
        !          2069: in /user/mark/bin for some more of these) before tar(1)ing these.  If
        !          2070: that's not possible, just /user/mark/f2c subtree.  If THAT's not
        !          2071: possible, just the /user/mark/f2c directory by itself.
        !          2072: 
        !          2073:        I also want to email him the diff -e between /user/mark/f2c
        !          2074: source files and /user/mark/update_f2c/original_f2c source files.  You
        !          2075: can find a list of all relevant source files in the file
        !          2076: /user/mark/f2c/myfiles.
        !          2077: \Rogue\Monster\
        !          2078: else
        !          2079:   echo "will not over write ./FINAL_NOTES"
        !          2080: fi
        !          2081: echo "Finished archive 1 of 1"
        !          2082: exit

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