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