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