home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / icont / lcode.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  39KB  |  1,434 lines
  1. /*
  2.  * lcode.c -- linker routines to parse .u1 files and produce icode.
  3.  */
  4.  
  5. #include "link.h"
  6. #include "tproto.h"
  7. #include "tglobals.h"
  8. #include "opcode.h"
  9. #include "keyword.h"
  10. #include "::h:version.h"
  11. #include "::h:header.h"
  12.  
  13. /*
  14.  *  This needs fixing ...
  15.  */
  16. #undef CsetPtr
  17. #define CsetPtr(b,c)    ((c) + (((b)&0377) >> LogIntBits))
  18.  
  19. /*
  20.  * Prototypes.
  21.  */
  22.  
  23. hidden novalue    backpatch    Params((int lab));
  24. hidden novalue    clearlab    Params((noargs));
  25. hidden novalue    flushcode    Params((noargs));
  26. hidden novalue    align        Params((noargs));
  27. hidden novalue    misalign    Params((noargs));
  28. hidden novalue    intout        Params((int oint));
  29. hidden novalue    lemit        Params((int op,char *name));
  30. hidden novalue    lemitcon    Params((int k));
  31. hidden novalue    lemitin        Params((int op,word offset,int n,char *name));
  32. hidden novalue    lemitint    Params((int op,long i,char *name));
  33. hidden novalue    lemitl        Params((int op,int lab,char *name));
  34. hidden novalue    lemitn        Params((int op,word n,char *name));
  35. hidden novalue    lemitproc
  36.    Params((word name,int nargs,int ndyn,int nstat, int fstat));
  37. hidden novalue    lemitr        Params((int op,word loc,char *name));
  38. hidden novalue    outblock    Params((char *addr,int count));
  39. hidden novalue    setfile        Params((noargs));
  40. hidden novalue    wordout        Params((word oword));
  41.  
  42. #ifdef DeBugLinker
  43. hidden novalue    dumpblock    Params((char *addr,int count));
  44. #endif                    /* DeBugLinker */
  45.  
  46. #if AMIGA
  47. #include <fcntl.h>
  48. #endif                    /* AMIGA */
  49.  
  50. #if MSDOS
  51. extern long fileOffsetOfStuffThatGoesInICX;
  52.   /* defined in Globals.h, set in link.c, used below */
  53. #endif                                  /* MSDOS */
  54.  
  55. #if MVS
  56. extern char *routname;
  57. #endif                    /* MVS */
  58.  
  59. word pc = 0;        /* simulated program counter */
  60.  
  61. #define outword(n)    wordout((word)(n))
  62. #define outop(n)    intout((int)(n))
  63. #define CodeCheck(n) if ((long)codep + (n) > (long)((long)codeb + maxcode))\
  64.                      codeb = (char *) trealloc(codeb, &codep, &maxcode, 1,\
  65.                        (n), "code buffer");
  66.  
  67. /*
  68.  * gencode - read .u1 file, resolve variable references, and generate icode.
  69.  *  Basic process is to read each line in the file and take some action
  70.  *  as dictated by the opcode.    This action sometimes involves parsing
  71.  *  of arguments and usually culminates in the call of the appropriate
  72.  *  lemit* routine.
  73.  */
  74. novalue gencode()
  75.    {
  76.    register int op, k, lab;
  77.    int j, nargs, flags, implicit;
  78.    char *name;
  79.    word id, procname;
  80.    struct centry *cp;
  81.    struct gentry *gp;
  82.    struct fentry *fp;
  83.    union xval gg;
  84.  
  85.    while ((op = getopc(&name)) != EOF) {
  86.       switch (op) {
  87.  
  88.          /* Ternary operators. */
  89.  
  90.          case Op_Toby:
  91.          case Op_Sect:
  92.  
  93.          /* Binary operators. */
  94.  
  95.          case Op_Asgn:
  96.          case Op_Cat:
  97.          case Op_Diff:
  98.          case Op_Div:
  99.          case Op_Eqv:
  100.          case Op_Inter:
  101.          case Op_Lconcat:
  102.          case Op_Lexeq:
  103.          case Op_Lexge:
  104.          case Op_Lexgt:
  105.          case Op_Lexle:
  106.          case Op_Lexlt:
  107.          case Op_Lexne:
  108.          case Op_Minus:
  109.          case Op_Mod:
  110.          case Op_Mult:
  111.          case Op_Neqv:
  112.          case Op_Numeq:
  113.          case Op_Numge:
  114.          case Op_Numgt:
  115.          case Op_Numle:
  116.          case Op_Numlt:
  117.          case Op_Numne:
  118.          case Op_Plus:
  119.          case Op_Power:
  120.          case Op_Rasgn:
  121.          case Op_Rswap:
  122.          case Op_Subsc:
  123.          case Op_Swap:
  124.          case Op_Unions:
  125.  
  126.          /* Unary operators. */
  127.  
  128.          case Op_Bang:
  129.          case Op_Compl:
  130.          case Op_Neg:
  131.          case Op_Nonnull:
  132.          case Op_Null:
  133.          case Op_Number:
  134.          case Op_Random:
  135.          case Op_Refresh:
  136.          case Op_Size:
  137.          case Op_Tabmat:
  138.          case Op_Value:
  139.  
  140.          /* Instructions. */
  141.  
  142.          case Op_Bscan:
  143.          case Op_Ccase:
  144.          case Op_Coact:
  145.          case Op_Cofail:
  146.          case Op_Coret:
  147.          case Op_Dup:
  148.          case Op_Efail:
  149.          case Op_Eret:
  150.          case Op_Escan:
  151.          case Op_Esusp:
  152.          case Op_Limit:
  153.          case Op_Lsusp:
  154.          case Op_Pfail:
  155.          case Op_Pnull:
  156.          case Op_Pop:
  157.          case Op_Pret:
  158.          case Op_Psusp:
  159.          case Op_Push1:
  160.          case Op_Pushn1:
  161.          case Op_Sdup:
  162.             newline();
  163.             lemit(op, name);
  164.             break;
  165.  
  166.          case Op_Chfail:
  167.          case Op_Create:
  168.          case Op_Goto:
  169.          case Op_Init:
  170.             lab = getlab();
  171.             newline();
  172.             lemitl(op, lab, name);
  173.             break;
  174.  
  175.          case Op_Cset:
  176.          case Op_Real:
  177.             k = getdec();
  178.             newline();
  179.             lemitr(op, lctable[k].c_pc, name);
  180.             break;
  181.  
  182.          case Op_Field:
  183.             id = getid();
  184.             newline();
  185.             fp = flocate(id);
  186.             if (fp != NULL)
  187.                lemitn(op, (word)(fp->f_fid-1), name);
  188.         else
  189.                lemitn(op, (word)-1, name);    /* no warning any more */
  190.             break;
  191.  
  192.  
  193.          case Op_Int: {
  194.             long i;
  195.             k = getdec();
  196.             newline();
  197.             cp = &lctable[k];
  198.             /*
  199.              * Check to see if a large integers has been converted to a string.
  200.              *  If so, generate the code for +s.
  201.              */
  202.             if (cp->c_flag & F_StrLit) {
  203.                lemit(Op_Pnull,"pnull");
  204.                lemitin(Op_Str, cp->c_val.sval, cp->c_length, "str");
  205.                lemit(Op_Number,"number");
  206.                break;
  207.                }
  208.             i = (long)cp->c_val.ival;
  209.             lemitint(op, i, name);
  210.             break;
  211.             }
  212.  
  213.  
  214.          case Op_Invoke:
  215.             k = getdec();
  216.             newline();
  217.             if (k == -1)
  218.                lemit(Op_Apply,"apply");
  219.             else
  220.                lemitn(op, (word)k, name);
  221.             break;
  222.  
  223.          case Op_Keywd:
  224.             id = getstr();
  225.             newline();
  226.             k = klookup(&lsspace[id]);
  227.             switch (k) {
  228.                case 0:
  229.                   lfatal(&lsspace[id],"invalid keyword");    
  230.                   break;
  231.                case K_FAIL:
  232.                   lemit(Op_Efail,"efail");
  233.                   break;
  234.                case K_NULL:
  235.                   lemit(Op_Pnull,"pnull");
  236.                   break;
  237.                default:
  238.                lemitn(op, (word)k, name);
  239.             }
  240.             break;
  241.  
  242.          case Op_Llist:
  243.             k = getdec();
  244.             newline();
  245.             lemitn(op, (word)k, name);
  246.             break;
  247.  
  248.          case Op_Lab:
  249.             lab = getlab();
  250.             newline();
  251.  
  252. #ifdef DeBugLinker
  253.             if (Dflag)
  254.                fprintf(dbgfile, "L%d:\n", lab);
  255. #endif                    /* DeBugLinker */
  256.             backpatch(lab);
  257.             break;
  258.  
  259.          case Op_Line:
  260.             /*
  261.              * Line number change.
  262.              *  All the interesting stuff happens in Op_Colm now.
  263.              */
  264.             lineno = getdec();
  265.  
  266. #ifndef SrcColumnInfo
  267.             /*
  268.              * Enter the value in the line number table
  269.              *  that is stored in the icode file and used during error
  270.              *  handling and execution monitoring.  One can generate a VM
  271.              *  instruction for these changes, but since the numbers are not
  272.              *  saved and restored during backtracking, it is more accurate
  273.              *  to check for line number changes in-line in the interpreter.
  274.              *  Fortunately, the in-line check is about as fast as executing
  275.              *  Op_Line instructions.  All of this is complicated by the use
  276.              *  of Op_Line to generate Noop instructions when enabled by the
  277.              *  LineCodes #define.
  278.              *
  279.              * If SrcColumnInfo is required, this code is duplicated,
  280.              *  with changes, in the Op_Colm case below.
  281.              */
  282.             if (lnfree >= &lntable[nsize])
  283.                lntable  = (struct ipc_line *)trealloc(lntable, &lnfree, &nsize,
  284.                   sizeof(struct ipc_line), 1, "line number table");
  285.             lnfree->ipc = pc;
  286.             lnfree->line = lineno;
  287.             lnfree++;
  288. #endif                    /* SrcColumnInfo */
  289.  
  290.             /*
  291.              * Could generate an Op_Line for monitoring, but don't anymore:
  292.              *
  293.              * lemitn(op, (word)lineno, name);
  294.              */
  295.             
  296.             newline();
  297.  
  298.  
  299. #ifdef LineCodes
  300. #ifndef EventMon
  301.             lemit(Op_Noop,"noop");
  302. #endif                    /* EventMon */
  303. #endif                    /* LineCodes */
  304.  
  305.             break;
  306.  
  307.          case Op_Colm:            /* always recognize, maybe ignore */
  308.  
  309.             colmno = getdec();
  310. #ifdef SrcColumnInfo
  311.             if (lnfree >= &lntable[nsize])
  312.                lntable  = (struct ipc_line *)trealloc(lntable, &lnfree, &nsize,
  313.                   sizeof(struct ipc_line), 1, "line number table");
  314.             lnfree->ipc = pc;
  315.             lnfree->line = lineno + (colmno << 16);
  316.             lnfree++;
  317. #endif                    /* SrcColumnInfo */
  318.             break;
  319.  
  320.          case Op_Mark:
  321.             lab = getlab();
  322.             newline();
  323.             lemitl(op, lab, name);
  324.             break;
  325.  
  326.          case Op_Mark0:
  327.             lemit(op, name);
  328.             break;
  329.  
  330.          case Op_Str:
  331.             k = getdec();
  332.             newline();
  333.             cp = &lctable[k];
  334.             lemitin(op, cp->c_val.sval, cp->c_length, name);
  335.             break;
  336.         
  337.          case Op_Tally:
  338.             k = getdec();
  339.             newline();
  340.             lemitn(op, (word)k, name);
  341.             break;
  342.  
  343.          case Op_Unmark:
  344.             lemit(Op_Unmark, name);
  345.             break;
  346.  
  347.          case Op_Var:
  348.             k = getdec();
  349.             newline();
  350.             flags = lltable[k].l_flag;
  351.             if (flags & F_Global)
  352.                lemitn(Op_Global, (word)(lltable[k].l_val.global->g_index),
  353.                   "global");
  354.             else if (flags & F_Static)
  355.                lemitn(Op_Static, (word)(lltable[k].l_val.staticid-1), "static");
  356.             else if (flags & F_Argument)
  357.                lemitn(Op_Arg, (word)(lltable[k].l_val.offset-1), "arg");
  358.             else
  359.                lemitn(Op_Local, (word)(lltable[k].l_val.offset-1), "local");
  360.             break;
  361.  
  362.          /* Declarations. */
  363.  
  364.          case Op_Proc:
  365.             getstr();
  366.             newline();
  367.             procname = putident(strlen(&lsspace[lsfree]) + 1, 0);
  368.             if (procname >= 0 && (gp = glocate(procname)) != NULL) {
  369.                /*
  370.                 * Initialize for wanted procedure.
  371.                 */
  372.                locinit();
  373.                clearlab();
  374.                lineno = 0;
  375.                implicit = gp->g_flag & F_ImpError;
  376.                nargs = gp->g_nargs;
  377.            align();
  378. #ifdef DeBugLinker
  379.                if (Dflag)
  380.                   fprintf(dbgfile, "\n# procedure %s\n", &lsspace[lsfree]);
  381. #endif                    /* DeBugLinker */
  382.                }
  383.             else {
  384.                /*
  385.                 * Skip unreferenced procedure.
  386.                 */
  387.                while ((op = getopc(&name)) != EOF && op != Op_End)
  388.                   if (op == Op_Filen)
  389.                      setfile();        /* handle filename op while skipping */
  390.                   else
  391.                      newline();        /* ignore everything else */
  392.                }
  393.             break;
  394.  
  395.          case Op_Local:
  396.             k = getdec();
  397.             flags = getoct();
  398.             id = getid();
  399.             putlocal(k, id, flags, implicit, procname);
  400.             break;
  401.  
  402.          case Op_Con:
  403.             k = getdec();
  404.             flags = getoct();
  405.             if (flags & F_IntLit) {
  406.                {
  407.                long m;
  408.                word s_indx;
  409.  
  410.                j = getdec();        /* number of characters in integer */
  411.                m = getint(j,&s_indx);    /* convert if possible */
  412.                if (m < 0) {         /* negative indicates integer too big */
  413.                   gg.sval = s_indx;    /* convert to a string */
  414.                   putconst(k, F_StrLit, j, pc, &gg);
  415.                   }
  416.                else {            /* integers is small enough */
  417.                   gg.ival = m;
  418.                   putconst(k, flags, 0, pc, &gg);
  419.                   }
  420.                }
  421.                }
  422.             else if (flags & F_RealLit) {
  423.                gg.rval = getreal();
  424.                putconst(k, flags, 0, pc, &gg);
  425.                }
  426.             else if (flags & F_StrLit) {
  427.                j = getdec();
  428.                gg.sval = getstrlit(j);
  429.                putconst(k, flags, j, pc, &gg);
  430.                }
  431.             else if (flags & F_CsetLit) {
  432.                j = getdec();
  433.                gg.sval = getstrlit(j);
  434.                putconst(k, flags, j, pc, &gg);
  435.                }
  436.             else
  437.                fprintf(stderr, "gencode: illegal constant\n");
  438.             newline();
  439.             lemitcon(k);
  440.             break;
  441.  
  442.          case Op_Filen:
  443.             setfile();
  444.             break;
  445.  
  446.          case Op_Declend:
  447.             newline();
  448.             gp->g_pc = pc;
  449.             lemitproc(procname, nargs, dynoff, lstatics-static1, static1);
  450.             break;
  451.  
  452.          case Op_End:
  453.             newline();
  454.             flushcode();
  455.             break;
  456.  
  457.          default:
  458.             fprintf(stderr, "gencode: illegal opcode(%d): %s\n", op, name);
  459.             newline();
  460.          }
  461.       }
  462.    }
  463.  
  464. /*
  465.  * setfile - handle Op_Filen.
  466.  */
  467. hidden novalue setfile()
  468.    {
  469.    if (fnmfree >= &fnmtbl[fnmsize])
  470.       fnmtbl = (struct ipc_fname *) trealloc(fnmtbl, &fnmfree,
  471.          &fnmsize, sizeof(struct ipc_fname), 1, "file name table");
  472.  
  473. #ifdef CRAY
  474.    fnmfree->ipc = pc/8;
  475. #else                    /* CRAY */
  476.    fnmfree->ipc = pc;
  477. #endif                    /* CRAY */
  478.  
  479.    fnmfree->fname = getrest();
  480.    fnmfree++;
  481.    newline();
  482.    }
  483.  
  484. /*
  485.  *  lemit - emit opcode.
  486.  *  lemitl - emit opcode with reference to program label.
  487.  *    for a description of the chaining and backpatching for labels.
  488.  *  lemitn - emit opcode with integer argument.
  489.  *  lemitr - emit opcode with pc-relative reference.
  490.  *  lemitin - emit opcode with reference to identifier table & integer argument.
  491.  *  lemitint - emit word opcode with integer argument.
  492.  *  lemitcon - emit constant table entry.
  493.  *  lemitproc - emit procedure block.
  494.  *
  495.  * The lemit* routines call out* routines to effect the "outputting" of icode.
  496.  *  Note that the majority of the code for the lemit* routines is for debugging
  497.  *  purposes.
  498.  */
  499. static novalue lemit(op, name)
  500. int op;
  501. char *name;
  502.    {
  503.  
  504. #ifdef DeBugLinker
  505.    if (Dflag)
  506.       fprintf(dbgfile, "%ld:\t%d\t\t\t\t# %s\n", (long)pc, op, name);
  507. #else                    /* DeBugLinker */
  508. #if MACINTOSH && MPW
  509. /* #pragma unused(name)    */
  510. #endif                    /* MACINTOSH && MPW */
  511. #endif                    /* DeBugLinker */
  512.  
  513.    outop(op);
  514.    }
  515.  
  516. static novalue lemitl(op, lab, name)
  517. int op, lab;
  518. char *name;
  519.    {
  520.    misalign();
  521.  
  522. #ifdef DeBugLinker
  523.    if (Dflag)
  524.       fprintf(dbgfile, "%ld:\t%d\tL%d\t\t\t# %s\n", (long)pc, op, lab, name);
  525. #else                    /* DeBugLinker */
  526. #if MACINTOSH && MPW
  527. /* #pragma unused(name)    */
  528. #endif                    /* MACINTOSH && MPW */
  529. #endif                    /* DeBugLinker */
  530.  
  531.    if (lab >= maxlabels)
  532.       labels  = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word),
  533.          lab - maxlabels + 1, "labels");
  534.    outop(op);
  535.    if (labels[lab] <= 0) {        /* forward reference */
  536.       outword(labels[lab]);
  537.       labels[lab] = WordSize - pc;    /* add to front of reference chain */
  538.       }
  539.    else                    /* output relative offset */
  540.  
  541. #ifdef CRAY
  542.       outword((labels[lab] - (pc + WordSize))/8);
  543. #else                    /* CRAY */
  544.       outword(labels[lab] - (pc + WordSize));
  545. #endif                    /* CRAY */
  546.    }
  547.  
  548. static novalue lemitn(op, n, name)
  549. int op;
  550. word n;
  551. char *name;
  552.    {
  553.    misalign();
  554.  
  555. #ifdef DeBugLinker
  556.    if (Dflag)
  557.       fprintf(dbgfile, "%ld:\t%d\t%ld\t\t\t# %s\n", (long)pc, op, (long)n,
  558.          name);
  559. #else                    /* DeBugLinker */
  560. #if MACINTOSH && MPW
  561. /* #pragma unused(name) */
  562. #endif                    /* MACINTOSH && MPW */
  563. #endif                    /* DeBugLinker */
  564.  
  565.    outop(op);
  566.    outword(n);
  567.    }
  568.  
  569.  
  570. static novalue lemitr(op, loc, name)
  571. int op;
  572. word loc;
  573. char *name;
  574.    {
  575.    misalign();
  576.  
  577. #ifdef CRAY
  578.    loc = (loc - pc - 16)/8;
  579. #else                    /* CRAY */
  580.    loc -= pc + ((IntBits/ByteBits) + WordSize);
  581. #endif                    /* CRAY */
  582.  
  583. #ifdef DeBugLinker
  584.    if (Dflag) {
  585.       if (loc >= 0)
  586.          fprintf(dbgfile, "%ld:\t%d\t*+%ld\t\t\t# %s\n",(long) pc, op,
  587.             (long)loc, name);
  588.       else
  589.          fprintf(dbgfile, "%ld:\t%d\t*-%ld\t\t\t# %s\n",(long) pc, op,
  590.             (long)-loc, name);
  591.       }
  592. #else                    /* DeBugLinker */
  593. #if MACINTOSH && MPW
  594. /* #pragma unused(name) */
  595. #endif                    /* MACINTOSH && MPW */
  596. #endif                    /* DeBugLinker */
  597.  
  598.    outop(op);
  599.    outword(loc);
  600.    }
  601.  
  602. static novalue lemitin(op, offset, n, name)
  603. int op, n;
  604. word offset;
  605. char *name;
  606.    {
  607.    misalign();
  608.  
  609. #ifdef DeBugLinker
  610.    if (Dflag)
  611.       fprintf(dbgfile, "%ld:\t%d\t%d,S+%ld\t\t\t# %s\n", (long)pc, op, n,
  612.          (long)offset, name);
  613. #else                    /* DeBugLinker */
  614. #if MACINTOSH && MPW
  615. /* #pragma unused(name) */
  616. #endif                    /* MACINTOSH && MPW */
  617. #endif                    /* DeBugLinker */
  618.  
  619.    outop(op);
  620.    outword(n);
  621.    outword(offset);
  622.    }
  623.  
  624. /*
  625.  * lemitint can have some pitfalls.  outword is used to output the
  626.  *  integer and this is picked up in the interpreter as the second
  627.  *  word of a short integer.  The integer value output must be
  628.  *  the same size as what the interpreter expects.  See op_int and op_intx
  629.  *  in interp.s
  630.  */
  631. static novalue lemitint(op, i, name)
  632. int op;
  633. long i;
  634. char *name;
  635.    {
  636.    misalign();
  637.  
  638. #ifdef DeBugLinker
  639.    if (Dflag)
  640.       fprintf(dbgfile,"%ld:\t%d\t%ld\t\t\t# %s\n",(long)pc,op,(long)i,name);
  641. #else                    /* DeBugLinker */
  642. #if MACINTOSH && MPW
  643. /* #pragma unused(name) */
  644. #endif                    /* MACINTOSH && MPW */
  645. #endif                    /* DeBugLinker */
  646.  
  647.    outop(op);
  648.    outword(i);
  649.    }
  650.  
  651. static novalue lemitcon(k)
  652. register int k;
  653.    {
  654.    register int i, j;
  655.    register char *s;
  656.    int csbuf[CsetSize];
  657.    union {
  658.       char ovly[1];  /* Array used to overlay l and f on a bytewise basis. */
  659.       long l;
  660.       double f;
  661.       } x;
  662.  
  663.    if (lctable[k].c_flag & F_RealLit) {
  664.  
  665. #ifdef Double
  666. /* access real values one word at a time */
  667.       {  int *rp, *rq;
  668.          rp = (int *) &(x.f);
  669.          rq = (int *) &(lctable[k].c_val.rval);
  670.          *rp++ = *rq++;
  671.          *rp    = *rq;
  672.       }
  673. #else                    /* Double */
  674.       x.f = lctable[k].c_val.rval;
  675. #endif                    /* Double */
  676.  
  677. #ifdef DeBugLinker
  678.       if (Dflag) {
  679.          fprintf(dbgfile, "%ld:\t%d\t\t\t\t# real(%g)", (long)pc, T_Real, x.f);
  680.          dumpblock(x.ovly,sizeof(double));
  681.          }
  682. #endif                    /* DeBugLinker */
  683.  
  684.       outword(T_Real);
  685.  
  686. #ifdef Double
  687. #if WordBits != 64
  688. /* fill out real block with an empty word */
  689.       outword(0);
  690. #ifdef DeBugLinker
  691.       if (Dflag)
  692.      fprintf(dbgfile,"\t0\t\t\t\t\t# padding\n");
  693. #endif                    /* DeBugLinker */
  694. #endif                    /* WordBits != 64 */
  695. #endif                    /* Double */
  696.  
  697.       outblock(x.ovly,sizeof(double));
  698.       }
  699.    else if (lctable[k].c_flag & F_CsetLit) {
  700.       for (i = 0; i < CsetSize; i++)
  701.          csbuf[i] = 0;
  702.       s = &lsspace[lctable[k].c_val.sval];
  703.       i = lctable[k].c_length;
  704.       while (i--) {
  705.          Setb(ToAscii(*s), csbuf);
  706.          s++;
  707.          }
  708.       j = 0;
  709.       for (i = 0; i < 256; i++) {
  710.          if (Testb(i, csbuf))
  711.            j++;
  712.          }
  713.  
  714. #ifdef DeBugLinker
  715.       if (Dflag) {
  716.          fprintf(dbgfile, "%ld:\t%d\n",(long) pc, T_Cset);
  717.          fprintf(dbgfile, "\t%d\n",j);
  718.          }
  719. #endif                    /* DeBugLinker */
  720.  
  721.       outword(T_Cset);
  722.       outword(j);           /* cset size */
  723.       outblock((char *)csbuf,sizeof(csbuf));
  724.  
  725. #ifdef DeBugLinker
  726.       if (Dflag)
  727.          dumpblock((char *)csbuf,CsetSize);
  728. #endif                    /* DeBugLinker */
  729.  
  730.       }
  731.    }
  732.  
  733. static novalue lemitproc(name, nargs, ndyn, nstat, fstat)
  734. word name;
  735. int nargs, ndyn, nstat, fstat;
  736.    {
  737.    register int i;
  738.    register char *p;
  739.    word s_indx;
  740.    int size;
  741.    /*
  742.     * FncBlockSize = sizeof(BasicFncBlock) +
  743.     *  sizeof(descrip)*(# of args + # of dynamics + # of statics).
  744.     */
  745. #ifdef MultiThread
  746.    size = (10*WordSize) + (2*WordSize) * (abs(nargs)+ndyn+nstat);
  747. #else                    /* MultiThread */
  748.    size = (9*WordSize) + (2*WordSize) * (abs(nargs)+ndyn+nstat);
  749. #endif                    /* MultiThread */
  750.  
  751.    p = &lsspace[name];
  752. #ifdef DeBugLinker
  753.    if (Dflag) {
  754.       fprintf(dbgfile, "%ld:\t%d\n", (long)pc, T_Proc); /* type code */
  755.       fprintf(dbgfile, "\t%d\n", size);            /* size of block */
  756.       fprintf(dbgfile, "\tZ+%ld\n",(long)(pc+size));    /* entry point */
  757.       fprintf(dbgfile, "\t%d\n", nargs);        /* # arguments */
  758.       fprintf(dbgfile, "\t%d\n", ndyn);            /* # dynamic locals */
  759.       fprintf(dbgfile, "\t%d\n", nstat);        /* # static locals */
  760.       fprintf(dbgfile, "\t%d\n", fstat);        /* first static */
  761.       fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n",    /* name of procedure */
  762.          (int)strlen(p), (long)(name), p);
  763.       }
  764. #endif                    /* DeBugLinker */
  765.  
  766.    outword(T_Proc);
  767.    outword(size);
  768.    outword(pc + size - 2*WordSize); /* Have to allow for the two words
  769.                             that we've already output. */
  770.    outword(nargs);
  771.    outword(ndyn);
  772.    outword(nstat);
  773.    outword(fstat);
  774. #ifdef MultiThread
  775.    outword(0);            /* program (filled in by interp) */
  776. #endif                /* MultiThread */
  777.    outword(strlen(p));          /* procedure name: length & offset */
  778.    outword(name);
  779.  
  780.    /*
  781.     * Output string descriptors for argument names by looping through
  782.     *  all locals, and picking out those with F_Argument set.
  783.     */
  784.    for (i = 0; i <= nlocal; i++) {
  785.       if (lltable[i].l_flag & F_Argument) {
  786.          s_indx = lltable[i].l_name;
  787.          p = &lsspace[s_indx];
  788.  
  789. #ifdef DeBugLinker
  790.          if (Dflag)
  791.             fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
  792.                (long)s_indx, p);
  793. #endif                    /* DeBugLinker */
  794.  
  795.          outword(strlen(p));
  796.          outword(s_indx);
  797.          }
  798.       }
  799.  
  800.    /*
  801.     * Output string descriptors for local variable names.
  802.     */
  803.    for (i = 0; i <= nlocal; i++) {
  804.       if (lltable[i].l_flag & F_Dynamic) {
  805.          s_indx = lltable[i].l_name;
  806.          p = &lsspace[s_indx];
  807.  
  808. #ifdef DeBugLinker
  809.          if (Dflag)
  810.             fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
  811.                (long)s_indx, p);
  812. #endif                    /* DeBugLinker */
  813.  
  814.          outword(strlen(p));
  815.          outword(s_indx);
  816.          }
  817.       }
  818.  
  819.    /*
  820.     * Output string descriptors for static variable names.
  821.     */
  822.    for (i = 0; i <= nlocal; i++) {
  823.       if (lltable[i].l_flag & F_Static) {
  824.          s_indx = lltable[i].l_name;
  825.          p = &lsspace[s_indx];
  826.  
  827. #ifdef DeBugLinker
  828.          if (Dflag)
  829.             fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
  830.                (long)s_indx, p);
  831. #endif                    /* DeBugLinker */
  832.  
  833.          outword(strlen(p));
  834.          outword(s_indx);
  835.          }
  836.       }
  837.    }
  838.  
  839. /*
  840.  * gentables - generate interpreter code for global, static,
  841.  *  identifier, and record tables, and built-in procedure blocks.
  842.  */
  843.  
  844. novalue gentables()
  845.    {
  846.    register int i;
  847.    register char *s;
  848.    register struct gentry *gp;
  849.    struct fentry *fp;
  850.    struct rentry *rp;
  851.    struct header hdr;
  852.  
  853. #if MVS
  854.    FILE *toutfile;        /* temporary file for icode output */
  855. #endif                    /* MVS */
  856.  
  857.    /*
  858.     * Output record constructor procedure blocks.
  859.     */
  860.    align();
  861.    hdr.Records = pc;
  862.  
  863. #ifdef DeBugLinker
  864.    if (Dflag) {
  865.       fprintf(dbgfile,"\n\n# global tables\n");
  866.       fprintf(dbgfile,"\n%ld:\t%d\t\t\t\t# record blocks\n",(long)pc,nrecords);
  867.       }
  868. #endif                    /* DeBugLinker */
  869.  
  870.    outword(nrecords);
  871.    for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
  872.       if ((gp->g_flag & F_Record) && gp->g_procid > 0) {
  873.          s = &lsspace[gp->g_name];
  874.          gp->g_pc = pc;
  875.  
  876. #ifdef DeBugLinker
  877.          if (Dflag) {
  878.             fprintf(dbgfile, "%ld:\n", pc);
  879.             fprintf(dbgfile, "\t%d\n", T_Proc);
  880.             fprintf(dbgfile, "\t%d\n", RkBlkSize(gp));
  881.             fprintf(dbgfile, "\t_mkrec\n");
  882.             fprintf(dbgfile, "\t%d\n", gp->g_nargs);
  883.             fprintf(dbgfile, "\t-2\n");
  884.             fprintf(dbgfile, "\t%d\n", gp->g_procid);
  885.             fprintf(dbgfile, "\t1\n");
  886.             fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(s),
  887.                (long)gp->g_name, s);
  888.             }
  889.  
  890. #endif                    /* DeBugLinker */
  891.  
  892.          outword(T_Proc);        /* type code */
  893.          outword(RkBlkSize(gp));
  894.          outword(0);            /* entry point (filled in by interp)*/
  895.          outword(gp->g_nargs);        /* number of fields */
  896.          outword(-2);            /* record constructor indicator */
  897.          outword(gp->g_procid);        /* record id */
  898.          outword(1);            /* serial number */
  899. #ifdef MultiThread
  900.          outword(0);            /* program (filled in by interp) */
  901. #endif                    /* MultiThread */
  902.          outword(strlen(s));        /* name of record: size and offset */
  903.          outword(gp->g_name);
  904.  
  905.          for (i=0;i<gp->g_nargs;i++) {    /* field names (filled in by interp) */
  906.             int foundit = 0;
  907.             /*
  908.              * Find the field list entry corresponding to field i in
  909.              * record gp, then write out a descriptor for it.
  910.              */
  911.             for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
  912.                for (rp = fp->f_rlist; rp!= NULL; rp=rp->r_link) {
  913.                   if (rp->r_gp == gp && rp->r_fnum == i) {
  914.                      if (foundit) {
  915.                         /*
  916.                          * This internal error should never occur
  917.                          */
  918.                         fprintf(stderr,"found rec %d field %d already!!\n",
  919.                             gp->g_procid, i);
  920.                         fflush(stderr);
  921.                         exit(1);
  922.                         }
  923. #ifdef DeBugLinker
  924.                      if (Dflag)
  925.                         fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n",
  926.                            (int)strlen(&lsspace[fp->f_name]),
  927.                            fp->f_name, &lsspace[fp->f_name]);
  928. #endif                    /* DeBugLinker */
  929.                      outword(strlen(&lsspace[fp->f_name]));
  930.                      outword(fp->f_name);
  931.                      foundit++;
  932.                      }
  933.                   }
  934.                }
  935.             if (!foundit) {
  936.                /*
  937.                 * This internal error should never occur
  938.                 */
  939.                fprintf(stderr,"never found rec %d field %d!!\n",
  940.                        gp->g_procid,i);
  941.                fflush(stderr);
  942.                exit(1);
  943.                }
  944.             }
  945.          }
  946.       }
  947.  
  948.    /*
  949.     * Output record/field table.
  950.     */
  951.    hdr.Ftab = pc;
  952.  
  953. #ifdef DeBugLinker
  954.    if (Dflag)
  955.       fprintf(dbgfile, "\n%ld:\t\t\t\t\t# record/field table\n", (long)pc);
  956. #endif                    /* DeBugLinker */
  957.  
  958.    for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
  959.  
  960. #ifdef DeBugLinker
  961.       if (Dflag)
  962.          fprintf(dbgfile, "%ld:\t\t\t\t\t# %s\n", (long)pc,
  963.             &lsspace[fp->f_name]);
  964. #endif                    /* DeBugLinker */
  965.  
  966.       rp = fp->f_rlist;
  967.       for (i = 1; i <= nrecords; i++) {
  968.          while (rp != NULL && rp->r_gp->g_procid < 0)
  969.             rp = rp->r_link;        /* skip unreferenced constructor */
  970.          if (rp != NULL && rp->r_gp->g_procid == i) {
  971.  
  972. #ifdef DeBugLinker
  973.             if (Dflag)
  974.                 fprintf(dbgfile, "\t%d\n", rp->r_fnum);
  975. #endif                    /* DeBugLinker */
  976.  
  977.             outop(rp->r_fnum);
  978.  
  979.             rp = rp->r_link;
  980.             }
  981.          else {
  982.  
  983. #ifdef DeBugLinker
  984.             if (Dflag)
  985.                 fprintf(dbgfile, "\t-1\n");
  986. #endif                    /* DeBugLinker */
  987.  
  988.             outop(-1);
  989.             }
  990.  
  991. #ifdef DeBugLinker
  992.          if (Dflag && (i == nrecords || (i & 03) == 0))
  993.             putc('\n', dbgfile);
  994. #endif                    /* DeBugLinker */
  995.  
  996.          }
  997.       }
  998.  
  999.    /*
  1000.     * Output descriptors for field names.
  1001.     */
  1002.  
  1003.    align();
  1004.    hdr.Fnames = pc;
  1005.    for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
  1006.       s = &lsspace[fp->f_name];
  1007.  
  1008. #ifdef DeBugLinker
  1009.       if (Dflag)
  1010.          fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n",
  1011.             (long)pc, (int)strlen(s), (long)fp->f_name, s);
  1012. #endif                    /* DeBugLinker */
  1013.  
  1014.       outword(strlen(s));      /* name of field: length & offset */
  1015.       outword(fp->f_name);
  1016.    }
  1017.  
  1018.  
  1019.    /*
  1020.     * Output global variable descriptors.
  1021.     */
  1022.    hdr.Globals = pc;
  1023.    for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
  1024.       if (gp->g_flag & F_Builtin) {        /* function */
  1025.  
  1026. #ifdef DeBugLinker
  1027.          if (Dflag)
  1028.             fprintf(dbgfile, "%ld:\t%06lo\t%d\t\t\t# %s\n",
  1029.                 (long)pc, (long)D_Proc, -gp->g_procid, &lsspace[gp->g_name]);
  1030. #endif                    /* DeBugLinker */
  1031.  
  1032.          outword(D_Proc);
  1033.          outword(-gp->g_procid);
  1034.          }
  1035.       else if (gp->g_flag & F_Proc) {        /* Icon procedure */
  1036.  
  1037. #ifdef DeBugLinker
  1038.          if (Dflag)
  1039.             fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n",
  1040.                 (long)pc,(long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]);
  1041. #endif                    /* DeBugLinker */
  1042.  
  1043.          outword(D_Proc);
  1044.          outword(gp->g_pc);
  1045.          }
  1046.       else if (gp->g_flag & F_Record) {        /* record constructor */
  1047.  
  1048. #ifdef DeBugLinker
  1049.          if (Dflag)
  1050.             fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n",
  1051.                 (long)pc, (long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]);
  1052. #endif                    /* DeBugLinker */
  1053.  
  1054.          outword(D_Proc);
  1055.          outword(gp->g_pc);
  1056.          }
  1057.       else {                    /* simple global variable */
  1058.  
  1059. #ifdef DeBugLinker
  1060.          if (Dflag)
  1061.             fprintf(dbgfile, "%ld:\t%06lo\t0\t\t\t# %s\n",(long)pc,
  1062.                (long)D_Null, &lsspace[gp->g_name]);
  1063. #endif                    /* DeBugLinker */
  1064.  
  1065.          outword(D_Null);
  1066.          outword(0);
  1067.          }
  1068.       }
  1069.  
  1070.    /*
  1071.     * Output descriptors for global variable names.
  1072.     */
  1073.    hdr.Gnames = pc;
  1074.    for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
  1075.  
  1076. #ifdef DeBugLinker
  1077.       if (Dflag)
  1078.          fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n",
  1079.             (long)pc, (int)strlen(&lsspace[gp->g_name]), (long)(gp->g_name),
  1080.                &lsspace[gp->g_name]);
  1081. #endif                    /* DeBugLinker */
  1082.  
  1083.       outword(strlen(&lsspace[gp->g_name]));
  1084.       outword(gp->g_name);
  1085.       }
  1086.  
  1087.    /*
  1088.     * Output a null descriptor for each static variable.
  1089.     */
  1090.    hdr.Statics = pc;
  1091.    for (i = lstatics; i > 0; i--) {
  1092.  
  1093. #ifdef DeBugLinker
  1094.       if (Dflag)
  1095.          fprintf(dbgfile, "%ld:\t0\t0\n", (long)pc);
  1096. #endif                    /* DeBugLinker */
  1097.  
  1098.       outword(D_Null);
  1099.       outword(0);
  1100.       }
  1101.    flushcode();
  1102.  
  1103.    /*
  1104.     * Output the string constant table and the two tables associating icode
  1105.     *  locations with source program locations.  Note that the calls to write
  1106.     *  really do all the work.
  1107.     */
  1108.  
  1109.    hdr.Filenms = pc;
  1110.    if (longwrite((char *)fnmtbl, (long)((char *)fnmfree - (char *)fnmtbl),
  1111.       outfile) < 0)
  1112.          quit("cannot write icode file");
  1113.  
  1114. #ifdef DeBugLinker
  1115.    if (Dflag) {
  1116.       int k = 0;
  1117.       struct ipc_fname *ptr;
  1118.       for (ptr = fnmtbl; ptr < fnmfree; ptr++) {
  1119.          fprintf(dbgfile, "%ld:\t%03d\tS+%03d\t\t\t# %s\n",
  1120.             (long)(pc + k), ptr->ipc, ptr->fname, &lsspace[ptr->fname]);
  1121.          k = k + 8;
  1122.          }
  1123.       putc('\n', dbgfile);
  1124.       }
  1125.  
  1126. #endif                    /* DeBugLinker */
  1127.  
  1128.    pc += (char *)fnmfree - (char *)fnmtbl;
  1129.  
  1130.    hdr.linenums = pc;
  1131.    if (longwrite((char *)lntable, (long)((char *)lnfree - (char *)lntable),
  1132.       outfile) < 0)
  1133.          quit("cannot write icode file");
  1134.  
  1135. #ifdef DeBugLinker
  1136.    if (Dflag) {
  1137.       int k = 0;
  1138.       struct ipc_line *ptr;
  1139.       for (ptr = lntable; ptr < lnfree; ptr++) {
  1140.          fprintf(dbgfile, "%ld:\t%03d\t%03d\n", (long)(pc + k),
  1141.             ptr->ipc, ptr->line);
  1142.          k = k + 8;
  1143.          }
  1144.       putc('\n', dbgfile);
  1145.       }
  1146.  
  1147. #endif                    /* DeBugLinker */
  1148.  
  1149.    pc += (char *)lnfree - (char *)lntable;
  1150.  
  1151.    hdr.Strcons = pc;
  1152. #ifdef DeBugLinker
  1153.    if (Dflag) {
  1154.       int c, j, k;
  1155.       j = k = 0;
  1156.       for (s = lsspace; s < &lsspace[lsfree]; ) {
  1157.          fprintf(dbgfile, "%ld:\t%03o", (long)(pc + k), *s++ & 0377);
  1158.          k = k + 8;
  1159.          for (i = 7; i > 0; i--) {
  1160.             if (s >= &lsspace[lsfree])
  1161.                fprintf(dbgfile,"    ");
  1162.             else
  1163.                fprintf(dbgfile, " %03o", *s++ & 0377);
  1164.             }
  1165.          fprintf(dbgfile, "   ");
  1166.          for (i = 0; i < 8; i++)
  1167.             if (j < lsfree)
  1168.                putc(isprint(c = lsspace[j++] & 0377) ? c : ' ', dbgfile);
  1169.          putc('\n', dbgfile);
  1170.          }
  1171.       }
  1172.  
  1173. #endif                    /* DeBugLinker */
  1174.  
  1175.  
  1176.    if (longwrite(lsspace, (long)lsfree, outfile) < 0)
  1177.          quit("cannot write icode file");
  1178.  
  1179.    pc += lsfree;
  1180.  
  1181.    /*
  1182.     * Output icode file header.
  1183.     */
  1184.    hdr.hsize = pc;
  1185.    strcpy((char *)hdr.config,IVersion);
  1186.    hdr.trace = trace;
  1187.  
  1188.  
  1189. #ifdef DeBugLinker
  1190.    if (Dflag) {
  1191.       fprintf(dbgfile, "\n");
  1192.       fprintf(dbgfile, "size:     %ld\n", (long)hdr.hsize);
  1193.       fprintf(dbgfile, "trace:     %ld\n", (long)hdr.trace);
  1194.       fprintf(dbgfile, "records: %ld\n", (long)hdr.Records);
  1195.       fprintf(dbgfile, "ftab:     %ld\n", (long)hdr.Ftab);
  1196.       fprintf(dbgfile, "fnames:  %ld\n", (long)hdr.Fnames);
  1197.       fprintf(dbgfile, "globals: %ld\n", (long)hdr.Globals);
  1198.       fprintf(dbgfile, "gnames:  %ld\n", (long)hdr.Gnames);
  1199.       fprintf(dbgfile, "statics: %ld\n", (long)hdr.Statics);
  1200.       fprintf(dbgfile, "strcons:   %ld\n", (long)hdr.Strcons);
  1201.       fprintf(dbgfile, "filenms:   %ld\n", (long)hdr.Filenms);
  1202.       fprintf(dbgfile, "linenums:   %ld\n", (long)hdr.linenums);
  1203.       fprintf(dbgfile, "config:   %s\n", hdr.config);
  1204.       }
  1205. #endif                    /* DeBugLinker */
  1206.  
  1207. #ifdef Header
  1208.    fseek(outfile, hdrsize, 0);
  1209. #else                                   /* Header */
  1210.  
  1211. #if MVS
  1212. /*
  1213.  * This kind of backpatching cannot work on a PDS member, and that's
  1214.  *  probably where the code is going.  So the code goes out first to
  1215.  *  a temporary file, and then copied to the real icode file after
  1216.  *  the header is written.
  1217.  */
  1218.    fseek(outfile, sizeof(hdr), SEEK_SET);
  1219.    toutfile = outfile;
  1220.    outfile = fopen(routname, WriteBinary);
  1221.    if (outfile == NULL)
  1222.       quitf("cannot create %s",routname);
  1223. #else
  1224. #if MSDOS
  1225.    fseek(outfile, fileOffsetOfStuffThatGoesInICX, 0);
  1226. #else                    /* MSDOS */
  1227.    fseek(outfile, 0L, 0);
  1228. #endif                    /* MSDOS */
  1229. #endif                                  /* MVS */
  1230. #endif                                  /* Header */
  1231.  
  1232.    if (longwrite((char *)&hdr, (long)sizeof(hdr), outfile) < 0)
  1233.       quit("cannot write icode file");
  1234.  
  1235. #if MVS
  1236.    {
  1237.       char *allelse = malloc(hdr.hsize);
  1238.       if (hdr.hsize != fread(allelse, 1, hdr.hsize, toutfile) ||
  1239.           longwrite(allelse, hdr.hsize, outfile) < 0)
  1240.             quit("cannot write icode file");
  1241.       free(allelse);
  1242.       fclose(toutfile);
  1243.    }
  1244. #endif                    /* MVS */
  1245.  
  1246.    if (verbose >= 2) {
  1247.       word tsize = sizeof(hdr) + hdr.hsize;
  1248. #ifdef Header
  1249.       fprintf(stderr, "  bootstrap  %7ld\n", hdrsize);
  1250.       tsize += hdrsize;
  1251. #endif                    /* Header */
  1252.       fprintf(stderr, "  header     %7ld\n", (long)sizeof(hdr));
  1253.       fprintf(stderr, "  procedures %7ld\n", (long)hdr.Records);
  1254.       fprintf(stderr, "  records    %7ld\n", (long)(hdr.Ftab - hdr.Records));
  1255.       fprintf(stderr, "  fields     %7ld\n", (long)(hdr.Globals - hdr.Ftab));
  1256.       fprintf(stderr, "  globals    %7ld\n", (long)(hdr.Statics - hdr.Globals));
  1257.       fprintf(stderr, "  statics    %7ld\n", (long)(hdr.Filenms - hdr.Statics));
  1258.       fprintf(stderr, "  linenums   %7ld\n", (long)(hdr.Strcons - hdr.Filenms));
  1259.       fprintf(stderr, "  strings    %7ld\n", (long)(hdr.hsize - hdr.Strcons));
  1260.       fprintf(stderr, "  total      %7ld\n", (long)tsize);
  1261.       }
  1262.    }
  1263.  
  1264. /*
  1265.  * align() outputs zeroes as padding until pc is a multiple of WordSize.
  1266.  */
  1267. static novalue align()
  1268.    {
  1269.    static word x = 0;
  1270.  
  1271.    if (pc % WordSize != 0)
  1272.       outblock((char *)&x, (int)(WordSize - (pc % WordSize)));
  1273.    }
  1274.  
  1275. /*
  1276.  * misalign() outputs a Noop instruction for padding if pc + sizeof(int)
  1277.  *  is not a multiple of WordSize.  This is for operations that output
  1278.  *  an int opcode followed by an operand that needs to be word-aligned.
  1279.  */
  1280. static novalue misalign()
  1281.    {
  1282.    if ((pc + IntBits/ByteBits) % WordSize != 0)
  1283.       lemit(Op_Noop, "noop [pad]");
  1284.    }
  1285.  
  1286. /*
  1287.  * intout(i) outputs i as an int that is used by the runtime system
  1288.  *  IntBits/ByteBits bytes must be moved from &word[0] to &codep[0].
  1289.  */
  1290. static novalue intout(oint)
  1291. int oint;
  1292.    {
  1293.    int i;
  1294.    union {
  1295.       int i;
  1296.       char c[IntBits/ByteBits];
  1297.       } u;
  1298.  
  1299.    CodeCheck(IntBits/ByteBits);
  1300.    u.i = oint;
  1301.  
  1302.    for (i = 0; i < IntBits/ByteBits; i++)
  1303.       codep[i] = u.c[i];
  1304.  
  1305.    codep += IntBits/ByteBits;
  1306.    pc += IntBits/ByteBits;
  1307.    }
  1308.  
  1309. /*
  1310.  * wordout(i) outputs i as a word that is used by the runtime system
  1311.  *  WordSize bytes must be moved from &oword[0] to &codep[0].
  1312.  */
  1313. static novalue wordout(oword)
  1314. word oword;
  1315.    {
  1316.    int i;
  1317.    union {
  1318.         word i;
  1319.         char c[WordSize];
  1320.         } u;
  1321.  
  1322.    CodeCheck(WordSize);
  1323.    u.i = oword;
  1324.  
  1325.    for (i = 0; i < WordSize; i++)
  1326.       codep[i] = u.c[i];
  1327.  
  1328.    codep += WordSize;
  1329.    pc += WordSize;
  1330.    }
  1331.  
  1332. /*
  1333.  * outblock(a,i) output i bytes starting at address a.
  1334.  */
  1335. static novalue outblock(addr,count)
  1336. char *addr;
  1337. int count;
  1338.    {
  1339.    CodeCheck(count);
  1340.    pc += count;
  1341.    while (count--)
  1342.       *codep++ = *addr++;
  1343.    }
  1344.  
  1345. #ifdef DeBugLinker
  1346. /*
  1347.  * dumpblock(a,i) dump contents of i bytes at address a, used only
  1348.  *  in conjunction with -L.
  1349.  */
  1350. static novalue dumpblock(addr, count)
  1351. char *addr;
  1352. int count;
  1353.    {
  1354.    int i;
  1355.    for (i = 0; i < count; i++) {
  1356.       if ((i & 7) == 0)
  1357.          fprintf(dbgfile,"\n\t");
  1358.       fprintf(dbgfile," %03o",(0377 & (unsigned)addr[i]));
  1359.       }
  1360.    putc('\n',dbgfile);
  1361.    }
  1362. #endif                    /* DeBugLinker */
  1363.  
  1364. /*
  1365.  * flushcode - write buffered code to the output file.
  1366.  */
  1367. static novalue flushcode()
  1368.    {
  1369.    if (codep > codeb)
  1370.       if (longwrite(codeb, DiffPtrs(codep,codeb), outfile) < 0)
  1371.          quit("cannot write icode file");
  1372.    codep = codeb;
  1373.    }
  1374.  
  1375. /*
  1376.  * clearlab - clear label table to all zeroes.
  1377.  */
  1378. static novalue clearlab()
  1379.    {
  1380.    register int i;
  1381.  
  1382.    for (i = 0; i < maxlabels; i++)
  1383.       labels[i] = 0;
  1384.    }
  1385.  
  1386. /*
  1387.  * backpatch - fill in all forward references to lab.
  1388.  */
  1389. static novalue backpatch(lab)
  1390. int lab;
  1391.    {
  1392.    word p, r;
  1393.    char *q;
  1394.    char *cp, *cr;
  1395.    register int j;
  1396.  
  1397.    if (lab >= maxlabels)
  1398.       labels  = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word),
  1399.          lab - maxlabels + 1, "labels");
  1400.  
  1401.    p = labels[lab];
  1402.    if (p > 0)
  1403.       quit("multiply defined label in ucode");
  1404.    while (p < 0) {        /* follow reference chain */
  1405.  
  1406. #ifdef CRAY
  1407.       r = (pc - (WordSize - p))/8;    /* compute relative offset */
  1408. #else                    /* CRAY */
  1409.       r = pc - (WordSize - p);    /* compute relative offset */
  1410. #endif                    /* CRAY */
  1411.       q = codep - (pc + p);    /* point to word with address */
  1412.       cp = (char *) &p;        /* address of integer p       */
  1413.       cr = (char *) &r;        /* address of integer r       */
  1414.       for (j = 0; j < WordSize; j++) {      /* move bytes from word pointed to */
  1415.          *cp++ = *q;              /* by q to p, and move bytes from */
  1416.          *q++ = *cr++;              /* r to word pointed to by q */
  1417.          }            /* moves integers at arbitrary addresses */
  1418.       }
  1419.    labels[lab] = pc;
  1420.    }
  1421.  
  1422. #ifdef DeBugLinker
  1423. novalue idump(s)        /* dump code region */
  1424.    char *s;
  1425.    {
  1426.    int *c;
  1427.  
  1428.    fprintf(stderr,"\ndump of code region %s:\n",s);
  1429.    for (c = (int *)codeb; c < (int *)codep; c++)
  1430.        fprintf(stderr,"%ld: %d\n",(long)c, (int)*c);
  1431.    fflush(stderr);
  1432.    }
  1433. #endif                    /* DeBugLinker */
  1434.