home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / trans.c < prev    next >
C/C++ Source or Header  |  1990-03-18  |  40KB  |  1,487 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18. #define define_globals
  19. #define PROTO_TRANS_C
  20. #include "trans.h"
  21.  
  22. #include <time.h>
  23.  
  24. /* Roadmap:
  25.  
  26.     trans.h         Declarations for all public global variables, types,
  27.                     and macros.  Functions are declared in separate
  28.                     files p2c.{proto,hdrs} which are created
  29.                     mechanically by the makeproto program.
  30.  
  31.     trans.c         Main program.  Parses the p2crc file.  Also reserves
  32.                     storage for public globals in trans.h.
  33.  
  34.     stuff.c         Miscellaneous support routines.
  35.  
  36.     out.c           Routines to handle the writing of C code to the output
  37.                     file.  This includes line breaking and indentation
  38.             support.
  39.  
  40.     comment.c       Routines for managing comments and comment lists.
  41.  
  42.     lex?.c          Lexical analyzer.  Manages input files and streams,
  43.                     splits input stream into Pascal tokens.  Parses
  44.             compiler directives and special comments.  Also keeps
  45.             the symbol table.
  46.  
  47.     parse?.c        Parsing and writing statements and blocks.
  48.  
  49.     decl?.c         Parsing and writing declarations.
  50.  
  51.     expr?.c         Manipulating expressions.
  52.  
  53.     pexpr?.c        Parsing and writing expressions.
  54.  
  55.     funcs?.c        Built-in special functions and procedures.
  56.  
  57.     dir.c           Interface file to "external" functions and procedures
  58.             such as hpmods and citmods.
  59.  
  60.     hpmods.c        Definitions for HP-supplied Pascal modules.
  61.  
  62.     citmods.c       Definitions for some Caltech-local Pascal modules.
  63.                     (Outside of Caltech this file is mostly useful
  64.                     as a large body of examples of how to write your
  65.                     own translator extensions.)
  66.  
  67.  
  68.     p2crc           Control file (read when p2c starts up).
  69.  
  70.     p2c.h           Header file used by translated programs.
  71.  
  72.     p2clib.c        Run-time library used by translated programs.
  73.  
  74. */
  75.  
  76.  
  77.  
  78.  
  79. Static Strlist *tweaksymbols, *synonyms;
  80. Strlist *addmacros;
  81.  
  82.  
  83.  
  84. Static void initrc()
  85. {
  86.     int i;
  87.  
  88.     for (i = 0; i < numparams; i++) {
  89.         switch (rctable[i].kind) {
  90.             case 'S':
  91.         case 'B':
  92.                 *((short *)rctable[i].ptr) = rctable[i].def;
  93.                 break;
  94.             case 'I':
  95.         case 'D':
  96.                 *((int *)rctable[i].ptr) = rctable[i].def;
  97.                 break;
  98.             case 'L':
  99.                 *((long *)rctable[i].ptr) = rctable[i].def;
  100.                 break;
  101.             case 'R':
  102.                 *((double *)rctable[i].ptr) = rctable[i].def/100.0;
  103.                 break;
  104.             case 'U':
  105.             case 'C':
  106.                 *((char *)rctable[i].ptr) = 0;
  107.                 break;
  108.             case 'A':
  109.                 *((Strlist **)rctable[i].ptr) = NULL;
  110.         break;
  111.         case 'X':
  112.         if (rctable[i].def == 1)
  113.             *((Strlist **)rctable[i].ptr) = NULL;
  114.         break;
  115.         }
  116.         rcprevvalues[i] = NULL;
  117.     }
  118.     tweaksymbols = NULL;
  119.     synonyms = NULL;
  120.     addmacros = NULL;
  121.     varmacros = NULL;
  122.     constmacros = NULL;
  123.     fieldmacros = NULL;
  124.     funcmacros = NULL;
  125. }
  126.  
  127. Static int readrc(rcname, need)
  128. char *rcname;
  129. int need;
  130. {
  131.     FILE *rc;
  132.     char buf[500], *cp, *cp2;
  133.     long val = 0;
  134.     int i;
  135.     Strlist *sl;
  136.  
  137.     rc = fopen(rcname, "r");
  138.     if (!rc) {
  139.         if (need)
  140.             perror(rcname);
  141.         return 0;
  142.     }
  143.     while (fgets(buf, 500, rc)) {
  144.         cp = my_strtok(buf, " =\t\n");
  145.         if (cp && *cp != '#') {
  146.             upc(cp);
  147.             i = numparams;
  148.             while (--i >= 0 && strcmp(rctable[i].name, cp)) ;
  149.             if (i >= 0) {
  150.                 if (rctable[i].kind != 'M') {
  151.                     cp = my_strtok(NULL, " =\t\n");
  152.                     if (cp && *cp == '#')
  153.                         cp = NULL;
  154.                     if (cp && (isdigit(*cp) || *cp == '-' || *cp == '+'))
  155.                         val = atol(cp);
  156.                     else
  157.                         val = rctable[i].def;
  158.                 }
  159.                 switch (rctable[i].kind) {
  160.  
  161.                     case 'S':
  162.                         *((short *)rctable[i].ptr) = val;
  163.                         break;
  164.  
  165.                     case 'I':
  166.                         *((int *)rctable[i].ptr) = val;
  167.                         break;
  168.  
  169.                     case 'D':
  170.                         *((int *)rctable[i].ptr) =
  171.                 parsedelta(cp, rctable[i].def);
  172.                         break;
  173.  
  174.                     case 'L':
  175.                         *((long *)rctable[i].ptr) = val;
  176.                         break;
  177.  
  178.             case 'R':
  179.             if (cp && (isdigit(*cp) || *cp == '-' || *cp == '.'))
  180.                 *((double *)rctable[i].ptr) = atof(cp);
  181.             else
  182.                 *((double *)rctable[i].ptr) = rctable[i].def/100.0;
  183.             break;
  184.  
  185.                     case 'U':
  186.                         if (cp)
  187.                             upc(cp);
  188.  
  189.                     /* fall through */
  190.                     case 'C':
  191.                         val = rctable[i].def;
  192.                         strncpy((char *)rctable[i].ptr, cp ? cp : "", val-1);
  193.                         ((char *)rctable[i].ptr)[val-1] = 0;
  194.                         break;
  195.  
  196.                     case 'F':
  197.                         while (cp && *cp != '#') {
  198.                             sl = strlist_append(&tweaksymbols,
  199.                         format_s("*%s", cp));
  200.                             sl->value = rctable[i].def;
  201.                             cp = my_strtok(NULL, " \t\n");
  202.                         }
  203.                         break;
  204.  
  205.                     case 'G':
  206.                         while (cp && *cp != '#') {
  207.                             sl = strlist_append(&tweaksymbols, cp);
  208.                             sl->value = rctable[i].def;
  209.                             cp = my_strtok(NULL, " \t\n");
  210.                         }
  211.                         break;
  212.  
  213.                     case 'A':
  214.                         while (cp && *cp != '#') {
  215.                             strlist_insert((Strlist **)rctable[i].ptr, cp);
  216.                             cp = my_strtok(NULL, " \t\n");
  217.                         }
  218.                         break;
  219.  
  220.                     case 'M':
  221.                         cp = my_strtok(NULL, "\n");
  222.                         if (cp) {
  223.                             while (isspace(*cp)) cp++;
  224.                             for (cp2 = cp; *cp2 && *cp2 != '#'; cp2++) ;
  225.                             *cp2 = 0;
  226.                             if (*cp) {
  227.                                 sl = strlist_append(&addmacros, cp);
  228.                                 sl->value = rctable[i].def;
  229.                             }
  230.                         }
  231.                         break;
  232.  
  233.             case 'B':
  234.             if (cp)
  235.                 val = parse_breakstr(cp);
  236.             if (val != -1)
  237.                 *((short *)rctable[i].ptr) = val;
  238.             break;
  239.  
  240.                     case 'X':
  241.                         switch (rctable[i].def) {
  242.  
  243.                             case 1:     /* strlist with string values */
  244.                                 if (cp) {
  245.                                     sl = strlist_append((Strlist **)rctable[i].ptr, cp);
  246.                                     cp = my_strtok(NULL, " =\t\n");
  247.                                     if (cp && *cp != '#')
  248.                                         sl->value = (long)stralloc(cp);
  249.                                 }
  250.                                 break;
  251.  
  252.                             case 2:     /* Include */
  253.                                 if (cp)
  254.                                     readrc(format_s(cp, infname), 1);
  255.                                 break;
  256.  
  257.                 case 3:     /* Synonym */
  258.                 if (cp) {
  259.                     sl = strlist_append(&synonyms, cp);
  260.                     cp = my_strtok(NULL, " =\t\n");
  261.                     if (cp && *cp != '#')
  262.                     sl->value = (long)stralloc(cp);
  263.                 }
  264.                 break;
  265.  
  266.                         }
  267.                 }
  268.             } else
  269.                 fprintf(stderr, "warning: can't understand %s in %s\n", cp, rcname);
  270.         }
  271.     }
  272.     fclose(rc);
  273.     return 1;
  274. }
  275.  
  276.  
  277. Static void postrc()
  278. {
  279.     int longbits;
  280.     long val;
  281.  
  282.     which_unix = UNIX_ANY;
  283.     if (!strcmp(target, "CHIPMUNK") ||
  284.         !strcmp(target, "HPUX-300") ||
  285.         !strcmp(target, "SUN-68K") ||
  286.         !strcmp(target, "AMIGA") ||
  287.         !strcmp(target, "BSD-VAX")) {
  288.         signedchars = 1;
  289.         sizeof_char = 8;
  290.         sizeof_short = 16;
  291.         sizeof_int = sizeof_long = sizeof_pointer = 32;
  292.         sizeof_enum = 32;
  293.     sizeof_float = 32;
  294.         sizeof_double = 64;
  295.         if (!strcmp(target, "CHIPMUNK") ||
  296.             !strcmp(target, "AMIGA") ||
  297.             !strcmp(target, "HPUX-300"))
  298.             which_unix = UNIX_SYSV;
  299.         else
  300.             which_unix = UNIX_BSD;
  301.     } else if (!strcmp(target, "LSC-MAC")) {
  302.         signedchars = 1;
  303.         if (prototypes < 0)
  304.             prototypes = 1;
  305.         if (fullprototyping < 0)
  306.             fullprototyping = 0;
  307.         if (voidstar < 0)
  308.             voidstar = 1;
  309.         sizeof_char = 8;
  310.         sizeof_short = sizeof_int = 16;
  311.         sizeof_long = sizeof_pointer = 32;
  312.     } else if (!strcmp(target, "BSD")) {
  313.         which_unix = UNIX_BSD;
  314.     } else if (!strcmp(target, "SYSV")) {
  315.         which_unix = UNIX_SYSV;
  316.     } else if (*target) {
  317.         fprintf(stderr, "p2c: warning: don't understand target name %s\n",
  318.                 target);
  319.     }
  320.     if (ansiC > 0) {
  321.         if (sprintf_value < 0)
  322.             sprintf_value = 0;
  323.         if (castnull < 0)
  324.             castnull = 0;
  325.     }
  326.     if (useenum < 0)
  327.         useenum = (ansiC != 0) ? 1 : 0;
  328.     if (void_args < 0)
  329.         void_args = (ansiC > 0 && prototypes != 0) ? 1 : 0;
  330.     if (prototypes < 0)
  331.         prototypes = (cplus > 0) ? 2 : (ansiC > 0) ? 1 : 0;
  332.     if (prototypes == 0)
  333.         fullprototyping = 0;
  334.     else if (fullprototyping < 0)
  335.         fullprototyping = 1;
  336.     if (useAnyptrMacros < 0)
  337.     useAnyptrMacros = (ansiC > 0 || cplus > 0) ? 2 : 1;
  338.     if (usePPMacros < 0)
  339.     usePPMacros = (ansiC > 0 || cplus > 0) ? 0 : 2;
  340.     if (voidstar < 0)
  341.         voidstar = (ansiC > 0 || cplus > 0) ? 1 : 0;
  342.     if (hassignedchar < 0)
  343.         hassignedchar = (ansiC > 0) ? 1 : 0;
  344.     if (useconsts < 0)
  345.         useconsts = (ansiC > 0 || cplus > 0) ? 1 : 0;
  346.     if (copystructs < 0)
  347.         copystructs = (ansiC != 0 || cplus > 0) ? 3 : 0;
  348.     if (copystructfuncs < 0)
  349.         copystructfuncs = (ansiC > 0 || cplus > 0) ? 0 : 1;
  350.     if (starfunctions < 0)
  351.         starfunctions = (ansiC > 0) ? 0 : 1;
  352.     if (variablearrays < 0)
  353.     variablearrays = (ansiC > 1) ? 1 : 0;
  354.     if (*memcpyname) {
  355.         if (ansiC > 0 || which_unix == UNIX_SYSV)
  356.             strcpy(memcpyname, "memcpy");
  357.         else if (which_unix == UNIX_BSD)
  358.             strcpy(memcpyname, "bcopy");
  359.     }
  360.     sizeof_integer = (sizeof_int >= 32) ? sizeof_int : sizeof_long;
  361.     integername = (sizeof_int >= 32) ? "int" : "long";
  362.     if (sizeof_integer && sizeof_integer < 32)
  363.         fprintf(stderr, "Warning: long integers have less than 32 bits\n");
  364.     if (sizeof_int >= 32 && sizeof_long > sizeof_int && prototypes == 0)
  365.         fprintf(stderr, "Warning: translated code assumes int and long are the same");
  366.     if (setbits < 0)
  367.         setbits = (sizeof_integer > 0) ? sizeof_integer : 32;
  368.     ucharname = (*name_UCHAR) ? name_UCHAR :
  369.                 (signedchars == 0) ? "char" : "unsigned char";
  370.     scharname = (*name_SCHAR) ? name_SCHAR :
  371.                 (signedchars == 1) ? "char" : 
  372.                 (useAnyptrMacros == 1) ? "Signed char" : "signed char";
  373.     for (longbits = 1, val = LONG_MAX; val >>= 1; longbits++) ;
  374.     if (sizeof_char) {
  375.         if (sizeof_char < 8 && ansiC > 0)
  376.             fprintf(stderr, "Warning: chars have less than 8 bits\n");
  377.         if (sizeof_char > longbits) {
  378.             min_schar = LONG_MIN;
  379.             max_schar = LONG_MAX;
  380.         } else {
  381.             min_schar = - (1<<(sizeof_char-1));
  382.             max_schar = (1<<(sizeof_char-1)) - 1;
  383.         }
  384.         if (sizeof_char >= longbits)
  385.             max_uchar = LONG_MAX;
  386.         else
  387.             max_uchar = (1<<sizeof_char) - 1;
  388.     } else {
  389.         min_schar = -128;      /* Ansi-required minimum maxima */
  390.         max_schar = 127;
  391.         max_uchar = 255;
  392.     }
  393.     if (sizeof_short) {
  394.         if (sizeof_short < 16 && ansiC > 0)
  395.             fprintf(stderr, "Warning: shorts have less than 16 bits\n");
  396.         if (sizeof_short > longbits) {
  397.             min_sshort = LONG_MIN;
  398.             max_sshort = LONG_MAX;
  399.         } else {
  400.             min_sshort = - (1<<(sizeof_short-1));
  401.             max_sshort = (1<<(sizeof_short-1)) - 1;
  402.         }
  403.         if (sizeof_short >= longbits)
  404.             max_ushort = LONG_MAX;
  405.         else
  406.             max_ushort = (1<<sizeof_short) - 1;
  407.     } else {
  408.         min_sshort = -32768;   /* Ansi-required minimum maxima */
  409.         max_sshort = 32767;
  410.         max_ushort = 65535;
  411.     }
  412.     if (symcase < 0)
  413.         symcase = 1;
  414.     if (smallsetconst == -2)
  415.         smallsetconst = (*name_SETBITS) ? -1 : 1;
  416.     hpux_lang = 0;
  417.     if (!strcmp(language, "TURBO")) {
  418.         which_lang = LANG_TURBO;
  419.     } else if (!strcmp(language, "UCSD")) {
  420.         which_lang = LANG_UCSD;
  421.     } else if (!strcmp(language, "MPW")) {
  422.         which_lang = LANG_MPW;
  423.     } else if (!strcmp(language, "HPUX") || !strcmp(language, "HP-UX")) {
  424.     which_lang = LANG_HP;
  425.     hpux_lang = 1;
  426.     } else if (!strcmp(language, "OREGON")) {
  427.     which_lang = LANG_OREGON;
  428.     } else if (!strcmp(language, "VAX") || !strcmp(language, "VMS")) {
  429.     which_lang = LANG_VAX;
  430.     } else if (!strncmp(language, "MODULA", 6)) {
  431.     which_lang = LANG_MODULA;
  432.     } else if (!strncmp(language, "BERK", 4) ||
  433.            !strcmp(language, "SUN")) {
  434.     which_lang = LANG_BERK;
  435.     } else {
  436.         if (*language && strcmp(language, "HP") && strcmp(language, "MODCAL"))
  437.             fprintf(stderr, "Warning: Language %s not recognized, using HP\n", language);
  438.         which_lang = LANG_HP;
  439.     }
  440.     if (modula2 < 0)
  441.     modula2 = (which_lang == LANG_MODULA) ? 1 : 0;
  442.     if (pascalcasesens < 0)
  443.     pascalcasesens = (which_lang == LANG_MODULA) ? 2 :
  444.                      (which_lang == LANG_BERK) ? 3 : 0;
  445.     if (implementationmodules < 0)
  446.     implementationmodules = (which_lang == LANG_VAX) ? 1 : 0;
  447.     if (integer16 < 0)
  448.         integer16 = (which_lang == LANG_TURBO ||
  449.              which_lang == LANG_MPW) ? 1 : 0;
  450.     if (doublereals < 0)
  451.     doublereals = (hpux_lang ||
  452.                which_lang == LANG_OREGON ||
  453.                which_lang == LANG_VAX) ? 0 : 1;
  454.     if (pascalenumsize < 0)
  455.     pascalenumsize = (which_lang == LANG_HP) ? 16 : 8;
  456.     if (storefilenames < 0)
  457.         storefilenames = (which_lang == LANG_TURBO) ? 1 : 0;
  458.     if (charfiletext < 0)
  459.         charfiletext = (which_lang == LANG_BERK) ? 1 : 0;
  460.     if (readwriteopen < 0)
  461.     readwriteopen = (which_lang == LANG_TURBO) ? 1 : 0;
  462.     if (literalfilesflag < 0)
  463.     literalfilesflag = (which_lang == LANG_BERK) ? 2 : 0;
  464.     if (newlinespace < 0)
  465.         newlinespace = (which_lang == LANG_TURBO) ? 0 : 1;
  466.     if (nestedcomments < 0)
  467.         nestedcomments = (which_lang == LANG_TURBO ||
  468.               which_lang == LANG_MPW ||
  469.               which_lang == LANG_UCSD ||
  470.               which_lang == LANG_BERK) ? 2 : 0;
  471.     if (importall < 0)
  472.         importall = (which_lang == LANG_HP) ? 1 : 0;
  473.     if (seek_base < 0)
  474.         seek_base = (which_lang == LANG_TURBO ||
  475.               which_lang == LANG_MPW ||
  476.              which_lang == LANG_UCSD) ? 0 : 1;
  477.     if (unsignedchar < 0 && signedchars == 0)
  478.         unsignedchar = 2;
  479.     if (hasstaticlinks < 0)
  480.     hasstaticlinks = (which_lang == LANG_HP) ? 1 : 0;
  481.     if (dollar_idents < 0)
  482.     dollar_idents = (which_lang == LANG_OREGON ||
  483.              which_lang == LANG_VAX) ? 1 : 0;
  484.     if (ignorenonalpha < 0)
  485.     ignorenonalpha = (which_lang == LANG_UCSD) ? 1 : 0;
  486.     if (stringtrunclimit < 0)
  487.     stringtrunclimit = (which_lang == LANG_TURBO) ? 80 : 0;
  488.     if (defaultsetsize < 0)
  489.     defaultsetsize = (which_lang == LANG_VAX) ? 256 :
  490.              (which_lang == LANG_BERK) ? 128 :
  491.                      (which_lang == LANG_MPW) ? 2040 : 8192;
  492.     if (enumbyte < 0)
  493.     enumbyte = (which_lang == LANG_HP) ? 0 : 1;
  494.     if (!*filenamefilter && (which_lang == LANG_OREGON ||
  495.                  which_lang == LANG_BERK))
  496.     strcpy(filenamefilter, "P_trimname");
  497.     charname = (useAnyptrMacros) ? "Char" :
  498.                (unsignedchar == 1) ? ucharname :
  499.                (unsignedchar == 0) ? scharname : "char";
  500.     if (!*memcpyname)
  501.         strcpy(memcpyname, "memcpy");
  502.     if (!*mallocname)
  503.         strcpy(mallocname, "malloc");
  504.     if (!*freename)
  505.         strcpy(freename, "free");
  506.     fix_parameters();
  507. }
  508.  
  509.  
  510.  
  511.  
  512. void saveoldfile(fname)
  513. char *fname;
  514. {
  515. #if defined(unix) || defined(__unix) || defined(CAN_LINK)
  516.     (void) unlink(format_s("%s~", fname));
  517.     if (link(fname, format_s("%s~", fname)) == 0)
  518.         (void) unlink(fname);
  519. #endif
  520. }
  521.  
  522.  
  523.  
  524. #ifndef __STDC__
  525. # ifdef NO_GETENV
  526. #  define getenv(x) NULL
  527. # else
  528. extern char *getenv PP((char *));
  529. # endif
  530. #endif
  531.  
  532. Static long starting_time;
  533.  
  534. Static void openlogfile()
  535. {
  536.     char *name, *uname;
  537.  
  538.     if (*codefname == '<')
  539.     name = format_ss(logfnfmt, infname, infname);
  540.     else
  541.     name = format_ss(logfnfmt, infname, codefname);
  542.     if (!name)
  543.     name = format_s("%s.log", codefname);
  544.     saveoldfile(name);
  545.     logf = fopen(name, "w");
  546.     if (logf) {
  547.     fprintf(logf, "\nTranslation of %s to %s by p2c %s\n",
  548.         infname, codefname, P2C_VERSION);
  549.     fprintf(logf, "Translated");
  550.     uname = getenv("USER");
  551.     if (uname)
  552.         fprintf(logf, " by %s", uname);
  553.     time(&starting_time);
  554.     fprintf(logf, " on %s", ctime(&starting_time));
  555.     fprintf(logf, "\n\n");
  556.     } else {
  557.     perror(name);
  558.     verbose = 0;
  559.     }
  560. }
  561.  
  562.  
  563. void closelogfile()
  564. {
  565.     long ending_time;
  566.  
  567.     if (logf) {
  568.     fprintf(logf, "\n\n");
  569. #if defined(unix) || defined(__unix)
  570.     fprintf(logf, "Total memory used: %ld bytes.\n", (long)sbrk(0));
  571. #endif
  572.     time(&ending_time);
  573.     fprintf(logf, "Processed %d source lines in %ld:%ld seconds.\n",
  574.         inf_ltotal,
  575.         (ending_time - starting_time) / 60,
  576.         (ending_time - starting_time) % 60);
  577.     fprintf(logf, "\n\nTranslation completed on %s", ctime(&ending_time));
  578.     fclose(logf);
  579.     }
  580. }
  581.  
  582. void showinitfile()
  583. {
  584.     FILE *f;
  585.     int ch;
  586.     char *name;
  587.  
  588.     name = format_s("%H/%s", "p2crc");
  589.     printf("# Copy of file %%H/p2crc => %s:\n\n", name);
  590.     f = fopen(name, "r");
  591.     if (!f) {
  592.     perror(name);
  593.     exit(1);
  594.     }
  595.     while ((ch = getc(f)) != EOF)
  596.     putchar(ch);
  597.     fclose(f);
  598.     exit(0);
  599. }
  600.  
  601.  
  602.  
  603.  
  604. void usage()
  605. {
  606.     fprintf(stderr, "usage: p2c [options] file [modulename] [-h file.h] [-o file.c]\n");
  607.     exit(EXIT_FAILURE);
  608. }
  609.  
  610.  
  611.  
  612. int main(argc, argv)
  613. int argc;
  614. char **argv;
  615. {
  616.     int numsearch;
  617.     char *searchlist[50];
  618.     char infnbuf[200], codefnbuf[200], hdrfnbuf[200], *cp;
  619.     Symbol *sp;
  620.     Strlist *sl;
  621.     int i, nobuffer = 0, savequiet;
  622.  
  623.     i = 0;
  624.     while (i < argc && strcmp(argv[i], "-H")) i++;
  625.     if (i < argc-1)
  626.     p2c_home = argv[i+1];
  627.     else {
  628.     cp = getenv("P2C_HOME");
  629.     if (cp)
  630.         p2c_home = cp;
  631.     }
  632.     init_stuff();
  633.     i = 0;
  634.     while (i < argc && strcmp(argv[i], "-i")) i++;
  635.     if (i < argc)
  636.     showinitfile();
  637.     initrc();
  638.     setup_dir();
  639.     infname = infnbuf;
  640.     *infname = 0;
  641.     i = 0;
  642.     while (i < argc && argv[i][0] == '-') i++;
  643.     if (i >= argc)
  644.     strcpy(infname, argv[i]);
  645.     i = 0;
  646.     while (i < argc && strcmp(argv[i], "-v")) i++;
  647.     if (i >= argc) {
  648.     cp = getenv("P2CRC");
  649.     if (cp)
  650.         readrc(cp, 1);
  651.     else
  652.         readrc(format_s("%H/%s", "p2crc"), 1);
  653.     }
  654.     i = 0;
  655.     while (i < argc && strcmp(argv[i], "-c")) i++;
  656.     if (i < argc-1) {
  657.         if (strcmp(argv[i+1], "-"))
  658.             readrc(argv[i+1], 1);
  659.     } else
  660.         if (!readrc("p2crc", 0))
  661.             readrc(".p2crc", 0);
  662.     codefname = codefnbuf;
  663.     *codefname = 0;
  664.     hdrfname = hdrfnbuf;
  665.     *hdrfname = 0;
  666.     requested_module = NULL;
  667.     found_module = 0;
  668.     error_crash = 0;
  669. #ifdef CONSERVE_MEMORY
  670.     conserve_mem = CONSERVE_MEMORY;
  671. #else
  672.     conserve_mem = 1;
  673. #endif
  674.     regression = 0;
  675.     verbose = 0;
  676.     partialdump = 1;
  677.     numsearch = 0;
  678.     argc--, argv++;
  679.     while (argc > 0) {
  680.         if (**argv == '-' && (*argv)[1]) {
  681.             if (!strcmp(*argv, "-a")) {
  682.                 ansiC = 1;
  683.         } else if (argv[0][1] == 'L') {
  684.         if (strlen(*argv) == 2 && argc > 1) {
  685.             strcpy(language, ++*argv);
  686.             --argc;
  687.         } else
  688.             strcpy(language, *argv + 2);
  689.         upc(language);
  690.             } else if (!strcmp(*argv, "-q")) {
  691.                 quietmode = 1;
  692.             } else if (!strcmp(*argv, "-o")) {
  693.                 if (*codefname || --argc <= 0)
  694.                     usage();
  695.                 strcpy(codefname, *++argv);
  696.             } else if (!strcmp(*argv, "-h")) {
  697.                 if (*hdrfname || --argc <= 0)
  698.                     usage();
  699.                 strcpy(hdrfname, *++argv);
  700.             } else if (!strcmp(*argv, "-s")) {
  701.                 if (--argc <= 0)
  702.                     usage();
  703.                 cp = *++argv;
  704.                 if (!strcmp(cp, "-"))
  705.                     librfiles = NULL;
  706.                 else
  707.                     searchlist[numsearch++] = cp;
  708.             } else if (!strcmp(*argv, "-c")) {
  709.                 if (--argc <= 0)
  710.                     usage();
  711.                 argv++;
  712.                 /* already done above */
  713.             } else if (!strcmp(*argv, "-v")) {
  714.                 /* already done above */
  715.             } else if (!strcmp(*argv, "-H")) {
  716.                 /* already done above */
  717.         } else if (argv[0][1] == 'I') {
  718.         if (strlen(*argv) == 2 && argc > 1) {
  719.             strlist_append(&importdirs, ++*argv);
  720.             --argc;
  721.         } else
  722.             strlist_append(&importdirs, *argv + 2);
  723.             } else if (argv[0][1] == 'p') {
  724.                 if (strlen(*argv) == 2)
  725.                     showprogress = 25;
  726.                 else
  727.                     showprogress = atoi(*argv + 2);
  728.         nobuffer = 1;
  729.             } else if (!strcmp(*argv, "-e")) {
  730.                 copysource++;
  731.             } else if (!strcmp(*argv, "-t")) {
  732.                 tokentrace++;
  733.             } else if (!strcmp(*argv, "-x")) {
  734.                 error_crash++;
  735.         } else if (argv[0][1] == 'E') {
  736.         if (strlen(*argv) == 2)
  737.             maxerrors = 0;
  738.         else
  739.             maxerrors = atoi(*argv + 2);
  740.             } else if (!strcmp(*argv, "-F")) {
  741.                 partialdump = 0;
  742.             } else if (argv[0][1] == 'd') {
  743.         nobuffer = 1;
  744.                 if (strlen(*argv) == 2)
  745.                     debug = 1;
  746.                 else
  747.                     debug = atoi(*argv + 2);
  748.         } else if (argv[0][1] == 'B') {
  749.         if (strlen(*argv) == 2)
  750.             i = 1;
  751.         else
  752.             i = atoi(*argv + 2);
  753.         if (argc == 2 &&
  754.             strlen(argv[1]) > 2 &&
  755.             !strcmp(argv[1] + strlen(argv[1]) - 2, ".c")) {
  756.             testlinebreaker(i, argv[1]);
  757.             exit(EXIT_SUCCESS);
  758.         } else
  759.             testlinebreaker(i, NULL);
  760.         } else if (argv[0][1] == 'C') {
  761.         if (strlen(*argv) == 2)
  762.             cmtdebug = 1;
  763.         else
  764.             cmtdebug = atoi(*argv + 2);
  765.             } else if (!strcmp(*argv, "-R")) {
  766.         regression = 1;
  767.             } else if (argv[0][1] == 'V') {
  768.         if (strlen(*argv) == 2)
  769.             verbose = 1;
  770.         else
  771.             verbose = atoi(*argv + 2);
  772.             } else if (argv[0][1] == 'M') {
  773.         if (strlen(*argv) == 2)
  774.             conserve_mem = 1;
  775.         else
  776.             conserve_mem = atoi(*argv + 2);
  777.         } else
  778.                 usage();
  779.         } else if (!*infname) {
  780.             strcpy(infname, *argv);
  781.         } else if (!requested_module) {
  782.             requested_module = stralloc(*argv);
  783.         } else
  784.             usage();
  785.         argc--, argv++;
  786.     }
  787.     if (requested_module && !*codefname)
  788.     strcpy(codefname, format_ss(modulefnfmt, infname, requested_module));
  789.     if (*infname && strcmp(infname, "-")) {
  790.     if (strlen(infname) > 2 &&
  791.         !strcmp(infname + strlen(infname) - 2, ".c")) {
  792.         fprintf(stderr, "What is wrong with this picture?\n");
  793.         exit(EXIT_FAILURE);
  794.     }
  795.         inf = fopen(infname, "r");
  796.         if (!inf) {
  797.             perror(infname);
  798.             exit(EXIT_FAILURE);
  799.         }
  800.         if (!*codefname)
  801.             strcpy(codefname, format_s(codefnfmt, infname));
  802.     } else {
  803.         strcpy(infname, "<stdin>");
  804.         inf = stdin;
  805.         if (!*codefname)
  806.             strcpy(codefname, "-");
  807.     }
  808.     if (strcmp(codefname, "-")) {
  809.         saveoldfile(codefname);
  810.         codef = fopen(codefname, "w");
  811.         if (!codef) {
  812.             perror(codefname);
  813.             exit(EXIT_FAILURE);
  814.         }
  815.         fprintf(codef, "/* Output from p2c, the Pascal-to-C translator */\n");
  816.     } else {
  817.         strcpy(codefname, "<stdout>");
  818.         codef = stdout;
  819.     }
  820.     if (nobuffer)
  821.         setbuf(codef, NULL);      /* for debugging */
  822.     outf = codef;
  823.     outf_lnum = 1;
  824.     logf = NULL;
  825.     if (verbose)
  826.     openlogfile();
  827.     setup_complete = 0;
  828.     init_lex();
  829.     leadingcomments();
  830.     postrc();
  831.     setup_comment();  /* must call this first */
  832.     setup_lex();      /* must call this second */
  833.     setup_out();
  834.     setup_decl();     /* must call *after* setup_lex() */
  835.     setup_parse();
  836.     setup_funcs();
  837.     for (sl = tweaksymbols; sl; sl = sl->next) {
  838.     cp = sl->s;
  839.     if (*cp == '*') {
  840.         cp++;
  841.         if (!pascalcasesens)
  842.         upc(cp);
  843.     }
  844.         sp = findsymbol(cp);
  845.     if (sl->value & FUNCBREAK) 
  846.         sp->flags &= ~FUNCBREAK;
  847.         sp->flags |= sl->value;
  848.     }
  849.     strlist_empty(&tweaksymbols);
  850.     for (sl = synonyms; sl; sl = sl->next) {
  851.     if (!pascalcasesens)
  852.         upc(sl->s);
  853.     sp = findsymbol(sl->s);
  854.     sp->flags |= SSYNONYM;
  855.     if (sl->value) {
  856.         if (!pascalcasesens)
  857.         upc((char *)sl->value);
  858.         strlist_append(&sp->symbolnames, "===")->value =
  859.         (long)findsymbol((char *)sl->value);
  860.     } else
  861.         strlist_append(&sp->symbolnames, "===")->value = 0;
  862.     }
  863.     strlist_empty(&synonyms);
  864.     for (sl = addmacros; sl; sl = sl->next) {
  865.         defmacro(sl->s, sl->value, "<macro>", 0);
  866.     }
  867.     strlist_empty(&addmacros);
  868.     handle_nameof();
  869.     setup_complete = 1;
  870.     savequiet = quietmode;
  871.     quietmode = 1;
  872.     for (sl = librfiles; sl; sl = sl->next)
  873.         (void)p_search(format_none(sl->s), "pas", 0);
  874.     for (i = 0; i < numsearch; i++)
  875.         (void)p_search(format_none(searchlist[i]), "pas", 1);
  876.     quietmode = savequiet;
  877.     p_program();
  878.     end_source();
  879.     flushcomments(NULL, -1, -1);
  880.     showendnotes();
  881.     check_unused_macros();
  882.     printf("\n");
  883.     if (!showprogress)
  884.     fprintf(stderr, "\n");
  885.     output("\n");
  886.     if (requested_module && !found_module)
  887.         error(format_s("Module \"%s\" not found in file", requested_module));
  888.     if (codef != stdout)
  889.         output("\n\n/* End. */\n");
  890.     if (inf != stdin)
  891.         fclose(inf);
  892.     if (codef != stdout)
  893.         fclose(codef);
  894.     closelogfile();
  895.     mem_summary();
  896.     if (!quietmode)
  897.         fprintf(stderr, "Translation completed.\n");
  898.     exit(EXIT_SUCCESS);
  899. }
  900.  
  901.  
  902.  
  903.  
  904. int outmem()
  905. {
  906.     fprintf(stderr, "p2c: Out of memory!\n");
  907.     exit(EXIT_FAILURE);
  908. }
  909.  
  910. #if !defined(NO_ISBOGUS) && (defined(mc68000) || defined(m68k) || defined(vax))
  911. int ISBOGUS(p)
  912. char *p;
  913. {
  914.     unsigned long ip = (unsigned long)p;
  915.  
  916.     if (ip < 0) {
  917.     if (ip < (unsigned long)&ip)
  918.         return 1;    /* below the start of the stack */
  919.     } else if (ip >= 512) {
  920.     if (ip > (unsigned long)sbrk(0))
  921.         return 1;    /* past the end of memory */
  922.     } else
  923.     return 1;
  924.     return 0;
  925. }
  926. #else
  927. #define ISBOGUS(p) 0
  928. #endif
  929.  
  930. char *meaningkindname(kind)
  931. enum meaningkind kind;
  932. {
  933. #ifdef HASDUMPS
  934.     if ((unsigned int)kind < (unsigned int)MK_LAST)
  935.         return meaningkindnames[(int) kind];
  936.     else
  937. #endif /*HASDUMPS*/
  938.         return format_d("<meaning %d>", (int) kind);
  939. }
  940.  
  941. char *typekindname(kind)
  942. enum typekind kind;
  943. {
  944. #ifdef HASDUMPS
  945.     if ((unsigned int)kind < (unsigned int)TK_LAST)
  946.         return typekindnames[(int) kind];
  947.     else
  948. #endif /*HASDUMPS*/
  949.         return format_d("<type %d>", (int) kind);
  950. }
  951.  
  952. char *exprkindname(kind)
  953. enum exprkind kind;
  954. {
  955. #ifdef HASDUMPS
  956.     if ((unsigned int)kind < (unsigned int)EK_LAST)
  957.         return exprkindnames[(int) kind];
  958.     else
  959. #endif /*HASDUMPS*/
  960.         return format_d("<expr %d>", (int) kind);
  961. }
  962.  
  963. char *stmtkindname(kind)
  964. enum stmtkind kind;
  965. {
  966. #ifdef HASDUMPS
  967.     if ((unsigned int)kind < (unsigned int)SK_LAST)
  968.         return stmtkindnames[(int) kind];
  969.     else
  970. #endif /*HASDUMPS*/
  971.         return format_d("<stmt %d>", (int) kind);
  972. }
  973.  
  974.  
  975.  
  976. void dumptype(tp)
  977. Type *tp;
  978. {
  979.     if (!tp) {
  980.         fprintf(outf, "<NULL>\n");
  981.         return;
  982.     }
  983.     if (ISBOGUS(tp)) {
  984.     fprintf(outf, "0x%lX\n", tp);
  985.     return;
  986.     }
  987.     fprintf(outf, "      Type %lx, kind=%s", tp, typekindname(tp->kind));
  988. #ifdef HASDUMPS
  989.     fprintf(outf, ", meaning=%lx, basetype=%lx, indextype=%lx\n",
  990.             tp->meaning, tp->basetype, tp->indextype);
  991.     tp->dumped = 1;
  992.     if (tp->basetype)
  993.     dumptype(tp->basetype);
  994.     if (tp->indextype)
  995.     dumptype(tp->indextype);
  996. #else
  997.     fprintf(outf, "\n");
  998. #endif /*HASDUMPS*/
  999. }
  1000.  
  1001.  
  1002. void dumpmeaning(mp)
  1003. Meaning *mp;
  1004. {
  1005.     if (!mp) {
  1006.         fprintf(outf, "<NULL>\n");
  1007.         return;
  1008.     }
  1009.     if (ISBOGUS(mp)) {
  1010.     fprintf(outf, "0x%lX\n", mp);
  1011.     return;
  1012.     }
  1013.     fprintf(outf, "   Meaning %lx, name=%s, kind=%s", mp, ((mp->name) ? mp->name : "<null>"),
  1014.                                                      meaningkindname(mp->kind));
  1015. #ifdef HASDUMPS
  1016.     fprintf(outf, ", ctx=%lx, cbase=%lx, cnext=%lx, type=%lx\n",
  1017.             mp->ctx, mp->cbase, mp->cnext, mp->type);
  1018.     if (mp->type && !mp->type->dumped)
  1019.     dumptype(mp->type);
  1020.     mp->dumped = 1;
  1021. #else
  1022.     fprintf(outf, "\n");
  1023. #endif /*HASDUMPS*/
  1024. }
  1025.  
  1026.  
  1027. void dumpsymtable(sym)
  1028. Symbol *sym;
  1029. {
  1030.     Meaning *mp;
  1031.  
  1032.     if (sym) {
  1033.     dumpsymtable(sym->left);
  1034. #ifdef HASDUMPS
  1035.     if ((sym->mbase && !sym->mbase->dumped) ||
  1036.         (sym->fbase && !sym->fbase->dumped))
  1037. #endif
  1038.         {
  1039.         fprintf(outf, "Symbol %s:\n", sym->name);
  1040.         for (mp = sym->mbase; mp; mp = mp->snext)
  1041.             dumpmeaning(mp);
  1042.         for (mp = sym->fbase; mp; mp = mp->snext)
  1043.             dumpmeaning(mp);
  1044.         fprintf(outf, "\n");
  1045.         }
  1046.     dumpsymtable(sym->right);
  1047.     }
  1048. }
  1049.  
  1050.  
  1051. void dumptypename(tp, waddr)
  1052. Type *tp;
  1053. int waddr;
  1054. {
  1055. #ifdef HASDUMPS
  1056.     if (!tp) {
  1057.     fprintf(outf, "<NULL>");
  1058.     return;
  1059.     }
  1060.     if (ISBOGUS(tp)) {
  1061.     fprintf(outf, "0x%lX", tp);
  1062.     return;
  1063.     }
  1064.     if (tp == tp_int)             fprintf(outf, "I");
  1065.     else if (tp == tp_sint)       fprintf(outf, "SI");
  1066.     else if (tp == tp_uint)       fprintf(outf, "UI");
  1067.     else if (tp == tp_integer)    fprintf(outf, "L");
  1068.     else if (tp == tp_unsigned)   fprintf(outf, "UL");
  1069.     else if (tp == tp_char)       fprintf(outf, "C");
  1070.     else if (tp == tp_schar)      fprintf(outf, "UC");
  1071.     else if (tp == tp_uchar)      fprintf(outf, "SC");
  1072.     else if (tp == tp_boolean)    fprintf(outf, "B");
  1073.     else if (tp == tp_longreal)   fprintf(outf, "R");
  1074.     else if (tp == tp_real)       fprintf(outf, "F");
  1075.     else if (tp == tp_anyptr)     fprintf(outf, "A");
  1076.     else if (tp == tp_void)       fprintf(outf, "V");
  1077.     else if (tp == tp_text)       fprintf(outf, "T");
  1078.     else if (tp == tp_sshort)     fprintf(outf, "SS");
  1079.     else if (tp == tp_ushort)     fprintf(outf, "US");
  1080.     else if (tp == tp_abyte)      fprintf(outf, "AB");
  1081.     else if (tp == tp_sbyte)      fprintf(outf, "SB");
  1082.     else if (tp == tp_ubyte)      fprintf(outf, "UB");
  1083.     else if (tp == tp_str255)     fprintf(outf, "S");
  1084.     else if (tp == tp_strptr)     fprintf(outf, "SP");
  1085.     else if (tp == tp_charptr)    fprintf(outf, "CP");
  1086.     else if (tp == tp_smallset)   fprintf(outf, "SMS");
  1087.     else if (tp == tp_proc)       fprintf(outf, "PR");
  1088.     else if (tp == tp_jmp_buf)    fprintf(outf, "JB");
  1089.     else {
  1090.     if (tp->meaning && !ISBOGUS(tp->meaning) &&
  1091.         tp->meaning->name && !ISBOGUS(tp->meaning->name) &&
  1092.         tp->meaning->name[0]) {
  1093.         fprintf(outf, "%s", tp->meaning->name);
  1094.         if (tp->dumped)
  1095.         return;
  1096.         fprintf(outf, "=");
  1097.         waddr = 1;
  1098.     }
  1099.     if (waddr) {
  1100.         fprintf(outf, "%lX", tp);
  1101.         if (tp->dumped)
  1102.         return;
  1103.         fprintf(outf, ":");
  1104.         tp->dumped = 1;
  1105.     }
  1106.     switch (tp->kind) {
  1107.         
  1108.       case TK_STRING:
  1109.         fprintf(outf, "Str");
  1110.         if (tp->structdefd)
  1111.         fprintf(outf, "Conf");
  1112.         break;
  1113.  
  1114.       case TK_SUBR:
  1115.         dumptypename(tp->basetype, 0);
  1116.         break;
  1117.  
  1118.       case TK_POINTER:
  1119.         fprintf(outf, "^");
  1120.         dumptypename(tp->basetype, 0);
  1121.         break;
  1122.  
  1123.       case TK_SMALLARRAY:
  1124.         fprintf(outf, "Sm");
  1125.         /* fall through */
  1126.  
  1127.       case TK_ARRAY:
  1128.         fprintf(outf, "Ar");
  1129.         if (tp->structdefd)
  1130.         fprintf(outf, "Conf");
  1131.         fprintf(outf, "{");
  1132.         dumptypename(tp->indextype, 0);
  1133.         fprintf(outf, "}");
  1134.         if (tp->smin) {
  1135.         fprintf(outf, "Skip(");
  1136.         dumpexpr(tp->smin);
  1137.         fprintf(outf, ")");
  1138.         }
  1139.         if (tp->smax) {
  1140.         fprintf(outf, "/");
  1141.         if (!ISBOGUS(tp->smax))
  1142.             dumptypename(tp->smax->val.type, 0);
  1143.         fprintf(outf, "{%d%s}", tp->escale,
  1144.             tp->issigned ? "S" : "U");
  1145.         }
  1146.         fprintf(outf, ":");
  1147.         dumptypename(tp->basetype, 0);
  1148.         break;
  1149.             
  1150.       case TK_SMALLSET:
  1151.         fprintf(outf, "Sm");
  1152.         /* fall through */
  1153.  
  1154.       case TK_SET:
  1155.         fprintf(outf, "Set{");
  1156.         dumptypename(tp->indextype, 0);
  1157.         fprintf(outf, "}");
  1158.         break;
  1159.  
  1160.       case TK_FILE:
  1161.         fprintf(outf, "File{");
  1162.         dumptypename(tp->basetype, 0);
  1163.         fprintf(outf, "}");
  1164.         break;
  1165.  
  1166.       case TK_FUNCTION:
  1167.         fprintf(outf, "Func");
  1168.         if (tp->issigned)
  1169.         fprintf(outf, "Link");
  1170.         fprintf(outf, "{");
  1171.         dumptypename(tp->basetype, 0);
  1172.         fprintf(outf, "}");
  1173.         break;
  1174.  
  1175.       case TK_CPROCPTR:
  1176.         fprintf(outf, "C");
  1177.         /* fall through */
  1178.  
  1179.       case TK_PROCPTR:
  1180.         fprintf(outf, "Proc%d{", tp->escale);
  1181.         dumptypename(tp->basetype, 0);
  1182.         fprintf(outf, "}");
  1183.         break;
  1184.  
  1185.       default:
  1186.         fprintf(outf, "%s", typekindname(tp->kind));
  1187.         break;
  1188.             
  1189.     }
  1190.     if (tp->kind != TK_ARRAY && tp->kind != TK_SMALLARRAY &&
  1191.         (tp->smin || tp->smax)) {
  1192.         fprintf(outf, "{");
  1193.         dumpexpr(tp->smin);
  1194.         fprintf(outf, "..");
  1195.         dumpexpr(tp->smax);
  1196.         fprintf(outf, "}");
  1197.     }
  1198.     }
  1199. #else
  1200.     fprintf(outf, "%lX", tp);
  1201. #endif
  1202. }
  1203.  
  1204.  
  1205. void dumptypename_file(f, tp)
  1206. FILE *f;
  1207. Type *tp;
  1208. {
  1209.     FILE *save = outf;
  1210.     outf = f;
  1211.     dumptypename(tp, 1);
  1212.     outf = save;
  1213. }
  1214.  
  1215.  
  1216. void dumpexpr(ex)
  1217. Expr *ex;
  1218. {
  1219.     int i;
  1220.     Type *type;
  1221.     char *name;
  1222.  
  1223.     if (!ex) {
  1224.         fprintf(outf, "<NULL>");
  1225.         return;
  1226.     }
  1227.     if (ISBOGUS(ex)) {
  1228.     fprintf(outf, "0x%lX", ex);
  1229.     return;
  1230.     }
  1231.     if (ex->kind == EK_CONST && ex->val.type == tp_integer &&
  1232.     ex->nargs == 0 && !ex->val.s) {
  1233.     fprintf(outf, "%ld", ex->val.i);
  1234.     return;
  1235.     }
  1236.     if (ex->kind == EK_LONGCONST && ex->val.type == tp_integer &&
  1237.     ex->nargs == 0 && !ex->val.s) {
  1238.     fprintf(outf, "%ldL", ex->val.i);
  1239.     return;
  1240.     }
  1241.     name = exprkindname(ex->kind);
  1242.     if (!strncmp(name, "EK_", 3))
  1243.     name += 3;
  1244.     fprintf(outf, "%s", name);
  1245. #ifdef HASDUMPS
  1246.  
  1247.     type = ex->val.type;
  1248.     fprintf(outf, "/");
  1249.     dumptypename(type, 1);
  1250.     if (ex->val.i) {
  1251.         switch (ex->kind) {
  1252.  
  1253.             case EK_VAR:
  1254.             case EK_FUNCTION:
  1255.             case EK_CTX:
  1256.             if (ISBOGUS(ex->val.i))
  1257.             fprintf(outf, "[0x%lX]", ex->val.i);
  1258.         else
  1259.             fprintf(outf, "[\"%s\"]", ((Meaning *)ex->val.i)->name);
  1260.                 break;
  1261.  
  1262.             default:
  1263.                 fprintf(outf, "[i=%ld]", ex->val.i);
  1264.                 break;
  1265.         }
  1266.     }
  1267.     if (ISBOGUS(ex->val.s))
  1268.     fprintf(outf, "[0x%lX]", ex->val.s);
  1269.     else if (ex->val.s) {
  1270.         switch (ex->kind) {
  1271.  
  1272.             case EK_BICALL:
  1273.             case EK_NAME:
  1274.             case EK_DOT:
  1275.             fprintf(outf, "[s=\"%s\"]", ex->val.s);
  1276.                 break;
  1277.  
  1278.             default:
  1279.                 switch (ex->val.type ? ex->val.type->kind : TK_VOID) {
  1280.                     case TK_STRING:
  1281.                         fprintf(outf, "[s=%s]", makeCstring(ex->val.s, ex->val.i));
  1282.                         break;
  1283.                     case TK_REAL:
  1284.                         fprintf(outf, "[s=%s]", ex->val.s);
  1285.                         break;
  1286.                     default:
  1287.                         fprintf(outf, "[s=%lx]", ex->val.s);
  1288.                 }
  1289.                 break;
  1290.         }
  1291.     }
  1292.     if (ex->nargs > 0) {
  1293.         fprintf(outf, "(");
  1294.         if (ex->nargs < 10) {
  1295.             for (i = 0; i < ex->nargs; i++) {
  1296.                 if (i)
  1297.                     fprintf(outf, ", ");
  1298.                 dumpexpr(ex->args[i]);
  1299.             }
  1300.         } else
  1301.             fprintf(outf, "...");
  1302.         fprintf(outf, ")");
  1303.     }
  1304. #endif
  1305. }
  1306.  
  1307.  
  1308. void dumpexpr_file(f, ex)
  1309. FILE *f;
  1310. Expr *ex;
  1311. {
  1312.     FILE *save = outf;
  1313.     outf = f;
  1314.     dumpexpr(ex);
  1315.     outf = save;
  1316. }
  1317.  
  1318.  
  1319. void innerdumpstmt(sp, indent)
  1320. Stmt *sp;
  1321. int indent;
  1322. {
  1323. #ifdef HASDUMPS
  1324.     if (!sp) {
  1325.         fprintf(outf, "<NULL>\n");
  1326.         return;
  1327.     }
  1328.     while (sp) {
  1329.     if (ISBOGUS(sp)) {
  1330.         fprintf(outf, "0x%lX\n", sp);
  1331.         return;
  1332.     }
  1333.         fprintf(outf, "%s", stmtkindname(sp->kind));
  1334.         if (sp->exp1) {
  1335.             fprintf(outf, ", exp1=");
  1336.             dumpexpr(sp->exp1);
  1337.         }
  1338.         if (sp->exp2) {
  1339.             fprintf(outf, ", exp2=");
  1340.             dumpexpr(sp->exp2);
  1341.         }
  1342.         if (sp->exp3) {
  1343.             fprintf(outf, ", exp3=");
  1344.             dumpexpr(sp->exp3);
  1345.         }
  1346.         fprintf(outf, "\n");
  1347.         if (sp->stm1) {
  1348.             fprintf(outf, "%*sstm1=", indent, "");
  1349.             innerdumpstmt(sp->stm1, indent+5);
  1350.         }
  1351.         if (sp->stm2) {
  1352.             fprintf(outf, "%*sstm2=", indent, "");
  1353.             innerdumpstmt(sp->stm2, indent+5);
  1354.         }
  1355.         sp = sp->next;
  1356.         if (sp) {
  1357.             if (indent > 5)
  1358.                 fprintf(outf, "%*s", indent-5, "");
  1359.             fprintf(outf, "next=");
  1360.         }
  1361.     }
  1362. #endif
  1363. }
  1364.  
  1365.  
  1366. void dumpstmt(sp, indent)
  1367. Stmt *sp;
  1368. int indent;
  1369. {
  1370.     fprintf(outf, "%*s", indent, "");
  1371.     innerdumpstmt(sp, indent);
  1372. }
  1373.  
  1374.  
  1375. void dumpstmt_file(f, sp)
  1376. FILE *f;
  1377. Stmt *sp;
  1378. {
  1379.     FILE *save = outf;
  1380.     Stmt *savenext = NULL;
  1381.     outf = f;
  1382.     if (sp) {
  1383.     savenext = sp->next;
  1384.     sp->next = NULL;
  1385.     }
  1386.     dumpstmt(sp, 5);
  1387.     if (sp)
  1388.     sp->next = savenext;
  1389.     outf = save;
  1390. }
  1391.  
  1392.  
  1393.  
  1394. void wrapup()
  1395. {
  1396.     int i;
  1397.  
  1398.     for (i = 0; i < SYMHASHSIZE; i++)
  1399.         dumpsymtable(symtab[i]);
  1400. }
  1401.  
  1402.  
  1403.  
  1404.  
  1405. void mem_summary()
  1406. {
  1407. #ifdef TEST_MALLOC
  1408.     printf("Summary of memory allocated but not freed:\n");
  1409.     printf("Total bytes = %d of %d\n", final_bytes, total_bytes);
  1410.     printf("Expressions = %d of %d\n", final_exprs, total_exprs);
  1411.     printf("Meanings =    %d of %d (%d of %d)\n",
  1412.        final_meanings, total_meanings,
  1413.        final_meanings / sizeof(Meaning),
  1414.        total_meanings / sizeof(Meaning));
  1415.     printf("Strings =     %d of %d\n", final_strings, total_strings);
  1416.     printf("Symbols =     %d of %d\n", final_symbols, total_symbols);
  1417.     printf("Types =       %d of %d (%d of %d)\n", final_types, total_types,
  1418.        final_types / sizeof(Type), total_types / sizeof(Type));
  1419.     printf("Statements =  %d of %d (%d of %d)\n", final_stmts, total_stmts,
  1420.        final_stmts / sizeof(Stmt), total_stmts / sizeof(Stmt));
  1421.     printf("Strlists =    %d of %d\n", final_strlists, total_strlists);
  1422.     printf("Literals =    %d of %d\n", final_literals, total_literals);
  1423.     printf("Ctxstacks =   %d of %d\n", final_ctxstacks, total_ctxstacks);
  1424.     printf("Temp vars =   %d of %d\n", final_tempvars, total_tempvars);
  1425.     printf("Input recs =  %d of %d\n", final_inprecs, total_inprecs);
  1426.     printf("Parens =      %d of %d\n", final_parens, total_parens);
  1427.     printf("Ptr Descs =   %d of %d\n", final_ptrdescs, total_ptrdescs);
  1428.     printf("Other =       %d of %d\n", final_misc, total_misc);
  1429.     printf("\n");
  1430. #endif
  1431. }
  1432.  
  1433.  
  1434. #ifdef TEST_MALLOC
  1435.  
  1436. anyptr memlist;
  1437.  
  1438. anyptr test_malloc(size, total, final)
  1439. int size, *total, *final;
  1440. {
  1441.     anyptr p;
  1442.  
  1443.     p = malloc(size + 3*sizeof(long));
  1444. #if 1
  1445.     ((anyptr *)p)[0] = memlist;
  1446.     memlist = p;
  1447.     ((long *)p)[1] = size;
  1448.     ((int **)p)[2] = final;
  1449.     total_bytes += size;
  1450.     final_bytes += size;
  1451.     *total += size;
  1452.     *final += size;
  1453. #endif
  1454.     return (anyptr)((long *)p + 3);
  1455. }
  1456.  
  1457. void test_free(p)
  1458. anyptr p;
  1459. {
  1460. #if 1
  1461.     final_bytes -= ((long *)p)[1-3];
  1462.     *((int **)p)[2-3] -= ((long *)p)[1-3];
  1463.     ((long *)p)[1-3] *= -1;
  1464. #endif
  1465. }
  1466.  
  1467. anyptr test_realloc(p, size)
  1468. anyptr p;
  1469. int size;
  1470. {
  1471.     anyptr p2;
  1472.  
  1473.     p2 = test_malloc(size, &total_misc, &final_misc);
  1474.     memcpy(p2, p, size);
  1475.     test_free(p);
  1476.     return p2;
  1477. }
  1478.  
  1479. #endif  /* TEST_MALLOC */
  1480.  
  1481.  
  1482.  
  1483.  
  1484. /* End. */
  1485.  
  1486.  
  1487.