home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3181 < prev    next >
Internet Message Format  |  1991-04-10  |  45KB

  1. From: bob@reed.UUCP (Bob Ankeney)
  2. Newsgroups: alt.sources
  3. Subject: PL/M to C converter Part 01/03
  4. Message-ID: <16303@reed.UUCP>
  5. Date: 9 Apr 91 17:00:59 GMT
  6.  
  7.  
  8. #!/bin/sh
  9. # shar:    Shell Archiver  (v1.22)
  10. #
  11. # This is part 1 of a multipart archive                                    
  12. # do not concatenate these parts, unpack them in order with /bin/sh        
  13. #
  14. #    Run the following text with /bin/sh to create:
  15. #      README
  16. #      CAVEATS.DOC
  17. #      FILES
  18. #      at_decl.cvt
  19. #      const.c
  20. #      context.c
  21. #      control.c
  22. #      convert.c
  23. #      cvt.h
  24. #      cvt_id.h
  25. #      decl_out.c
  26. #      declare.c
  27. #      defs.h
  28. #      error.c
  29. #      io.c
  30. #      lit.c
  31. #      main.c
  32. #      makefile
  33. #      makefile.ibm
  34. #      mem.c
  35. #      misc.h
  36. #      parse.c
  37. #      struct.h
  38. #      test.c.out
  39. #      test.plm
  40. #      tkn_defs.h
  41. #      tkn_ext.h
  42. #      token.c
  43. #      tokens.h
  44. #      typedefs.c
  45. #      version.c
  46. #
  47. if test -r s2_seq_.tmp
  48. then echo "Must unpack archives in sequence!"
  49.      next=`cat s2_seq_.tmp`; echo "Please unpack part $next next"
  50.      exit 1; fi
  51. sed 's/^X//' << 'SHAR_EOF' > README &&
  52. X     This is a PL/M to C converter.  It will take most PL/M code and do a nice
  53. Xjob of converting it to C.  It tries to be intelligent about leaving formatting
  54. Xand comments intact.  This version supports PL/M-286.  It is something I wrote
  55. Xabout a year ago to convert several meg of source code, and it did a 99.5%
  56. Xconversion.  I was later handed some source code that it crashed on, and I
  57. Xextended it to support that code too.
  58. X     Please keep in mind that this may well not work for your code.  It has
  59. Xbeen tested only on a few sets of code, each following its own set of coding
  60. Xstandards.  Also, don't expect a lot of support from me, as my interest in
  61. XPL/M is next to none.  I no longer work for the employer for whom I wrote
  62. Xthis converter, but they have given me permission to own and post the sources.
  63. XI will, time permitting, collect bug fixes and post patches to the software.
  64. XPlease mail fixes directly to me, as I may miss any posting of them.  If
  65. Xanyone is interested in taking over maintenance of this code, please let me
  66. Xknow!
  67. X     The source code compiles under Unix.  I've compiled it on a Sun-4, a VAX
  68. Xrunning Ultrix, and a VAX running Mt. Xinu.  At one time I had a version that
  69. Xran under MSDOS, but I can't guarantee it will now.  I've included a makefile
  70. Xfor use with Turbo-C.  You need to define IBMPC to compile it.  What it could
  71. Xreally use is tuning for a large memory model, as in it's present state, it
  72. Xcan only handle small source files.  It could also benefit from a good man
  73. Xpage.
  74. X     The converter expects source code to be in "proper" format (i.e. proper
  75. Xuse of EXTERNAL declarations, and following of the Intel PL/M grammar as the
  76. Xconverter knows it.)  It has some moderate error-recovery, but may well dump
  77. Xcore if it expects one thing and gets another.
  78. X     I've included a garbage file test.plm; typeing "plm2c test.plm" should
  79. Xresult in a test.c file that is identical to the provided test.c.out.
  80. X     See the file CAVEATS.DOC for compatibility issues.
  81. X
  82. X     Hope you find it useful!
  83. X
  84. X     Robert Ankeney
  85. X     April 9, 1991
  86. X     ...!tektronix!bob@reed.bitnet
  87. X
  88. X
  89. SHAR_EOF
  90. chmod 0644 README || echo "restore of README fails"
  91. sed 's/^X//' << 'SHAR_EOF' > CAVEATS.DOC &&
  92. XSome notes about the PL/M to C converter:
  93. X
  94. XWith case conversion enabled by the "ifdef" in main.c, all upper case 
  95. Xcharacters in an identifier are converted to lower case, and all lower case 
  96. Xcharacters are converted to upper case except for identifiers declared 
  97. XLITERALLY, in which case the identifier is not case converted.
  98. X
  99. XDollar signs used in identifiers are discarded.
  100. X
  101. XThe use of the AND, OR and NOT operators are converted to &&, ||, and !
  102. Xoperators respectively.  This should work, but conversion to &, |, and ~
  103. Xmay be desirable in many cases.  There is no clear way to distinguish which
  104. Xconversion to use, thus the previous conversions were chosen.  A #define
  105. Xin tokens.h allows either convention to be chosen.  A more intelligent
  106. Xexpression parser could do a better job of determining use of these operators.
  107. X
  108. XLabels are limited in scope to that defined in C.  That is, use of labels is
  109. Xlimited to the current function.  PL/M allows external labels.
  110. X
  111. XThe dot operator is treated the same as the @ operator (converted to a &
  112. Xreference).
  113. X
  114. XConstant lists of the form:
  115. X     @('string', 0)
  116. Xare converted to:
  117. X     "string"
  118. X
  119. XConstant lists of the form:
  120. X     @('string')
  121. Xare converted to:
  122. X     's', 't', 'r', 'i', 'n', 'g'
  123. X
  124. XBYTE strings of the form:
  125. X     'string'
  126. Xare converted to:
  127. X     's', 't', 'r', 'i', 'n', 'g'
  128. X
  129. XADDRESSes and SELECTORs are not supported.
  130. X
  131. XVariables declared AT in one module and EXTERNAL in another will produce
  132. Xincorrect results, as the EXTERNAL declared variable will not be treated
  133. Xas a pointer.  For example, in module A:
  134. X
  135. X     PL/M code:                           C code:
  136. X     ---------------------------------    ----------------------------------
  137. X     DECLARE MEMVAR BYTE AT(8000H);       BYTE *memvar = (BYTE *) 0x8000;
  138. X     MEMVAR = 14H;                        (*memvar) = 0x14;
  139. X
  140. XAnd in module B:
  141. X
  142. X     PL/M code:                           C code:
  143. X     ---------------------------------    ----------------------------------
  144. X     DECLARE MEMVAR BYTE EXTERNAL;        BYTE memvar;
  145. X     MEMVAR = 14H;                        memvar = 0x14;
  146. X
  147. XTo avoid this problem, list each AT variable used on a single line in a file
  148. Xcalled "at_decl.cvt".
  149. X
  150. XVariable declarations within a procedure with the PUBLIC attribute *probably*
  151. Xshould be placed prior to the procedure definition. Currently, the PUBLIC
  152. Xattribute is ignored.
  153. X
  154. XVariable declarations of type POINTER are treated as type void.
  155. XBASED variables are treated as a pointer to the based variable.
  156. XFor example, for the following declarations, the associated C code is
  157. Xgenerated:
  158. X
  159. X     PL/M code:                           C code:
  160. X     ---------------------------------    ----------------------------------
  161. X     DECLARE I BYTE;                      BYTE i;
  162. X     DECLARE ITEM_PTR POINTER;            void *item_ptr;
  163. X     DECLARE ITEM BASED ITEM_PTR BYTE;    BYTE **item = (BYTE **) &item_ptr;
  164. X     ITEM_PTR = @I;                       item_ptr = &i;
  165. X     ITEM = 77H;                          (**item) = 0x77;
  166. X
  167. X
  168. XCare should be taken in the use of LITERALLY declared variables.  Such
  169. Xdeclarations are converted to a #define directive.  With the cvt.h flag
  170. XPARSE_LITERALS defined, the converter attempts to parse the contents of
  171. Xall LITERALLY declared variables as the definition for the #define
  172. Xdirective.  With PARSE_LITERALS undefined, no parsing takes place.  Thus,
  173. Xfor the declaration:
  174. X    DECLARE MAX_COUNT LITERALLY '55H';
  175. Xthe code generated with PARSE_LITERALS defined is:
  176. X    #define MAX_COUNT 0x55
  177. Xand the code generated with PARSE_LITERALS undefined is:
  178. X    #define MAX_COUNT 55H
  179. X
  180. X
  181. XControl directives within comments are ignored.
  182. X
  183. XThe procedure attribute REENTRANT is ignored.  Technically, all PL/M variables
  184. Xare static and could be declared as such in all but REENTRANT procedures.
  185. XThis was not done, as it was deemed improbable that any problems would result.
  186. XThe user should keep this fact in mind though.  Especially in cases where the
  187. XC compiler warns about using a variable before it has been defined.
  188. X
  189. XIn most cases, white space (spaces, tabs, returns, line-feeds and comments)
  190. Xare retained in their appropriate place.  In obscure instances, white space
  191. Xmay be discarded for the sake of simpler code.  For example, white space in
  192. Xsome portions of a DECLARE statement is discarded, since the structure of
  193. Xa DECLARE statement is drastically converted.
  194. X
  195. XArray subscripts and function calls appear to be ambiguous.  The converter
  196. Xkeeps a symbol table of DECLARATIONS to try to correctly distinguish one from
  197. Xthe other.
  198. X
  199. X
  200. SHAR_EOF
  201. chmod 0660 CAVEATS.DOC || echo "restore of CAVEATS.DOC fails"
  202. sed 's/^X//' << 'SHAR_EOF' > FILES &&
  203. XREADME
  204. XCAVEATS.DOC
  205. XFILES
  206. Xat_decl.cvt
  207. Xconst.c
  208. Xcontext.c
  209. Xcontrol.c
  210. Xconvert.c
  211. Xcvt.h
  212. Xcvt_id.h
  213. Xdecl_out.c
  214. Xdeclare.c
  215. Xdefs.h
  216. Xerror.c
  217. Xio.c
  218. Xlit.c
  219. Xmain.c
  220. Xmakefile
  221. Xmakefile.ibm
  222. Xmem.c
  223. Xmisc.h
  224. Xparse.c
  225. Xstruct.h
  226. Xtest.c.out
  227. Xtest.plm
  228. Xtkn_defs.h
  229. Xtkn_ext.h
  230. Xtoken.c
  231. Xtokens.h
  232. Xtypedefs.c
  233. Xversion.c
  234. SHAR_EOF
  235. chmod 0644 FILES || echo "restore of FILES fails"
  236. sed 's/^X//' << 'SHAR_EOF' > at_decl.cvt &&
  237. SHAR_EOF
  238. chmod 0644 at_decl.cvt || echo "restore of at_decl.cvt fails"
  239. sed 's/^X//' << 'SHAR_EOF' > const.c &&
  240. X
  241. X
  242. Xfoop(i, j)
  243. Xshort i, j;
  244. X{
  245. X}
  246. X
  247. Xfloat foo()
  248. X{
  249. X}
  250. X
  251. X    WORD bletch;
  252. X    void *ptr;
  253. X
  254. X    farp("Hi\014\037\253\036");
  255. X    farp(&foo, &bar, &bletch);
  256. X    bletch = foo + foop(1, 2);
  257. X    bletch = foo + foop;
  258. X    ptr = (void *)  &foo;
  259. X    ptr = (void *)  &bar;
  260. X    ptr = (void *)  &bletch;
  261. X    foo();
  262. X    bar();
  263. X    (*ptr)();
  264. X    (*bletch)();
  265. X    (*ptr)(1, 2);
  266. X
  267. SHAR_EOF
  268. chmod 0660 const.c || echo "restore of const.c fails"
  269. sed 's/^X//' << 'SHAR_EOF' > context.c &&
  270. X#include "misc.h"
  271. X#include "defs.h"
  272. X#include "cvt.h"
  273. X#include "struct.h"
  274. X
  275. X/*
  276. X *    Pointer to the current context
  277. X */
  278. XCONTEXT        *context_head;
  279. X/*
  280. X *    Pointer to all popped contexts
  281. X */
  282. XCONTEXT        *old_context;
  283. X
  284. X/*
  285. X *    Search DECL_MEMBER list for symbol and if found, return TRUE
  286. X *    and pointer to DECL_ID for that symbol.
  287. X */
  288. Xfind_member_symbol(symbol, decl_ptr, decl_id)
  289. XTOKEN        *symbol;
  290. XDECL_MEMBER    *decl_ptr;
  291. XDECL_ID        **decl_id;
  292. X{
  293. X    DECL_ID    *var_ptr;
  294. X
  295. X    for (var_ptr = decl_ptr->name_list; var_ptr;
  296. X            var_ptr = var_ptr->next_var) {
  297. X        if (!strcmp(var_ptr->name->token_name, symbol->token_name)) {
  298. X            *decl_id = var_ptr;
  299. X            return TRUE;
  300. X        }
  301. X    }
  302. X    *decl_id = NULL;
  303. X    return FALSE;
  304. X}
  305. X
  306. X/*
  307. X *    Search DECL_MEMBER list for symbol.
  308. X *    If found, return pointer to DECL_MEMBER containing that symbol
  309. X *    in decl_found, and return TRUE.
  310. X *    If not found, return null pointer in decl_found, and return FALSE.
  311. X */
  312. Xfind_list_symbol(symbol, decl_ptr, decl_found, decl_id)
  313. XTOKEN        *symbol;
  314. XDECL_MEMBER    *decl_ptr, **decl_found;
  315. XDECL_ID        **decl_id;
  316. X{
  317. X    for (*decl_found = decl_ptr; *decl_found;
  318. X            *decl_found = (*decl_found)->next_member) {
  319. X        if (find_member_symbol(symbol, *decl_found, decl_id))
  320. X            return TRUE;
  321. X    }
  322. X    return FALSE;
  323. X}
  324. X
  325. X/*
  326. X *    Search context for symbol.
  327. X *    If found, return pointer to DECL_MEMBER containing that symbol
  328. X *    in decl_found, return DECL_ID for that symbol in decl_id, and
  329. X *    return TRUE.
  330. X *    If not found, return null pointers in decl_found and decl_id,
  331. X *    and return FALSE.
  332. X */
  333. Xfind_symbol(symbol, decl_found, decl_id)
  334. XTOKEN        *symbol;
  335. XDECL_MEMBER    **decl_found;
  336. XDECL_ID        **decl_id;
  337. X{
  338. X    CONTEXT    *context_ptr;
  339. X
  340. X    for (context_ptr = context_head; context_ptr;
  341. X            context_ptr = context_ptr->next_context) {
  342. X        if (find_list_symbol(symbol, context_ptr->decl_head,
  343. X                decl_found, decl_id))
  344. X            return TRUE;
  345. X    }
  346. X    return FALSE;
  347. X}
  348. X
  349. X/*
  350. X *    Add a declaration to current context
  351. X */
  352. Xadd_to_context(decl)
  353. XDECL_MEMBER    *decl;
  354. X{
  355. X    DECL_MEMBER    *decl_ptr;
  356. X
  357. X        /* Find end of declaration list */
  358. X    for (decl_ptr = decl; decl_ptr->next_member; )
  359. X        decl_ptr = decl_ptr->next_member;
  360. X
  361. X        /* Add current declarations to tail of new list */
  362. X    decl_ptr->next_member = context_head->decl_head;
  363. X    context_head->decl_head = decl;
  364. X}
  365. X
  366. X/*
  367. X *    Add a DECL list to context and NULL the list pointer
  368. X */
  369. Xadd_decl_to_context(decl)
  370. XDECL    *decl;
  371. X{
  372. X    DECL    *decl_ptr;
  373. X
  374. X        /* Find end of declaration list */
  375. X    for (decl_ptr = decl; decl_ptr; decl_ptr = decl_ptr->next_decl) {
  376. X        if (decl_ptr->decl_list)
  377. X            add_to_context(decl_ptr->decl_list);
  378. X        decl_ptr->decl_list = NULL;
  379. X    }
  380. X}
  381. X
  382. X/*
  383. X *    Push a new context of specified type and name
  384. X */
  385. Xnew_context(type, name)
  386. Xint    type;
  387. XTOKEN    *name;
  388. X{
  389. X    CONTEXT    *new_context;
  390. X
  391. X    get_context_ptr(&new_context);
  392. X    new_context->context_type = type;
  393. X    if (name) {
  394. X        get_token_ptr(&new_context->context_name);
  395. X        token_copy(name, new_context->context_name);
  396. X    } else
  397. X        new_context->context_name = NULL;
  398. X    new_context->next_context = context_head;
  399. X    context_head = new_context;
  400. X}
  401. X
  402. X/*
  403. X *    Pop current context and place on old context
  404. X */
  405. Xpop_context()
  406. X{
  407. X    CONTEXT    *popped_context;
  408. X
  409. X    popped_context = context_head;
  410. X    context_head = popped_context->next_context;
  411. X    popped_context->next_context = old_context;
  412. X    old_context = popped_context;
  413. X}
  414. X
  415. X/*
  416. X *    Initializes context pointers
  417. X */
  418. Xinit_context()
  419. X{
  420. X    context_head = NULL;
  421. X    old_context = NULL;
  422. X}
  423. X
  424. SHAR_EOF
  425. chmod 0660 context.c || echo "restore of context.c fails"
  426. sed 's/^X//' << 'SHAR_EOF' > control.c &&
  427. X#include "misc.h"
  428. X#include "defs.h"
  429. X#include "cvt.h"
  430. X#include "struct.h"
  431. X#include "tokens.h"
  432. X#include "tkn_ext.h"
  433. X
  434. Xextern    char    *text_buffer;
  435. Xextern    char    *text_ptr;
  436. X
  437. X/*
  438. X *    Parse a control directive.
  439. X *    Handles:        Abbreviation:
  440. X *        $INCLUDE    $IC
  441. X *        $SET
  442. X *        $RESET
  443. X *        $IF
  444. X *        $ELSE
  445. X *        $ELSEIF
  446. X *        $ENDIF
  447. X */
  448. Xparse_control()
  449. X{
  450. X    TOKEN        ctl_token, token;
  451. X    int        token_class;
  452. X    RESERVED_WORD    *word_ptr;
  453. X    char        include_file[128], *include_ptr;
  454. X
  455. X    token_class = get_token(&ctl_token);
  456. X    if (token_class != IDENTIFIER) {
  457. X        control_error("Invalid directive");
  458. X        return;
  459. X    }
  460. X
  461. X    for (word_ptr = &control_directives[0]; word_ptr->token != END_OF_FILE;
  462. X            word_ptr++) {
  463. X        if ((strlen(word_ptr->name) == ctl_token.token_length) &&
  464. X        !strncmp(word_ptr->name, ctl_token.token_start,
  465. X                ctl_token.token_length)) {
  466. X        switch (word_ptr->token) {
  467. X
  468. X        case C_INCLUDE :
  469. X            token_class = get_token(&token);
  470. X            if (token_class != LEFT_PAREN) {
  471. X                control_error("'(' expected");
  472. X                return;
  473. X            }
  474. X                /* Copy and send file name (up to ')') */
  475. X            include_ptr = include_file;
  476. X            while (*text_ptr != ')') {
  477. X                if ((*text_ptr >= 'A') && (*text_ptr <= 'Z'))
  478. X                        /* Convert to lower case */
  479. X                    *include_ptr++ = *text_ptr++ + ' ';
  480. X                else
  481. X                    *include_ptr++ = *text_ptr++;
  482. X            }
  483. X            *include_ptr++ = '\0';
  484. X
  485. X                /* Skip ')' */
  486. X            text_ptr++;
  487. X
  488. X                /* Parse include file */
  489. X            cvt_file(include_file);
  490. X
  491. X                /* Convert .plm to .c */
  492. X            if (strcmp(include_ptr - 5, "plm")) {
  493. X                (void) strcpy(include_ptr - 5, ".c");
  494. X                include_ptr -= 2;
  495. X            }
  496. X
  497. X            out_to_start();
  498. X            out_str("#include");
  499. X            out_must_white(&token);
  500. X            out_char('"');
  501. X            out_str(include_file);
  502. X
  503. X            out_char('"');
  504. X            return;
  505. X
  506. X        default :
  507. X            control_error("Non-supported directive");
  508. X            return;
  509. X        }
  510. X        }
  511. X    }
  512. X
  513. X    control_error("Invalid directive");
  514. X}
  515. X
  516. SHAR_EOF
  517. chmod 0660 control.c || echo "restore of control.c fails"
  518. sed 's/^X//' << 'SHAR_EOF' > convert.c &&
  519. X#include <stdio.h>
  520. X#ifdef IBMPC
  521. X#include <stdlib.h>
  522. X#endif
  523. X#include "misc.h"
  524. X#include "defs.h"
  525. X#include "cvt.h"
  526. X#include "struct.h"
  527. X#include "tokens.h"
  528. X
  529. XBOOLEAN        syntax_error;
  530. X
  531. Xextern    char    *text_buffer, *text_ptr;
  532. Xextern    int    line_count;
  533. X
  534. X/*
  535. X *    Determine statement type and call appropriate parse routine.
  536. X *    Return statement class or, if a reserved word, reserved word token.
  537. X */
  538. Xparse_statement(first_token)
  539. XTOKEN    *first_token;
  540. X{
  541. X    int    token_type;
  542. X
  543. X        /* Flush standard output and standard error */
  544. X    (void) fflush(stdout);
  545. X    (void) fflush(stderr);
  546. X
  547. X        /* Flag no error yet */
  548. X    syntax_error = FALSE;
  549. X
  550. X    switch (first_token->token_class) {
  551. X
  552. X    case RESERVED:
  553. X        token_type = first_token->token_type;
  554. X
  555. X        switch (token_type) {
  556. X
  557. X        case DECLARE :
  558. X            parse_declare(first_token);
  559. X            break;
  560. X
  561. X        case DO :
  562. X            parse_do(first_token);
  563. X            break;
  564. X
  565. X        case IF :
  566. X            parse_if(first_token);
  567. X            break;
  568. X
  569. X        case THEN :
  570. X            parse_then();
  571. X            break;
  572. X
  573. X        case ELSE :
  574. X            parse_else(first_token);
  575. X            break;
  576. X
  577. X        case GOTO :
  578. X            parse_goto(first_token);
  579. X            break;
  580. X
  581. X        case GO :
  582. X            parse_go(first_token);
  583. X            break;
  584. X
  585. X        case CALL :
  586. X            parse_call(first_token);
  587. X            break;
  588. X
  589. X        case RETURN :
  590. X            parse_return(first_token);
  591. X            break;
  592. X
  593. X        case END :
  594. X            parse_end(first_token);
  595. X            break;
  596. X
  597. X        case DISABLE :
  598. X            parse_int_ctl(first_token);
  599. X            break;
  600. X
  601. X        case ENABLE :
  602. X            parse_int_ctl(first_token);
  603. X            break;
  604. X
  605. X        case OUTPUT :
  606. X            parse_output(first_token);
  607. X            break;
  608. X
  609. X        case OUTWORD :
  610. X            parse_outword(first_token);
  611. X            break;
  612. X
  613. X        case OUTHWORD :
  614. X            parse_outhword(first_token);
  615. X            break;
  616. X
  617. X        default :
  618. X            parse_error("Illegal reserved word");
  619. X            return ERROR;
  620. X        }
  621. X
  622. X        return token_type;
  623. X
  624. X    case IDENTIFIER:
  625. X        parse_identifier(first_token);
  626. X        break;
  627. X
  628. X    case LABEL:
  629. X        parse_label();
  630. X        break;
  631. X
  632. X    case END_OF_LINE:
  633. X        parse_eol(first_token);
  634. X        break;
  635. X
  636. X    case END_OF_FILE:
  637. X        out_white_space(first_token);
  638. X        return END_OF_FILE;
  639. X
  640. X    default:
  641. X        parse_error("Illegal statement");
  642. X        return ERROR;
  643. X
  644. X    }
  645. X
  646. X    return first_token->token_class;
  647. X}
  648. X
  649. Xparse_new_statement()
  650. X{
  651. X    TOKEN        first_token;
  652. X
  653. X        /* Get first token on line */
  654. X    (void) get_token(&first_token);
  655. X
  656. X    return parse_statement(&first_token);
  657. X}
  658. X
  659. Xparse_file()
  660. X{
  661. X    while (parse_new_statement() != END_OF_FILE) ;
  662. X}
  663. X
  664. SHAR_EOF
  665. chmod 0660 convert.c || echo "restore of convert.c fails"
  666. sed 's/^X//' << 'SHAR_EOF' > cvt.h &&
  667. X/*
  668. X *    Parse LITERALLY declared strings
  669. X */
  670. X#define PARSE_LITERALS
  671. X
  672. X/*
  673. X *    Ignore Invalid control errors
  674. X */
  675. X#define    IGNORE_CONTROL_ERRORS
  676. X
  677. X/*
  678. X *    Convert lower case to upper and upper to lower in identifiers
  679. X */
  680. X#define    CONVERT_CASE
  681. X
  682. X/*
  683. X *    If CONVERT_TYPES defined, use the following type conversions.
  684. X */
  685. X#define CONVERT_TYPES
  686. X
  687. X/*
  688. X *    Type conversions
  689. X */
  690. X#define TYPE_BYTE    "BYTE"
  691. X#define TYPE_WORD    "WORD"
  692. X#define TYPE_DWORD    "DWORD"
  693. X#define TYPE_INTEGER    "short"
  694. X#define TYPE_REAL    "float"
  695. X
  696. X/*
  697. X *    For initialized DATA, use this prefix.
  698. X *    Probably should be "const" or "static".
  699. X */
  700. X#define TYPE_DATA    "const"
  701. X
  702. X/*
  703. X *    Default POINTER type.
  704. X */
  705. X#define TYPE_POINTER    "void"
  706. X
  707. X/*
  708. X *    Sizes of data types
  709. X */
  710. X#define SIZE_BYTE    1
  711. X#define SIZE_WORD    2
  712. X#define SIZE_DWORD    4
  713. X
  714. X/*
  715. X *    Conversion operators
  716. X */
  717. X#define AND_OP    "&&"
  718. X#define OR_OP    "||"
  719. X#define NOT_OP    "!"
  720. X/*
  721. X#define AND_OP    "&"
  722. X#define OR_OP    "|"
  723. X#define NOT_OP    "~"
  724. X*/
  725. X/*
  726. X#define AND_OP    "AND"
  727. X#define OR_OP    "OR"
  728. X#define NOT_OP    "NOT"
  729. X*/
  730. X
  731. X/*
  732. X *    Function call equivalent to OUTPUT(port) = expr
  733. X *    Becomes: FUNC_OUTPUT(port, expr)
  734. X */
  735. X#define FUNC_OUTPUT    "outportb"
  736. X
  737. X/*
  738. X *    Function call equivalent to OUTWORD(port) = expr
  739. X *    Becomes: FUNC_OUTWORD(port, expr)
  740. X */
  741. X#define FUNC_OUTWORD    "outport"
  742. X
  743. X/*
  744. X *    Function call equivalent to OUTHWORD(port) = expr
  745. X *    Becomes: FUNC_OUTHWORD(port, expr)
  746. X */
  747. X#define FUNC_OUTHWORD    "outporth"
  748. X
  749. SHAR_EOF
  750. chmod 0660 cvt.h || echo "restore of cvt.h fails"
  751. sed 's/^X//' << 'SHAR_EOF' > cvt_id.h &&
  752. X/*
  753. X *    PL/M Cast function equivalents
  754. X */
  755. XCVT_ID cast_functions[] = {
  756. X    "float",    TYPE_REAL,
  757. X    "real",        TYPE_REAL,
  758. X    "fix",        TYPE_INTEGER,
  759. X    "int",        TYPE_INTEGER,
  760. X    "signed",    TYPE_INTEGER,
  761. X    "integer",    TYPE_INTEGER,
  762. X    "unsign",    TYPE_WORD,
  763. X    "word",        TYPE_WORD,
  764. X    "byte",        TYPE_BYTE,
  765. X    "dword",    TYPE_DWORD,
  766. X    "pointer",    TYPE_POINTER,
  767. X    "",        ""
  768. X};
  769. X
  770. X/*
  771. X *    PL/M function equivalents
  772. X */
  773. XCVT_ID cvt_functions[] = {
  774. X    "size",            "sizeof",
  775. X    "abs",            "fabs",
  776. X    "iabs",            "abs",
  777. X    "input",        "inportb",
  778. X    "inword",        "inport",
  779. X    "setinterrupt",        "signal",
  780. X    "initrealmathunit",    "_fpreset",
  781. X    "",        ""
  782. X};
  783. X
  784. X/*
  785. X *    PL/M identifier equivalents
  786. X */
  787. XCVT_ID cvt_identifiers[] = {
  788. X    "getrealerror",        "_status87()",
  789. X    "",            ""
  790. X};
  791. X
  792. SHAR_EOF
  793. chmod 0660 cvt_id.h || echo "restore of cvt_id.h fails"
  794. sed 's/^X//' << 'SHAR_EOF' > decl_out.c &&
  795. X#include "misc.h"
  796. X#include "defs.h"
  797. X#include "cvt.h"
  798. X#include "struct.h"
  799. X#include "tokens.h"
  800. X
  801. Xextern    char    *text_ptr;
  802. Xextern    int    at_decl_count;
  803. Xextern    char    at_decl_list[MAX_AT_DECLS][MAX_TOKEN_LENGTH];
  804. X
  805. X/*
  806. X *    Output *<name> if use_parens == NULL, else (*<name>).
  807. X */
  808. Xout_pointer(name, use_parens)
  809. XTOKEN    *name;
  810. XBOOLEAN    use_parens;
  811. X{
  812. X        /* Use parentheses? */
  813. X    if (use_parens) {
  814. X            /* Yes - make it (*name) */
  815. X        out_str("(*");
  816. X        out_token_name(name);
  817. X        out_char(')');
  818. X    } else {
  819. X            /* No - make it *name */
  820. X        out_char('*');
  821. X        out_token_name(name);
  822. X    }
  823. X}
  824. X
  825. X/*
  826. X *    Output array bound (if any)
  827. X */
  828. Xout_bound(bound)
  829. XTOKEN    *bound;
  830. X{
  831. X    if (bound) {
  832. X        out_char('[');
  833. X        out_token(bound);
  834. X        out_char(']');
  835. X    }
  836. X}
  837. X
  838. X/*
  839. X *    Output a declaration type.
  840. X */
  841. Xout_decl_type(decl_ptr)
  842. XDECL_MEMBER    *decl_ptr;
  843. X{
  844. X    if (decl_ptr->type->token_type != STRUCTURE) {
  845. X        out_type(decl_ptr->type->token_type);
  846. X    } else {
  847. X        out_struct(decl_ptr->struct_list);
  848. X    }
  849. X}
  850. X
  851. X/*
  852. X *    Output structure contents.
  853. X */
  854. Xout_struct(el_ptr)
  855. XDECL_MEMBER    *el_ptr;
  856. X{
  857. X    DECL_ID        *var_ptr;
  858. X
  859. X    out_str("struct {");
  860. X
  861. X    while (el_ptr) {
  862. X            /* Use initial white space before type */
  863. X        var_ptr = el_ptr->name_list;
  864. X        if (var_ptr)
  865. X            out_must_white(var_ptr->name);
  866. X
  867. X        out_decl_type(el_ptr);
  868. X        out_char(' ');
  869. X
  870. X        while (var_ptr) {
  871. X            out_token_name(var_ptr->name);
  872. X            out_bound(el_ptr->array_bound);
  873. X            var_ptr = var_ptr->next_var;
  874. X            if (var_ptr) {
  875. X                out_char(',');
  876. X                out_must_white(var_ptr->name);
  877. X            }
  878. X        }
  879. X        if ((el_ptr = el_ptr->next_member) != NULL)
  880. X            out_char(';');
  881. X    }
  882. X    out_char('}');
  883. X}
  884. X
  885. X/*
  886. X *    Output C declaration list member.
  887. X */
  888. Xout_decl_member(decl_list, decl_token)
  889. XDECL_MEMBER    *decl_list;
  890. XTOKEN        *decl_token;
  891. X{
  892. X    int    i;
  893. X    TOKEN    token, tmp_token;
  894. X    int    token_class;
  895. X    int    name_count;
  896. X    char    count_str[8];
  897. X    DECL_ID    *var_ptr;
  898. X    char    *tmp_white_start, *tmp_white_end;
  899. X    char    *tmp_text_ptr;
  900. X    BOOLEAN    typedefed, is_at;
  901. X    int    string_len, string_size;
  902. X    char    *string_ptr;
  903. X
  904. X        /* Output characters up to CR */
  905. X    out_pre_white(decl_token);
  906. X
  907. X    if (decl_list->type->token_type == LABEL)
  908. X            /* Ignore label declarations */
  909. X        return;
  910. X
  911. X    var_ptr = decl_list->name_list;
  912. X
  913. X    if (decl_list->type->token_type == LITERALLY) {
  914. X            /* Make sure we're at start of new line */
  915. X        out_pre_white(var_ptr->name);
  916. X        out_to_start();
  917. X
  918. X            /* Convert to a #define */
  919. X        out_str("#define ");
  920. X        out_cvt_name(var_ptr->name);
  921. X        out_char(' ');
  922. X        out_str(decl_list->literal);
  923. X/*
  924. X        out_str("\n");
  925. X*/
  926. X        return;
  927. X    }
  928. X
  929. X    var_ptr->name->white_space_start = decl_token->white_space_start;
  930. X    var_ptr->name->white_space_end = decl_token->white_space_end;
  931. X
  932. X        /* Swap white space between type and first identifier */
  933. X        /* and eat any new_lines prior to first identifier */
  934. X    tmp_white_start = decl_list->type->white_space_start;
  935. X    tmp_white_end = decl_list->type->white_space_end;
  936. X
  937. X    while ((tmp_white_start < tmp_white_end) && (*tmp_white_start < ' '))
  938. X        tmp_white_start++;
  939. X
  940. X    decl_list->type->white_space_start = var_ptr->name->white_space_start;
  941. X    var_ptr->name->white_space_start = tmp_white_start;
  942. X    decl_list->type->white_space_end = var_ptr->name->white_space_end;
  943. X    var_ptr->name->white_space_end = tmp_white_end;
  944. X
  945. X    out_white_space(decl_list->type);
  946. X
  947. X    if (decl_list->attributes == EXTERNAL) {
  948. X        out_str("extern ");
  949. X
  950. X            /* Check if declared AT in another module */
  951. X        for (i = 0; i < at_decl_count; i++)
  952. X            if (!strcmp(var_ptr->name->token_name, at_decl_list[i]))
  953. X                    /* Yes - flag as so */
  954. X                var_ptr->is_ext_at = TRUE;
  955. X    } else
  956. X
  957. X    if (decl_list->initialization == DATA) {
  958. X        out_str(TYPE_DATA);
  959. X        out_char(' ');
  960. X    }
  961. X
  962. X
  963. X    is_at = (decl_list->at_ptr != NULL) || var_ptr->is_ext_at;
  964. X
  965. X        /* Determine if a structure with an AT attribute */
  966. X    typedefed = (decl_list->type->token_type == STRUCTURE) && is_at;
  967. X
  968. X        /* Output type */
  969. X        /* Is this a structure with an AT attribute? */
  970. X    if (typedefed) {
  971. X            /* Yes - output typedefed structure */
  972. X        out_str("typedef ");
  973. X        out_struct(decl_list->struct_list);
  974. X        out_must_white(var_ptr->name);
  975. X#ifdef USE_DEFINES
  976. X        out_char('_');
  977. X#endif
  978. X        out_cvt_name(var_ptr->name);
  979. X        if (decl_list->array_bound)
  980. X            out_bound(decl_list->array_bound);
  981. X        out_str(";\n");
  982. X        out_white_space(decl_token);
  983. X#ifdef USE_DEFINES
  984. X        out_char('_');
  985. X#endif
  986. X        out_cvt_name(var_ptr->name);
  987. X    } else
  988. X        out_decl_type(decl_list);
  989. X
  990. X        /* Walk through name list */
  991. X    name_count = 0;
  992. X    while (var_ptr) {
  993. X        if (is_at) {
  994. X                /* AT (<expression>) -
  995. X                   OK... don't panic...
  996. X                   we can handle this
  997. X                */
  998. X/*
  999. X * Output:
  1000. X *    <type> *<ident> = (<type> *) <AT expr> + name_count
  1001. X *
  1002. X * NOTE: BASED variables are not dealt with.
  1003. X */
  1004. X            out_must_white(var_ptr->name);
  1005. X                /* Is this an array? */
  1006. X            if ((decl_list->array_bound) && !typedefed)
  1007. X                    /* Yes - output ( *<ident> ) */
  1008. X                out_char('(');
  1009. X            out_char('*');
  1010. X#ifdef USE_DEFINES
  1011. X                /* Output case converted name */
  1012. X            out_cvt_name(var_ptr->name);
  1013. X#else
  1014. X            out_token_name(var_ptr->name);
  1015. X#endif
  1016. X            if ((decl_list->array_bound) && !typedefed) {
  1017. X                out_char(')');
  1018. X                    /* Output array bound (if any) */
  1019. X                out_bound(decl_list->array_bound);
  1020. X            }
  1021. X
  1022. X            if (decl_list->attributes != EXTERNAL) {
  1023. X                out_str(" = (");
  1024. X                /* Is this a structure? */
  1025. X                if (decl_list->type->token_type == STRUCTURE) {
  1026. X                    /* Yes - output structure name prefix */
  1027. X#ifdef USE_DEFINES
  1028. X                out_char('_');
  1029. X#endif
  1030. X                out_cvt_name(decl_list->name_list->name);
  1031. X                } else
  1032. X                out_decl_type(decl_list);
  1033. X                out_str(" *) ");
  1034. X
  1035. X                out_str(decl_list->at_ptr);
  1036. X                if (name_count) {
  1037. X                (void) sprintf(count_str, " + %d", name_count);
  1038. X                out_str(count_str);
  1039. X                }
  1040. X            }
  1041. X        } else {
  1042. X                /* Not an AT expression (whew!) */
  1043. X            out_must_white(var_ptr->name);
  1044. X
  1045. X                /* Is variable based? */
  1046. X            if (var_ptr->based_name) {
  1047. X                    /* Yes - Output **name = */
  1048. X                    /*    (type **) &based_name */
  1049. X                if (decl_list->array_bound) {
  1050. X                        /* Use (**name)[] */
  1051. X                    out_str("(**");
  1052. X                    out_token_name(var_ptr->name);
  1053. X                    out_str(")[]");
  1054. X                } else {
  1055. X                    out_str("**");
  1056. X                    out_token_name(var_ptr->name);
  1057. X                }
  1058. X
  1059. X                out_str(" = (");
  1060. X                out_decl_type(decl_list);
  1061. X                out_str(" **) &");
  1062. X                out_token_name(var_ptr->based_name);
  1063. X            } else
  1064. X
  1065. X            if (decl_list->type->token_type == POINTER) {
  1066. X                    /* Yes - if based on an array */
  1067. X                    /* output (*name) else output *name */
  1068. X                out_pointer(var_ptr->name,
  1069. X                    (BOOLEAN) decl_list->array_bound);
  1070. X            } else {
  1071. X                    /* Output variable name */
  1072. X                out_token_name(var_ptr->name);
  1073. X
  1074. X                    /* Output array bound (if any) */
  1075. X                out_bound(decl_list->array_bound);
  1076. X            }
  1077. X        }
  1078. X
  1079. X            /* Get next name */
  1080. X        if ((var_ptr = var_ptr->next_var) != NULL) {
  1081. X            out_char(',');
  1082. X            name_count++;
  1083. X        }
  1084. X    }
  1085. X
  1086. X        /* Check for INITIAL or DATA initializers */
  1087. X    if (decl_list->initialization != NONE) {
  1088. X        out_str(" = ");
  1089. X            /* Point back to initializer string */
  1090. X        tmp_text_ptr = text_ptr;
  1091. X        text_ptr = decl_list->init_ptr;
  1092. X        if (decl_list->array_bound) {
  1093. X            out_char('{');
  1094. X                /* Array - determine if just a single string */
  1095. X            switch (decl_list->type->token_type) {
  1096. X
  1097. X            case BYTE :
  1098. X                string_size = SIZE_BYTE;
  1099. X                break;
  1100. X
  1101. X            case WORD :
  1102. X                string_size = SIZE_WORD;
  1103. X                break;
  1104. X
  1105. X            case DWORD :
  1106. X                string_size = SIZE_DWORD;
  1107. X                break;
  1108. X
  1109. X            case STRUCTURE :
  1110. X/*
  1111. X *  Oh, SH-T!!  fake it!
  1112. X */
  1113. X                string_size = SIZE_BYTE;
  1114. X                break;
  1115. X
  1116. X            default :
  1117. X                string_size = 0;
  1118. X            }
  1119. X
  1120. X            if (string_size && (get_token(&token) == STRING) &&
  1121. X                (get_token(&tmp_token) == RIGHT_PAREN)) {
  1122. X                    /* Single string - break up into */
  1123. X                    /* Pieces of sizeof(<type>) size */
  1124. X                string_ptr = token.token_name;
  1125. X                string_len = token.token_length;
  1126. X                while (string_len) {
  1127. X                    out_str_const(string_ptr, string_size);
  1128. X                    if (string_size > string_len)
  1129. X                        string_size = string_len;
  1130. X                    string_ptr += string_size;
  1131. X                    if (string_len -= string_size)
  1132. X                        out_char(',');
  1133. X                }
  1134. X            } else {
  1135. X                    /* Point back to init string */
  1136. X                text_ptr = decl_list->init_ptr;
  1137. X                do {
  1138. X                    token_class = parse_expression(&token);
  1139. X                    if (token_class == COMMA)
  1140. X                        out_token(&token);
  1141. X                } while (token_class == COMMA);
  1142. X            }
  1143. X
  1144. X            out_char('}');
  1145. X                /* Point past init string */
  1146. X            text_ptr = token.token_start + token.token_length + 2;
  1147. X            token_class = get_token(&token);
  1148. X        } else {
  1149. X            token_class = parse_expression(&token);
  1150. X        }
  1151. X        if (token_class != RIGHT_PAREN)
  1152. X            parse_error("')' expected");
  1153. X        text_ptr = tmp_text_ptr;
  1154. X    }
  1155. X
  1156. X    out_char(';');
  1157. X
  1158. X#ifdef USE_DEFINES
  1159. X        /* Walk through name list and check for BASED variables */
  1160. X    var_ptr = decl_list->name_list;
  1161. X    while (var_ptr) {
  1162. X            /* See if variable is BASED */
  1163. X        if (var_ptr->based_name) {
  1164. X                /* Make sure we're at start of new line */
  1165. X            out_to_start();
  1166. X            out_str("#define");
  1167. X            out_must_token(var_ptr->based_name);
  1168. X            out_white_space(var_ptr->name);
  1169. X            out_str("(*");
  1170. X            out_token_name(var_ptr->name);
  1171. X            out_str(")\n");
  1172. X        }
  1173. X
  1174. X            /* See if variable is AT */
  1175. X        if (is_at) {
  1176. X                /* Make sure we're at start of new line */
  1177. X            out_to_start();
  1178. X            out_str("#define");
  1179. X            out_must_token(var_ptr->name);
  1180. X            out_white_space(var_ptr->name);
  1181. X            out_str("(*");
  1182. X            out_cvt_name(var_ptr->name);
  1183. X            out_str(")\n");
  1184. X        }
  1185. X
  1186. X        var_ptr = var_ptr->next_var;
  1187. X    }
  1188. X#endif
  1189. X}
  1190. X
  1191. Xout_decl(decl)
  1192. XDECL        *decl;
  1193. X{
  1194. X    DECL_MEMBER    *decl_list;
  1195. X
  1196. X    while (decl) {
  1197. X        for (decl_list = decl->decl_list; decl_list;
  1198. X                decl_list = decl_list->next_member)
  1199. X            out_decl_member(decl_list, decl->decl_token);
  1200. X        decl = decl->next_decl;
  1201. X    }
  1202. X}
  1203. SHAR_EOF
  1204. chmod 0660 decl_out.c || echo "restore of decl_out.c fails"
  1205. sed 's/^X//' << 'SHAR_EOF' > declare.c &&
  1206. X#include "misc.h"
  1207. X#include "defs.h"
  1208. X#include "cvt.h"
  1209. X#include "struct.h"
  1210. X#include "tokens.h"
  1211. X
  1212. Xextern    char    *text_ptr;
  1213. Xextern    char    *out_string;
  1214. X
  1215. X/*
  1216. X *    Routines to process DECLARE statements.
  1217. X */
  1218. X
  1219. X/*
  1220. X *    Skip to closing right parenthesis
  1221. X */
  1222. Xfind_right_paren()
  1223. X{
  1224. X    TOKEN    token;
  1225. X    int    token_class;
  1226. X    int    paren_count;
  1227. X
  1228. X    paren_count = 1;
  1229. X    do {
  1230. X        token_class = get_token(&token);
  1231. X        if (token_class == LEFT_PAREN)
  1232. X            paren_count++;
  1233. X        else
  1234. X        if (token_class == RIGHT_PAREN)
  1235. X            paren_count--;
  1236. X    } while (paren_count);
  1237. X}
  1238. X
  1239. X/*
  1240. X *    Copy an element from source to destination
  1241. X */
  1242. Xelement_copy(src, dest)
  1243. XDECL_MEMBER    *src, *dest;
  1244. X{
  1245. X        /* Don't copy name list */
  1246. X    dest->name_list = NULL;
  1247. X        /* Don't copy link */
  1248. X    dest->next_member = NULL;
  1249. X    dest->literal = src->literal;
  1250. X    dest->array_bound = src->array_bound;
  1251. X    dest->type = src->type;
  1252. X    dest->attributes = src->attributes;
  1253. X    dest->initialization = src->initialization;
  1254. X    dest->at_ptr = src->at_ptr;
  1255. X    dest->init_ptr = src->init_ptr;
  1256. X    if (src->struct_list)
  1257. X        element_copy(src->struct_list, dest->struct_list);
  1258. X}
  1259. X
  1260. X/*
  1261. X *    Generate a linked list of variables of the form:
  1262. X *        <id> [BASED <id>[.<id>]] or
  1263. X *        ( <id> [BASED <id>[.<id>]] [ ,<id> [BASED <id>[.<id>]] ] ... )
  1264. X *    Return token following variable list.
  1265. X */
  1266. Xget_var_list(list_ptr, sep_token)
  1267. XDECL_ID    **list_ptr;
  1268. XTOKEN    *sep_token;
  1269. X{
  1270. X    DECL_ID    *var_ptr, *last_var;
  1271. X    TOKEN    *token;
  1272. X    int    token_class;
  1273. X    BOOLEAN    multi_list;
  1274. X    char    *par_white_start, *par_white_end;
  1275. X
  1276. X    *list_ptr = NULL;
  1277. X        /* Get first token */
  1278. X    get_token_ptr(&token);
  1279. X    token_class = get_token(token);
  1280. X
  1281. X        /* Determine if <var> or list of ( <var> [,<var>] ... ) */
  1282. X    if (token_class == LEFT_PAREN) {
  1283. X            /* List of ( <var> [,<var>] ... ) */
  1284. X        multi_list = TRUE;
  1285. X
  1286. X            /* Use white space before '(' for first identifier */
  1287. X        par_white_start = token->white_space_start;
  1288. X        par_white_end = token->white_space_end;
  1289. X
  1290. X            /* Get first identifier */
  1291. X        token_class = get_token(token);
  1292. X        token->white_space_start = par_white_start;
  1293. X        token->white_space_end = par_white_end;
  1294. X    } else
  1295. X            /* <var> */
  1296. X        multi_list = FALSE;
  1297. X
  1298. X        /* Process identifier list */
  1299. X    last_var = NULL;
  1300. X    while (1) {
  1301. X        if (token_class != IDENTIFIER) {
  1302. X            parse_error("Identifier expected");
  1303. X            free_var_list(*list_ptr);
  1304. X            free((char *) token);
  1305. X            *list_ptr = NULL;
  1306. X            return ERROR;
  1307. X        }
  1308. X
  1309. X            /* Get a variable structure */
  1310. X        get_var_ptr(&var_ptr);
  1311. X
  1312. X        if (*list_ptr == NULL)
  1313. X                /* Point to first variable */
  1314. X            *list_ptr = var_ptr;
  1315. X
  1316. X        if (last_var)
  1317. X            last_var->next_var = var_ptr;
  1318. X        last_var = var_ptr;
  1319. X
  1320. X            /* Save variable name */
  1321. X        var_ptr->name = token;
  1322. X
  1323. X            /* Check for BASED */
  1324. X        token_class = get_token(sep_token);
  1325. X
  1326. X        if ((token_class == RESERVED) &&
  1327. X            (sep_token->token_type == BASED)) {
  1328. X                /* BASED <id>[ .<id> ] */
  1329. X                /* Get based name */
  1330. X            get_token_ptr(&token);
  1331. X            token_class = get_token(token);
  1332. X            if (token_class != IDENTIFIER) {
  1333. X                parse_error("Identifier expected");
  1334. X                free_var_list(*list_ptr);
  1335. X                free((char *) token);
  1336. X                *list_ptr = NULL;
  1337. X                return ERROR;
  1338. X            }
  1339. X            token_class = parse_simple_variable(token, sep_token);
  1340. X
  1341. X#ifdef USE_DEFINES
  1342. X                /* Swap variable name with based name */
  1343. X            var_ptr->based_name = var_ptr->name;
  1344. X            var_ptr->name = token;
  1345. X#else
  1346. X            var_ptr->based_name = token;
  1347. X#endif
  1348. X        }
  1349. X
  1350. X        if (!multi_list)
  1351. X            return token_class;
  1352. X
  1353. X        if (token_class != COMMA)
  1354. X            break;
  1355. X
  1356. X            /* Get next variable */
  1357. X        get_token_ptr(&token);
  1358. X        token_class = get_token(token);
  1359. X    }
  1360. X
  1361. X    if (token_class == RIGHT_PAREN) {
  1362. X            /* Get next token */
  1363. X        token_class = get_token(sep_token);
  1364. X        return token_class;
  1365. X    } else {
  1366. X        parse_error("')' expected");
  1367. X        free_var_list(*list_ptr);
  1368. X        *list_ptr = NULL;
  1369. X        return ERROR;
  1370. X    }
  1371. X}
  1372. X
  1373. X/*
  1374. X *    Parse a structure declaration of the form:
  1375. X *    STRUCTURE ( <member> [ ,<member> ] ... )
  1376. X *        where:
  1377. X *    <member> ::= { <id> | ( <id> [ ,<id> ] ... ) } [ ( <numeric> ) ] <type>
  1378. X */
  1379. Xparse_structure(list_ptr)
  1380. XDECL_MEMBER    **list_ptr;
  1381. X{
  1382. X    DECL_MEMBER    *struct_ptr, *last_struct;
  1383. X    TOKEN        token;
  1384. X    int        token_class;
  1385. X
  1386. X    *list_ptr = NULL;
  1387. X
  1388. X        /* Get left paren */
  1389. X    token_class = get_token(&token);
  1390. X    if (token_class != LEFT_PAREN) {
  1391. X        parse_error("'(' expected");
  1392. X        return;
  1393. X    }
  1394. X
  1395. X    last_struct = NULL;
  1396. X    do {
  1397. X            /* Get a DECL_MEMBER structure */
  1398. X        get_element_ptr(&struct_ptr);
  1399. X
  1400. X        if (*list_ptr == NULL)
  1401. X                /* Point to first structure */
  1402. X            *list_ptr = struct_ptr;
  1403. X
  1404. X        if (last_struct)
  1405. X            last_struct->next_member = struct_ptr;
  1406. X        last_struct = struct_ptr;
  1407. X
  1408. X            /* Get variable list */
  1409. X        token_class = get_var_list(&struct_ptr->name_list, &token);
  1410. X
  1411. X            /* Get type and optional array designator */
  1412. X        get_token_ptr(&struct_ptr->type);
  1413. X        token_class = parse_type(struct_ptr, &token);
  1414. X
  1415. X            /* Get seperator */
  1416. X        token_class = get_token(&token);
  1417. X    } while (token_class == COMMA);
  1418. X
  1419. X    if (token_class != RIGHT_PAREN) {
  1420. X        parse_error("'(' expected");
  1421. X        free_decl_list(*list_ptr);
  1422. X        *list_ptr = NULL;
  1423. X        return;
  1424. X    }
  1425. X}
  1426. X
  1427. X/*
  1428. X *    Parse type and optional array designator.
  1429. X *    Passed initial token.
  1430. X *    Returns RESERVED if appropriate type found, else returns END_OF_LINE.
  1431. X */
  1432. Xparse_type(el_ptr, token)
  1433. XDECL_MEMBER    *el_ptr;
  1434. XTOKEN        *token;
  1435. X{
  1436. X    TOKEN    *temp_token;
  1437. X    int    token_class;
  1438. X
  1439. X    token_class = token->token_class;
  1440. X    if (token_class == LEFT_PAREN) {
  1441. X            /* Array specifier */
  1442. X            /* Get numeric or '*' */
  1443. X        get_token_ptr(&temp_token);
  1444. X        token_class = get_token(temp_token);
  1445. X
  1446. X        if ((token_class == NUMERIC) ||
  1447. X            ((token_class == OPERATOR) &&
  1448. X                (temp_token->token_type == TIMES))) {
  1449. X            if (token_class != NUMERIC)
  1450. X                /* array(*) specified - ignore '*' */
  1451. X                temp_token->token_name[0] = '\0';
  1452. X
  1453. X                /* Save array bound token */
  1454. X            el_ptr->array_bound = temp_token;
  1455. X        } else {
  1456. X            parse_error("Illegal array bound");
  1457. X            free((char *) temp_token);
  1458. X            return ERROR;
  1459. X        }
  1460. X
  1461. X            /* Get right paren */
  1462. X        token_class = get_token(token);
  1463. X        if (token_class != RIGHT_PAREN) {
  1464. X            parse_error("')' expected");
  1465. X            free((char *) temp_token);
  1466. X            return ERROR;
  1467. X        }
  1468. X
  1469. X            /* Get type */
  1470. X        token_class = get_token(token);
  1471. X    }
  1472. X
  1473. X    if ((token_class == RESERVED) && (token->token_type >= BYTE) &&
  1474. X                     (token->token_type <= STRUCTURE)) {
  1475. X
  1476. X            /* Save type token */
  1477. X        token_copy(token, el_ptr->type);
  1478. X
  1479. X        if (token->token_type == STRUCTURE) {
  1480. X                /* Get structure list */
  1481. X            parse_structure(&el_ptr->struct_list);
  1482. X        }
  1483. X        return token_class;
  1484. X    } else {
  1485. X        parse_error("Illegal type");
  1486. X        return ERROR;
  1487. X    }
  1488. X}
  1489. X
  1490. X/*
  1491. X *    Parse a DECLARE element.
  1492. X *    Return token terminating DECLARE element.
  1493. X */
  1494. Xget_element(element, token)
  1495. XDECL_MEMBER    **element;
  1496. XTOKEN        *token;
  1497. X{
  1498. X    DECL_MEMBER    *el_ptr;
  1499. X    TOKEN        temp_token, eof_token;
  1500. X    int        token_class;
  1501. X    char        *tmp_text_ptr;
  1502. X    char        *tmp_out_string;
  1503. X
  1504. X    char        *get_mem();
  1505. X
  1506. X    get_element_ptr(element);
  1507. X
  1508. X        /* Point to element */
  1509. X    el_ptr = *element;
  1510. X
  1511. X        /* Get name list */
  1512. X    token_class = get_var_list(&el_ptr->name_list, token);
  1513. X
  1514. X        /* Malloc space for type */
  1515. X    get_token_ptr(&el_ptr->type);
  1516. X
  1517. X    if (token_class == RESERVED)
  1518. X        switch (token->token_type) {
  1519. X
  1520. X        case LABEL :
  1521. X            /* LABEL declaration */
  1522. X        token_copy(token, el_ptr->type);
  1523. X
  1524. X            /* Check for PUBLIC or EXTERNAL */
  1525. X        token_class = get_token(token);
  1526. X        if ((token_class == RESERVED) &&
  1527. X            ((token->token_type == PUBLIC) ||
  1528. X             (token->token_type == EXTERNAL)))
  1529. X                /* Indeed, who cares? */
  1530. X            token_class = get_token(token);
  1531. X        return token_class;
  1532. X
  1533. X        case LITERALLY :
  1534. X        token_copy(token, el_ptr->type);
  1535. X
  1536. X            /* Check for 'string' */
  1537. X        if (get_token(token) != STRING) {
  1538. X            parse_error("String expected");
  1539. X            free_decl_list(el_ptr);
  1540. X            return ERROR;
  1541. X        }
  1542. X
  1543. X        el_ptr->literal = get_mem(MAX_LITERAL_SIZE);
  1544. X#ifdef PARSE_LITERALS
  1545. X            /* Parse literal string if only one token in string */
  1546. X        tmp_text_ptr = text_ptr;
  1547. X        text_ptr = token->token_name;
  1548. X
  1549. X            /* Parse token in string */
  1550. X        if (get_token(&temp_token) == END_OF_FILE)
  1551. X            el_ptr->literal[0] = '\0';
  1552. X        else
  1553. X        if (get_token(&eof_token) == END_OF_FILE) {
  1554. X                /* Single token literal */
  1555. X            (void) strcpy(el_ptr->literal, temp_token.token_name);
  1556. X                /* Save parsed token */
  1557. X            get_token_ptr(&el_ptr->literal_token);
  1558. X            token_copy(&temp_token, el_ptr->literal_token);
  1559. X        } else
  1560. X            (void) strcpy(el_ptr->literal, token->token_name);
  1561. X
  1562. X        text_ptr = tmp_text_ptr;
  1563. X#else
  1564. X            /* Put string in literal */
  1565. X        (void) strcpy(el_ptr->literal, token->token_name);
  1566. X#endif
  1567. X
  1568. X            /* Return following token */
  1569. X        token_class = get_token(token);
  1570. X        return token_class;
  1571. X    }
  1572. X
  1573. X    if (parse_type(el_ptr, token) != RESERVED) {
  1574. X            /* Error occurred */
  1575. X        free_decl_list(el_ptr);
  1576. X        return END_OF_LINE;
  1577. X    }
  1578. X
  1579. X        /* Process attribute information (if any) */
  1580. X        /* Check for EXTERNAL [ DATA ] */
  1581. X    token_class = get_token(token);
  1582. X    if (token_class != RESERVED)
  1583. X        return token_class;
  1584. X
  1585. X    if (token->token_type == EXTERNAL) {
  1586. X        el_ptr->attributes = EXTERNAL;
  1587. X
  1588. X            /* Check for DATA attribute */
  1589. X        token_class = get_token(token);
  1590. X        if (token_class == RESERVED) {
  1591. X            if (token->token_type == DATA) {
  1592. X/*
  1593. X *    Ignore attribute
  1594. X *                el_ptr->initialization = DATA;
  1595. X */
  1596. X                token_class = get_token(token);
  1597. X            } else {
  1598. X                parse_error("Illegal attribute");
  1599. X                free_decl_list(el_ptr);
  1600. X                return ERROR;
  1601. X            }
  1602. X        }
  1603. X
  1604. X        return token_class;
  1605. X    } else
  1606. X
  1607. X        /* Check for PUBLIC */
  1608. X    if (token->token_type == PUBLIC) {
  1609. X        el_ptr->attributes = PUBLIC;
  1610. X        token_class = get_token(token);
  1611. X    }
  1612. X
  1613. X    if (token_class != RESERVED)
  1614. X        return token_class;
  1615. X
  1616. X        /* Check for AT ( <expr> ) */
  1617. X    if (token->token_type == AT) {
  1618. X            /* Check for '(' */
  1619. X        token_class = get_token(token);
  1620. X
  1621. X        if (token_class != LEFT_PAREN) {
  1622. X                parse_error("'(' expected");
  1623. X                free_decl_list(el_ptr);
  1624. X                return ERROR;
  1625. X        }
  1626. X
  1627. X            /* Generate a string for the AT expression */
  1628. X        el_ptr->at_ptr = get_mem(MAX_AT_EXPR_SIZE);
  1629. X        el_ptr->at_ptr[0] = '\0';
  1630. X        tmp_out_string = out_string;
  1631. X        out_string = el_ptr->at_ptr;
  1632. X
  1633. X            /* Parse the expression into at_ptr */
  1634. X        token_class = parse_expression(token);
  1635. X        if (token_class != RIGHT_PAREN) {
  1636. X            parse_error("')' expected");
  1637. X            free_decl_list(el_ptr);
  1638. X            return ERROR;
  1639. X        }
  1640. X        out_string = tmp_out_string;
  1641. X        token_class = get_token(token);
  1642. X    }
  1643. X
  1644. X    if (token_class != RESERVED)
  1645. X        return token_class;
  1646. X
  1647. X        /* Check for INITIAL or DATA ( <expr> ) */
  1648. X    if ((token->token_type == INITIAL) ||
  1649. X        (token->token_type == DATA)) {
  1650. X
  1651. X        el_ptr->initialization = token->token_type;
  1652. X
  1653. X            /* Check for '(' */
  1654. X        token_class = get_token(token);
  1655. X
  1656. X        if (token_class != LEFT_PAREN) {
  1657. X                parse_error("'(' expected");
  1658. X                free_decl_list(el_ptr);
  1659. X                return ERROR;
  1660. X        }
  1661. X
  1662. X        el_ptr->init_ptr = text_ptr;
  1663. X            /* Skip to ')' */
  1664. X        find_right_paren();
  1665. X        token_class = get_token(token);
  1666. X    }
  1667. X    return token_class;
  1668. X}
  1669. X
  1670. X/*
  1671. X *    Parse a DECLARE list.
  1672. X *    Passed a pointer to a DECL, returns with DECL filled.
  1673. X */
  1674. Xget_decl_list(decl)
  1675. XDECL    *decl;
  1676. X{
  1677. X    DECL_MEMBER    *el_ptr, *decl_ptr;
  1678. X    TOKEN        token;
  1679. X    int        token_class;
  1680. X
  1681. X    decl->decl_list = NULL;
  1682. X    decl->next_decl = NULL;
  1683. X    decl_ptr = NULL;
  1684. X
  1685. X    do {
  1686. X            /* Get a declaration element */
  1687. X        token_class = get_element(&el_ptr, &token);
  1688. X
  1689. X        if (decl->decl_list == NULL)
  1690. X            decl->decl_list = el_ptr;
  1691. X
  1692. X            /* Link previous element */
  1693. X        if (decl_ptr)
  1694. X            decl_ptr->next_member = el_ptr;
  1695. X        decl_ptr = el_ptr;
  1696. X    } while (token_class == COMMA);
  1697. X}
  1698. X
  1699. X/*
  1700. X *    Parse a DECLARE statement.
  1701. X */
  1702. Xparse_declare(first_token)
  1703. XTOKEN    *first_token;
  1704. X{
  1705. X    DECL        decl;
  1706. X
  1707. X    decl.decl_token = first_token;
  1708. X    get_decl_list(&decl);
  1709. X    out_decl(&decl);
  1710. X    add_to_context(decl.decl_list);
  1711. X}
  1712. SHAR_EOF
  1713. chmod 0660 declare.c || echo "restore of declare.c fails"
  1714. sed 's/^X//' << 'SHAR_EOF' > defs.h &&
  1715. X/*
  1716. X *    Maximum number of characters in a token
  1717. X */
  1718. X#define    MAX_TOKEN_LENGTH 512
  1719. X
  1720. X/*
  1721. X *    Maximum number of characters in an individual DO CASE statement
  1722. X */
  1723. X#define MAX_CASE_STATEMENT_SIZE 10240
  1724. X
  1725. X/*
  1726. X *    Maximum number of characters in an AT expression
  1727. X */
  1728. X#define MAX_AT_EXPR_SIZE 128
  1729. X
  1730. X/*
  1731. X *    Maximum number of characters in a literal string
  1732. X */
  1733. X#define MAX_LITERAL_SIZE 512
  1734. X
  1735. X/*
  1736. X *    Maximum number of identifier names in at_decl.cvt
  1737. X */
  1738. X#define MAX_AT_DECLS 64
  1739. SHAR_EOF
  1740. chmod 0660 defs.h || echo "restore of defs.h fails"
  1741. sed 's/^X//' << 'SHAR_EOF' > error.c &&
  1742. X#include <stdio.h>
  1743. X#include <string.h>
  1744. X#include "misc.h"
  1745. X#include "defs.h"
  1746. X#include "cvt.h"
  1747. X#include "struct.h"
  1748. X#include "tokens.h"
  1749. X#include "tkn_ext.h"
  1750. X
  1751. Xextern    BOOLEAN    syntax_error;
  1752. X
  1753. Xextern    char    *text_ptr;
  1754. Xextern    int    line_count;
  1755. Xextern    char    *line_ptr;
  1756. Xextern    char    current_file_name[];
  1757. X
  1758. X/*
  1759. X *    parse_mesg() -    Print given message, message type, and current
  1760. X *            line number.  Skip to error_eol.
  1761. X */
  1762. Xparse_mesg(error_string, error_type, error_eol)
  1763. Xchar    *error_string, *error_type;
  1764. Xchar    error_eol;
  1765. X{
  1766. X    char    *err_ptr;
  1767. X    int    i, offset;
  1768. X    TOKEN    token;
  1769. X
  1770. X    syntax_error = TRUE;
  1771. X
  1772. X    offset = text_ptr - line_ptr - 1;
  1773. X
  1774. X        /* Find end of line */
  1775. X    for (err_ptr = line_ptr; (*err_ptr != '\0') &&
  1776. X                 (*err_ptr != LF); err_ptr++) ;
  1777. X
  1778. X    if (*error_string) {
  1779. X        (void) fprintf(stderr, "\n%s - Parse %s: %s.\nOccurred at line %d near:\n",
  1780. X            current_file_name, error_type, error_string, line_count);
  1781. X
  1782. X            /* Print offending line */
  1783. X        (void) fwrite(line_ptr, err_ptr - line_ptr + 1, 1, stderr);
  1784. X
  1785. X        for (i = 0; i < offset; i++)
  1786. X            if (line_ptr[i] < ' ')
  1787. X                (void) fputc(line_ptr[i], stderr);
  1788. X            else
  1789. X                (void) fputc(' ', stderr);
  1790. X        (void) fputc('^', stderr);
  1791. X
  1792. X        if (*err_ptr == '\0')
  1793. X            (void) fputc(LF, stderr);
  1794. X    }
  1795. X
  1796. X    if (*err_ptr != '\0')
  1797. X        err_ptr++;
  1798. X
  1799. X        /* Skip to end-of-line */
  1800. X    if (error_eol == '\0')
  1801. X        return;
  1802. X    else
  1803. X
  1804. X    if (error_eol == LF) {
  1805. X        text_ptr = err_ptr;
  1806. X        line_ptr = err_ptr;
  1807. X        line_count++;
  1808. X    } else {
  1809. X
  1810. X        if (*(text_ptr - 1) != ';') {
  1811. X            do {
  1812. X                i = get_token(&token);
  1813. X            } while ((i != END_OF_FILE) && (i != END_OF_LINE));
  1814. X        }
  1815. X
  1816. X            /* Point at end of line */
  1817. X        text_ptr--;
  1818. X    }
  1819. X}
  1820. X
  1821. X/*
  1822. X *    parse_error() -    Print given error message and current line number.
  1823. X *            Called when an unrecognised or unprocessable token
  1824. X *            appears.
  1825. X */
  1826. Xparse_error(error_string)
  1827. Xchar    *error_string;
  1828. X{
  1829. X    if (syntax_error)
  1830. X            /* Already had an error on this line */
  1831. X        return;
  1832. X
  1833. X    parse_mesg(error_string, "error", END_OF_LINE);
  1834. X}
  1835. X
  1836. X/*
  1837. X *    Do a parse_error(), but move to END_OF_LINE, not ';'
  1838. X */
  1839. Xcontrol_error(error_string)
  1840. Xchar    *error_string;
  1841. X{
  1842. X#ifdef IGNORE_CONTROL_ERRORS
  1843. X    parse_mesg("", "", LF);
  1844. X#else
  1845. X    parse_mesg(error_string, "error", LF);
  1846. X#endif
  1847. X}
  1848. X
  1849. X/*
  1850. X *    parse_warning - Generate a warning message
  1851. X */
  1852. Xparse_warning(warning_string)
  1853. Xchar    *warning_string;
  1854. X{
  1855. X    parse_mesg(warning_string, "warning", '\0');
  1856. X}
  1857. X
  1858. SHAR_EOF
  1859. chmod 0660 error.c || echo "restore of error.c fails"
  1860. sed 's/^X//' << 'SHAR_EOF' > io.c &&
  1861. X#include <stdio.h>
  1862. X#ifdef IBMPC
  1863. X#include <stdlib.h>
  1864. X#endif
  1865. X#include "misc.h"
  1866. X#include "defs.h"
  1867. X#include "cvt.h"
  1868. X#include "struct.h"
  1869. X#include "tokens.h"
  1870. X
  1871. Xchar    *out_string;
  1872. Xchar    last_out_ch;
  1873. X
  1874. Xchar    *str_shifts[] = { "0", "8", "16", "24" };
  1875. X
  1876. Xextern    char    *text_buffer, *text_ptr;
  1877. Xextern    int    line_count;
  1878. Xextern    int    file_depth;
  1879. Xextern    FILE    *ofd;
  1880. X
  1881. Xextern    BOOLEAN    parsing_literal;
  1882. Xextern    TOKEN    literal_token;
  1883. X
  1884. X/*
  1885. X *    Output data of specified length.
  1886. X *    If out_string is not NULL, append string to out_string.
  1887. X *    Otherwise write string to stdout.
  1888. X */
  1889. Xout_data(string, length)
  1890. Xchar    *string;
  1891. Xint    length;
  1892. X{
  1893. X    if (length) {
  1894. X        if (out_string)
  1895. X            (void) strncat(out_string, string, length);
  1896. X        else
  1897. X        if (file_depth == 1)
  1898. X#ifdef DEBUG
  1899. X            (void) fwrite(string, length, 1, stdout);
  1900. X#else
  1901. X            (void) fwrite(string, length, 1, ofd);
  1902. X#endif
  1903. X        else
  1904. X            return;
  1905. X
  1906. X            /* Save last character output */
  1907. X        last_out_ch = *(string + length - 1);
  1908. X    }
  1909. X}
  1910. X
  1911. X/*
  1912. X *    Print white space
  1913. X */
  1914. Xout_white_space(token)
  1915. XTOKEN    *token;
  1916. X{
  1917. X    int    length;
  1918. X
  1919. X        /* Compute length of white space */
  1920. X    length = token->white_space_end - token->white_space_start;
  1921. X
  1922. X    if (length)
  1923. X        out_data(token->white_space_start, length);
  1924. X}
  1925. X
  1926. X/*
  1927. X *    Print white space, if any.  If start of white space string is not
  1928. X *    white, prefix with a space.
  1929. X */
  1930. Xout_must_white(token)
  1931. XTOKEN    *token;
  1932. X{
  1933. X    if (!is_white(*(token->white_space_start)))
  1934. X        out_char(' ');
  1935. X    out_white_space(token);
  1936. SHAR_EOF
  1937. echo "End of part 1, continue with part 2"
  1938. echo "2" > s2_seq_.tmp
  1939. exit 0
  1940.