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