home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / netsrcs / pascal2c < prev    next >
Internet Message Format  |  1987-03-28  |  36KB
  1. From dan@srs.UUCP Thu Mar 26 09:06:29 1987
  2. Path: seismo!rochester!ur-tut!ur-cvsvax!srs!dan
  3. From: dan@srs.UUCP (Dan Kegel)
  4. Newsgroups: net.sources,comp.sys.ibm.pc
  5. Subject: new Pascal to C translator
  6. Message-ID: <141@srs.UUCP>
  7. Date: 26 Mar 87 14:06:29 GMT
  8. Organization: S.R.Systems
  9. Lines: 1133
  10.  
  11. Here's a Pascal to C translator which correctly handles function,
  12. procedure, and most type declarations (yay!).  It is adapted from p2c.c 1.1 of
  13. the mod.sources archives; I suppose it should be called "p2c, version 2.0".  
  14. I wrote it in anticipation of a need to convert a VERY large Turbo Pascal 
  15. program, but the need never arose... so the resulting program is untested 
  16. and unpolished.  Nevertheless, it should be interesting and useful to those 
  17. willing to play with it a bit.
  18. Cheers,
  19.     Dan Kegel
  20.     seismo!rochester!srs!dan
  21.  
  22. p.s. Hi, Rick!
  23.  
  24. #!/bin/sh
  25. #
  26. # shar archiver, delete everything above the #!/bin/sh line
  27. # and run through sh (not csh)
  28. #
  29. echo 'shar: extracting "p2c.doc" (2297 characters)'
  30. sed 's/^XX //' > p2c.doc << 'XXX_EOF_XXX'
  31. XX NAME
  32. XX     p2c    - Pascal to C translator
  33. XX 
  34. XX SYNOPSIS
  35. XX     p2c < foo.pas > foo.c
  36. XX 
  37. XX DESCRIPTION
  38. XX     p2c converts many Pascal structures to their C equivalent.
  39. XX     The Pascal source can be in upper, lower, or mixed case; case is
  40. XX     preserved during translation.
  41. XX 
  42. XX     Structures translated properly include simple assignment
  43. XX     and comparison statments, variable, type, and label declarations, 
  44. XX     enumerated types, and procedure and function declarations and instances.
  45. XX 
  46. XX     Structures NOT translated properly include sets, constant declarations,
  47. XX     variant records, files, subrange types, VAR parameters, CASE, FOR, 
  48. XX     WITH, READ, and WRITE statements, and nested procedures.
  49. XX 
  50. XX     The translator provides hints about untranslated regions by inserting
  51. XX     UPPERCASE messages enclosed with /* and */ into the translated source.
  52. XX     Error messages are of the form /***# Expected ... ***/.
  53. XX 
  54. XX     Human massaging of the output will certainly be needed.
  55. XX     In fact, you may want to modify the keyword translation table
  56. XX     to better translate your particular variant of Pascal.
  57. XX 
  58. XX IMPLEMENTATION
  59. XX     Written in C for Sun UNIX workstations; ought to compile on other 
  60. XX     systems without change...
  61. XX     Some of the translation is done with a keyword table, but most of
  62. XX     the work is done by a recursive-descent parser.
  63. XX 
  64. XX BUGS
  65. XX     Not well tested.
  66. XX     Error recovery is very poor- the first error in translation inside
  67. XX     the recursive-descent section will result in a very long stream of
  68. XX     error messages.
  69. XX     Some of the bread-and-butter structures of Pascal- like CASE and FOR-
  70. XX     are not translated properly, although it would be easy to extend
  71. XX     the parser to understand them.
  72. XX 
  73. XX     I welcome bug reports, and invite anyone interested to implement
  74. XX     more PASCAL structures; I probably won't work on it much, because
  75. XX     I don't use Pascal these days.
  76. XX 
  77. XX VERSION
  78. XX     This version by Daniel Kegel <dan@srs.UUCP> or <seismo!rochester!srs!dan>,
  79. XX     25 March 87.
  80. XX     Based on a program by James A Mullens  <jcm@ornl-msr.arpa>  29-Jan-87
  81. XX     which was in turn based on two nearly identical programs by Robert Heller  
  82. XX     (1 Feb 1985) and Rick Walker <walker@hpl-opus.hp.COM> (8 Sep 1986)
  83. XX     which were reportedly derived from a similar program in the Feb 85 Byte
  84. XX     which did a C TO PASCAL conversion.
  85. XX 
  86. XXX_EOF_XXX
  87. if test 2297 -ne "`wc -c < p2c.doc`"
  88. then
  89.     echo 'shar: transmission error on "p2c.doc"'
  90. fi
  91. echo 'shar: extracting "p2c.h" (1096 characters)'
  92. sed 's/^XX //' > p2c.h << 'XXX_EOF_XXX'
  93. XX /*---- p2c.h ------------------------------------------------------
  94. XX Defines and Global Variable for the Pascal to C translator
  95. XX 3/25/87 Daniel Kegel (seismo!rochester!srs!dan)
  96. XX -------------------------------------------------------------------*/
  97. XX 
  98. XX #define MAXTOKLEN 2048    /* maximum token length */
  99. XX     /* Note: even comments are jammed into a token; that's why this is big. */
  100. XX 
  101. XX typedef struct {    /* holds keywords, operators, etc. */
  102. XX     char str[MAXTOKLEN];
  103. XX     int kind;        /* code from table of wnodes */
  104. XX } token;
  105. XX 
  106. XX typedef struct {
  107. XX   int  ktype;        /* the meaning of the keyword */
  108. XX   char *pname;        /* the Pascal name of the keyword */
  109. XX   char *cname;        /* the C      name of the keyword */
  110. XX } wnode;
  111. XX 
  112. XX     /* Allocate or Reallocate n 'type' items */
  113. XX #define MALLOC(type, n) \
  114. XX     ((type *) DoMalloc((unsigned) sizeof(type) * (n)))
  115. XX #define REALLOC(ptr, type, n) \
  116. XX     ((type *) DoRealloc((char *)ptr, (unsigned) sizeof(type) * (n)))
  117. XX 
  118. XX #ifndef TRUE
  119. XX #define TRUE 1
  120. XX #define FALSE 0
  121. XX #endif
  122. XX #ifndef boolean
  123. XX #define boolean int
  124. XX #endif
  125. XX 
  126. XX /*--- The Global Variable ---------*/
  127. XX token cTok;        /* current token from scanner */
  128. XX 
  129. XXX_EOF_XXX
  130. if test 1096 -ne "`wc -c < p2c.h`"
  131. then
  132.     echo 'shar: transmission error on "p2c.h"'
  133. fi
  134. echo 'shar: extracting "ktypes.h" (1438 characters)'
  135. sed 's/^XX //' > ktypes.h << 'XXX_EOF_XXX'
  136. XX /*--- ktypes.h ------------------------------------------------------
  137. XX Keyword types for the Pascal to C translator.
  138. XX 3/25/87 Daniel Kegel (seismo!rochester!srs!dan)
  139. XX ---------------------------------------------------------------------*/
  140. XX #define T_ZIP        0    /* Nondescript identifier */
  141. XX #define T_BEGIN        1    /* BEGIN */
  142. XX #define T_END        2    /* END */
  143. XX #define T_PROC        3    /* PROCEDURE */
  144. XX #define T_FUNC        4    /* FUNCTION */
  145. XX #define T_FORWARD    5    /* FORWARD */
  146. XX #define T_CONST     6    /* CONST */
  147. XX #define T_VAR         7    /* VAR */
  148. XX #define T_COMPARE    8    /* ==, <>, >, < */
  149. XX #define T_EQUALS    9    /* = alone; in CONST, TYPE or comparison */
  150. XX #define T_COLON     10    /* : alone; in VAR, READ, or WRITE */
  151. XX #define T_SEMI        11    /* ; alone */
  152. XX #define T_LPAREN    12    /* ( alone */
  153. XX #define T_RPAREN    13    /* ) alone */
  154. XX #define T_SPACE     14    /* a string of blanks, tabs, and/or newlines */
  155. XX #define T_STRUCTMEMBER    15    /* ^. */
  156. XX #define T_ASSIGN    16    /* := */
  157. XX #define T_STRING    17    /* quoted string */
  158. XX #define T_COMMENT    18    /* comment text */
  159. XX #define T_EOF        19    /* end of source file */
  160. XX #define T_COMMA        20    /* , */
  161. XX #define T_LABEL        21    /* LABEL */
  162. XX #define T_DEREF        22    /* ^ alone */
  163. XX #define T_LBRACKET    23    /* [ */
  164. XX #define T_RBRACKET    24    /* ] */
  165. XX #define T_ARRAY        25    /* ARRAY */
  166. XX #define T_RANGE        26    /* .. */
  167. XX #define T_OF        27    /* OF */
  168. XX #define T_RECORD    28    /* RECORD */
  169. XX #define T_FILE        29    /* FILE */
  170. XX #define T_TYPE        30    /* TYPE */
  171. XX #define T_STRINGTYPE    31    /* STRING(n) or STRING[n] type */
  172. XX #define T_CASE        32    /* CASE */
  173. XXX_EOF_XXX
  174. if test 1438 -ne "`wc -c < ktypes.h`"
  175. then
  176.     echo 'shar: transmission error on "ktypes.h"'
  177. fi
  178. echo 'shar: extracting "p2c.c" (10964 characters)'
  179. sed 's/^XX //' > p2c.c << 'XXX_EOF_XXX'
  180. XX /*----------------------------------------------------------------------
  181. XX   PAS2C.C  Version 1.1
  182. XX   Translate Pascal keywords and operators to C.
  183. XX   useage:  pas2c < pascal_source  > c_source
  184. XX     i.e., this is a filter program which filters out the Pascal.
  185. XX   By James A Mullens <jcm@ornl-msr.arpa>    29-Jan-87
  186. XX 
  187. XX   Revisions:
  188. XX     Version 1.1  17-Feb-87  Changed several keyword translations on the
  189. XX     advice of James R. Van Zandt <jrv@mitre-bedford.ARPA>.  Added many
  190. XX     more translations.  Added a source for function strcmpi for the
  191. XX     unfortunates who don't have this case-insensitive string comparison
  192. XX     in their C library.
  193. XX 
  194. XX     Dan Kegel     15 Mar 87    Made it work on Sun workstation.  Ripped out
  195. XX     translations that hurt translation of a large (20,000 line) Turbo program.
  196. XX ----------------------------------------------------------------------*/
  197. XX 
  198. XX #include <stdio.h>    /* standard I/O */
  199. XX #include <ctype.h>    /* character macros */
  200. XX #include <string.h>    /* string functions */
  201. XX #include "p2c.h"
  202. XX #include "ktypes.h"    /* keyword type definitions */
  203. XX 
  204. XX boolean WasSemi;    /* kludge to avoid duplicating semicolons */
  205. XX 
  206. XX /* Change these translations to fit your desires, but the Pascal names must 
  207. XX    be written in lower case and must be in alphabetical order.  If you include 
  208. XX    a C comment in your translation output as a HINT to the programmer, write 
  209. XX    it in CAPITALs, else write the comment in lower case, eh?
  210. XX */
  211. XX 
  212. XX wnode xlate[] = {
  213. XX   {T_ZIP,    "and",        "&&"    },
  214. XX   {T_ARRAY,    "array",    ""    },    /* see parseTypeDecl */
  215. XX   {T_BEGIN,    "begin",    "{"    },
  216. XX   {T_ZIP,    "boolean",    "boolean"},
  217. XX   {T_ZIP,    "byte",        "char"    },    /* Turbo */
  218. XX   {T_CASE,    "case",        "switch"},
  219. XX   {T_CONST,    "const",    "/* CONST */"},
  220. XX   {T_ZIP,    "div",        "/"    },
  221. XX   {T_ZIP,    "do",        ")"    },
  222. XX   {T_ZIP,    "downto",    ";/*DOWNTO*/"},
  223. XX   {T_ZIP,    "else",        "; else"},
  224. XX   {T_END,    "end",        "}"    },
  225. XX   {T_ZIP,    "false",    "FALSE"    },    
  226. XX   {T_FILE,    "file",        ""    },    /* see parseTypeDecl() */
  227. XX   {T_ZIP,    "for",        "for ("    },
  228. XX   {T_FORWARD,    "forward",    ""    },
  229. XX   {T_FUNC,    "function",    ""    },    /* see parseProcedure() */
  230. XX   {T_ZIP,    "if",        "if ("    },
  231. XX   {T_ZIP,    "implementation", "/* private (static) section */"},
  232. XX   {T_ZIP,    "input",    "stdin"    },
  233. XX   {T_ZIP,    "integer",    "int"    },
  234. XX   {T_ZIP,    "interface",    "/* exported symbol section */"},
  235. XX   {T_ZIP,    "ioresult",    "errno"    },    /* UCSD, Turbo */
  236. XX   {T_LABEL,    "label",    ""    },    /* see parseLabel() */
  237. XX   {T_ZIP,    "mod",        "%"    },
  238. XX   {T_ZIP,    "not",        "!"    },
  239. XX   {T_OF,    "of",        ""    },    /* see parseTypeDecl() */
  240. XX   {T_ZIP,    "or",        "||"    },
  241. XX   {T_ZIP,    "output",    "stdout"},
  242. XX   {T_ZIP,    "packed",    "/* PACKED */"},
  243. XX   {T_PROC,    "procedure",    "void"    },    /* see parseProcedure() */
  244. XX   {T_ZIP,    "program",    "main"    },
  245. XX   {T_ZIP,    "read",        "scanf"    },
  246. XX   {T_ZIP,    "readln",    "/*LINE*/scanf"},/* hint - read end-of-line */
  247. XX   {T_ZIP,    "real",        "double"},    /* or "float" */
  248. XX   {T_RECORD,    "record",    ""    },    /* see parseTypeDecl() */
  249. XX   {T_ZIP,    "repeat",    "do {"    },
  250. XX   {T_STRINGTYPE,"string",    ""    },    /* UCSD, Turbo string type */
  251. XX   {T_ZIP,    "text",        "FILE *"},    /* UCSD, Turbo file type */
  252. XX   {T_ZIP,    "then",        ")"    },
  253. XX   {T_ZIP,    "to",        ";"    },
  254. XX   {T_ZIP,    "true",        "TRUE"    },    
  255. XX   {T_TYPE,    "type",        ""    },    /* see parseType() */
  256. XX   {T_ZIP,    "until",    "} until ("},
  257. XX   {T_ZIP,    "uses",        "/* USES */\n#include"},
  258. XX   {T_VAR,    "var",        "/* VAR */"},    /* see parseProc, parseVar() */
  259. XX   {T_ZIP,    "while",    "while ("},
  260. XX   {T_ZIP,    "with",        "/* WITH */"},    /*hint-set pointer to struct*/
  261. XX   {T_ZIP,    "write",    "printf"},
  262. XX   {T_ZIP,    "writeln",    "/*LINE*/printf"},/* hint - write newline */
  263. XX   {T_ZIP,    "",        ""    }    /* marks end of xlate table */
  264. XX };
  265. XX 
  266. XX wnode theend = {T_ZIP,    "", ""};
  267. XX 
  268. XX wnode *hash[26];        /* quick index into the translation array */
  269. XX 
  270. XX /* Fill in the quick index ("hash") array 
  271. XX */
  272. XX void init_hash()
  273. XX {
  274. XX     int ch, cmp;
  275. XX     wnode *nptr = xlate;
  276. XX 
  277. XX     for (ch='a'; ch<='z'; ch++) {
  278. XX     while (nptr->pname[0] && (cmp = ch - *nptr->pname) > 0) 
  279. XX         nptr++;
  280. XX     hash[ch-'a'] = (cmp==0) ? nptr : &theend;
  281. XX     }
  282. XX }
  283. XX 
  284. XX 
  285. XX /* compare two strings without regard to case,
  286. XX    the equivalent of this function may already be in your C library 
  287. XX    Used to fail on Suns because it used tolower on lowercase chars...
  288. XX    Assumes second argument already lowercase.
  289. XX */
  290. XX int strcmpi(s1,s2)
  291. XX     register char *s1, *s2;
  292. XX { 
  293. XX     register char c1;
  294. XX 
  295. XX     while ((c1= *s1++) && *s2) {    /* get char, advance ptr */
  296. XX     if (isupper(c1)) c1 = tolower(c1);
  297. XX     if (c1 != *s2) break;
  298. XX     s2++;
  299. XX     }
  300. XX     return(c1 - *s2);
  301. XX }
  302. XX 
  303. XX 
  304. XX /* Pass an identifier through the translation table; return its
  305. XX    keyword type.  Translated keyword left in same buffer.
  306. XX */
  307. XX int
  308. XX translate(word)
  309. XX     register char *word;
  310. XX { 
  311. XX     register wnode *xptr;
  312. XX     int nomatch;
  313. XX     int c;
  314. XX 
  315. XX     c = *word;
  316. XX     if (isalpha(c)) {
  317. XX     if (isupper(c)) c=tolower(c);
  318. XX     xptr = hash[c - 'a'];
  319. XX     while ( xptr->pname[0] && (nomatch = strcmpi(word,xptr->pname)) > 0 ) 
  320. XX         xptr++;
  321. XX     if (!nomatch) {
  322. XX         word[0]=0;
  323. XX         if (!WasSemi && xptr->ktype == T_END)
  324. XX         strcpy(word, ";");
  325. XX         strcat(word, xptr->cname);
  326. XX         return(xptr->ktype);
  327. XX     }
  328. XX     }
  329. XX     return(T_ZIP);
  330. XX }
  331. XX 
  332. XX #define Q_NOQUOTE  1
  333. XX #define Q_ONEQUOTE 2
  334. XX #define Q_DONE     3
  335. XX #define Q_ERR      4
  336. XX 
  337. XX #define Q_C_ESCAPES  FALSE   /* Set true if your Pascal knows backslashes */
  338. XX 
  339. XX /*---- parseQuotedString -------------------------------------------------
  340. XX Accepts Pascal quoted string from stdin, converts to C quoted string, and 
  341. XX places in buf.
  342. XX Examples:
  343. XX   'hi' -> "hi"    'hi''' -> "hi'"  'hi''''' -> "hi''"
  344. XX   ''   -> ""      ''''   -> "'"    ''''''   -> "''"
  345. XX   ''hi' -> ERROR  '''hi' -> "'hi"  '''''hi' -> "''hi"
  346. XX   'I''m'  -> "I'm"
  347. XX Double quotes and backslashes are preceded with backslashes, except that
  348. XX if Q_C_ESCAPES is TRUE, backslashes are left naked.
  349. XX --------------------------------------------------------------------------*/
  350. XX void
  351. XX parseQuotedString(buf)
  352. XX char *buf;
  353. XX {
  354. XX     register char c;
  355. XX     register char *letter=buf;
  356. XX     int qstate;
  357. XX 
  358. XX     *letter++ = '"';
  359. XX     qstate = Q_NOQUOTE;
  360. XX     while (qstate < Q_DONE) {
  361. XX     switch (c=getchar()) {
  362. XX     case '\'':
  363. XX         switch (qstate) {
  364. XX         case Q_NOQUOTE:  
  365. XX         qstate = Q_ONEQUOTE; break;
  366. XX         case Q_ONEQUOTE: 
  367. XX         *letter++ = c; qstate = Q_NOQUOTE; break;
  368. XX         }
  369. XX         break;
  370. XX     case EOF:
  371. XX     case '\n':
  372. XX         qstate= (qstate==Q_ONEQUOTE) ? Q_DONE : Q_ERR;
  373. XX         ungetc(c,stdin);
  374. XX         break;
  375. XX     default:
  376. XX         switch (qstate) {
  377. XX         case Q_ONEQUOTE: 
  378. XX         ungetc(c,stdin); qstate = Q_DONE; break;
  379. XX         case Q_NOQUOTE:
  380. XX         if (c=='\\' && !Q_C_ESCAPES) *letter++ = c;
  381. XX         if (c=='"') *letter++ = '\\';
  382. XX         *letter++ = c; 
  383. XX         break; 
  384. XX         }
  385. XX     }
  386. XX     }
  387. XX     *letter++ = '"';
  388. XX     *letter++ = '\0';
  389. XX     if (qstate == Q_ERR) {
  390. XX     fprintf(stderr,"Newline in string constant: %s\n",buf);
  391. XX     fprintf(stdout," %c*** \\n IN STRING ***%c ",
  392. XX         '/', buf, '/');
  393. XX     }
  394. XX }
  395. XX 
  396. XX void
  397. XX getTok()
  398. XX {
  399. XX     register char *letter = cTok.str;
  400. XX     register char *sEnd = letter + MAXTOKLEN-3;
  401. XX     register int c;
  402. XX 
  403. XX     c = getchar();
  404. XX     if (isalnum(c)) {
  405. XX     while (c != EOF && isalnum(c)) {
  406. XX         *letter++ = c;
  407. XX         c = getchar();
  408. XX     }
  409. XX     ungetc(c,stdin);
  410. XX     *letter++ = 0;
  411. XX     cTok.kind = translate(cTok.str);
  412. XX     } else {
  413. XX     switch(c) {
  414. XX     case '\n':    /* newline */
  415. XX     case 0x20:    /* space */
  416. XX     case 0x9:    /* tab */
  417. XX         do        /* Gather a string of blank space into one token */
  418. XX         *letter++ = c;
  419. XX         while ((c=getchar()) != EOF && isspace(c));
  420. XX         ungetc(c, stdin);
  421. XX         *letter++ = '\0';
  422. XX         cTok.kind = T_SPACE;
  423. XX         break;
  424. XX     case '\'':                 /* Quoted String */
  425. XX         parseQuotedString(cTok.str);
  426. XX         cTok.kind = T_STRING;
  427. XX         break;
  428. XX     case '{' :                 /* Curly Comment */
  429. XX         *letter++='/'; 
  430. XX         *letter++='*';
  431. XX         while ((c=getchar()) != EOF && c!='}' && letter!=sEnd)
  432. XX         *letter++ = c;
  433. XX         if (letter == sEnd) {
  434. XX         printf("/***ERROR: Comment too long (sorry) ***/");
  435. XX         while ((c=getchar()) != EOF && c!='}')
  436. XX             ;
  437. XX         }
  438. XX         strcpy(letter, "*/");
  439. XX         cTok.kind = T_COMMENT;
  440. XX         break;
  441. XX     case '(' : 
  442. XX         if ((c=getchar())!='*') {        /* Parenthesis */
  443. XX         ungetc(c,stdin);
  444. XX         strcpy(letter, "(");
  445. XX         cTok.kind = T_LPAREN;
  446. XX         } else {
  447. XX         register int lastc = '\0';    /* (* Comment *) */
  448. XX         *letter++='/'; 
  449. XX         *letter++='*';
  450. XX         while ((c=getchar())!=EOF && !(c==')' && lastc == '*') && 
  451. XX             letter != sEnd) {
  452. XX             lastc = c;
  453. XX             *letter++ = c;
  454. XX         }
  455. XX         if (letter == sEnd) {
  456. XX             printf("/***ERROR: Comment too long (sorry) ***/");
  457. XX             while ((c=getchar())!=EOF && !(c==')' && lastc == '*'))
  458. XX             lastc = c;
  459. XX         }
  460. XX         strcpy(letter, "/");        /* * already there! */
  461. XX         cTok.kind = T_COMMENT;
  462. XX         }
  463. XX         break;
  464. XX     case ')' :
  465. XX         strcpy(letter, ")");
  466. XX         cTok.kind = T_RPAREN;
  467. XX         break;
  468. XX     case ':' : 
  469. XX         if ((c=getchar())=='=') {        /* Assignment */
  470. XX         strcpy(letter, "=");
  471. XX         cTok.kind = T_ASSIGN;
  472. XX         } else {                /* Colon */
  473. XX         ungetc(c,stdin);
  474. XX         strcpy(letter, ":");
  475. XX         cTok.kind = T_COLON;
  476. XX         }
  477. XX         break;
  478. XX     case '=':
  479. XX         strcpy(letter, "==");        /* Might be equality test...*/
  480. XX         cTok.kind = T_EQUALS;        /* depends on parse state */
  481. XX         break;
  482. XX     case '<' : 
  483. XX         switch (c=getchar()) {
  484. XX         case '>':  
  485. XX         strcpy(letter, "!=");
  486. XX         break;
  487. XX         case '=':  
  488. XX         strcpy(letter, "<=");
  489. XX         break;
  490. XX         default :  
  491. XX         ungetc(c,stdin);
  492. XX         strcpy(letter,"<");
  493. XX         }
  494. XX         cTok.kind = T_COMPARE;
  495. XX         break;
  496. XX     case '>' : 
  497. XX         if ((c=getchar()) == '=')
  498. XX         strcpy(letter, ">=");
  499. XX         else {
  500. XX         ungetc(c,stdin);
  501. XX         strcpy(letter, ">");
  502. XX         }
  503. XX         cTok.kind = T_COMPARE;
  504. XX         break;
  505. XX     case '^' :
  506. XX         if ((c=getchar()) == '.') {    /* perhaps we should skip blanks? */
  507. XX         strcpy(letter, "->");
  508. XX         cTok.kind = T_STRUCTMEMBER;
  509. XX         } else {
  510. XX         ungetc(c,stdin);
  511. XX         strcpy(letter, "[0]");    /* '*' would have to go in front */
  512. XX         cTok.kind = T_DEREF;
  513. XX         }
  514. XX         break;
  515. XX     case '$' :            /* Turbo Pascal extension */ 
  516. XX         strcpy(letter, "0x");
  517. XX         cTok.kind = T_ZIP;
  518. XX         break;
  519. XX     case ';' :             /* Semicolon- translation depends on */
  520. XX         strcpy(letter, ";");    /* parse state... */
  521. XX         cTok.kind = T_SEMI;
  522. XX         break;
  523. XX     case '.':
  524. XX         if ((c=getchar()) == '.') {
  525. XX         cTok.kind = T_RANGE;
  526. XX         letter[0]=0;
  527. XX         } else {
  528. XX         ungetc(c,stdin);
  529. XX         strcpy(letter, ".");
  530. XX         cTok.kind = T_ZIP;
  531. XX         }
  532. XX         break;
  533. XX     case '[':
  534. XX         *letter++ = c; *letter = '\0';
  535. XX         cTok.kind = T_LBRACKET;
  536. XX         break;
  537. XX     case ']':
  538. XX         *letter++ = c; *letter = '\0';
  539. XX         cTok.kind = T_RBRACKET;
  540. XX         break;
  541. XX     case ',':
  542. XX         *letter++ = c; *letter = '\0';
  543. XX         cTok.kind = T_COMMA;
  544. XX         break;
  545. XX     case EOF:            /* end of file */
  546. XX         cTok.kind = T_EOF;
  547. XX         break;
  548. XX     default: 
  549. XX         *letter++ = c;        /* Pass unknown chars thru as tokens */
  550. XX         *letter = '\0';
  551. XX         cTok.kind = T_ZIP;
  552. XX     }
  553. XX     }
  554. XX }
  555. XX 
  556. XX main(argc, argv)
  557. XX int argc;
  558. XX char **argv;
  559. XX {
  560. XX     int debug;
  561. XX     
  562. XX     debug = (argc > 1);
  563. XX     init_hash();
  564. XX     WasSemi = FALSE;
  565. XX 
  566. XX     getTok(); 
  567. XX     do {
  568. XX     switch(cTok.kind) {
  569. XX     case T_VAR:
  570. XX         parseVar();
  571. XX         break;
  572. XX     case T_PROC:
  573. XX     case T_FUNC:
  574. XX         parseProcedure();
  575. XX         break;
  576. XX     case T_LABEL:
  577. XX         parseLabel();
  578. XX         break;
  579. XX     case T_TYPE:
  580. XX         parseType();
  581. XX         break;
  582. XX     default:
  583. XX         if (debug)
  584. XX         printf("'%s' %d\n", cTok.str, cTok.kind);
  585. XX         else {    /* fancy stuff to avoid duplicating semicolons */
  586. XX         if (cTok.kind != T_SEMI || !WasSemi)
  587. XX             fputs(cTok.str, stdout);
  588. XX         if (cTok.kind != T_SPACE && cTok.kind != T_COMMENT)
  589. XX             WasSemi = (cTok.kind == T_SEMI);
  590. XX         }
  591. XX         getTok();
  592. XX     }
  593. XX     } while (cTok.kind != T_EOF);
  594. XX }
  595. XX 
  596. XXX_EOF_XXX
  597. if test 10964 -ne "`wc -c < p2c.c`"
  598. then
  599.     echo 'shar: transmission error on "p2c.c"'
  600. fi
  601. echo 'shar: extracting "proc.c" (14091 characters)'
  602. sed 's/^XX //' > proc.c << 'XXX_EOF_XXX'
  603. XX /*--- proc.c -------------------------------------------------------------
  604. XX Procedure, type, variable, and label parsing routines for the Pascal to C
  605. XX translator.
  606. XX 3/25/87 Daniel Kegel (seismo!rochester!srs!dan)
  607. XX --------------------------------------------------------------------------*/
  608. XX #include <stdio.h>
  609. XX #include <string.h>
  610. XX #include "p2c.h"
  611. XX #include "ktypes.h"    /* keyword type definitions */
  612. XX 
  613. XX #define SLEN 80    
  614. XX typedef char sstr[SLEN+1];    /* short string */
  615. XX #define PLEN 1024
  616. XX typedef char pstr[PLEN+1];    /* long string */
  617. XX 
  618. XX /* pgroup is used in parseProcedure to store the procedure's parameters */
  619. XX struct pgroup {
  620. XX     sstr pclass;    /* VAR or empty */
  621. XX     sstr ptype;        /* what type all these guys are */
  622. XX     pstr params;    /* identifiers separated by commas and space */
  623. XX };
  624. XX 
  625. XX boolean
  626. XX isSectionKeyword(k)
  627. XX register int k;
  628. XX {
  629. XX     return(k==T_CONST||k==T_TYPE||k==T_VAR||k==T_PROC||k==T_FUNC||k==T_BEGIN);
  630. XX }
  631. XX 
  632. XX /*--- skipSpace ---------------------------------------------------------
  633. XX Accepts and throws away space and comment tokens.
  634. XX ------------------------------------------------------------------------*/
  635. XX void
  636. XX skipSpace()
  637. XX {
  638. XX     do
  639. XX     getTok();
  640. XX     while (cTok.kind == T_SPACE || cTok.kind == T_COMMENT);
  641. XX     if (cTok.kind == T_EOF) {
  642. XX     printf("\n/***# EOF ***/\n");
  643. XX     fflush(stdout);
  644. XX     exit(1);
  645. XX     }
  646. XX }
  647. XX 
  648. XX /*--- parseSpace ---------------------------------------------------------
  649. XX Accepts and prints space and comment tokens.
  650. XX ------------------------------------------------------------------------*/
  651. XX void
  652. XX parseSpace()
  653. XX {
  654. XX     do {
  655. XX     getTok();
  656. XX     if (cTok.kind == T_SPACE || cTok.kind == T_COMMENT)
  657. XX         fputs(cTok.str, stdout);
  658. XX     } while (cTok.kind == T_SPACE || cTok.kind == T_COMMENT);
  659. XX     if (cTok.kind == T_EOF) {
  660. XX     printf("\n/***# EOF ***/\n");
  661. XX     fflush(stdout);
  662. XX     exit(1);
  663. XX     }
  664. XX }
  665. XX 
  666. XX void
  667. XX expected(s)
  668. XX char *s;
  669. XX {
  670. XX     printf("/***# Expected %s ***/", s);
  671. XX     fflush(stdout);
  672. XX }
  673. XX 
  674. XX /*---- expectThing -------------------------------------------------------
  675. XX Makes sure current token is of desired type, else prints error message.
  676. XX ------------------------------------------------------------------------*/
  677. XX 
  678. XX void
  679. XX expectThing(s, k)
  680. XX char *s;
  681. XX {
  682. XX     if (cTok.kind != k)
  683. XX     expected(s);
  684. XX }
  685. XX 
  686. XX /*---- getThing -------------------------------------------------------
  687. XX Gets next nonblank token, makes sure it is desired type, else prints error 
  688. XX message.
  689. XX ------------------------------------------------------------------------*/
  690. XX void
  691. XX getThing(s, k)
  692. XX char *s;
  693. XX int k;
  694. XX {
  695. XX     skipSpace();
  696. XX     expectThing(s, k);
  697. XX }
  698. XX 
  699. XX /*---- parseVarDec ----------------------------------------------------
  700. XX Translates one (possibly multi-)variable declaration.
  701. XX Works for complex types, but can't be used to parse procedure parameters.
  702. XX On entry, cTok is first token in identifier list.
  703. XX On exit, cTok is the token after the type- probably T_SEMI.
  704. XX Semicolon is translated, too.
  705. XX ----------------------------------------------------------------------*/
  706. XX 
  707. XX struct ident {            /* Used to save variable declaration body */
  708. XX     char *str;            /* until type is known */
  709. XX     int  kind;
  710. XX };
  711. XX #define MAXIDENTS 132        /* allows about 32 variables */
  712. XX 
  713. XX void
  714. XX parseVarDec()
  715. XX {
  716. XX     void parseTypeDecl();        /* forward declaration */
  717. XX     sstr indir, index;
  718. XX     struct ident idents[MAXIDENTS];
  719. XX     int i, n;
  720. XX 
  721. XX     /* Get identifiers, up to the colon that marks end of list */
  722. XX     n=0;
  723. XX     while (cTok.kind != T_COLON) {
  724. XX     if (n == MAXIDENTS-1)
  725. XX         printf("/***# Variable declaration too long ***/");
  726. XX     if (n == MAXIDENTS) n--;
  727. XX     idents[n].str = MALLOC(char, strlen(cTok.str));
  728. XX     strcpy(idents[n].str, cTok.str);
  729. XX     idents[n++].kind = cTok.kind;
  730. XX     if (cTok.kind != T_ZIP && cTok.kind != T_COMMA 
  731. XX     && cTok.kind != T_SPACE && cTok.kind != T_COMMENT)
  732. XX         expected(" (variable declaration) comma or identifier");
  733. XX     getTok();        /* don't nuke spaces or comments */
  734. XX     }
  735. XX 
  736. XX     /* Output any whitespace given before the type declaration */
  737. XX     for (i=0; i<n&&(idents[i].kind==T_SPACE||idents[i].kind==T_COMMENT); i++){
  738. XX     fputs(idents[i].str, stdout);
  739. XX     free(idents[i].str);
  740. XX     }
  741. XX 
  742. XX     /* Translate type specification */
  743. XX     indir[0]=index[0]='\0';
  744. XX     parseTypeDecl(indir, index);
  745. XX 
  746. XX     /* Output the identifiers, with appropriate modification for 
  747. XX        ptr & array types */
  748. XX     putchar(' ');        /* separate RECORD from first element...? */
  749. XX     for (; i<n; i++) {
  750. XX     if (idents[i].kind == T_ZIP && indir[0]!='\0')
  751. XX         fputs(indir, stdout);
  752. XX     fputs(idents[i].str, stdout);
  753. XX     if (idents[i].kind == T_ZIP && index[0]!='\0')
  754. XX         fputs(index, stdout);
  755. XX     free(idents[i].str);
  756. XX     }
  757. XX     if (cTok.kind == T_SEMI)
  758. XX     putchar(';');
  759. XX }
  760. XX 
  761. XX /*---- parseProcedure -------------------------------------------------------
  762. XX On entry, cTok is "PROCEDURE" or "FUNCTION".
  763. XX On exit, cTok is the token after the semicolon after the function header.
  764. XX 
  765. XX Turns declarations like
  766. XX     foo(a:int; b:int)
  767. XX into
  768. XX     foo(a,b)
  769. XX     int a;
  770. XX     int b;
  771. XX 
  772. XX Breaks up function declarations into 
  773. XX     1. name
  774. XX     2. parameter declarations
  775. XX     3. type (or 'void', if procedure)
  776. XX Breaks up parameter declarations into an array of pgroups.
  777. XX ----------------------------------------------------------------------------*/
  778. XX void
  779. XX parseProcedure()
  780. XX {
  781. XX     boolean isProcedure;
  782. XX     boolean isForward;
  783. XX     sstr fnName;
  784. XX     sstr fnType;
  785. XX     struct pgroup *pgps=NULL;
  786. XX     int i, npgp=0;
  787. XX     register struct pgroup *p;
  788. XX 
  789. XX     /* Remember whether is returns a value or not */
  790. XX     isProcedure = (cTok.kind == T_PROC);
  791. XX     /* Get function or procedure name, skipping space & comments */
  792. XX     getThing("function name", T_ZIP);
  793. XX     strcpy(fnName, cTok.str);
  794. XX     skipSpace();            /* eat the function name */
  795. XX     /* Get open paren (or semicolon of a parameterless procedure or fn) */
  796. XX     if (cTok.kind == T_LPAREN) {
  797. XX     do {
  798. XX         register char *cp;
  799. XX         /* Allocate and initialize another parameter group */
  800. XX         if (npgp++ == 0) pgps=MALLOC(struct pgroup, 1);
  801. XX         else pgps = REALLOC(pgps, struct pgroup, npgp);
  802. XX         p = pgps + npgp-1;
  803. XX         p->pclass[0] = p->ptype[0] = '\0';
  804. XX 
  805. XX         /* Get optional class keyword */
  806. XX         skipSpace();        /* eat the paren or semicolon */
  807. XX         if (cTok.kind == T_VAR) {
  808. XX         strcpy(p->pclass, cTok.str);
  809. XX         skipSpace();        /* eat the class keyword */
  810. XX         }
  811. XX         /* Get identifier list & type */
  812. XX         cp = p->params;
  813. XX         /* Get identifiers, up to the colon that marks end of list */
  814. XX         while (cTok.kind != T_COLON) {
  815. XX         register char *cq=cTok.str;
  816. XX         if (cTok.kind != T_ZIP && cTok.kind != T_COMMA)
  817. XX             expected(" (variable declaration) comma or identifier");
  818. XX         while (*cp++ = *cq++)
  819. XX             ;
  820. XX         cp--;
  821. XX         skipSpace();
  822. XX         }
  823. XX         *cp = 0;
  824. XX 
  825. XX         /* Get type specifier, which may be many tokens.  Primitive. */
  826. XX         skipSpace();
  827. XX         p->ptype[0]=0;
  828. XX         do {
  829. XX         strcat(p->ptype, cTok.str);
  830. XX         skipSpace();
  831. XX         } while (cTok.kind != T_SEMI && cTok.kind != T_RPAREN);
  832. XX     } while (cTok.kind == T_SEMI);
  833. XX     expectThing(") at end of param list", T_RPAREN);
  834. XX     skipSpace();
  835. XX     }
  836. XX     /* Get return type */
  837. XX     if (isProcedure) {
  838. XX     strcpy(fnType, "void");
  839. XX     } else {
  840. XX     expectThing(":", T_COLON);
  841. XX     getThing("function type", T_ZIP);
  842. XX     strcpy(fnType, cTok.str);
  843. XX     skipSpace();
  844. XX     }
  845. XX     expectThing("semicolon", T_SEMI);
  846. XX     /* Get optional FORWARD keyword */
  847. XX     skipSpace();
  848. XX     if (isForward = (cTok.kind == T_FORWARD)) {
  849. XX     getThing(";", T_SEMI);
  850. XX     skipSpace();
  851. XX     }
  852. XX 
  853. XX     /* Output the first part of the translated function declaration */
  854. XX     printf("%s %s(", fnType, fnName);
  855. XX     for (i=0, p=pgps; i++ < npgp; p++) {
  856. XX     fputs(p->params, stdout);
  857. XX     if (i<npgp) putchar(',');
  858. XX     }
  859. XX     putchar(')');
  860. XX     if (isForward)
  861. XX     puts(";");
  862. XX     else {
  863. XX     /* Output second part */
  864. XX     putchar('\n');
  865. XX     for (i=0, p=pgps; i++ < npgp; p++) {
  866. XX         if (p->pclass[0])
  867. XX         fputs(p->pclass, stdout);    /* already xlated */
  868. XX         printf("%s %s;\n", p->ptype, p->params);
  869. XX     }
  870. XX     }
  871. XX }
  872. XX 
  873. XX /*--- convertArrayBound -----------------------------------------------------
  874. XX Given the upper bound of a Pascal array, append the C array size specification
  875. XX to the buffer tindex.
  876. XX Lower bounds are ignored, 'cause it's safe to do so, and impossibly difficult
  877. XX to handle.
  878. XX ----------------------------------------------------------------------------*/
  879. XX void
  880. XX convertArrayBound(s, tindex)
  881. XX char *s, *tindex;
  882. XX {
  883. XX     sstr buf;
  884. XX     int ubound;
  885. XX 
  886. XX     ubound = atoi(s);
  887. XX     if (ubound == 0) {
  888. XX     /* Probably symbolic */
  889. XX     sprintf(buf, "[%s+1]", s);
  890. XX     } else {
  891. XX     if (ubound < 0)
  892. XX         expected("positive upper bound");
  893. XX     sprintf(buf, "[%d]", ubound+1);
  894. XX     }
  895. XX     strcat(tindex, buf);
  896. XX }
  897. XX 
  898. XX /*---- parseTypeDecl -------------------------------------------------------
  899. XX Translates a type definition in place.  Appends indirection & array subscrips,
  900. XX if any, to the buffers tindir and tindex.
  901. XX Never translates the semicolon- that is done in parseType.
  902. XX 
  903. XX On entry, cTok is the token that made us expect to find a type
  904. XX (e.g. the colon in a variable declaration, or the equals in a type declaration,
  905. XX On exit, cTok is the token after the type, usually T_SEMI (but may be T_END 
  906. XX in the last declaration in a RECORD).
  907. XX 
  908. XX Pascal (or at least, Turbo Pascal) doesn't allow constructions like
  909. XX     a = ^array [0..10] of integer;
  910. XX rather, it forces you to define the base type, too:
  911. XX     b = array [0..10] of integer;
  912. XX     a = ^b;
  913. XX Thus any type definition can be unambiguously broken up into 2 parts:
  914. XX     - the base type (which may be complex)
  915. XX     - if pointer, how many levels of indirection
  916. XX       else if array, how many indices the type has, with limits
  917. XX -----------------------------------------------------------------------*/
  918. XX void
  919. XX parseTypeDecl(tindir, tindex)
  920. XX char *tindir, *tindex;        /* buffer to put * or [n] in */
  921. XX {
  922. XX     skipSpace();        /* get initial token of type */
  923. XX 
  924. XX     switch (cTok.kind) {
  925. XX     case T_DEREF:        /* pointer type */
  926. XX     strcat(tindir, "*");
  927. XX     parseTypeDecl(tindir, tindex);
  928. XX     break;
  929. XX     case T_LPAREN:        /* enumerated type */
  930. XX     fputs("enum {", stdout);
  931. XX     do {
  932. XX         parseSpace();
  933. XX         if (cTok.kind != T_RPAREN)
  934. XX         fputs(cTok.str, stdout);
  935. XX     } while (cTok.kind != T_RPAREN);
  936. XX     getThing(";", T_SEMI);
  937. XX     putchar('}');
  938. XX     break;
  939. XX     case T_ARRAY:        /* array type */
  940. XX     getThing("[", T_LBRACKET);
  941. XX     do {                    /* Get all the dimensions */
  942. XX         getThing("lower bound", T_ZIP);    /* Ignore lower bound except */
  943. XX         if (cTok.str[0] == '-')        /* to make sure >= 0 */
  944. XX         expected("non-negative lower bound");
  945. XX         getThing("..", T_RANGE);
  946. XX         getThing("upper bound", T_ZIP);
  947. XX         convertArrayBound(cTok.str, tindex);
  948. XX         skipSpace();
  949. XX     } while (cTok.kind == T_COMMA);
  950. XX     expectThing("]", T_RBRACKET);
  951. XX     getThing("OF", T_OF);
  952. XX     parseTypeDecl(tindir, tindex);
  953. XX     break;
  954. XX     case T_STRINGTYPE:        /* Turbo (& UCSD?) string type */
  955. XX     printf("char");
  956. XX     skipSpace();
  957. XX     if (cTok.kind != T_LPAREN && cTok.kind != T_LBRACKET) 
  958. XX         expected("[ or ( after STRING");
  959. XX     getThing("string length", T_ZIP);
  960. XX     convertArrayBound(cTok.str, tindex);
  961. XX     skipSpace();
  962. XX     if (cTok.kind != T_RPAREN && cTok.kind != T_RBRACKET) 
  963. XX         expected("] or ) after STRING[");
  964. XX     getThing(";", T_SEMI);
  965. XX     break;
  966. XX     case T_FILE:        /* file type - not supported in C */
  967. XX     strcat(tindir, "*");
  968. XX     printf("FILE /* OF ");    /* show what it's a file of in the comment */
  969. XX     do {
  970. XX         skipSpace();
  971. XX         if (cTok.kind != T_COMMENT);    /* avoid nesting comments */
  972. XX         fputs(cTok.str, stdout);
  973. XX     } while (cTok.kind != T_SEMI);
  974. XX     printf(" */ ");
  975. XX     break;
  976. XX     case T_RECORD:        /* struct definition */
  977. XX     printf("struct {");
  978. XX     parseSpace();        /* eat RECORD */
  979. XX     do {
  980. XX         if (cTok.kind == T_CASE) {
  981. XX         printf("/***# Sorry- variant records not supported\n\t");
  982. XX         do {
  983. XX             if (cTok.kind != T_COMMENT)
  984. XX             fputs(cTok.str, stdout);
  985. XX             getTok();
  986. XX         } while (cTok.kind != T_END);
  987. XX         printf(" ***/");
  988. XX         break;
  989. XX         }
  990. XX         parseVarDec();
  991. XX         if (cTok.kind == T_SEMI)
  992. XX         parseSpace();
  993. XX         else if (cTok.kind == T_END)
  994. XX         putchar(';');        /* Pascal doesn't need ; but C does*/
  995. XX         else if (cTok.kind != T_CASE)
  996. XX         expected("Either semicolon or END");
  997. XX     } while (cTok.kind != T_END);
  998. XX     parseSpace();        /* eat the END, get the semi */
  999. XX     printf("}");
  1000. XX     break;
  1001. XX     case T_ZIP:            /* probably a type keyword like 'integer' */
  1002. XX     fputs(cTok.str, stdout);
  1003. XX     skipSpace();        /* eat the type, get the semi */
  1004. XX     break;
  1005. XX     default:            /* unexpected */
  1006. XX     expected("type");
  1007. XX     }
  1008. XX }
  1009. XX 
  1010. XX /*---- parseVar -------------------------------------------------------
  1011. XX Translates the VAR section of a program or procedure.
  1012. XX 
  1013. XX On entry, cTok is "VAR".
  1014. XX On exit, cTok is any section-starting keyword.
  1015. XX Turns declarations like
  1016. XX     foo : ^integer;
  1017. XX into
  1018. XX     int *foo;
  1019. XX ----------------------------------------------------------------------------*/
  1020. XX void
  1021. XX parseVar()
  1022. XX {
  1023. XX     getTok();        /* eat the VAR */
  1024. XX     do {
  1025. XX     parseVarDec();
  1026. XX     if (cTok.kind == T_SEMI)
  1027. XX         parseSpace();
  1028. XX     } while (!isSectionKeyword(cTok.kind));
  1029. XX }
  1030. XX 
  1031. XX /*---- parseType -----------------------------------------------------------
  1032. XX Translates the TYPE section of a program or procedure.
  1033. XX On entry, cTok is TYPE.
  1034. XX On exit, cTok is any section-starting keyword.
  1035. XX 
  1036. XX Turns declarations like
  1037. XX     foo = array [0..10, LO..HI] of integer;
  1038. XX     boo = record
  1039. XX         x : foo;
  1040. XX         y : ^foo
  1041. XX       end;
  1042. XX 
  1043. XX into
  1044. XX     typedef integer foo[11][HI+1];
  1045. XX     typedef struct {
  1046. XX     foo x;
  1047. XX     foo *y;
  1048. XX     } boo;
  1049. XX ---------------------------------------------------------------------------*/
  1050. XX void
  1051. XX parseType()
  1052. XX {
  1053. XX     parseSpace();
  1054. XX     do {
  1055. XX     sstr typ;
  1056. XX     sstr tindir, tindex;
  1057. XX     expectThing("type identifier", T_ZIP);
  1058. XX     strcpy(typ, cTok.str);
  1059. XX     parseSpace();
  1060. XX     expectThing("=", T_EQUALS);
  1061. XX     printf("typedef ");
  1062. XX     tindir[0]=tindex[0]=0;
  1063. XX     parseTypeDecl(tindir, tindex);
  1064. XX     expectThing(";", T_SEMI);
  1065. XX     printf(" %s%s%s;", tindir, typ, tindex);
  1066. XX     parseSpace();
  1067. XX     } while (!isSectionKeyword(cTok.kind));
  1068. XX }
  1069. XX 
  1070. XX /*---- parseLabel -------------------------------------------------------
  1071. XX On entry, cTok is "LABEL".
  1072. XX On exit, cTok is whatever follows the semicolon.
  1073. XX 
  1074. XX Turns declarations like
  1075. XX LABEL foo, goo;
  1076. XX into
  1077. XX / * LABEL foo, goo; * /
  1078. XX ----------------------------------------------------------------------------*/
  1079. XX void
  1080. XX parseLabel()
  1081. XX {
  1082. XX     skipSpace();        /* eat the LABEL */
  1083. XX     printf("/* LABEL ");
  1084. XX     /* Get identifiers, up to the semicolon that marks end of list */
  1085. XX     while (cTok.kind != T_SEMI) {
  1086. XX     if (cTok.kind != T_ZIP && cTok.kind != T_COMMA)
  1087. XX         expected(" (label declaration) comma or identifier");
  1088. XX     fputs(cTok.str, stdout);
  1089. XX     skipSpace();
  1090. XX     }
  1091. XX     /* Get semicolon without wiping out trailing space */
  1092. XX     getTok();
  1093. XX     fputs("; */", stdout);
  1094. XX }
  1095. XXX_EOF_XXX
  1096. if test 14091 -ne "`wc -c < proc.c`"
  1097. then
  1098.     echo 'shar: transmission error on "proc.c"'
  1099. fi
  1100. echo 'shar: extracting "doalloc.c" (672 characters)'
  1101. sed 's/^XX //' > doalloc.c << 'XXX_EOF_XXX'
  1102. XX /* doalloc.c: memory allocations which exit upon error */
  1103. XX 
  1104. XX #include <stdio.h>
  1105. XX #ifndef NULL
  1106. XX #define NULL ((char *) 0)
  1107. XX #endif
  1108. XX 
  1109. XX /* act like calloc, but return only if no error */
  1110. XX char *DoRealloc(ptr,size)
  1111. XX     char *ptr;
  1112. XX     unsigned size;
  1113. XX {
  1114. XX     extern char *realloc();
  1115. XX     char *p;
  1116. XX 
  1117. XX     if ((p=realloc(ptr, size)) == NULL) {
  1118. XX     fprintf(stderr, "memory allocation (realloc) error");
  1119. XX     exit(1);
  1120. XX     }
  1121. XX     return (p);
  1122. XX }
  1123. XX 
  1124. XX 
  1125. XX /* act like malloc, but return only if no error */
  1126. XX char *DoMalloc(size)
  1127. XX     unsigned size;
  1128. XX {
  1129. XX     extern char *malloc();
  1130. XX     char *p;
  1131. XX 
  1132. XX     if ((p=malloc(size)) == NULL) {
  1133. XX     fprintf(stderr, "memory allocation (malloc) error");
  1134. XX     exit(1);
  1135. XX     }
  1136. XX     return (p);
  1137. XX }
  1138. XX 
  1139. XXX_EOF_XXX
  1140. if test 672 -ne "`wc -c < doalloc.c`"
  1141. then
  1142.     echo 'shar: transmission error on "doalloc.c"'
  1143. fi
  1144.  
  1145.  
  1146.