home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / funnel / parser.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  47.4 KB  |  1,290 lines
  1. /*##############################################################################
  2.  
  3. FUNNNELWEB COPYRIGHT
  4. ====================
  5. FunnelWeb is a literate-programming macro preprocessor.
  6.  
  7. Copyright (C) 1992 Ross N. Williams.
  8.  
  9.    Ross N. Williams
  10.    ross@spam.adelaide.edu.au
  11.    16 Lerwick Avenue, Hazelwood Park 5066, Australia.
  12.  
  13. This program is free software; you can redistribute it and/or modify
  14. it under the terms of Version 2 of the GNU General Public License as
  15. published by the Free Software Foundation.
  16.  
  17. This program is distributed WITHOUT ANY WARRANTY; without even the implied
  18. warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  19. See Version 2 of the GNU General Public License for more details.
  20.  
  21. You should have received a copy of Version 2 of the GNU General Public
  22. License along with this program. If not, you can FTP the license from
  23. prep.ai.mit.edu/pub/gnu/COPYING-2 or write to the Free Software
  24. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. Section 2a of the license requires that all changes to this file be
  27. recorded prominently in this file. Please record all changes here.
  28.  
  29. Programmers:
  30.    RNW  Ross N. Williams  ross@spam.adelaide.edu.au
  31.  
  32. Changes:
  33.    07-May-1992  RNW  Program prepared for release under GNU GPL V2.
  34.  
  35. ##############################################################################*/
  36.  
  37.  
  38. /******************************************************************************/
  39. /*                                    PARSER.C                                */
  40. /******************************************************************************/
  41.  
  42. #include <setjmp.h>
  43. #include "style.h"
  44.  
  45. #include "as.h"
  46. #include "data.h"
  47. #include "lister.h"
  48. #include "machin.h"
  49. #include "mapper.h"
  50. #include "memory.h"
  51. #include "misc.h"
  52. #include "parser.h"
  53. #include "section.h"
  54. #include "table.h"
  55.  
  56. /******************************************************************************/
  57.  
  58. #define DUMMYINT 0                 /* It doesn't matter what this value is!!! */
  59. #define TKPS &(p_tk->tk_ps)        /* A commonly used construct.              */
  60.  
  61. /******************************************************************************/
  62.  
  63. /* The following variables look after sections. */
  64. LOCVAR sn_t     last_sn;   /* Hierarchical section number of last section.    */
  65. LOCVAR ps_t     pssection; /* Position of last section.                       */
  66. LOCVAR p_dc_t   p_secdc;   /* Pointer to current section document component.  */
  67. LOCVAR tk_t    *p_tk;      /* Pointer to the current token (a structure).     */
  68. LOCVAR ulong    sequence;  /* Current sequence number.                        */
  69. LOCVAR jmp_buf  jmp_pos;   /* Setjmp() position of main parsing loop.         */
  70.  
  71. /******************************************************************************/
  72. /*                             Comparison Functions                           */
  73. /******************************************************************************/
  74.  
  75. LOCAL sign cm_name P_((name_t *,name_t *));
  76. LOCAL sign cm_name(name1,name2)
  77. /* Compares two names and returns:               */
  78. /*    -1 if name1 < name2                        */
  79. /*     0 if name1 = name2                        */
  80. /*     1 if name1 > name2                        */
  81. /* Provides a full ordering on the set of names. */
  82. name_t *name1;
  83. name_t *name2;
  84. {
  85.  return signof(strcmp(&(*name1)[0],&(*name2)[0]));
  86. }
  87.  
  88. /******************************************************************************/
  89.  
  90. LOCAL sign eq_txst P_((p_scls_t,char *));
  91. LOCAL sign eq_txst(p_scls,p_str)
  92. /* The first argument is a list of text scraps.             */
  93. /* The second argument is an ordinary string.               */
  94. /* Returns TRUE iff the two are identical. Otherwise FALSE. */
  95. p_scls_t  p_scls;
  96. char     *p_str;
  97. {
  98.  /* To compare the scrap list with the string, we run through the scrap list */
  99.  /* comparing the bytes its scraps yield progressively with the string.      */
  100.  /* The two scanning groups are (p_scls,p_sc,p_ch) and p_str.                */
  101.  sc_t *p_sc;
  102.  
  103.  ls_fir(p_scls);
  104.  ls_nxt(p_scls,PPV &p_sc);
  105.  while (p_sc!=NULL)
  106.    {
  107.     /* The loop body compares a single scrap pointed to by p_sc. */
  108.     char *p_ch;
  109.     for (p_ch=p_sc->sc_first; p_ch<=p_sc->sc_last; p_ch++)
  110.       {
  111.        if (*p_str==EOS || *p_str != *p_ch) return FALSE;
  112.        p_str++;
  113.       }
  114.     ls_nxt(p_scls,PPV &p_sc);
  115.    }
  116.  return *p_str==EOS;
  117. }
  118.  
  119. /******************************************************************************/
  120. /*                               Parsing Primitives                           */
  121. /******************************************************************************/
  122. /* The following functions provide the basic parsing primitives used by the   */
  123. /* main parsing routines.                                                     */
  124. /******************************************************************************/
  125.  
  126. LOCAL void next_tk P_((bool));
  127. LOCAL void next_tk(iseoferr)
  128. /* This function reads the next token from the token list and places a        */
  129. /* pointer to the token (structure) in the global variable "token".           */
  130. /* The "iseoferr" determines whether a fuss should be made if the next token  */
  131. /* fetched is TK_EOF. If iseoferr==TRUE and the next token is TK_EOF, next_tk */
  132. /* jumps to the main parsing loop.                                            */
  133. bool iseoferr;
  134. {
  135.  ls_nxt(token_list,PPV &p_tk);
  136.  as_cold(p_tk!=NULL,"next_tk: Attempted to read next token at EOF.");
  137.  if (iseoferr && p_tk->tk_kind==TK_EOF)
  138.    {
  139.     lr_err(TKPS,"Ouch! High velocity encounter with end of file.");
  140.     lr_mes(TKPS,"FunnelWeb expected something else when it hit the EOF.");
  141.     longjmp(jmp_pos,DUMMYINT);    /* Jump up to the main parsing loop. */
  142.    }
  143. }
  144.  
  145. /******************************************************************************/
  146.  
  147. LOCAL void recover P_((void));
  148. LOCAL void recover()
  149. /* Parsing functions call this function at points where a syntax error has    */
  150. /* has occurred that it is unlikely that the particular parsing function will */
  151. /* be able to recover from on its own. In these situations, the parser        */
  152. /* resorts to a course grained syntactic error-recovery implemented by this   */
  153. /* function. The goal of the error recovery system is to skip tokens until    */
  154. /* the next major outer-level-syntax structure is encountered. These are:     */
  155. /*    - A new section (@A etc.).                                              */
  156. /*    - A macro definition (@$ or @O).                                        */
  157. /*    - End of file.                                                          */
  158. /* Once one of these three is found, "recover" raises the syntax exception    */
  159. /* which sends control to the main parsing loop which is the correct place    */
  160. /* to deal with a new, major syntactic construct.                             */
  161. {
  162.  lr_mes(TKPS,"Skipping after error to the next major construct...");
  163.  
  164.  /* Skip to one of TK_NSEC,... */
  165.  while (TRUE)
  166.    {
  167.     tk_k_t k = p_tk->tk_kind;
  168.     if (k==TK_NSEC || k==TK_MDEF || k==TK_FDEF || k==TK_EOF) break;
  169.     next_tk(FALSE);
  170.    }
  171.  
  172.  /* Keep the user informed. */
  173.  lr_mes(TKPS,"...skipped to here after the error.");
  174.  
  175.  /* Jump up to the main parsing loop. */
  176.  longjmp(jmp_pos,DUMMYINT);
  177. }
  178.  
  179. /******************************************************************************/
  180.  
  181. LOCAL void genexerr P_((tk_k_t));
  182. LOCAL void genexerr(tk_kind)
  183. /* Genexerr stands for GENerate EXpecting ERRor.                              */
  184. /* Given a token kind, genexerr issues an error saying that the specified     */
  185. /* kind of token was expected. It then invokes recover() for error recovery.  */
  186. tk_k_t tk_kind;
  187. {
  188.  switch (tk_kind)
  189.    {
  190.     /* Note: Not all token kinds are listed here. Only those token kinds that */
  191.     /* are passed to pr_token and check_tk by the main parsing routines are   */
  192.     /* included here. There are some tokens that one never expects!           */
  193.     case TK_NSEC: lr_err(TKPS,"Expecting '@*'."); break;
  194.     case TK_ONAM: lr_err(TKPS,"Expecting '@<'."); break;
  195.     case TK_ODEF: lr_err(TKPS,"Expecting '@{'."); break;
  196.     case TK_CDEF: lr_err(TKPS,"Expecting '@}'."); break;
  197.     case TK_EMPH: lr_err(TKPS,"Expecting '@/'."); break;
  198.     case TK_CPAR: lr_err(TKPS,"Expecting '@)'."); break;
  199.     case TK_QUOT: lr_err(TKPS,"Expecting '@\"'."); break;
  200.     case TK_PARM: lr_err(TKPS,"Expecting one of [@1..@9]." ); break;
  201.     case TK_TEXT: lr_err(TKPS,"Expecting a text character."); break;
  202.     default: as_bomb("genexerr: Case defaulted.");
  203.    }
  204.  recover();
  205. }
  206.  
  207. /******************************************************************************/
  208.  
  209. LOCAL void pr_token P_((tk_k_t));
  210. LOCAL void pr_token(tk_kind)
  211. /* Parses a single token of the specified kind.                               */
  212. /* If the token is of the specified kind, gets the next token.                */
  213. /* If the token is not of the specified kind, generates an "expecting" error. */
  214. tk_k_t tk_kind;
  215. {
  216.  if (p_tk->tk_kind != tk_kind)
  217.     genexerr(tk_kind);
  218.  next_tk(TRUE);
  219. }
  220.  
  221. /******************************************************************************/
  222.  
  223. LOCAL void check_tk P_((tk_k_t));
  224. LOCAL void check_tk(tk_kind)
  225. /* Same as pr_token, but only checks that the token is OK. Does not move on.  */
  226. tk_k_t tk_kind;
  227. {
  228.  if (p_tk->tk_kind != tk_kind)
  229.     genexerr(tk_kind);
  230. }
  231.  
  232. /******************************************************************************/
  233.  
  234. LOCAL void ass_tk P_((tk_k_t));
  235. LOCAL void ass_tk(tk_kind)
  236. /* Aborts the program if the current token is not of the specified kind.      */
  237. /* This function is intended to perform internal consistency checks, and      */
  238. /* should not be considered to be part of the parsing operation.              */
  239. tk_k_t tk_kind;
  240. {
  241.  as_cold(p_tk->tk_kind==tk_kind,"Parser.ass_tk: Incorrect token.");
  242. }
  243.  
  244. /******************************************************************************/
  245.  
  246. LOCAL void ass_tks P_((tk_k_t,tk_k_t));
  247. LOCAL void ass_tks(tk_kind1,tk_kind2)
  248. /* Same as ass_tk except it allows a choice of two token kinds. */
  249. tk_k_t tk_kind1;
  250. tk_k_t tk_kind2;
  251. {
  252.  as_cold((p_tk->tk_kind == tk_kind1) || (p_tk->tk_kind == tk_kind2),
  253.          "Parser.ass_tks: Token is neither of two allowables.");
  254. }
  255.  
  256. /******************************************************************************/
  257. /*                            Main Parsing Functions                          */
  258. /******************************************************************************/
  259.  
  260. /* The parse expression procedure is the only procedure for which a forward   */
  261. /* declaration is required. This is a product of the recursive definition of  */
  262. /* a FunnelWeb expression.                                                    */
  263. LOCAL void pr_exp P_((p_ells_t *,p_ma_t));
  264.  
  265. /******************************************************************************/
  266.  
  267. LOCAL void pr_text P_((p_scls_t *,bool *));
  268. LOCAL void pr_text(pp_scls,p_white)
  269. /* This function parses a sequence of zero or more text tokens (until it runs */
  270. /* into a non-text token) and constructs a list of scraps containing the text */
  271. /* pointed to by the tokens. In addition the function writes TRUE to its      */
  272. /* second argument iff all of the text scraps are whitespace.                 */
  273. p_scls_t *pp_scls;
  274. bool     *p_white;
  275. {
  276.  *pp_scls=ls_cre(sizeof(sc_t));
  277.  *p_white=TRUE;
  278.  
  279.  while (p_tk->tk_kind==TK_TEXT)
  280.    {
  281.     *p_white = *p_white && p_tk->tk_sc.sc_white;
  282.     ls_add(*pp_scls,PV &p_tk->tk_sc);
  283.     next_tk(FALSE);
  284.    }
  285. }
  286.  
  287. /******************************************************************************/
  288.  
  289. LOCAL void pr_white P_((p_scls_t *));
  290. LOCAL void pr_white(pp_scls)
  291. /* Same as pr_text, but generates an error if the text is non-white. */
  292. p_scls_t *pp_scls;
  293. {
  294.  bool iswhite;
  295.  ps_t ps;
  296.  ASSIGN(ps,p_tk->tk_ps);
  297.  pr_text(pp_scls,&iswhite);
  298.  if (!iswhite)
  299.     lr_err(&ps,"Expecting whitespace text.");
  300. }
  301.  
  302. /******************************************************************************/
  303.  
  304. LOCAL void pr_name P_((char *));
  305. LOCAL void pr_name(p_name)
  306. /* Parses a single FunnelWeb name (e.g. "@<Sloth@>" and "@#K"). */
  307. char *p_name;   /* Really should be of type p_name_t but this caused trouble. */
  308. {
  309.  uword namelen = 0;
  310.  
  311.  /* Deal with the special case of a token name. */
  312.  if (p_tk->tk_kind==TK_NAME)
  313.    {
  314.     p_name[0]=p_tk->tk_gen;
  315.     p_name[1]=EOS;
  316.     next_tk(TRUE);
  317.     return;
  318.    }
  319.  
  320.  ass_tk(TK_ONAM);
  321.  next_tk(TRUE);
  322.  
  323.  while (TRUE)
  324.     switch (p_tk->tk_kind)
  325.       {
  326.        case TK_TEXT:
  327.          {
  328.           /* Copy the text token to the name array, checking all the time. */
  329.           char  *p;
  330.           for (p=p_tk->tk_sc.sc_first; p<=p_tk->tk_sc.sc_last; p++)
  331.             {
  332.              if (*p==EOL)
  333.                {
  334.                 lr_err(TKPS,"Names cannot cross lines.");
  335.                 recover();
  336.                }
  337.              namelen++;
  338.              if (namelen>NAME_MAX)
  339.                {
  340.                 lr_err(TKPS,"Name is too long.");
  341.                 sprintf(linet1,
  342.                    "The maximum length of a legal name is %lu characters.",
  343.                    (unsigned long) NAME_MAX);
  344.                 lr_mes(TKPS,linet1);
  345.                 recover();
  346.                }
  347.              p_name[namelen-1] = *p;
  348.             }
  349.           next_tk(TRUE);
  350.           break;
  351.          }
  352.        case TK_CNAM:
  353.           /* We finish successfully if we hit a close name token "@>". */
  354.           p_name[namelen]=EOS;
  355.           next_tk(TRUE);
  356.           return;
  357.        default:
  358.           lr_err(TKPS,"Illegal character or symbol in name.");
  359.           recover();
  360.       } /* End switch */
  361. }
  362.  
  363. /******************************************************************************/
  364.  
  365. LOCAL void pr_dctxt P_((void));
  366. LOCAL void pr_dctxt()
  367. /* Parse a major text chunk. */
  368. {
  369.  dc_t  dc;
  370.  bool  dummybool;
  371.  ps_t  pstext;
  372.  
  373.  ass_tk(TK_TEXT);
  374.  
  375.  ASSIGN(pstext,p_tk->tk_ps);
  376.  pr_text(&dc.dc_text,&dummybool);
  377.  ASSIGN(dc.dc_ps,pstext);
  378.  dc.dc_kind=DC_TEXT;
  379.  ls_add(document_list,PV &dc);
  380. }
  381.  
  382. /******************************************************************************/
  383.  
  384. LOCAL void sendtype P_((ty_k_t));
  385. LOCAL void sendtype(ty_kind)
  386. /* Send a document component of kind typesetter directive with no attributes. */
  387. ty_k_t ty_kind;
  388. {
  389.  dc_t dc;
  390.  ASSIGN(dc.dc_ps,p_tk->tk_ps);
  391.  dc.dc_kind = DC_TYPE;
  392.  dc.dc_ty.ty_kind=ty_kind;
  393.  ls_add(document_list,PV &dc);
  394. }
  395.  
  396. /******************************************************************************/
  397.  
  398. LOCAL void pr_lit P_((void));
  399. LOCAL void pr_lit()
  400. /* Parse a string delimited by literal typeset directives e.g. @{sloth@}.     */
  401. {
  402.  /* Check and get past opening directive. */
  403.  ass_tk(TK_ODEF);
  404.  sendtype(TY_OLIT);
  405.  
  406.  /* Move past the opening directive and parse the sandwich text. */
  407.  next_tk(TRUE);
  408.  if (p_tk->tk_kind!=TK_TEXT)
  409.    {
  410.     lr_err(TKPS,"Text expected after open literal token \"@{\".");
  411.     if (p_tk->tk_kind==TK_CDEF)
  412.        lr_mes(TKPS,"Sorry, empty literal strings are not allowed.");
  413.     recover();
  414.    }
  415.  pr_dctxt();
  416.  
  417.  /* Check and parse the closing directive. */
  418.  pr_token(TK_CDEF);
  419.  sendtype(TY_CLIT);
  420. }
  421.  
  422. /******************************************************************************/
  423.  
  424. LOCAL void pr_emp P_((void));
  425. LOCAL void pr_emp()
  426. /* Parse a string delimited by emphasis typeset directives e.g. @/sloth@/.    */
  427. {
  428.  /* Check and get past opening directive. */
  429.  ass_tk(TK_EMPH);
  430.  sendtype(TY_OEMP);
  431.  
  432.  /* Move past the opening directive and parse the sandwich text. */
  433.  next_tk(TRUE);
  434.  if (p_tk->tk_kind!=TK_TEXT)
  435.    {
  436.     lr_err(TKPS,"Text expected after open emphasise token \"@/\".");
  437.     if (p_tk->tk_kind==TK_EMPH)
  438.        lr_mes(TKPS,"Sorry, empty emphasised strings are not allowed.");
  439.     recover();
  440.    }
  441.  pr_dctxt();
  442.  
  443.  /* Check and parse the closing directive. */
  444.  pr_token(TK_EMPH);
  445.  sendtype(TY_CEMP);
  446. }
  447.  
  448. /******************************************************************************/
  449.  
  450. LOCAL void pr_npag P_((void));
  451. LOCAL void pr_npag()
  452. /* Parse a newpage token. */
  453. {
  454.  ass_tk(TK_NPAG);
  455.  sendtype(TY_NPAG);
  456.  pr_token(TK_NPAG);
  457. }
  458.  
  459. /******************************************************************************/
  460.  
  461. LOCAL void pr_tocs P_((void));
  462. LOCAL void pr_tocs()
  463. /* Parse a table of contents token. */
  464. {
  465.  ass_tk(TK_TOCS);
  466.  sendtype(TY_TOCS);
  467.  pr_token(TK_TOCS);
  468. }
  469.  
  470. /******************************************************************************/
  471.  
  472. LOCAL void pr_skip P_((void));
  473. LOCAL void pr_skip()
  474. /* Parse a skip token. */
  475. {
  476.  dc_t dc;
  477.  ass_tk(TK_SKIP);
  478.  ASSIGN(dc.dc_ps,p_tk->tk_ps);
  479.  dc.dc_kind = DC_TYPE;
  480.  dc.dc_ty.ty_kind=TY_SKIP;
  481.  dc.dc_ty.ty_mm=p_tk->tk_gen;
  482.  ls_add(document_list,PV &dc);
  483.  pr_token(TK_SKIP);
  484. }
  485.  
  486. /******************************************************************************/
  487.  
  488. LOCAL void pr_titl P_((void));
  489. LOCAL void pr_titl()
  490. /* Parse a title token. Bascially moving bones from one grave to another.     */
  491. {
  492.  dc_t dc;
  493.  ass_tk(TK_TITL);
  494.  ASSIGN(dc.dc_ps,p_tk->tk_ps);
  495.  dc.dc_kind        = DC_TYPE;
  496.  dc.dc_ty.ty_kind  = TY_TITL;
  497.  dc.dc_ty.ty_font  = p_tk->tk_gen / LRFT_PACK;
  498.  dc.dc_ty.ty_align = p_tk->tk_gen % LRFT_PACK;
  499.  ASSIGN(dc.dc_ty.ty_sc,p_tk->tk_sc);
  500.  ls_add(document_list,PV &dc);
  501.  pr_token(TK_TITL);
  502. }
  503.  
  504. /******************************************************************************/
  505.  
  506. LOCAL void pr_sec P_((void));
  507. LOCAL void pr_sec()
  508. /* Parse a new section marker ("@A.. and @*") and its optional name.          */
  509. {
  510.  ps_t   secps;     /* Position of this new section.                           */
  511.  ubyte  level;     /* Level number of new section.                            */
  512.  bool   has_name;  /* Set to TRUE iff the section has a name.                 */
  513.  name_t name;      /* Name of the section (if it has a name).                 */
  514.  
  515.  /* If called, a new section marker must have been seen. */
  516.  ass_tk(TK_NSEC);
  517.  
  518.  /* Grab a copy of the position of the start of the section. */
  519.  ASSIGN(secps,p_tk->tk_ps);
  520.  
  521.  /* Grab the level number of the section marker. Move to the next token. */
  522.  level=p_tk->tk_gen;
  523.  next_tk(TRUE);
  524.  
  525.  /* Check for a discontinuity in level. */
  526.  if (level>sn_lev(&last_sn)+1)
  527.    {
  528.     if (sn_lev(&last_sn)==0)
  529.        lr_err(&secps,"The first section in a document must be an @A section.");
  530.     else
  531.       {
  532.        sprintf(linet1,"The next section (at line %lu) is too deep.",
  533.                    (unsigned long) secps.ps_line);
  534.        lr_mes(&pssection,linet1);
  535.        lr_err(&secps,"This section is more than one level deeper than the last");
  536.        sprintf(linet1,"section (at line %lu). Example: @B followed by @D is not allowed.",
  537.                    (unsigned long) pssection.ps_line);
  538.        lr_mes(&secps,linet1);
  539.       }
  540.     /* At this point we know that the section structure of the document is    */
  541.     /* faulty and that the weaver will never be invoked. As such the          */
  542.     /* principal concern becomes that of error recovery. The best we can do   */
  543.     /* there is to set to the specified level regardless of how silly it is.  */
  544.     /* This ensures that we generate section errors only relative to the      */
  545.     /* previous section. Thus, we avoid cascades of errors, if, for example   */
  546.     /* the user mistypes an @A at the beginning of a FunnelWeb document.      */
  547.     /* Once an error has occurred we don't care about the actual numbers.     */
  548.     sn_set(&last_sn,level);
  549.    }
  550.  
  551.  /* Actually increment the section number at the specified level. */
  552.  sn_inc(&last_sn,level);
  553.  
  554.  /* Record the position. */
  555.  ASSIGN(pssection,secps);
  556.  
  557.  /* Parse optional name (e.g. "@<Sloth@>"). */
  558.  if (p_tk->tk_kind==TK_ONAM || p_tk->tk_kind==TK_NAME)
  559.    {
  560.     pr_name(name);
  561.     has_name=TRUE;
  562.    }
  563.  else
  564.    {
  565.     strcpy(name,"No name given");
  566.     has_name=FALSE;
  567.    }
  568.  
  569.  /* Place all the information we have into a document component structure     */
  570.  /* and add it to the document list.                                          */
  571.  {
  572.   dc_t dc;
  573.   ASSIGN(dc.dc_ps,secps);
  574.   dc.dc_kind = DC_TYPE;
  575.   dc.dc_ty.ty_kind=TY_NSEC;
  576.   ASSIGN(dc.dc_ty.ty_sn,last_sn);
  577.   dc.dc_ty.ty_isnam = has_name;
  578.   strcpy(&dc.dc_ty.ty_name[0],&name[0]);
  579.   ls_add(document_list,PV &dc);
  580.   ls_tai(document_list,PPV &p_secdc);
  581.  }
  582. }
  583.  
  584. /******************************************************************************/
  585.  
  586. LOCAL void rem_name P_((char *));
  587. LOCAL void rem_name(p_name)
  588. /* rem_name stands for REMember NAME. rem_name accepts a pointer to a name.   */
  589. /* It looks up the name in the global macro table, and if the name is in the  */
  590. /* table performs no action. If the name isn't in the table, it creates a new */
  591. /* entry for the name, filling the entry's fields with "blank" values.        */
  592. /* The rem_name function should not be seen as recording the definition of a  */
  593. /* macro. This is handled by the md_isdef field. Instead the rem_name macro   */
  594. /* should be viewed as just creating the space in the table for the info.     */
  595. char * p_name;  /* Really should be of type p_name_t but this caused trouble. */
  596. {
  597.  if (!tb_itb(macro_table,PV p_name))
  598.    {
  599.     p_ma_t p_macro=(p_ma_t) mm_temp(sizeof(ma_t));
  600.     strcpy(&p_macro->ma_name[0],&p_name[0]);
  601.     p_macro->ma_calls         = ls_cre(sizeof(mc_t));
  602.     p_macro->ma_defn.md_isdef = FALSE;
  603.     p_macro->ma_actn          = ls_cre(sizeof(p_elll_t));
  604.     tb_ins(macro_table,PV p_name,PV &p_macro);
  605.    }
  606. }
  607.  
  608. /******************************************************************************/
  609.  
  610. LOCAL void chk_whex P_((p_ps_t,p_ells_t,p_scls_t *));
  611. LOCAL void chk_whex(p_ps,p_ex,pp_white)
  612. /* This function should really be a subfunction of pr_plist. However, C       */
  613. /* doesn't allow nested functions so we have to put it here. This function is */
  614. /* called after pr_plist has just parsed an opening expression followed by    */
  615. /* @". This means that the expression should consist of whitespace crud. Our  */
  616. /* mission here is to check that it really does contain only whitespace crud  */
  617. /* and return a text list containing the crud. If, on the other hand, it      */
  618. /* contains meatier items, we have to call recover().                         */
  619. p_ps_t   p_ps;       /* Position of the start of the expression.              */
  620. p_ells_t p_ex;       /* The expression that we have to check out.             */
  621. p_scls_t *pp_white;  /* The place to put the resultant whitespace list.       */
  622. {
  623.  p_el_t p_el;
  624.  
  625.  /* If the expression is empty, we can return an empty list. */
  626.  if (ls_len(p_ex)==0)
  627.    {
  628.     *pp_white=ls_cre(sizeof(sc_t));
  629.     return;
  630.    }
  631.  
  632.  /* If there is more than one element, there is ...trouble. */
  633.  if (ls_len(p_ex) > 1) goto trouble;
  634.  
  635.  /* Extract the first element of the list. */
  636.  ls_fir(p_ex); ls_nxt(p_ex,PPV &p_el);
  637.  
  638.  /* If it's not text, there is ...trouble. */
  639.  if (p_el->el_kind != EL_TEXT) goto trouble;
  640.  
  641.  /* If the text isn't lilly white, there is ...trouble. */
  642.  {
  643.   p_scls_t p_scls = p_el->el_text;
  644.   p_sc_t   p_sc;
  645.   ls_fir(p_scls);
  646.   while (TRUE)
  647.     {
  648.      ls_nxt(p_scls,PPV &p_sc);
  649.      if (p_sc==NULL) break;
  650.      if (!p_sc->sc_white) goto trouble;
  651.     }
  652.   /* If we got this far, we know that the expression contains a single */
  653.   /* element and that that element is a text list and that that text   */
  654.   /* list consists entirely of whitespace. We can now return it.       */
  655.   *pp_white=p_scls;
  656.   return;
  657.  }
  658.  
  659.  /* We COULD start dissecting the expression and issuing detailed specific    */
  660.  /* error messages. However, the general approach is cleaner and so a general */
  661.  /* error message is used.                                                    */
  662.  trouble:
  663.  lr_err(       p_ps,"Everything from here...");
  664.  lr_mes(TKPS,"...to here should be whitespace.");
  665.  lr_mes(TKPS,"Use of @\" to delimit macro parameters is optional, but");
  666.  lr_mes(TKPS,"if they are used, any surrounding text must be white.");
  667.  recover();
  668. }
  669.  
  670. /******************************************************************************/
  671.  
  672. LOCAL void pr_plist P_((p_elll_t *, p_scll_t *, p_scll_t *,p_ma_t));
  673. LOCAL void pr_plist(pp_plist,p_before,p_after,p_curmac)
  674. /* This function parses an optional parameter list. If the current token is   */
  675. /* not TK_OPAR, then it is assumed that no list is present and no tokens are  */
  676. /* consumed and empty lists are returned.                                     */
  677. /* The three lists returned are:                                              */
  678. /*    A list of parameters each being a pointer to a list of elements.        */
  679. /*    A list of whitespace blocks being the space before each parameter.      */
  680. /*    A list of whitespace blocks being the space after  each parameter.      */
  681. /* The last parameter p_curmac should be supplied by the caller and should    */
  682. /* contain a pointer to the macro currently being parsed.                     */
  683. p_elll_t *pp_plist;
  684. p_scll_t *p_before;
  685. p_scll_t *p_after;
  686. p_ma_t   p_curmac;
  687. {
  688.  /* Initialize all the result lists to empty. */
  689.  *pp_plist = ls_cre(sizeof(p_ells_t));
  690.  *p_before = ls_cre(sizeof(p_scls_t));
  691.  *p_after  = ls_cre(sizeof(p_scls_t));
  692.  
  693.  /* The parameter list is optional. If it isn't there we assume a null one.   */
  694.  if (p_tk->tk_kind!=TK_OPAR)
  695.     return;
  696.  next_tk(TRUE);
  697.  
  698.  /* Now parse the parameter list, one parameter during each iteration. */
  699.  while (TRUE)
  700.    {
  701.     ps_t     exp_ps;
  702.     p_ells_t p_ex;
  703.     p_scls_t p_white;
  704.  
  705.     /* Things get a little tricky here because the double quotes around       */
  706.     /* parameters are optional (per parameter). Thus the following calls are  */
  707.     /* all legal (and functionally identical):                                */
  708.     /*    @<Sloth@>@( @"walrus@" @, @"aardvark@" @)                           */
  709.     /*    @<Sloth@>@(walrus@,       @"aardvark@" @)                           */
  710.     /*    @<Sloth@>@(walrus@,aardvark@)                                       */
  711.  
  712.     /* Note the position of the start of this parameter slot. */
  713.     ASSIGN(exp_ps,p_tk->tk_ps);
  714.  
  715.     /* Because we face either crud text or an expression, we parse an exp.    */
  716.     pr_exp(&p_ex,p_curmac);
  717.  
  718.     /* Now take a look at the next token. If it is @" we know that we have    */
  719.     /* been parsing whitespace crud. If it is @, or @) we know that we have   */
  720.     /* been parsing the parameter expression itself.                          */
  721.     if (p_tk->tk_kind==TK_COMA || p_tk->tk_kind==TK_CPAR)
  722.       {
  723.        p_scls_t p_scls = ls_cre(sizeof(sc_t));
  724.        ls_add(*p_before,PV &p_scls);  /* Add empty whitespace to crud list.   */
  725.        ls_add(*pp_plist,PV &p_ex);    /* Add expression to parameter list.    */
  726.        ls_add(*p_after ,PV &p_scls);  /* Add empty whitespace to crud list.   */
  727.       }
  728.     else
  729.        if (p_tk->tk_kind==TK_QUOT)
  730.          {
  731.           /* After parsing the expression we hit a @". This means that the    */
  732.           /* expression just parsed SHOULD turn out to contain a single       */
  733.           /* element consisting of a white space text list.                   */
  734.           chk_whex(&exp_ps,p_ex,&p_white);
  735.           ls_add(*p_before,PV &p_white);
  736.  
  737.           /* Get past the quote. */
  738.           next_tk(TRUE);
  739.  
  740.           /* Parse the expression and add it to the parameter list. */
  741.           pr_exp(&p_ex,p_curmac); ls_add(*pp_plist,PV &p_ex);
  742.  
  743.           /* Parse the quote to move onto the whitespace. */
  744.           pr_token(TK_QUOT);
  745.  
  746.           /* Parse the whitespace after the parameter. */
  747.           {p_scls_t p_white; pr_white(&p_white); ls_add(*p_after,PV &p_white);}
  748.          }
  749.        else
  750.           {lr_err(TKPS,"Expecting @\" or @, or @)."); recover();}
  751.  
  752.     /* The parameter list can now end (TK_CPAR) or continue (TK_COMA). */
  753.     if (p_tk->tk_kind==TK_COMA)
  754.        next_tk(TRUE);
  755.     else
  756.        if (p_tk->tk_kind==TK_CPAR)
  757.           {next_tk(TRUE);return;}
  758.        else
  759.           {lr_err(TKPS,"Expecting @, or @)."); recover();}
  760.    } /* End while */
  761. }
  762.  
  763. /******************************************************************************/
  764.  
  765. LOCAL void pr_invelt P_((p_el_t,p_ma_t));
  766. LOCAL void pr_invelt(p_el,p_curmac)
  767. /* Parses an "invocation element" which is just FunnelWebSpeak for "macro     */
  768. /* call". Upon entry the current token must be TK_ONAM or TK_NAME which       */
  769. /* presumably is the start of a macro call. Returns a pointer to an element   */
  770. /* object describing the call. Does some other macro table stuff too.         */
  771. /* p_curmac should be supplied by the caller and should be a pointer to the   */
  772. /* macro currently being parsed.                                              */
  773. p_el_t p_el;
  774. p_ma_t p_curmac;
  775. {
  776.  name_t   name;      /* Name of the macro being invoked.                      */
  777.  ps_t     mc_ps;     /* Position of the start of the macro invocation.        */
  778.  mc_t     mc;        /* Macro call object that describes the invocation.      */
  779.  p_ma_t   p_callee;  /* Pointer to the macro object of the target macro.      */
  780.  p_elll_t parlist;   /* The parameter list of the invocation.                 */
  781.  p_scll_t before;    /* Whitespace before each parameter in the param list.   */
  782.  p_scll_t after;     /* Whitespace after  each parameter in the param list.   */
  783.  
  784.  /* We shouldn't have been called unless we have seen the start of a name. */
  785.  ass_tks(TK_ONAM,TK_NAME);
  786.  
  787.  /* Note the position of the start of the invocation. */
  788.  mc_ps=p_tk->tk_ps;
  789.  
  790.  /* Parse the invocation (name and optional parameter list). */
  791.  pr_name(name); pr_plist(&parlist,&before,&after,p_curmac);
  792.  
  793.  /* Ensure that there is an entry for this macro name in the macro table. */
  794.  rem_name(name);
  795.  
  796.  /* Construct a macro call object describing the call and add it to the */
  797.  /* callee macro's call list.                                           */
  798.  /* Note: The +1 in sequence+1 is because the sequence number is incremented  */
  799.  /* at the end of each macro definition and we are only halfway here.         */
  800.  mc.mc_seq  = sequence+1;
  801.  mc.mc_ps   = mc_ps;
  802.  mc.mc_npar = ls_len(parlist);
  803.  tb_loo(macro_table,PV name,PV &p_callee);
  804.  ls_add(p_callee->ma_calls,PV &mc);
  805.  
  806.  /* Write an invocation element describing the call to the parameter. */
  807.  p_el->el_kind  = EL_INVC;
  808.  p_el->el_p_mac = p_callee;
  809.  p_el->el_parls = parlist;
  810.  p_el->el_pretx = before;
  811.  p_el->el_postx = after;
  812. }
  813.  
  814. /******************************************************************************/
  815.  
  816. LOCAL void pr_txtelt P_((p_el_t));
  817. LOCAL void pr_txtelt(p_el)
  818. /* Parses a text element. Upon entry, the current token must be of type       */
  819. /* TK_TEXT. Writes a text element into its parameter.                         */
  820. p_el_t p_el;
  821. {
  822.  p_scls_t p_scls;
  823.  bool     dummy;
  824.  ass_tk(TK_TEXT);
  825.  pr_text(&p_scls,&dummy);
  826.  p_el->el_kind = EL_TEXT;
  827.  p_el->el_text = p_scls;
  828. }
  829.  
  830. /******************************************************************************/
  831.  
  832. LOCAL void pr_parelt P_((p_el_t,p_ma_t));
  833. LOCAL void pr_parelt(p_el,p_curmac)
  834. /* Parses a parameter element (e.g. @5). Writes the resultant parameter       */
  835. /* element object to the first parameter. The second parameter should be      */
  836. /* supplied by the caller and should be a pointer to the macro being parsed.  */
  837. p_el_t p_el;
  838. p_ma_t p_curmac;
  839. {
  840.  /* We have to be sitting on a parameter token. */
  841.  ass_tk(TK_PARM);
  842.  
  843.  /* Complain if the parameter does not exist. */
  844.  if (p_tk->tk_gen > p_curmac->ma_defn.md_npar)
  845.    {
  846.     sprintf(linet1,"Macro being defined has only %lu parameter%s.",
  847.             (unsigned long) p_curmac->ma_defn.md_npar,
  848.             p_curmac->ma_defn.md_npar==1 ? "" : "s");
  849.     lr_err(TKPS,linet1);
  850.    }
  851.  
  852.  /* Write a parameter element to the function parameter. */
  853.  p_el->el_kind  = EL_PARM;
  854.  p_el->el_parno = p_tk->tk_gen;
  855.  p_el->el_which = p_curmac;
  856.  
  857.  /* Move on to the token following the parameter token. */
  858.  next_tk(TRUE);
  859. }
  860.  
  861. /******************************************************************************/
  862.  
  863. LOCAL void pr_exp(p_ex,p_curmac)
  864. /* Parses an expression and writes an expression list to the first parameter. */
  865. /* The second parameter should be supplied by the user and should be a        */
  866. /* pointer to the macro currently being parsed.                               */
  867. p_ells_t *p_ex;
  868. p_ma_t   p_curmac;
  869. {
  870.  p_ells_t ex = ls_cre(sizeof(el_t));
  871.  
  872.  while (TRUE)
  873.    {
  874.     el_t el;
  875.     switch (p_tk->tk_kind)
  876.       {
  877.        case TK_TEXT: pr_txtelt(&el);          break;
  878.        case TK_NAME:
  879.        case TK_ONAM: pr_invelt(&el,p_curmac); break;
  880.        case TK_PARM: pr_parelt(&el,p_curmac); break;
  881.        default     : *p_ex=ex;                return;
  882.       }
  883.     ls_add(ex,PV &el);
  884.    }
  885. }
  886.  
  887. /******************************************************************************/
  888.  
  889. LOCAL void pr_formal P_((uword *,p_ps_t));
  890. LOCAL void pr_formal(p_numpar,p_ps)
  891. /* A FunnelWeb formal parameter list looks something like this: "@(@5@)".     */
  892. /* This function parses a parameter list if present and returns the number of */
  893. /* parameters in the formal parameter list. The function also returns the     */
  894. /* position the parameter list.                                               */
  895. uword  *p_numpar;
  896. p_ps_t  p_ps;
  897. {
  898.  /* If the parameter list is absent, we default to having zero parameters and */
  899.  /* making the position of the parameter list the position of the next token. */
  900.  *p_numpar = 0;
  901.  *p_ps     = p_tk->tk_ps;
  902.  
  903.  /* Parse the parameter list only if one is present. */
  904.  if (p_tk->tk_kind==TK_OPAR)
  905.    {
  906.     /* Move to the parameter token and get its number and position. */
  907.     next_tk(TRUE);
  908.     check_tk(TK_PARM);
  909.     *p_numpar=p_tk->tk_gen;
  910.     *p_ps=p_tk->tk_ps;
  911.  
  912.     /* Parse the end of the formal parameter list. */
  913.     next_tk(TRUE);
  914.     pr_token(TK_CPAR);
  915.    }
  916. }
  917.  
  918. /******************************************************************************/
  919.  
  920. LOCAL void pr_number P_((bool *,bool *));
  921. LOCAL void pr_number(p_iszer,p_isman)
  922. /* Parses optional @Z@M after parameter list. */
  923. bool *p_iszer;
  924. bool *p_isman;
  925. {
  926.  *p_iszer=FALSE;
  927.  *p_isman=FALSE;
  928.  
  929.  /* The following parse allows zero, one or both of @Z@M, but in order. */
  930.  
  931.  /* Grab an @Z if it is there. */
  932.  if (p_tk->tk_kind==TK_ZERO)
  933.    {
  934.     next_tk(TRUE);
  935.     *p_iszer=TRUE;
  936.    }
  937.  
  938.  /* Grab an @M too if it is there. */
  939.  if (p_tk->tk_kind==TK_MANY)
  940.    {
  941.     next_tk(TRUE);
  942.     *p_isman=TRUE;
  943.    }
  944. }
  945.  
  946. /******************************************************************************/
  947.  
  948. LOCAL void pr_equals P_((bool *,p_ps_t));
  949. LOCAL void pr_equals(isadd,p_ps)
  950. /* Parses optional "==" or "+=". Sets *isadd==TRUE iff "+=" parsed else FALSE.*/
  951. /* Sets *p_ps to the position of the equals.                                  */
  952. bool   *isadd;
  953. p_ps_t p_ps;
  954. {
  955.  p_scls_t p_scls;
  956.  bool     dummy;
  957.  
  958.  /* Grab a copy of the position of the equals (even if it is not there)    . */
  959.  ASSIGN(*p_ps,p_tk->tk_ps);
  960.  
  961.  /* If the equals isn't there, we default to FALSE. */
  962.  *isadd=FALSE;
  963.  if (p_tk->tk_kind!=TK_TEXT) return;
  964.  
  965.  /* Parse text tokens producing a text list. */
  966.  pr_text(&p_scls,&dummy);
  967.  
  968.  /* Compare the text list with the assignment constant strings. */
  969.  if (eq_txst(p_scls,"==")) {*isadd=FALSE; ls_des(p_scls); return;}
  970.  if (eq_txst(p_scls,"+=")) {*isadd=TRUE;  ls_des(p_scls); return;}
  971.  
  972.  lr_err(p_ps,"Expecting \"==@{\" or \"+=@{\" or just \"@{\".");
  973.  lr_mes(p_ps,"(or @Z or @M if they have not already appeared).");
  974.  lr_mes(p_ps,"Note: FunnelWeb is intolerant of spaces at this point.");
  975.  ls_des(p_scls);
  976.  recover();
  977. }
  978.  
  979. /******************************************************************************/
  980.  
  981. LOCAL bool checkdef P_((p_ma_t,bool,ulong,bool,bool,bool,
  982.                         p_ps_t,p_ps_t,p_ps_t,p_ps_t));
  983. LOCAL bool checkdef (p_ma,is_file,numpar,iszer,isman,isadd,
  984.                         p_psnam,p_psfor,p_pseql,p_psnum)
  985. /* This function performs all sorts of checks on a macro definition.          */
  986. /* If there is anything wrong, it generates and error and calls recover().    */
  987. /* This would be best as a local function but because C doesn't have local    */
  988. /* functions we have to use millions of parameters instead.                   */
  989. p_ma_t p_ma;
  990. bool   is_file;
  991. ulong  numpar;
  992. bool   iszer;
  993. bool   isman;
  994. bool   isadd;
  995. p_ps_t p_psnam;
  996. p_ps_t p_psfor;
  997. p_ps_t p_pseql;
  998. p_ps_t p_psnum;
  999. {
  1000.  bool semerr = FALSE;
  1001.  
  1002.  /* CHECK INTERNAL INCONSISTENCIES */
  1003.  /* ------------------------------ */
  1004.  /* Complain if a file macro has a parameter list. */
  1005.  if (is_file && numpar>0)
  1006.    {
  1007.     lr_err(p_psfor,"Macros attached to output files cannot be parameterized.");
  1008.     lr_mes(p_psfor,"Reason: No actual parameters would be available during");
  1009.     lr_mes(p_psfor,"        output file generation.");
  1010.     semerr=TRUE;
  1011.    }
  1012.  
  1013.  /* Complain if a file macro is declared additive. */
  1014.  if (is_file && isadd)
  1015.    {
  1016.     lr_err(p_pseql,"Macros attached to output files cannot be additive.");
  1017.     lr_mes(p_pseql,"Reason: Preventing this makes it easy to find output");
  1018.     lr_mes(p_pseql,"file macros later, because there will be exactly one");
  1019.     lr_mes(p_pseql,"@O declaration in the input file for each output file.");
  1020.     lr_mes(p_pseql,"To do what you are trying to do, just create an additive");
  1021.     lr_mes(p_pseql,"bridging macro, like this:");
  1022.     lr_mes(p_pseql,"   @O@<prog.c@>@{@<Bridge@>@}");
  1023.     lr_mes(p_pseql,"   @$@<Bridge@>+=@{void stringhack()...@}");
  1024.     lr_mes(p_pseql,"   @$@<Bridge@>+=@{main()...@}");
  1025.     semerr=TRUE;
  1026.    }
  1027.  
  1028.  /* Complain if a file macro has a name that is too long. */
  1029.  if (is_file && strlen(&p_ma->ma_name[0])>FILENAME_MAX)
  1030.    {
  1031.     lr_err(p_psnam,
  1032.     "File macro's name is longer than the maximum permissible filename length.");
  1033.     sprintf(linet1,"Maximum filename length is %lu characters.",
  1034.                    (unsigned long) FILENAME_MAX);
  1035.     lr_mes(p_psnam,linet1);
  1036.     semerr=TRUE;
  1037.    }
  1038.  
  1039.  /* Complain if a file macro has "zero" or "many" attributes. */
  1040.  if (is_file && (iszer || isman))
  1041.    {
  1042.     lr_err(p_psnum,"Macros attached to output files cannot have @Z or @M.");
  1043.     lr_mes(p_psnum,"Reason: They are always called once to generate their");
  1044.     lr_mes(p_psnum,"output file and they cannot be called from other macros.");
  1045.     lr_mes(p_psnum,"Hence they are always called exactly once and so there");
  1046.     lr_mes(p_psnum,"can be no need for @Z or @M in their declarations.");
  1047.     semerr=TRUE;
  1048.    }
  1049.  
  1050.  /* COMPARE WITH EARLIER DEFINITIONS */
  1051.  /* -------------------------------- */
  1052.  /* Don't do this section if no previous definition exists. */
  1053.  if (!p_ma->ma_defn.md_isdef) goto finish;
  1054.  
  1055.  /* Assert: An earlier definition of this macro exists. */
  1056.  
  1057.  /* Old definition is a full definition, not admitting partial ones now. */
  1058.  if (!p_ma->ma_defn.md_isadd)
  1059.    {
  1060.     if (isadd)
  1061.       {
  1062.        sprintf(linet1,"A full definition of this macro appears at line %lu.",
  1063.                       (ulong) p_ma->ma_defn.md_ps.ps_line);
  1064.        lr_err(p_psnam,linet1);
  1065.        lr_mes(p_psnam,"Full and additive definitions of the same macro cannot coexist.");
  1066.       }
  1067.     else
  1068.       {
  1069.        sprintf(linet1,"This macro is already fully defined (at line %lu).",
  1070.                       (ulong) p_ma->ma_defn.md_ps.ps_line);
  1071.        lr_err(p_psnam,linet1);
  1072.       }
  1073.     semerr=TRUE;
  1074.    }
  1075.  
  1076.  /* Old definition is partial but new definition is full. */
  1077.  if (p_ma->ma_defn.md_isadd && !isadd)
  1078.    {
  1079.     sprintf(linet1,"An additive definition of this macro appears at line %lu.",
  1080.                    (ulong) p_ma->ma_defn.md_ps.ps_line);
  1081.     lr_err(p_psnam,linet1);
  1082.     lr_mes(p_psnam,"Full and additive definitions of the same macro cannot coexist.");
  1083.      semerr=TRUE;
  1084.    }
  1085.  
  1086.  /* Make sure that non-first body parts of additive macros do not have params.*/
  1087.  if (isadd && (numpar>0))
  1088.    {
  1089.     lr_err(p_psfor,"The formal parameter list of an additive macro");
  1090.     lr_mes(p_psfor,"must be placed only in the first definition part.");
  1091.     sprintf(linet1,"The first part of this macro appears at line %lu.",
  1092.                    (ulong) p_ma->ma_defn.md_ps.ps_line);
  1093.     lr_mes(p_psfor,linet1);
  1094.     semerr=TRUE;
  1095.    }
  1096.  
  1097.  /* Complain if number attributes are being attached to an additive. */
  1098.  if (isadd && (iszer || isman))
  1099.    {
  1100.     lr_err(p_psnum,"@Z and @M modifiers for additive macros must");
  1101.     lr_mes(p_psnum,"be placed only in the first definition part.");
  1102.     sprintf(linet1,"The first part of this macro appears at line %lu.",
  1103.                    (ulong) p_ma->ma_defn.md_ps.ps_line);
  1104.     lr_mes(p_psnum,linet1);
  1105.     semerr=TRUE;
  1106.    }
  1107.  
  1108.  finish:
  1109.  if (semerr)
  1110.    {
  1111.     lr_mes(p_psnam,"Macro definition ignored.");
  1112.     recover();
  1113.    }
  1114.  return TRUE;
  1115. }
  1116.  
  1117. /******************************************************************************/
  1118.  
  1119. LOCAL void pr_macro P_((void));
  1120. LOCAL void pr_macro()
  1121. /* This function parses a single macro definition. Upon entry, the current    */
  1122. /* token must be either TK_MDEF or TK_FDEF.                                   */
  1123. {
  1124.  ps_t     ps_mac;   /* Position of start of the macro definition.             */
  1125.  bool     is_file;  /* TRUE iff definition starts with @O instead of @$.      */
  1126.  name_t   name;     /* The macro name appearing in this definition.           */
  1127.  p_ma_t   p_ma;     /* Pointer to the macro record corresponding to 'name'.   */
  1128.  ps_t     ps_name;  /* Position of the macro name.                            */
  1129.  ps_t     ps_form;  /* Position of the formal parameter list.                 */
  1130.  ps_t     ps_equal; /* Position of the equals.                                */
  1131.  ps_t     ps_num;   /* Position of number attributes.                         */
  1132.  uword    numpar;   /* Number of parameters in formal parameter list.         */
  1133.  bool     iszer;    /* TRUE iff macro is allowed to be called zero times.     */
  1134.  bool     isman;    /* TRUE iff macro is allowed to be called more than once. */
  1135.  bool     isadd;    /* TRUE iff equals parsed here is "+=" not "==".          */
  1136.  p_ells_t ex;       /* Expression constituting this macro body part.          */
  1137.  bool     hasname;  /* TRUE iff current section already has a name.           */
  1138.  
  1139.  /* We should not have got in here without seeing a definition token. */
  1140.  ass_tks(TK_MDEF,TK_FDEF);
  1141.  
  1142.  /* Grab a copy of the position of the start of the macro. */
  1143.  ASSIGN(ps_mac,p_tk->tk_ps);
  1144.  
  1145.  /* If we have seen a macro definition token then it means that the user is   */
  1146.  /* TRYING to define a macro. The macro may or may not provoke errors. In     */
  1147.  /* either case though we do not want to hassle the user with errors about    */
  1148.  /* nameless sections not containing macros if it is obvious that an attempt  */
  1149.  /* to define a macro has been made. So here we set the name flag after       */
  1150.  /* having a look at it so we can use its value later.                        */
  1151.  if (sn_lev(&last_sn)>0)
  1152.    {
  1153.     as_cold(p_secdc->dc_kind==DC_TYPE,"pr_macro: section processing error (1).");
  1154.     as_cold(p_secdc->dc_ty.ty_kind==TY_NSEC,"pr_macro: section processing error (2).");
  1155.     hasname=p_secdc->dc_ty.ty_isnam;
  1156.     p_secdc->dc_ty.ty_isnam=TRUE;
  1157.    }
  1158.  
  1159.  /* Record whether the macro is attached to an product file. */
  1160.  is_file= (p_tk->tk_kind==TK_FDEF);
  1161.  
  1162.  /* Parse the macro name. Record its position. Ensure that there is an entry  */
  1163.  /* in the macro table for this macro name (i.e. create one if not there).    */
  1164.  next_tk(TRUE);
  1165.  if (p_tk->tk_kind!=TK_ONAM && p_tk->tk_kind!=TK_NAME)
  1166.    {
  1167.     lr_err(TKPS,"Macro name expected (@<...@> or @#c).");
  1168.     recover();
  1169.    }
  1170.  ps_name=p_tk->tk_ps;
  1171.  pr_name (name);
  1172.  rem_name(name);
  1173.  tb_loo(macro_table,PV name,PV &p_ma);
  1174.  
  1175.  /* Parse the optional formal parameter list and the equals. */
  1176.  /* Extract positioning and other information.               */
  1177.  pr_formal(&numpar,&ps_form );
  1178.  ASSIGN(ps_num,p_tk->tk_ps);
  1179.  pr_number(&iszer, &isman);
  1180.  pr_equals(&isadd ,&ps_equal);
  1181.  
  1182.  /* Perform semantic checks on whether this definition is valid.              */
  1183.  checkdef(p_ma,is_file,numpar,iszer,isman,isadd,
  1184.                &ps_name,&ps_form,&ps_equal,&ps_num);
  1185.  
  1186.  /* If we have got this far, we know that we have parsed a valid macro        */
  1187.  /* definition except possibly for the actual expression body.                */
  1188.  /* If this is the first definition of this macro, establish its definition.  */
  1189.  if (!p_ma->ma_defn.md_isdef)
  1190.    {
  1191.     p_ma->ma_defn.md_isdef = TRUE;
  1192.     ASSIGN(p_ma->ma_defn.md_ps,ps_mac);
  1193.     p_ma->ma_defn.md_npar  = numpar;
  1194.     p_ma->ma_defn.md_isadd = isadd;
  1195.     p_ma->ma_defn.md_iszer = iszer;
  1196.     p_ma->ma_defn.md_isman = isman;
  1197.     p_ma->ma_defn.md_isfil = is_file;
  1198.     p_ma->ma_defn.md_body  = ls_cre(sizeof(bp_t));
  1199.     if (is_file) tb_ins(file_table,PV name,PV &p_ma);
  1200.    }
  1201.  
  1202.  /* Parse the body of this macro definition. */
  1203.  pr_token(TK_ODEF); pr_exp(&ex,p_ma); pr_token(TK_CDEF);
  1204.  
  1205.  /* We are now clear to execute the effects of the macro on our tables.       */
  1206.  /* First we bump up the sequence number.                                     */
  1207.  sequence++;
  1208.  
  1209.  {
  1210.   /* Construct a body part object containing the information in this          */
  1211.   /* definition and append it to the list of body parts in the macro record.  */
  1212.   bp_t bp;
  1213.   bp.bp_ex  = ex;
  1214.   bp.bp_seq = sequence;
  1215.   bp.bp_ps  = ps_name;
  1216.   ls_add(p_ma->ma_defn.md_body,PV &bp);
  1217.  }
  1218.  
  1219.  {
  1220.   /* Construct a document component object for this definition and append it  */
  1221.   /* to the global document component list.                                   */
  1222.   dc_t dc;
  1223.   ASSIGN(dc.dc_ps,ps_mac);
  1224.   dc.dc_kind = DC_MACR;
  1225.   dc.dc_p_ma = p_ma;
  1226.   dc.dc_part = ls_len(p_ma->ma_defn.md_body);
  1227.   ls_add(document_list,PV &dc);
  1228.  }
  1229.  
  1230.  /* Sections without names inherit the name of their first macro. */
  1231.  if (sn_lev(&last_sn)>0 && !hasname)
  1232.     strcpy(&p_secdc->dc_ty.ty_name[0],name);
  1233. }
  1234.  
  1235. /******************************************************************************/
  1236.  
  1237. EXPORT void parser()
  1238. /* This is the main parser function. This function contains parser            */
  1239. /* initialization as well as the main parsing loop to which control is        */
  1240. /* returned (by recover()) when an error occurs.                              */
  1241. {
  1242.  /* Create the lists and tables generated by the parser. */
  1243.  macro_table  = tb_cre (sizeof(name_t),sizeof(p_ma_t),(p_kycm_t) cm_name);
  1244.  file_table   = tb_cre (sizeof(name_t),sizeof(p_ma_t),(p_kycm_t) cm_name);
  1245.  document_list= ls_cre (sizeof(dc_t));
  1246.  
  1247.  /* Initialize the section number counter. */
  1248.  sequence = 0;
  1249.  sn_ini(&last_sn);
  1250.  p_secdc  = NULL;
  1251.  
  1252.  /* Prime the scanning of the token list. */
  1253.  ls_fir(token_list);
  1254.  next_tk(FALSE);
  1255.  
  1256.  /* This is where we longjmp back to after hitting a nasty syntax error.  */
  1257.  /* We don't actually have to test dummyint, as our control state is no   */
  1258.  /* different after a syntax error has occurred. Example: We try to parse */
  1259.  /* a macro but there is a syntax error. So we skip to the start of the   */
  1260.  /* next macro and then longjmp back to here ready to parse the next      */
  1261.  /* macro. Thus, there is no need to a fork test.                         */
  1262.  (void) setjmp(jmp_pos);
  1263.  
  1264.  /* This is the main parser loop which parses major syntactic chunks. */
  1265.  while (p_tk->tk_kind != TK_EOF)
  1266.     switch (p_tk->tk_kind)
  1267.       {
  1268.        case TK_NSEC: pr_sec  (); break;
  1269.        case TK_TEXT: pr_dctxt(); break;
  1270.        case TK_MDEF: pr_macro(); break;
  1271.        case TK_FDEF: pr_macro(); break;
  1272.        case TK_ODEF: pr_lit  (); break;
  1273.        case TK_EMPH: pr_emp  (); break;
  1274.        case TK_NPAG: pr_npag (); break;
  1275.        case TK_TOCS: pr_tocs (); break;
  1276.        case TK_SKIP: pr_skip (); break;
  1277.        case TK_TITL: pr_titl (); break;
  1278.        default:
  1279.           lr_err(TKPS,"The parser was at the top level and was expecting");
  1280.           lr_mes(TKPS,"one of: {Directive, Text, Macro definition, EOF}.");
  1281.           next_tk(FALSE);
  1282.           break;
  1283.       }
  1284.  
  1285. }
  1286.  
  1287. /******************************************************************************/
  1288. /*                              End of PARSER.C                               */
  1289. /******************************************************************************/
  1290.