home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / pascal / src / fdec.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-16  |  6.9 KB  |  307 lines
  1. /*-
  2.  * Copyright (c) 1980 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * Redistribution and use in source and binary forms, with or without
  6.  * modification, are permitted provided that the following conditions
  7.  * are met:
  8.  * 1. Redistributions of source code must retain the above copyright
  9.  *    notice, this list of conditions and the following disclaimer.
  10.  * 2. Redistributions in binary form must reproduce the above copyright
  11.  *    notice, this list of conditions and the following disclaimer in the
  12.  *    documentation and/or other materials provided with the distribution.
  13.  * 3. All advertising materials mentioning features or use of this software
  14.  *    must display the following acknowledgement:
  15.  *    This product includes software developed by the University of
  16.  *    California, Berkeley and its contributors.
  17.  * 4. Neither the name of the University nor the names of its contributors
  18.  *    may be used to endorse or promote products derived from this software
  19.  *    without specific prior written permission.
  20.  *
  21.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  22.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  25.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31.  * SUCH DAMAGE.
  32.  */
  33.  
  34. #ifndef lint
  35. static char sccsid[] = "@(#)fdec.c    5.2 (Berkeley) 4/16/91";
  36. #endif /* not lint */
  37.  
  38. #include "whoami.h"
  39. #include "0.h"
  40. #include "tree.h"
  41. #include "opcode.h"
  42. #include "objfmt.h"
  43. #include "align.h"
  44. #include "tmps.h"
  45.  
  46. /*
  47.  * this array keeps the pxp counters associated with
  48.  * functions and procedures, so that they can be output
  49.  * when their bodies are encountered
  50.  */
  51. int    bodycnts[ DSPLYSZ ];
  52.  
  53. #ifdef PC
  54. #   include "pc.h"
  55. #   include <pcc.h>
  56. #endif PC
  57.  
  58. #ifdef OBJ
  59. int    cntpatch;
  60. int    nfppatch;
  61. #endif OBJ
  62.  
  63. funcfwd(fp)
  64.     struct nl *fp;
  65. {
  66.  
  67.         /*
  68.          *    save the counter for this function
  69.          */
  70.     if ( monflg ) {
  71.         fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
  72.     }
  73. }
  74.  
  75. /*
  76.  * Funcext marks the procedure or
  77.  * function external in the symbol
  78.  * table. Funcext should only be
  79.  * called if PC, and is an error
  80.  * otherwise.
  81.  */
  82.  
  83. struct nl *
  84. funcext(fp)
  85.     struct nl *fp;
  86. {
  87.  
  88. #ifdef OBJ
  89.     error("Procedures or functions cannot be declared external.");
  90. #endif OBJ
  91.  
  92. #ifdef PC
  93.         /*
  94.          *    save the counter for this function
  95.          */
  96.     if ( monflg ) {
  97.         fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
  98.     }
  99.      if (opt('s')) {
  100.         standard();
  101.         error("External procedures and functions are not standard");
  102.     } else {
  103.         if (cbn == 1) {
  104.             fp->extra_flags |= NEXTERN;
  105.             stabefunc( fp -> symbol , fp -> class , line );
  106.         }
  107.         else
  108.             error("External procedures and functions can only be declared at the outermost level.");
  109.     }
  110. #endif PC
  111.  
  112.     return(fp);
  113. }
  114.  
  115. /*
  116.  * Funcbody is called
  117.  * when the actual (resolved)
  118.  * declaration of a procedure is
  119.  * encountered. It puts the names
  120.  * of the (function) and parameters
  121.  * into the symbol table.
  122.  */
  123. struct nl *
  124. funcbody(fp)
  125.     struct nl *fp;
  126. {
  127.     register struct nl *q;
  128.  
  129.     cbn++;
  130.     if (cbn >= DSPLYSZ) {
  131.         error("Too many levels of function/procedure nesting");
  132.         pexit(ERRS);
  133.     }
  134.     tmpinit(cbn);
  135.     gotos[cbn] = NIL;
  136.     errcnt[cbn] = syneflg;
  137.     parts[ cbn ] = NIL;
  138.     dfiles[ cbn ] = FALSE;
  139.     if (fp == NIL)
  140.         return (NIL);
  141.     /*
  142.      * Save the virtual name
  143.      * list stack pointer so
  144.      * the space can be freed
  145.      * later (funcend).
  146.      */
  147.     fp->ptr[2] = nlp;
  148.     if (fp->class != PROG) {
  149.         for (q = fp->chain; q != NIL; q = q->chain) {
  150.             (void) enter(q);
  151. #            ifdef PC
  152.                 q -> extra_flags |= NPARAM;
  153. #            endif PC
  154.         }
  155.     }
  156.     if (fp->class == FUNC) {
  157.         /*
  158.          * For functions, enter the fvar
  159.          */
  160.         (void) enter(fp->ptr[NL_FVAR]);
  161. #        ifdef PC
  162.             q = fp -> ptr[ NL_FVAR ];
  163.             if (q -> type != NIL ) {
  164.             sizes[cbn].curtmps.om_off = q -> value[NL_OFFS];
  165.             sizes[cbn].om_max = q -> value[NL_OFFS];
  166.             }
  167. #        endif PC
  168.     }
  169. #    ifdef PTREE
  170.         /*
  171.          *    pick up the pointer to porf declaration
  172.          */
  173.         PorFHeader[ ++nesting ] = fp -> inTree;
  174. #    endif PTREE
  175.     return (fp);
  176. }
  177.  
  178. /*
  179.  * Segend is called to check for
  180.  * unresolved variables, funcs and
  181.  * procs, and deliver unresolved and
  182.  * baduse error diagnostics at the
  183.  * end of a routine segment (a separately
  184.  * compiled segment that is not the 
  185.  * main program) for PC. This
  186.  * routine should only be called
  187.  * by PC (not standard).
  188.  */
  189.  segend()
  190.  {
  191. #ifdef PC
  192.     register struct nl *p;
  193.     register int i,b;
  194.     char *cp;
  195.  
  196.     if ( monflg ) {
  197.         error("Only the module containing the \"program\" statement");
  198.         cerror("can be profiled with ``pxp''.\n");
  199.     }
  200.     if (opt('s')) {
  201.         standard();
  202.         error("Separately compiled routine segments are not standard.");
  203.     } else {
  204.         b = cbn;
  205.         for (i=0; i<077; i++) {
  206.             for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
  207.             switch (p->class) {
  208.                 case BADUSE:
  209.                     cp = "s";
  210.                     if (((struct udinfo *) (p->chain))->ud_next == NIL)
  211.                         cp++;
  212.                     eholdnl();
  213.                     if (p->value[NL_KINDS] & ISUNDEF)
  214.                         nerror("%s undefined on line%s", p->symbol, cp);
  215.                     else
  216.                         nerror("%s improperly used on line%s", p->symbol, cp);
  217.                     pnumcnt = 10;
  218.                     pnums((struct udinfo *) (p->chain));
  219.                     pchr('\n');
  220.                     break;
  221.                 
  222.                 case FUNC:
  223.                 case PROC:
  224.                     if ((p->nl_flags & NFORWD) &&
  225.                         ((p->extra_flags & NEXTERN) == 0))
  226.                         nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
  227.                     break;
  228.  
  229.                 case FVAR:
  230.                     if (((p->nl_flags & NMOD) == 0) &&
  231.                         ((p->chain->extra_flags & NEXTERN) == 0))
  232.                         nerror("No assignment to the function variable");
  233.                     break;
  234.                 }
  235.                }
  236.                disptab[i] = p;
  237.             }
  238.     }
  239. #endif PC
  240. #ifdef OBJ
  241.     error("Missing program statement and program body");
  242. #endif OBJ
  243.  
  244. }
  245.  
  246.  
  247. /*
  248.  * Level1 does level one processing for
  249.  * separately compiled routine segments
  250.  */
  251. level1()
  252. {
  253.  
  254. #    ifdef OBJ
  255.         error("Missing program statement");
  256. #    endif OBJ
  257. #    ifdef PC
  258.         if (opt('s')) {
  259.             standard();
  260.             error("Missing program statement");
  261.         }
  262. #    endif PC
  263.  
  264.     cbn++;
  265.     tmpinit(cbn);
  266.     gotos[cbn] = NIL;
  267.     errcnt[cbn] = syneflg;
  268.     parts[ cbn ] = NIL;
  269.     dfiles[ cbn ] = FALSE;
  270.     progseen = TRUE;
  271. }
  272.  
  273.  
  274.  
  275. pnums(p)
  276.     struct udinfo *p;
  277. {
  278.  
  279.     if (p->ud_next != NIL)
  280.         pnums(p->ud_next);
  281.     if (pnumcnt == 0) {
  282.         printf("\n\t");
  283.         pnumcnt = 20;
  284.     }
  285.     pnumcnt--;
  286.     printf(" %d", p->ud_line);
  287. }
  288.  
  289. /*VARARGS*/
  290. nerror(a1, a2, a3)
  291.     char *a1,*a2,*a3;
  292. {
  293.  
  294.     if (Fp != NIL) {
  295.         yySsync();
  296. #ifndef PI1
  297.         if (opt('l'))
  298.             yyoutline();
  299. #endif
  300.         yysetfile(filename);
  301.         printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
  302.         Fp = NIL;
  303.         elineoff();
  304.     }
  305.     error(a1, a2, a3);
  306. }
  307.