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