home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / funnel / scanner.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  69.4 KB  |  1,825 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. /*                                   SCANNER.C                                */
  40. /******************************************************************************/
  41. /*                                                                            */
  42. /* Introduction                                                               */
  43. /* ------------                                                               */
  44. /* The FunnelWeb scanner is a little messy because it deals with two          */
  45. /* structures at the same time while attempting to be efficient. On the one   */
  46. /* hand it is busy constructing the line list. This means that it has to keep */
  47. /* an eye out for end of line characters ('\n'=EOL) so that it can add a line */
  48. /* record whenever it sees one. On the other hand, it has to scan the input   */
  49. /* file into a token stream consisting of text tokens and special tokens      */
  50. /* which usually have no regard for end of lines. It is tempting to divide    */
  51. /* these two functions up (into perhaps a LINER and a TOKENIZER). However,    */
  52. /* the presence of the include file facility would make this messy. Also, the */
  53. /* tokenizer has to count end of line markers so that it can generate         */
  54. /* correctly positioned diagnostics.                                          */
  55. /*                                                                            */
  56. /* The long and short of it all is that the best way to do the scanning seems */
  57. /* to be to run a liner and a tokenizer as parallel layers. The liner         */
  58. /* extracts characters from the input file and hands them to the tokenizer.   */
  59. /* It also keeps an eye out for newline characters, sending a line record off */
  60. /* whenever it sees one, and counting lines. The tokenizer receives the       */
  61. /* characters from the liner and performs the tokenize operation.             */
  62. /*                                                                            */
  63. /* Notes                                                                      */
  64. /* -----                                                                      */
  65. /* - Currently FunnelWeb recognises only two characters as whitespace.        */
  66. /*   These are ' ' and EOL.                                                   */
  67. /*                                                                            */
  68. /******************************************************************************/
  69.  
  70. #include <ctype.h>
  71. #include <limits.h>
  72. #include "style.h"
  73.  
  74. #include "as.h"
  75. #include "clock.h"
  76. #include "data.h"
  77. #include "dump.h"
  78. #include "list.h"
  79. #include "lister.h"
  80. #include "machin.h"
  81. #include "mapper.h"
  82. #include "memory.h"
  83. #include "misc.h"
  84. #include "option.h"
  85. #include "scanner.h"
  86.  
  87. /******************************************************************************/
  88.  
  89. /* The "special" character is the character that is used to introduce a       */
  90. /* "special sequence". FunnelWeb allows the user to change this character so  */
  91. /* as to cater for documents where the "default" character is common. This    */
  92. /* definition defines what the default character is.                          */
  93. #define CH_DSPE ('@')
  94.  
  95. /* FunnelWeb allows include files which are handled by the scanner by placing */
  96. /* recursive calls to scan_file. A maximum is placed on the level of nested   */
  97. /* includes. This acts as a good sanity check as well as catching recursive   */
  98. /* include files which are never a sensible construct in FunnelWeb as         */
  99. /* FunnelWeb does not provide any conditional construct.                      */
  100. #define MAX_INCL (10)
  101.  
  102. /* FunnelWeb is very conservative about what characters it will allow in its  */
  103. /* input and output files. Currently the only characters allowed are          */
  104. /* printables and end of lines. When FunnelWeb does spot an illegal character */
  105. /* it needs to be able to draw the user's attention to the character. The     */
  106. /* best way to do this is to point to it in the listing file. However, if the */
  107. /* character is banned, it cannot appear in the listing file! The problem is  */
  108. /* solved by having the scanner replace all illegal characters in each mapped */
  109. /* file by the following character. This eliminates further problems.         */
  110. #define CENSORCH ('?')
  111.  
  112. /* Following the Unix convention, mapped in files are not terminated with an  */
  113. /* end-of-file character. However, the presence of such a character at the    */
  114. /* end of the mapped file simplifies scanning and so we add one. This         */
  115. /* definition defines what the character is to be. It doesn't matter what the */
  116. /* character is, so long as it cannot legally appear in the file. A control   */
  117. /* character is a good choice as these are filtered out by the liner (see     */
  118. /* above).                                                                    */
  119. /* We undef EOF (from <stdio.h>) because it is too dangerously close to EOFCH.*/
  120. /* (EOF wasn't redefined as that might confuse readers used to <stdio.h>.     */
  121. /* However, we still use EOF as an acronym for End Of File.                   */
  122. #define EOFCH (26)
  123. #undef EOF
  124.  
  125. /* Tokens have a field for a general attribute which has meaning for some     */
  126. /* token kinds. For other kinds, it has no meaning. This constant is used to  */
  127. /* indicate a "don't care" value.                                             */
  128. #define DONTCARE 0
  129.  
  130. /* A nominal maximum value for the maximum length of an input line.           */
  131. #define INMAXINF (ULONG_MAX)
  132.  
  133. /******************************************************************************/
  134.  
  135. /* The following type is used in the suite of pragma routines for parsing.    */
  136. typedef
  137.    struct
  138.      {
  139.       ps_t  pt_ps;    /* Position of the start of this argument.              */
  140.       char *pt_pstr;  /* Pointer to a string containing the argument.         */
  141.       char *pt_pinl;  /* Pointer to first byte of the argument in commndline. */
  142.      } pt_t;
  143. typedef pt_t *p_pt_t;
  144.  
  145. /******************************************************************************/
  146.  
  147.                         /* Variables Instantiated Over The Entire Scan        */
  148.                         /* -------------------------------------------        */
  149. LOCVAR p_ck_t p_mapp;   /* Pointer to mapper's clock.                         */
  150. LOCVAR p_ck_t p_scan;   /* Pointer to scanner's clock.                        */
  151. LOCVAR ulong globalno;  /* Global line number of line being scanned.          */
  152. LOCVAR ulong inclevel;  /* Include level of current file. Top file is zero.   */
  153. LOCVAR bool  seenind;   /* TRUE iff we have seen an indentation pragma.       */
  154. LOCVAR ps_t  ps_ind;    /* seenind==TRUE => ps_ind is position of pragma.     */
  155. LOCVAR bool  seentyp;   /* TRUE iff we have seen a typesetter pragma.         */
  156. LOCVAR ps_t  ps_typ;    /* seentyp==TRUE => ps_typ is position of pragma.     */
  157. LOCVAR bool  seenlimo;  /* TRUE iff we have seen an out lin len limit pragma. */
  158. LOCVAR ps_t  ps_limo;   /* seenlimo==TRUE => ps_limo is position of pragma.   */
  159.  
  160.                         /* Variables Instantiated Over The Current File       */
  161.                         /* --------------------------------------------       */
  162. LOCVAR ulong inln_max;  /* Maximum permitted length of an input line.         */
  163. LOCVAR char  specialch; /* Current special (escape) character.                */
  164. LOCVAR char  *p_eof;    /* Pointer to EOFCH byte at the end of current file.  */
  165. LOCVAR ulong  localno;  /* Local line number of line being scanned.           */
  166.  
  167.                         /* Variables Instantiated Over The Current Line       */
  168.                         /* --------------------------------------------       */
  169. LOCVAR char  *p_sol;    /* Pointer to Start (first char) Of current Line.     */
  170. LOCVAR char  *p_ch;     /* Pointer to current character in current line.      */
  171. LOCVAR char   ch;       /* *p_ch.                                             */
  172.  
  173. /******************************************************************************/
  174. /*                          Line Processing Layer                             */
  175. /******************************************************************************/
  176. /*                                                                            */
  177. /* This mini-section contains the two routines (prepline and NEXTCH) that     */
  178. /* take care of the line based-scanning and feed characters to the            */
  179. /* token-based scanner routines which have the top level of control.          */
  180. /* After mapping in a file to be read, place a call to prepline passing the   */
  181. /* address of the first byte of the mapped file as an argument. At that       */
  182. /* point the current position will be the first byte on the first line and    */
  183. /* the "variables instantiated over the current line" will be well defined.   */
  184. /* Calls to NEXTCH then move the position through the mapped file one byte at */
  185. /* a time, stopping at the end of file at which point calls will not move the */
  186. /* marker which will point to the EOF character.                              */
  187. /*                                                                            */
  188. /******************************************************************************/
  189.  
  190. LOCAL void prepline P_((char *));
  191. LOCAL void prepline(p_line)
  192. /* This function should be called at the end of each line to prepare the next */
  193. /* line for scanning. The user of the liner mini-package should place a       */
  194. /* single call to this function at the start of scanning a mapped file.       */
  195. /* The user should then place calls to NEXTCH (which calls prepline when      */
  196. /* necessary).                                                                */
  197. /* This function serves two purposes:                                         */
  198. /*    1. It looks at the next line and converts all non-printables into       */
  199. /*       CENSORCH and issues errors for each non-printable.                   */
  200. /*    2. It initializes the line scanning variables for the next line.        */
  201. /* The argument is a pointer to the first byte of the next line.              */
  202. char *p_line;
  203. {
  204.  char *p;  /* Scans through the line and winds up sitting on the EOL.         */
  205.  
  206.  /* Test to see if the "line" we have been given is the end of file marker.   */
  207.  /* We have to be careful here because the byte we are using to mark the end  */
  208.  /* of file could appear as an illegal unprintable. This is the reason for    */
  209.  /* the test p_line==p_eof.                                                   */
  210.  if (*p_line==EOFCH && p_line==p_eof)
  211.    {
  212.     /* The line we have to process is in fact the end of file marker. */
  213.     p_sol = p_line;
  214.     p_ch  = p_line;
  215.     ch    = EOFCH;
  216.     return;
  217.    }
  218.  
  219.  /* At this point we know that we are faced with a run of bytes terminated by */
  220.  /* an EOL character (we know this cos we put an EOL before EOF earlier on).  */
  221.  /* We know that we have a line, so we can now bump up the line counters.     */
  222.  globalno++;
  223.  localno++;
  224.  
  225.  /* Run through the line checking for non-printables and issuing errors.      */
  226.  p = p_line;
  227.  while (*p != EOL)
  228.     {
  229.      /* The following test tests to see if the character is a printable in    */
  230.      /* seven bit ascii. FunnelWeb is not currently designed to work with     */
  231.      /* any character set other than seven-bit ascii and so we flag and       */
  232.      /* convert all out-of-range characters here before they are exposed to   */
  233.      /* the rest of the scanner code which assumes that each line that it is  */
  234.      /* handed consists entirely of printables except for the EOL char on the */
  235.      /* end and possibly an EOF char at the "Start" of a line.                */
  236.      /* In particular, the NEXTCH macro will fail on machines with siged     */
  237.      /* chars if non-printables are not removed. It goes into an infinite     */
  238.      /* loop.                                                                 */
  239.      /* Note: I don't use library function "isprint" here because on the vax  */
  240.      /* it's definition is too loose (seems to accept characters with the top */
  241.      /* bit set as printable).                                                */
  242.      if (!isascprn(*p))  /* If not a printable character. */
  243.        {
  244.         ps_t ps;
  245.         char c = *p;
  246.         ubyte_ uc = *((ubyte_ *) p);
  247.         ps.ps_line   = globalno;
  248.         ps.ps_column = p-p_line+1;
  249.         if (strlen(chabbrev(c))==0)
  250.            sprintf(linet1,
  251.               "Non printable character (Sym=<none>, Dec=%03u, Hex=%02X, Oct=%03o).",
  252.               (unsigned) uc,(unsigned) uc,(unsigned) uc);
  253.         else
  254.            sprintf(linet1,
  255.               "Non printable character (Sym=%s, Dec=%03u, Hex=%02X, Oct=%03o).",
  256.                    chabbrev(c),(unsigned) uc,(unsigned) uc,(unsigned) uc);
  257.         lr_err(&ps,linet1);
  258.         *p=CENSORCH;
  259.        }
  260.      p++;
  261.     }
  262.  /* Assert: p_line points to the start of the current line.     */
  263.  /* Assert: p points to the EOL at the end of the current line. */
  264.  
  265.  /* Check that the line is not too long. */
  266.  if ((p-p_line)>inln_max)
  267.    {
  268.     ps_t ps;
  269.     ps.ps_line   = globalno;
  270.     ps.ps_column = inln_max+1;
  271.     lr_err(&ps,"Input line is too long (this character is the first offender).");
  272.     sprintf(linet1,"Currently, the maximum allowable input line length is %lu.",
  273.                    (unsigned long) inln_max);
  274.     lr_mes(&ps,linet1);
  275.     lr_mes(&ps,"Note: You can change this using a pragma directive (@p).");
  276.    }
  277.  
  278.  /* Now check for trailing spaces. */
  279.  if ((p != p_line) && (*(p-1) == ' '))
  280.    {
  281.     ps_t ps;
  282.     ps.ps_line   = globalno;
  283.     ps.ps_column = p-p_line;
  284.     lr_war(&ps,"Line has trailing spaces up to and including this space.");
  285.    }
  286.  
  287.  /* Construct a line record and append the record to the line list. */
  288.  /* Note that the line scrap encompasses the trailing EOL.          */
  289.  {
  290.   ln_t line;
  291.   line.ln_global        = globalno;
  292.   line.ln_local         = localno;
  293.   line.ln_body.sc_first = p_line;
  294.   line.ln_body.sc_last  = p;
  295.   /* Note: We do not set sc_white as it is not used in lines. */
  296.   ls_add(line_list,PV &line);
  297.  }
  298.  
  299.  /* Finally, set the line scanning variables to the start of the line. */
  300.  /* We can't do this earlier in case the start of the line was a       */
  301.  /* non-printable and got substituted (ch might pick it up).           */
  302.  p_sol =  p_line;
  303.  p_ch  =  p_line;
  304.  ch    = *p_line;
  305.  
  306. } /* End of prepline. */
  307.  
  308. /* NEXTCH can be called continuously after an initializing call to prepline.  */
  309. /* After a call to NEXTCH, p_sol, p_ch, ch are all well-defined. p_sol points */
  310. /* to the start of the current line, p_ch points to the current character,    */
  311. /* and ch contains *p_ch. NEXTCH can be called repeatedly forever. When it    */
  312. /* hits the EOF character, it sticks on it and returns it forever.            */
  313. /* Note: The "ch<' '" is an optimized form of "(ch==EOL)||(ch=EOFCH)". Speed  */
  314. /* is very important here as this macro is called in scanning tightloops.     */
  315. /* This line of code is a little tricky so read it carefully.                 */
  316. /* WARNING: The ch<' ' will cause an infinite loop if a character appears     */
  317. /* that satisfies this condition without being EOF or EOL (e.g. a control     */
  318. /* char (meant to be filtered out earlier) or a top-bit-set character on      */
  319. /* machines with signed character type.                                       */
  320. #define NEXTCH {if (ch<' ') {if (ch==EOL) prepline(p_ch+1);} else ch= *++p_ch;}
  321.  
  322. /******************************************************************************/
  323. /*                           Scanner Support Routines                         */
  324. /******************************************************************************/
  325.  
  326. LOCAL ps_t *psofch P_((void));
  327. LOCAL ps_t *psofch()
  328. /* Returns a pointer to an internal static ps structure holding the line and  */
  329. /* column number of the current character ch.                                 */
  330. {
  331.  STAVAR ps_t chps;
  332.  chps.ps_line   = globalno;
  333.  chps.ps_column = p_ch-p_sol+1;
  334.  return &chps;
  335. }
  336.  
  337. /******************************************************************************/
  338.  
  339. LOCAL void grabchps P_((p_ps_t));
  340. LOCAL void grabchps(p_ps)
  341. /* Writes the position of the current ch into the argument position struct.   */
  342. p_ps_t p_ps;
  343. {
  344.  p_ps->ps_line   = globalno;
  345.  p_ps->ps_column = p_ch-p_sol+1;
  346. }
  347.  
  348. /******************************************************************************/
  349.  
  350. LOCAL void sendspec P_((p_ps_t,tk_k_t,ubyte));
  351. LOCAL void sendspec(p_tkps,tk_kind,tk_gen)
  352. /* Appends a non-text token of kind tk_kind to the end of the token list.     */
  353. /* p_ps is a pointer to a position structure giving the position of the       */
  354. /* first character of the token. tk_gen is the general token attribute.       */
  355. p_ps_t p_tkps;
  356. tk_k_t tk_kind;
  357. ubyte  tk_gen;
  358. {
  359.  tk_t token;
  360.  token.tk_kind        = tk_kind;
  361.  ASSIGN(token.tk_ps,*p_tkps);
  362.  token.tk_sc.sc_first = NULL;
  363.  token.tk_sc.sc_last  = NULL;
  364.  token.tk_sc.sc_white = TRUE;
  365.  token.tk_gen         = tk_gen;
  366.  ls_add(token_list,PV &token);
  367. }
  368.  
  369. /******************************************************************************/
  370.  
  371. LOCAL void sendtext P_((p_ps_t,char *,char *,bool));
  372. LOCAL void sendtext(p_tkps,p_first,p_last,is_white)
  373. /* Appends a text token to the end of the token list.                         */
  374. /* IN: p_ps is a pointer to a position structure giving the position of the   */
  375. /*     first character of the token.                                          */
  376. /* IN: p_first and p_last point to the first and last byte of the text scrap. */
  377. /* IN: is_white should be set to TRUE iff scrap is entirely whitespace.       */
  378. p_ps_t p_tkps;
  379. char  *p_first;
  380. char  *p_last;
  381. bool   is_white;
  382. {
  383.  tk_t token;
  384.  
  385.  /* Empty text scraps should never be generated. */
  386.  as_cold(p_first<=p_last,"sendtext: Text scrap bounds are bad.");
  387.  
  388.  /* If ch=EOL then we should be scanning more text, not shipping it! */
  389.  as_cold(ch!=EOL,"senttext: Shipping text while still more to scan.");
  390.  
  391.  /* Send the text token. */
  392.  token.tk_kind        = TK_TEXT;
  393.  ASSIGN(token.tk_ps,*p_tkps);
  394.  token.tk_sc.sc_first = p_first;
  395.  token.tk_sc.sc_last  = p_last;
  396.  token.tk_sc.sc_white = is_white;
  397.  token.tk_gen         = DONTCARE;
  398.  ls_add(token_list,PV &token);
  399. }
  400.  
  401. /******************************************************************************/
  402.  
  403. LOCAL void add_eof P_((void));
  404. LOCAL void add_eof()
  405. /* This function adds terminators to the line and token list.                 */
  406. /*    1. It adds a TK_EOF token to the end of the token list.                 */
  407. /*    2. It adds a visible <eof> line to the end of the line list.            */
  408. /* This assists the parser by allowing it to point diagnostic messages to a   */
  409. /* visible EOF marker rather than pointing vaguely to the end of the last     */
  410. /* line of the input file which (by the way) may not even exist!              */
  411. {
  412.  STAVAR char *eofstr = "<End-Of-File>\n";
  413.  ln_t line;
  414.  ps_t ps;
  415.  
  416.  /* When the liner mini package encounters an end of file marker, it stops    */
  417.  /* dead on the marker and returns EOFCH forever. scan_file() eventually gets */
  418.  /* the message and drops out. However, in all of this, the line numbers are  */
  419.  /* not incremented to indicate that we have moved to an EOF line. This is    */
  420.  /* intended, as we do not want EOFs to appear in the listing for include     */
  421.  /* files; only at the end of the main input file. Thus, here we effectively  */
  422.  /* perform the liner function of moving from the last line of the input file */
  423.  /* to the imaginary line containing the EOF marker. This is done by          */
  424.  /* incrementing the line numbers. Note that the fact that these line number  */
  425.  /* variables are incorrect from the point of detection of the final EOF to   */
  426.  /* here doesn't matter as no tokens or diagnostics are ever added after an   */
  427.  /* EOF is detected.                                                          */
  428.  globalno++;
  429.  localno++;
  430.  
  431.  /* Add a line to represent the EOF marker. */
  432.  line.ln_global        = globalno;
  433.  line.ln_local         = localno;
  434.  line.ln_body.sc_first = eofstr;
  435.  line.ln_body.sc_last  = eofstr+strlen(eofstr)-1;
  436.  /* Note: We do not set sc_white as it is not used in lines. */
  437.  ls_add(line_list,PV &line);
  438.  
  439.  /* Add a TK_EOF token to the end of the token list. */
  440.  ps.ps_line   = globalno;
  441.  ps.ps_column = 1;
  442.  sendspec(&ps,TK_EOF,DONTCARE);
  443. }
  444.  
  445. /******************************************************************************/
  446. /*                              The Scanner Proper                            */
  447. /******************************************************************************/
  448.  
  449. LOCAL void skiptoeol P_((void));
  450. LOCAL void skiptoeol()
  451. {
  452.  while (ch != EOL)
  453.     NEXTCH;
  454. }
  455.  
  456. /******************************************************************************/
  457.  
  458. /* The incl_fil function calls this, so we have to declare it in advance. */
  459. LOCAL void scan_file P_((char *));
  460.  
  461. LOCAL void incl_fil P_((p_ps_t));
  462. LOCAL void incl_fil(p_ps)
  463. /* Upon entry, the current character is the "i" of an "@i" sequence. Our task */
  464. /* is first to see if the sequence occurred at the start of a line (the only  */
  465. /* point at which it is legal) and issue an error if it isn't. If it is legal,*/
  466. /* we have to read in the specified file and scan that. The included file     */
  467. /* replaces exactly the line starting with the "@i" command and we return     */
  468. /* to the "calling" file with the current position being the EOL character of */
  469. /* the include line.                                                          */
  470. p_ps_t p_ps;
  471. {
  472.  /* Complain if the include directive was not at the start of a line. */
  473.  if (p_ch-1 != p_sol)
  474.    {
  475.     lr_err(p_ps,"Include sequence must be at the beginning of a line.");
  476.     lr_mes(p_ps,"Include ignored.");
  477.     skiptoeol();
  478.     return;
  479.    }
  480.  
  481.  /* The include command should be followed by a blank. Get the next char. */
  482.  NEXTCH;
  483.  
  484.  /* Complain if the next character is not a blank. */
  485.  if (ch != ' ')
  486.    {
  487.     ps_t ps;
  488.     ASSIGN(ps,*p_ps);
  489.     ps.ps_column+=2;
  490.     lr_err(&ps,"Include sequence (@i) must be followed by a blank.");
  491.     lr_mes(&ps,"Example include: @i macros.fwi");
  492.     lr_mes(&ps,"Include ignored.");
  493.     skiptoeol();
  494.     return;
  495.    }
  496.  
  497.  /* Complain if the include level is too high. */
  498.  if (inclevel == MAX_INCL)
  499.    {
  500.     lr_err(p_ps,"This include file is nested too deeply. It's probably recursive.");
  501.     sprintf(linet1,"The maximum level of nested includes is %u.",
  502.                    (unsigned) MAX_INCL);
  503.     lr_mes(p_ps,linet1);
  504.     lr_mes(p_ps,"Include ignored.");
  505.     skiptoeol();
  506.     return;
  507.    }
  508.  
  509.  {/* This construct does the work of the include.                 */
  510.   /* Warning: The following variables MUST be declared automatic. */
  511.   char   *p_filename;
  512.   char   *p_tempname;
  513.   ulong  length;
  514.   char  *p;
  515.   ulong xinln_max;
  516.   char  xspecial;
  517.   char  *xp_eof;
  518.   ulong  xlocalno;
  519.   char  *xp_sol;
  520.   char  *xp_ch;
  521.   char   xch;
  522.  
  523.   /* We save stack space by sticking this filename in the heap. */
  524.   p_filename=mm_temp((size_t) FILENAME_MAX+1+10); /* 10 is for paranoia. */
  525.   p_tempname=mm_temp((size_t) FILENAME_MAX+1+10); /* 10 is for paranoia. */
  526.  
  527.   /* The rest of the line is supposed to hold a filename. Copy it. */
  528.   NEXTCH;
  529.   p=p_tempname;
  530.   length=0;
  531.   while (ch!=EOL)
  532.     {
  533.      if (++length > FILENAME_MAX)
  534.        {
  535.         lr_err(p_ps,
  536.         "This include command's file specification is too long.");
  537.         if (option.op_b7_b)
  538.            sprintf(linet1,"The maximum file name length is %s characters.",
  539.                       SUPPVAL);
  540.         else
  541.            sprintf(linet1,"The maximum file name length is %u characters.",
  542.                       (unsigned) FILENAME_MAX);
  543.         lr_mes(p_ps,linet1);
  544.         lr_mes(p_ps,"Include ignored.");
  545.         skiptoeol();
  546.         return;
  547.        }
  548.      *p++=ch;
  549.      NEXTCH;
  550.     }
  551.   *p=EOS;
  552.   /* Note: Current position is now on the EOL at the end of the @i line. */
  553.  
  554.   /* Complain if the user has not specified a filename. */
  555.   if (strlen(p_tempname) ==0)
  556.     {
  557.      lr_err(psofch(),"Expecting the name of a file to include.");
  558.      return;
  559.     }
  560.  
  561.   /* Perform the necessary filename inheritance.                              */
  562.   strcpy(p_filename,"");
  563.   fn_ins(p_filename,option.op_f_s);
  564.   fn_ins(p_filename,".fwi");
  565.   fn_ins(p_filename,option.op_i_s);
  566.   fn_ins(p_filename,p_tempname);
  567.  
  568.   /* Include the included file by calling scan_file recursively. */
  569.   /* Save and restore all variables in instantiation scope.      */
  570.   xinln_max = inln_max;
  571.   xspecial  = specialch;
  572.   xp_eof    = p_eof;
  573.   xlocalno  = localno;
  574.   xp_sol    = p_sol;
  575.   xp_ch     = p_ch;
  576.   xch       = ch;
  577.   inclevel++;
  578.   scan_file(p_filename);
  579.   inclevel--;
  580.   ch        = xch;
  581.   p_ch      = xp_ch;
  582.   p_sol     = xp_sol;
  583.   localno   = xlocalno;
  584.   p_eof     = xp_eof;
  585.   specialch = xspecial;
  586.   inln_max  = xinln_max;
  587.  }
  588. }
  589.  
  590. /******************************************************************************/
  591.  
  592. LOCAL void do_ascii P_((p_ps_t));
  593. LOCAL void do_ascii(p_psspec)
  594. /* Upon entry, the current character is the '^' of a @^ sequence. The task is */
  595. /* to parse the following ascii code and generate a text token.               */
  596. p_ps_t p_psspec;
  597. {
  598.  ubyte  base;             /* Base of the number we are scanning.              */
  599.  ubyte  digits;           /* Number of digits expected.                       */
  600.  uword  val;              /* Value of target character.                       */
  601.  ubyte  i;                /* Looping variable.                                */
  602.  STAVAR char alphab[256]; /* Static alphabet array to which to point scraps.  */
  603.  STAVAR bool init=FALSE;  /* Tells if alphab has been initialized.            */
  604.  
  605.  /* Establish an array containing the ascii character set. Later on we can    */
  606.  /* point the sc_first and sc_last pointers to particular characters.         */
  607.  if (!init) {uword i; for (i=0;i<256;i++) alphab[i]=(char) i; init=TRUE;}
  608.  
  609.  /* Make sure that the base character is legal. */
  610.  NEXTCH;
  611.  switch(toupper(ch))
  612.    {
  613.     case 'B': base= 2; digits=8; break;
  614.     case 'O':
  615.     case 'Q': base= 8; digits=3; break;
  616.     case 'D': base=10; digits=3; break;
  617.     case 'H':
  618.     case 'X': base=16; digits=2; break;
  619.     default : lr_err(psofch(),"Expecting one of 'B', 'Q', 'D', 'H'.");
  620.               lr_mes(psofch(),"(For Binary, Octal, Decimal, and Hexadecimal).");
  621.               base=10;
  622.               goto trouble;
  623.    }
  624.  
  625.  /* Parse opening parenthesis. */
  626.  NEXTCH;
  627.  if (ch!='(')
  628.    {lr_err(psofch(),"Expecting '('.");goto trouble;}
  629.  
  630.  val=0;
  631.  for (i=0;i<digits;i++)
  632.    {
  633.     char uch;
  634.     ubyte d;
  635.  
  636.     NEXTCH;
  637.     uch=toupper(ch);
  638.     if (('0'<=uch) && (uch<='9'))
  639.        d=uch-'0';
  640.     else
  641.        if ('A'<=uch && uch<='F')
  642.           d=10+uch-'A';
  643.        else
  644.           d=100;
  645.     if (d>=base)
  646.       {lr_err(psofch(),"Illegal digit."); goto trouble;}
  647.     val = base*val + d;
  648.    }
  649.  
  650.  /* Parse closing parenthesis. */
  651.  NEXTCH;
  652.  if (ch!=')')
  653.    {lr_err(psofch(),"Expecting ')'.");goto trouble;}
  654.  
  655.  /* Make sure that the number is not too big (this is possible in decimal). */
  656.  if (val>255)
  657.    {
  658.     lr_err(psofch(),"Character number is too large.");
  659.     lr_mes(psofch(),"Character number must be in the range [0,255] (decimal).");
  660.     goto trouble;
  661.    }
  662.  
  663.  /* Success! Now we can parcel it up into a scrap! */
  664.  sendtext(p_psspec,&alphab[val],&alphab[val],ch==' ' || ch==EOL);
  665.  return;
  666.  
  667.  trouble:
  668.  /* Jump here after a specific diagnostic to give the user a reminder of */
  669.  /* how to specify an ascii character constant.                          */
  670.  switch (base)
  671.     {
  672.      case  2:
  673.         lr_mes(psofch(),
  674.         "A binary character representation takes the form \"@^B(dddddddd)\".");
  675.         lr_mes(psofch(),
  676.         "(exactly 8 digits) where each digit d is either 0 or 1.");
  677.         break;
  678.      case  8:
  679.         lr_mes(psofch(),
  680.         "An octal character representation takes the form \"@^Q(ddd)\" (or \"@^O(ddd)\").");
  681.         lr_mes(psofch(),
  682.         "(exactly 3 digits) where each digit d is in the range 0..7.");
  683.         break;
  684.      case 10:
  685.         lr_mes(psofch(),
  686.         "A decimal character representation takes the form \"@^D(ddd)\".");
  687.         lr_mes(psofch(),
  688.         "(exactly 3 digits) where each digit d is in the range 0..9.");
  689.         break;
  690.      case 16:
  691.         lr_mes(psofch(),
  692.         "A hexadecimal character representation takes the form \"@^X(dd)\" (or \"@^H(dd)\").");
  693.         lr_mes(psofch(),
  694.         "(exactly 2 digits) where each digit d is in the range 0..9,A..F.");
  695.         break;
  696.      default: as_bomb("do_ascii: trouble base switch defaulted.");
  697.     }
  698. }
  699.  
  700. /******************************************************************************/
  701.  
  702. LOCAL void do_name P_((p_ps_t));
  703. LOCAL void do_name (p_psspec)
  704. /* Upon entry, the current character is the # of a @#. The task is to parse   */
  705. /* it and transmit a name token.                                              */
  706. p_ps_t p_psspec;
  707. {
  708.  as_cold(ch=='#',"do_name: character is wrong.");
  709.  NEXTCH;
  710.  if ((ch==EOL) || (ch==' '))
  711.     {lr_err(psofch(),"Expecting a printable character."); return;}
  712.  
  713.  /* Transmit a name token. */
  714.  sendspec(p_psspec,TK_NAME,(ubyte) ch);
  715. }
  716.  
  717. /******************************************************************************/
  718.  
  719. LOCAL void do_pgind P_((uword,p_pt_t));
  720. LOCAL void do_pgind(numarg,arg)
  721. /* Parse an indentation pragma. */
  722. uword numarg;
  723. p_pt_t   arg;
  724. {
  725.  bool pragind;
  726.  ps_t psprag;
  727.  
  728.  /* Make sure that there are exactly three arguments. */
  729.  if (numarg != 3)  /* "indentation"  "none|blank". */
  730.    {
  731.     lr_err(&arg[0].pt_ps,
  732.            "This indentation pragma has the wrong number of arguments.");
  733.     goto help;
  734.    }
  735.  
  736.  /* Make sure that the second argument is an "=". */
  737.  if (0 != strcmp(arg[2].pt_pstr,"="))
  738.    {
  739.     lr_err(&arg[2].pt_ps,"Expecting \"=\".");
  740.     goto help;
  741.    }
  742.  
  743.  /* Check the third argument. */
  744.       if (strcmp(arg[3].pt_pstr,"none" )==0) pragind=FALSE;
  745.  else if (strcmp(arg[3].pt_pstr,"blank")==0) pragind=TRUE;
  746.  else
  747.    {
  748.     lr_err(&arg[3].pt_ps,"Expecting either \"none\" or \"blank\".");
  749.     goto help;
  750.    }
  751.  
  752.  /* Construct a shorthand for the start of the pragma. */
  753.  ASSIGN(psprag,arg[0].pt_ps);
  754.  
  755.  /* Make sure that the pragma does not contradict an earlier pragma. */
  756.  if (seenind && (tgindent!=pragind))
  757.    {
  758.     sprintf(linet1,"This pragma is opposed by the pragma at line %lu.",
  759.                    (unsigned long) psprag.ps_line);
  760.     lr_mes(&ps_ind,linet1);
  761.     sprintf(linet1,"This pragma opposes the pragma at line %lu.",
  762.                    (unsigned long) ps_ind.ps_line);
  763.     lr_err(&psprag,linet1);
  764.     lr_mes(&psprag,"You can have as many indentation pragmas as you like,");
  765.     lr_mes(&psprag,"but they all have to be the same!");
  766.     lr_mes(&psprag,"Pragma ignored.");
  767.     return;
  768.    }
  769.  
  770.  /* Success: Record the pragma information. */
  771.  seenind  = TRUE;       /* Record that we have seen a pragma. */
  772.  tgindent = pragind;    /* Record what the pragma said.       */
  773.  ASSIGN(ps_ind,psprag); /* Record where the pragma was.       */
  774.  return;
  775.  
  776.  help:
  777.     lr_mes(&arg[0].pt_ps,
  778.            "The correct format is: \"@p indentation = none|blank\".");
  779.     lr_mes(&arg[0].pt_ps,"Pragma ignored.");
  780.     return;
  781. }
  782.  
  783. /******************************************************************************/
  784.  
  785. LOCAL void do_pginl P_((uword,p_pt_t));
  786. LOCAL void do_pginl(numarg,arg)
  787. /* Parse a maximum input line length pragma. */
  788. uword numarg;
  789. p_pt_t   arg;
  790. {
  791.  char  *numstr;
  792.  uword spn;
  793.  
  794.  /* Make sure that there are exactly three arguments. */
  795.  if (numarg != 3)  /* "max..length = <num>". */
  796.    {
  797.     lr_err(&arg[0].pt_ps,"This pragma has the wrong number of arguments.");
  798.     goto help;
  799.    }
  800.  
  801.   /* Make sure that the second argument is "=". */
  802.  if (0 != strcmp(arg[2].pt_pstr,"="))
  803.    {lr_err(&arg[2].pt_ps,"Expecting \"=\"."); goto help;}
  804.  
  805.  /* Set up an abbreviation. */
  806.  numstr=arg[3].pt_pstr;
  807.  
  808.  /* See if the value is "infinity". */
  809.  if (strcmp(numstr,"infinity")==0)
  810.    {inln_max=INMAXINF; return;}
  811.  
  812.  /* Calculate length of longest prefix containing all decimal digits. */
  813.  /* Check that there are no illegal digits.                           */
  814.  spn=strspn(numstr,"0123456789");
  815.  if (spn != strlen(numstr))
  816.    {
  817.     ps_t ps;
  818.     ASSIGN(ps,arg[3].pt_ps);
  819.     ps.ps_column+=spn;
  820.     lr_err(&ps,"Illegal digit. Value must consist entirely of decimal digits.");
  821.     lr_mes(&ps,"You can also use the value \"infinity\".");
  822.     lr_mes(&ps,"Pragma ignored.");
  823.     return;
  824.    }
  825.  
  826.  /* Check that the number is not too long. */
  827.  if (strlen(numstr)>8)
  828.    {
  829.     lr_err(&arg[3].pt_ps,"Too many digits. The maximum is eight.");
  830.     lr_mes(&arg[3].pt_ps,"Pragma ignored.");
  831.     return;
  832.    }
  833.  
  834.  /* Convert the argument into an integer. */
  835.  {
  836.   ulong val;
  837.   int result;
  838.   /* Note: Should really be %lu, but the Vax doesn't know about the %u */
  839.   /* in sscanf and so we make do with %ld.                             */
  840.   result=sscanf(numstr,"%ld",&val);
  841.   as_cold(result==1,"do_pginl:sscanf failed.");
  842.   inln_max=val;
  843.  }
  844.  return;
  845.  
  846.  help:
  847.     lr_mes(&arg[0].pt_ps,
  848.     "The correct format is: \"@p maximum_input_line_length = <num>|infinity\".");
  849.     lr_mes(&arg[0].pt_ps,"Pragma ignored.");
  850.     return;
  851. }
  852.  
  853. /******************************************************************************/
  854.  
  855. LOCAL void do_pgotl P_((uword,p_pt_t));
  856. LOCAL void do_pgotl(numarg,arg)
  857. /* Parse a maximum product file line length pragma. */
  858. uword numarg;
  859. p_pt_t   arg;
  860. {
  861.  char  *numstr;
  862.  uword spn;
  863.  ulong val;
  864.  ps_t psprag;
  865.  
  866.  /* Set up an abbreviation. */
  867.  ASSIGN(psprag,arg[0].pt_ps);
  868.  
  869.  /* Make sure that there are exactly three arguments. */
  870.  if (numarg != 3)  /* "max..length" "=" "value". */
  871.    {
  872.     lr_err(&arg[0].pt_ps,"This pragma has the wrong number of arguments.");
  873.     goto help;
  874.    }
  875.  
  876.   /* Make sure that the second argument is an "=". */
  877.  if (0 != strcmp(arg[2].pt_pstr,"="))
  878.    {lr_err(&arg[2].pt_ps,"Expecting \"=\"."); goto help;}
  879.  
  880.  /* Set up an abbreviation. */
  881.  numstr=arg[3].pt_pstr;
  882.  
  883.  /* See if the value is "infinity". */
  884.  if (strcmp(numstr,"infinity")==0)
  885.    {val=TGMAXINF; goto gotvalue;}
  886.  
  887.  /* Calculate length of longest prefix containing all decimal digits. */
  888.  /* Check that there are no illegal digits.                           */
  889.  spn=strspn(numstr,"0123456789");
  890.  if (spn != strlen(numstr))
  891.    {
  892.     ps_t ps;
  893.     ASSIGN(ps,arg[3].pt_ps);
  894.     ps.ps_column+=spn;
  895.     lr_err(&ps,"Illegal digit. Value must consist entirely of decimal digits.");
  896.     lr_mes(&ps,"You can also use the value \"infinity\".");
  897.     lr_mes(&ps,"Pragma ignored.");
  898.     return;
  899.    }
  900.  
  901.  /* Check that the number is not too long. */
  902.  if (strlen(numstr)>8)
  903.    {
  904.     lr_err(&arg[3].pt_ps,"Too many digits. The maximum is eight.");
  905.     lr_mes(&arg[3].pt_ps,"Pragma ignored.");
  906.     return;
  907.    }
  908.  
  909.  /* Convert the argument into an integer. */
  910.  {
  911.   int result=sscanf(numstr,"%ld",&val);
  912.   as_cold(result==1,"do_pgotl:sscanf failed.");
  913.  }
  914.  
  915.  gotvalue:
  916.  /* Make sure that the pragma does not contradict an earlier pragma. */
  917.  if (seenlimo && (tglinmax!=val))
  918.    {
  919.     sprintf(linet1,"This pragma is opposed by the pragma at line %lu.",
  920.                    (unsigned long) psprag.ps_line);
  921.     lr_mes(&ps_limo,linet1);
  922.     sprintf(linet1,"This pragma opposes the pragma at line %lu.",
  923.                    (unsigned long) ps_limo.ps_line);
  924.     lr_err(&psprag,linet1);
  925.     lr_mes(&psprag,"You can have as many output line length pragmas");
  926.     lr_mes(&psprag,"as you like, but they all have to be the same!");
  927.     lr_mes(&psprag,"Pragma ignored.");
  928.     return;
  929.    }
  930.  
  931.  /* If we got this far then the pragma is just the same as an earlier one. */
  932.  /* We don't want to set the pragma position to the later pragma so we     */
  933.  /* return now.                                                            */
  934.  if (seenlimo) return;
  935.  
  936.  /* Success. Set the variables. */
  937.  tglinmax=val;
  938.  seenlimo=TRUE;
  939.  ASSIGN(ps_limo,psprag);
  940.  return;
  941.  
  942.  help:
  943.     lr_mes(&arg[0].pt_ps,
  944.     "The correct format is: \"@p maximum_output_line_length = <num>|infinity\".");
  945.     lr_mes(&arg[0].pt_ps,"Pragma ignored.");
  946.     return;
  947. }
  948.  
  949. /******************************************************************************/
  950.  
  951. LOCAL void do_pgnpg P_((uword,p_pt_t));
  952. LOCAL void do_pgnpg(numarg,arg)
  953. /* Parse a newpage typesetter directive. */
  954. uword numarg;
  955. p_pt_t   arg;
  956. {
  957.  /* Make sure that there is exactly one argument. */
  958.  if (numarg > 1)  /* "new_page" */
  959.    {
  960.     lr_err(&arg[2].pt_ps,"The new_page directive does not take arguments.");
  961.     lr_mes(&arg[2].pt_ps,"Directive ignored.");
  962.     return;
  963.    }
  964.  sendspec(&arg[0].pt_ps,TK_NPAG,DONTCARE);
  965. }
  966.  
  967. /******************************************************************************/
  968.  
  969. LOCAL void do_pgtoc P_((uword,p_pt_t));
  970. LOCAL void do_pgtoc(numarg,arg)
  971. /* Parse a table of contents typesetter directive. */
  972. uword numarg;  /* Number of arguments to table of contents directive.         */
  973. p_pt_t   arg;  /* Array describing arguments.                                 */
  974. {
  975.  /* Make sure that there is exactly one argument. */
  976.  if (numarg > 1)  /* "table_of_contents" */
  977.    {
  978.     lr_err(&arg[2].pt_ps,
  979.            "The table_of_contents directive does not take arguments.");
  980.     lr_mes(&arg[2].pt_ps,"Directive ignored.");
  981.     return;
  982.    }
  983.  sendspec(&arg[0].pt_ps,TK_TOCS,DONTCARE);
  984. }
  985.  
  986. /******************************************************************************/
  987.  
  988. LOCAL void do_pgvsk P_((uword,p_pt_t));
  989. LOCAL void do_pgvsk(numarg,arg)
  990. /* Parse a vskip typesetter directive. */
  991. uword numarg;  /* Number of arguments to indentation directive.               */
  992. p_pt_t   arg;  /* Array describing arguments.                                 */
  993. {
  994.  char  *numstr;
  995.  uword spn;
  996.  
  997.  /* Make sure that there are exactly three arguments. */
  998.  if (numarg != 3)  /* "vskip" n "mm". */
  999.    {
  1000.     lr_err(&arg[0].pt_ps,"This directive has the wrong number of arguments.");
  1001.     goto help;
  1002.    }
  1003.  
  1004.   /* Make sure that the third argument is "mm". */
  1005.  if (0 != strcmp(arg[3].pt_pstr,"mm"))
  1006.    {lr_err(&arg[3].pt_ps,"Expecting \"mm\"."); goto help;}
  1007.  
  1008.  /* Set up an abbreviation. */
  1009.  numstr=arg[2].pt_pstr;
  1010.  
  1011.  /* Calculate length of longest prefix containing all decimal digits. */
  1012.  /* Check that there are no illegal digits.                           */
  1013.  spn=strspn(numstr,"0123456789");
  1014.  if (spn != strlen(numstr))
  1015.    {
  1016.     ps_t ps;
  1017.     ASSIGN(ps,arg[2].pt_ps);
  1018.     ps.ps_column+=spn;
  1019.     lr_err(&ps,"Illegal digit.");
  1020.     lr_mes(&ps,"Value must consist entirely of decimal digits.");
  1021.     lr_mes(&ps,"Directive ignored.");
  1022.     return;
  1023.    }
  1024.  
  1025.  /* Check that the number is not too long. */
  1026.  if (strlen(numstr)>3)
  1027.    {
  1028.     lr_err(&arg[2].pt_ps,"Too many digits. The maximum is three.");
  1029.     lr_mes(&arg[2].pt_ps,"Directive ignored.");
  1030.     return;
  1031.    }
  1032.  
  1033.  /* Convert the argument into an integer. */
  1034.  {
  1035.   ulong val;
  1036.   int result;
  1037.   result=sscanf(numstr,"%ld",&val);
  1038.   as_cold(result==1,"do_pginl:sscanf failed.");
  1039.   if (val>255)
  1040.     {
  1041.      lr_err(&arg[2].pt_ps,"Value too large. Maximum is 255.");
  1042.      lr_mes(&arg[2].pt_ps,"Directive ignored.");
  1043.      return;
  1044.     }
  1045.   sendspec(&arg[0].pt_ps,TK_SKIP,(ubyte) val);
  1046.  }
  1047.  return;
  1048.  
  1049.  help:
  1050.     lr_mes(&arg[0].pt_ps,"The correct format is: \"@t vskip <num> mm\".");
  1051.     lr_mes(&arg[0].pt_ps,"Directive ignored.");
  1052.     return;
  1053. }
  1054.  
  1055. /******************************************************************************/
  1056.  
  1057. LOCAL void do_pgtit P_((uword,p_pt_t));
  1058. LOCAL void do_pgtit(numarg,arg)
  1059. /* Parse a title typesetter directive. */
  1060. uword numarg;  /* Number of arguments to title directive.                     */
  1061. p_pt_t   arg;  /* Array describing arguments.                                 */
  1062. {
  1063.  uword align;
  1064.  uword font;
  1065.  char *p_sot,*p_eot;
  1066.  
  1067.  /* Make sure that there are at least three arguments. */
  1068.  if (numarg < 4)  /* "title <font> <align> <text>". */
  1069.    {lr_err(&arg[0].pt_ps,"This directive has too few arguments."); goto help;}
  1070.  
  1071.  /* Check the font argument. */
  1072.       if (strcmp(arg[2].pt_pstr,"normalfont"    )==0) font=FT_NORM;
  1073.  else if (strcmp(arg[2].pt_pstr,"titlefont"     )==0) font=FT_TITL;
  1074.  else if (strcmp(arg[2].pt_pstr,"smalltitlefont")==0) font=FT_STIT;
  1075.  else
  1076.    {
  1077.     lr_err(&arg[2].pt_ps,
  1078.     "Expecting one of {titlefont,smalltitlefont,normalfont}.");
  1079.     lr_mes(&arg[2].pt_ps,"Directive ignored.");
  1080.     return;
  1081.    }
  1082.  
  1083.  /* Check the alignment argument. */
  1084.       if (strcmp(arg[3].pt_pstr,"left"  )==0) align=LR_LEFT;
  1085.  else if (strcmp(arg[3].pt_pstr,"right" )==0) align=LR_RIGH;
  1086.  else if (strcmp(arg[3].pt_pstr,"centre")==0) align=LR_CENT;
  1087.  else
  1088.    {
  1089.     lr_err(&arg[3].pt_ps,"Expecting one of {left,right,centre}.");
  1090.     if (strcmp(arg[3].pt_pstr,"center")==0)
  1091.       {
  1092.        lr_mes(&arg[3].pt_ps,"Note: Centre is spelt centRE, not centER.");
  1093.        lr_mes(&arg[3].pt_ps,"      This is my revenge for years of getting error messages");
  1094.        lr_mes(&arg[3].pt_ps,"      from TeX whenever I accidentally wrote \\centreline - Ross Williams.");
  1095.       }
  1096.     lr_mes(&arg[3].pt_ps,"Directive ignored.");
  1097.     return;
  1098.    }
  1099.  
  1100.  /* Now make sure that the remainder of the line is delimited by quotes. */
  1101.  p_sot=arg[4].pt_pinl;
  1102.  p_eot=p_sot+strlen(p_sot)-1;
  1103.  if (*p_sot!='"' || *p_eot!='"' || p_sot==p_eot)
  1104.    {
  1105.     lr_err(&arg[4].pt_ps,"Text argument must be delimited by double quotes.");
  1106.     lr_mes(&arg[4].pt_ps,"Directive ignored.");
  1107.     return;
  1108.    }
  1109.  p_sot++; p_eot--;
  1110.  
  1111.  /* Ship out a token whose fields are all fully laden. */
  1112.  {
  1113.   tk_t token;
  1114.   token.tk_kind        = TK_TITL;
  1115.   ASSIGN(token.tk_ps,arg[0].pt_ps);
  1116.   token.tk_sc.sc_first = p_sol+ (3+(p_sot-arg[1].pt_pinl));
  1117.   token.tk_sc.sc_last  = p_sol+ (3+(p_eot-arg[1].pt_pinl));
  1118.   token.tk_sc.sc_white = FALSE;
  1119.   token.tk_gen         = LRFT_PACK*font+align;
  1120.   ls_add(token_list,PV &token);
  1121.  }
  1122.  return;
  1123.  
  1124.  help:
  1125.     lr_mes(&arg[0].pt_ps,
  1126.     "The correct format is: \"@t title <font> <align> <text>\".");
  1127.     lr_mes(&arg[0].pt_ps,
  1128.     "   where <font>  = titlefont | smalltitlefont | normalfont.");
  1129.     lr_mes(&arg[0].pt_ps,
  1130.     "   and   <align> = left | centre | right.");
  1131.     lr_mes(&arg[0].pt_ps,
  1132.     "   and   <text>  = text delimited by double quotes.");
  1133.     lr_mes(&arg[0].pt_ps,"Directive ignored.");
  1134.     return;
  1135. }
  1136.  
  1137. /******************************************************************************/
  1138.  
  1139. LOCAL void do_pgtyp P_((uword,p_pt_t));
  1140. LOCAL void do_pgtyp(numarg,arg)
  1141. /* Parse a typesetter pragma. */
  1142. uword numarg;
  1143. p_pt_t   arg;
  1144. {
  1145.  tr_k_t pragtyp;
  1146.  ps_t   psprag;
  1147.  
  1148.  /* Make sure that there are exactly three arguments. */
  1149.  if (numarg != 3)  /* "typesetter" "=" "name". */
  1150.    {
  1151.     lr_err(&arg[0].pt_ps,
  1152.            "This typesetter pragma has the wrong number of arguments.");
  1153.     goto help;
  1154.    }
  1155.  
  1156.  /* Make sure that the second argument is "=". */
  1157.  if (0 != strcmp(arg[2].pt_pstr,"="))
  1158.    {
  1159.     lr_err(&arg[2].pt_ps,"Expecting \"=\".");
  1160.     goto help;
  1161.    }
  1162.  
  1163.  /* Check the third argument. */
  1164.       if (strcmp(arg[3].pt_pstr,"none")==0) pragtyp=TR_NONE;
  1165.  else if (strcmp(arg[3].pt_pstr,"tex" )==0) pragtyp=TR_TEX;
  1166.  else
  1167.    {
  1168.     lr_err(&arg[3].pt_ps,"Expecting either \"none\" or \"tex\".");
  1169.     goto help;
  1170.    }
  1171.  
  1172.  /* Construct a shorthand for the start of the pragma. */
  1173.  ASSIGN(psprag,arg[0].pt_ps);
  1174.  
  1175.  /* Make sure that the pragma does not contradict an earlier pragma. */
  1176.  if (seentyp && (tr_codes != pragtyp))
  1177.    {
  1178.     sprintf(linet1,"This pragma is opposed by the pragma at line %lu.",
  1179.                    (unsigned long) psprag.ps_line);
  1180.     lr_mes(&ps_typ,linet1);
  1181.     sprintf(linet1,"This pragma opposes the pragma at line %lu.",
  1182.                    (unsigned long) ps_typ.ps_line);
  1183.     lr_err(&psprag,linet1);
  1184.     lr_mes(&psprag,"You can have as many typesetter pragmas as you like,");
  1185.     lr_mes(&psprag,"but they all have to be the same!");
  1186.     lr_mes(&psprag,"Pragma ignored.");
  1187.     return;
  1188.    }
  1189.  
  1190.  /* Success: Record the pragma information. */
  1191.  seentyp  = TRUE;       /* Record that we have seen a pragma. */
  1192.  tr_codes = pragtyp;    /* Record what the pragma said.       */
  1193.  ASSIGN(ps_typ,psprag); /* Record where the pragma was.       */
  1194.  return;
  1195.  
  1196.  help:
  1197.     lr_mes(&arg[0].pt_ps,
  1198.            "The correct format is: \"@p typesetter = none|tex\".");
  1199.     lr_mes(&arg[0].pt_ps,"Pragma ignored.");
  1200.     return;
  1201. }
  1202.  
  1203. /******************************************************************************/
  1204.  
  1205. LOCAL void do_pragma P_((p_ps_t,bool));
  1206. LOCAL void do_pragma(p_ps,is_typ)
  1207. /* Upon entry, the current character is:                                      */
  1208. /* is_typ=FALSE => The P of a @p.                                             */
  1209. /* is_typ=TRUE  => The T of a @t.                                             */
  1210. /* This function processes these contructs.                                   */
  1211. p_ps_t p_ps;
  1212. bool is_typ;
  1213. {
  1214. #define MAXPARG     10         /* Maximum recorded arguments to a pragma.     */
  1215. #define PRAGMA_MAX 100         /* Maximum length of a pragma.                 */
  1216.  char  praglin[PRAGMA_MAX+1];  /* Array to hold pragma as a complete line.    */
  1217.  char  pragstr[PRAGMA_MAX+1];  /* Array to hold pragma as strings.            */
  1218.  pt_t  pragarg[MAXPARG+1];     /* Array of pragma arguments.                  */
  1219.  uword length;                 /* Helps prevent scanning overrun.             */
  1220.  char  *p,*q;                  /* Temporary.                                  */
  1221.  uword numarg,na;              /* Number of arguments seen so far.            */
  1222.  
  1223.  /* Complain if the pragma directive is not at the start of a line. */
  1224.  if (p_ch-1 != p_sol)
  1225.    {
  1226.     if (is_typ)
  1227.       {
  1228.        lr_err(p_ps,"Typesetter directive @t must be at the start of a line.");
  1229.        lr_mes(p_ps,"The rest of this line will be ignored.");
  1230.       }
  1231.     else
  1232.       {
  1233.        lr_err(p_ps,"Pragma sequence @p must be at the start of a line.");
  1234.        lr_mes(p_ps,"The rest of this line will be ignored.");
  1235.       }
  1236.     skiptoeol();
  1237.     goto help;
  1238.    }
  1239.  
  1240.  /* The include command should be followed by a blank. Get the next char. */
  1241.  NEXTCH;
  1242.  
  1243.  /* Complain if the next character is not a blank. */
  1244.  if (ch != ' ')
  1245.    {
  1246.     /* Note: If we position this error correctly, it gets put after the */
  1247.     /*       help message!                                              */
  1248.     if (is_typ)
  1249.        lr_err(p_ps,"Typesetter directive @t must be followed by a blank.");
  1250.     else
  1251.        lr_err(p_ps,"Pragma sequence @p must be followed by a blank.");
  1252.     skiptoeol();
  1253.     goto help;
  1254.    }
  1255.  
  1256.  /* Copy the rest of the line to the pragma arrays. */
  1257.  NEXTCH;
  1258.  p = &praglin[0];
  1259.  q = &pragstr[0];
  1260.  length=0;
  1261.  while (ch!=EOL)
  1262.    {
  1263.     if (++length > PRAGMA_MAX-3)  /* 3 is for "@p " or "@t " */
  1264.       {
  1265.        if (is_typ)
  1266.          {
  1267.           lr_err(p_ps,"This typestter directive line is too long.");
  1268.           sprintf(linet1,"The maximum typesetter directive line length is %u characters.",
  1269.                      (unsigned) PRAGMA_MAX);
  1270.           lr_mes(p_ps,linet1);
  1271.          }
  1272.        else
  1273.          {
  1274.           lr_err(p_ps,"This pragma line is too long.");
  1275.           sprintf(linet1,"The maximum pragma line length is %u characters.",
  1276.                      (unsigned) PRAGMA_MAX);
  1277.           lr_mes(p_ps,linet1);
  1278.          }
  1279.        skiptoeol();
  1280.        goto help;
  1281.       }
  1282.     *p++=ch;
  1283.     *q++=ch;
  1284.     NEXTCH;
  1285.    }
  1286.  *p=EOS;
  1287.  *q=EOS;
  1288.  /* Note: Current position is now on the EOL at the end of the @p line. */
  1289.  /* That is the way we want to leave it for the scanspec() routine.     */
  1290.  
  1291.  /* So far we have copied the body of the pragma line into two arrays. The    */
  1292.  /* next lump of code parses that line into a sequence of non-blank arguments.*/
  1293.  /* The result is an array of pt_t objects each of which contains the         */
  1294.  /* position of each argument, a pointer to the first character of each       */
  1295.  /* argument in praglin, and also a pointer to a string containing the arg.   */
  1296.  /* The string resides in the array pragstr which is the same as praglin      */
  1297.  /* except that some blanks have been replaced by EOSs so as to allow us to   */
  1298.  /* point into it to form strings. All this probably seems rather overdone    */
  1299.  /* for the analysis of a "simple" pragma, but I have found that pulling the  */
  1300.  /* different kinds of pragma lines apart separately is very messy. Far       */
  1301.  /* better to suffer here in what is at least reasonably neat code than       */
  1302.  /* later in the specific pragma routines.                                    */
  1303.  numarg=0;
  1304.  p= &praglin[0];
  1305.  q= &pragstr[0];
  1306.  while (TRUE)
  1307.    {
  1308.     /* Skip whitespace between arguments. */
  1309.     while (*p==' ') {p++;q++;}
  1310.  
  1311.     /* Exit if we have hit the end of the line. */
  1312.     if ((numarg==MAXPARG) || (*p==EOS)) break;
  1313.  
  1314.     /* We have found another argument! */
  1315.     numarg++;
  1316.  
  1317.     /* Record the argument. */
  1318.     ASSIGN(pragarg[numarg].pt_ps,*p_ps);
  1319.     pragarg[numarg].pt_ps.ps_column=4+(p-praglin);
  1320.     pragarg[numarg].pt_pinl=p;
  1321.     pragarg[numarg].pt_pstr=q;
  1322.  
  1323.     /* Skip to the end of the argument. */
  1324.     while (*p!=' ' && *p!=EOS) {p++;q++;}
  1325.  
  1326.     /* Drop a null in the string array to complete string rep of argument. */
  1327.     *q=EOS;
  1328.    }
  1329.  
  1330.  /* At this point numarg is MIN(arguments,MAXPARG), and pragargs contains an  */
  1331.  /* entry for each of the numarg arguments.                                   */
  1332.  
  1333.  /* It is handy to have the position of the pragma itself handy. */
  1334.  ASSIGN(pragarg[0].pt_ps,*p_ps);
  1335.  
  1336.  /* CHECK: Make sure that the line and string arrays square up. */
  1337.  {
  1338.   uword i;
  1339.   for (i=1;i<=numarg;i++)
  1340.     {
  1341.      uword j;
  1342.      uword t=strlen(pragarg[i].pt_pstr);
  1343.      for (j=0;j<t;j++)
  1344.        {
  1345.         as_cold(pragarg[i].pt_pstr[j]==pragarg[i].pt_pinl[j],
  1346.                 "do_pragma: String and line arrays are not equal.");
  1347.         as_cold((pragarg[i].pt_pstr-pragstr)==(pragarg[i].pt_pinl-praglin),
  1348.                 "do_pragma: String and line arrays are out of synch.");
  1349.        }
  1350.     }
  1351.  }
  1352.  
  1353.  /* Complain if there are no arguments at all. */
  1354.  if (numarg==0)
  1355.    {
  1356.     if (is_typ)
  1357.        lr_err(p_ps,"Typesetter directive @t must be followed by a keyword.");
  1358.     else
  1359.        lr_err(p_ps,"Pragma sequence @p must be followed by a keyword.");
  1360.     skiptoeol();
  1361.     goto help;
  1362.    }
  1363.  
  1364.  /* Branch off to specific routines based on the first argument. */
  1365.  p=pragarg[1].pt_pstr; na=numarg;
  1366.  if (is_typ)
  1367.    {
  1368.     if (0==strcmp(p,"new_page"          )) {do_pgnpg(na,pragarg);return;}
  1369.     if (0==strcmp(p,"table_of_contents" )) {do_pgtoc(na,pragarg);return;}
  1370.     if (0==strcmp(p,"title"             )) {do_pgtit(na,pragarg);return;}
  1371.     if (0==strcmp(p,"vskip"             )) {do_pgvsk(na,pragarg);return;}
  1372.    }
  1373.  else
  1374.    {
  1375.     if (0==strcmp(p,"indentation"               )) {do_pgind(na,pragarg);return;}
  1376.     if (0==strcmp(p,"maximum_input_line_length" )) {do_pginl(na,pragarg);return;}
  1377.     if (0==strcmp(p,"maximum_output_line_length")) {do_pgotl(na,pragarg);return;}
  1378.     if (0==strcmp(p,"typesetter"                )) {do_pgtyp(na,pragarg);return;}
  1379.    }
  1380.  
  1381.  help:
  1382.  if (is_typ)
  1383.    {
  1384.     lr_err(p_ps,"Unrecognised typesetter directive. Legal ones are:");
  1385.     lr_mes(p_ps,"   @t new_page");
  1386.     lr_mes(p_ps,"   @t table_of_contents");
  1387.     lr_mes(p_ps,"   @t title <font> <align> <string>");
  1388.     lr_mes(p_ps,"   @t vskip <num> mm");
  1389.     lr_mes(p_ps,"The blanks between arguments are important.");
  1390.     lr_mes(p_ps,"Typesetter directive ignored.");
  1391.    }
  1392.  else
  1393.    {
  1394.     lr_err(p_ps,"Unrecognised pragma. Possible legal pragmas are:");
  1395.     lr_mes(p_ps,"   @p indentation = none | blank");
  1396.     lr_mes(p_ps,"   @p maximum_input_line_length  = <num>|infinity");
  1397.     lr_mes(p_ps,"   @p maximum_output_line_length = <num>|infinity");
  1398.     lr_mes(p_ps,"   @p typesetter = none | tex");
  1399.     lr_mes(p_ps,"The blanks between arguments are important.");
  1400.     lr_mes(p_ps,"Pragma ignored.");
  1401.    }
  1402. }
  1403.  
  1404. /******************************************************************************/
  1405.  
  1406. LOCAL void chksol P_((void));
  1407. LOCAL void chksol()
  1408. /* This function is called when the current character is the character after  */
  1409. /* an @. The function checks to see if the @ was at the start of a line and   */
  1410. /* issues a error message if it isn't.                                        */
  1411. {
  1412.  ps_t ps;
  1413.  grabchps(&ps);
  1414.  if (ps.ps_column != 2)
  1415.    {
  1416.     ps.ps_column--;
  1417.     sprintf(linet1,"@%c is legal only at the start of a line.",ch);
  1418.     lr_err(&ps,linet1);
  1419.    }
  1420. }
  1421.  
  1422. /******************************************************************************/
  1423.  
  1424. LOCAL void scanspec P_((void));
  1425. LOCAL void scanspec()
  1426. /* Upon entry the current character is the special character (usually '@').   */
  1427. /* The task is to scan the special sequence. Upon exit, the current character */
  1428. /* is the character following the special sequence.                           */
  1429. {
  1430.  ps_t  ps_spec;                   /* Position of start of special sequence.   */
  1431.  
  1432.  /* Make a note of where the special sequence starts. */
  1433.  grabchps(&ps_spec);
  1434.  
  1435.  /* Move onto the character following the special (escape) character. */
  1436.  NEXTCH;
  1437.  
  1438.  /* Now react to the character. In most cases, the special sequence is simply */
  1439.  /* a marker in the input and we can simply transmit it. The nasty special    */
  1440.  /* case sequences are left until the end of the switch statement.            */
  1441.  /* Purists will complain about how all the case options are hardwired and    */
  1442.  /* say that symbols should have been used. They once were, but were taken    */
  1443.  /* out when it was discovered that the symbols had cryptic names (because of */
  1444.  /* the portability eight-character rule) and were only used here anyway.     */
  1445.  switch (toupper(ch))
  1446.    {
  1447.     case '<': sendspec(&ps_spec,TK_ONAM,DONTCARE); break;
  1448.     case '>': sendspec(&ps_spec,TK_CNAM,DONTCARE); break;
  1449.     case '{': sendspec(&ps_spec,TK_ODEF,DONTCARE); break;
  1450.     case '}': sendspec(&ps_spec,TK_CDEF,DONTCARE); break;
  1451.     case '(': sendspec(&ps_spec,TK_OPAR,DONTCARE); break;
  1452.     case ')': sendspec(&ps_spec,TK_CPAR,DONTCARE); break;
  1453.     case ',': sendspec(&ps_spec,TK_COMA,DONTCARE); break;
  1454.     case '"': sendspec(&ps_spec,TK_QUOT,DONTCARE); break;
  1455.     case '/': sendspec(&ps_spec,TK_EMPH,DONTCARE); break;
  1456.     case 'A': sendspec(&ps_spec,TK_NSEC,1); chksol(); break;
  1457.     case 'B': sendspec(&ps_spec,TK_NSEC,2); chksol(); break;
  1458.     case 'C': sendspec(&ps_spec,TK_NSEC,3); chksol(); break;
  1459.     case 'D': sendspec(&ps_spec,TK_NSEC,4); chksol(); break;
  1460.     case 'E': sendspec(&ps_spec,TK_NSEC,5); chksol(); break;
  1461.     case '1': sendspec(&ps_spec,TK_PARM,1); break;
  1462.     case '2': sendspec(&ps_spec,TK_PARM,2); break;
  1463.     case '3': sendspec(&ps_spec,TK_PARM,3); break;
  1464.     case '4': sendspec(&ps_spec,TK_PARM,4); break;
  1465.     case '5': sendspec(&ps_spec,TK_PARM,5); break;
  1466.     case '6': sendspec(&ps_spec,TK_PARM,6); break;
  1467.     case '7': sendspec(&ps_spec,TK_PARM,7); break;
  1468.     case '8': sendspec(&ps_spec,TK_PARM,8); break;
  1469.     case '9': sendspec(&ps_spec,TK_PARM,9); break;
  1470.     case 'M': sendspec(&ps_spec,TK_MANY,DONTCARE); break;
  1471.     case 'Z': sendspec(&ps_spec,TK_ZERO,DONTCARE); break;
  1472.     case 'O': sendspec(&ps_spec,TK_FDEF,DONTCARE); chksol(); break;
  1473.     case '$': sendspec(&ps_spec,TK_MDEF,DONTCARE); chksol(); break;
  1474.     case EOL:
  1475.        lr_err(&ps_spec,"<special><endofline> is not a legal special sequence.");
  1476.        break;
  1477.     case ' ':
  1478.        lr_err(&ps_spec,"<special><space> is not a legal special sequence.");
  1479.        break;
  1480.     case '@':
  1481.        /* @ instructs FunnelWeb to replace the special construct with the */
  1482.        /* special character. Luckily one appears just before the @ !!     */
  1483.        /* Note: FALSE is OK because space is not a legal specialch.       */
  1484.        sendtext(&ps_spec,p_ch-1,p_ch-1,FALSE);
  1485.        break;
  1486.     case '-':
  1487.        /* - instructs FunnelWeb to suppress the following end of line. */
  1488.        if (*(p_ch+1) == EOL)
  1489.           NEXTCH
  1490.        else
  1491.           lr_err(&ps_spec,
  1492.                  "Suppress EOL sequence is legal only at the end of a line.");
  1493.        break;
  1494.     case '+':
  1495.        /* + instructs FunnelWeb to insert an EOL. We can't look to the end of */
  1496.        /* the previous line to find an EOL as this might be the first line.   */
  1497.        /* Running ahead to the end of the line is expensive, and having the   */
  1498.        /* liner mini-package maintain a variable for it would be extra        */
  1499.        /* housekeeping. Instead of all this, we just point to a static.       */
  1500.        {STAVAR char stateol = EOL;
  1501.         sendtext(&ps_spec,&stateol,&stateol,TRUE);}
  1502.        break;
  1503.     case '=':
  1504.       /* = instructs FunnelWeb to change the special character to the         */
  1505.       /* character following the <special>= sequence.                         */
  1506.       NEXTCH;
  1507.       if (ch == ' ')
  1508.         {
  1509.          lr_err(&ps_spec,"You cannot set the special character to <space>!");
  1510.          lr_mes(&ps_spec,"Special sequence ignored.");
  1511.         }
  1512.       else if (ch == EOL)
  1513.         {
  1514.          lr_err(&ps_spec,
  1515.                 "You cannot set the special character to <endofline>!");
  1516.          lr_mes(&ps_spec,"Special sequence ignored.");
  1517.         }
  1518.       else
  1519.          specialch=ch;
  1520.       break;
  1521.     case '!':
  1522.        /* ! instructs FunnelWeb to ignore the rest of the line (a comment). */
  1523.        skiptoeol();
  1524.        break;
  1525.     case 'I':
  1526.        /* i instructs FunnelWeb to include a file. */
  1527.        incl_fil(&ps_spec);
  1528.        break;
  1529.     case '^':
  1530.        /* ^ instructs FunnelWeb to insert a specific ascii character. */
  1531.        do_ascii(&ps_spec);
  1532.        break;
  1533.     case '#':
  1534.        /* # instructs FunnelWeb to transmit a two character name "#c". */
  1535.        do_name(&ps_spec);
  1536.        break;
  1537.     case 'P':
  1538.        /* P is used as a miscellaneous PRAGMA. */
  1539.        do_pragma(&ps_spec,FALSE);
  1540.        break;
  1541.     case 'T':
  1542.        /* T introduces a one-line typesetting directive. */
  1543.        do_pragma(&ps_spec,TRUE);
  1544.        break;
  1545.     default:
  1546.        lr_err(&ps_spec,"Unknown special sequence.");
  1547.        break;
  1548.    }
  1549.  
  1550.  /* The switch statment absorbs the special sequence and its effects.      */
  1551.  /* This NEXTCH places us on the character following the special sequence. */
  1552.  NEXTCH;
  1553. }
  1554.  
  1555. /******************************************************************************/
  1556.  
  1557. LOCAL void scantext P_((void));
  1558. LOCAL void scantext()
  1559. /* Upon entry, we know that the current character is not EOF and that it is   */
  1560. /* not the special character. Our task is to parse as much text as we can and */
  1561. /* ship it off as a text token. The scanner will probably spend most of its   */
  1562. /* time in the loops in this function so it is important that they be         */
  1563. /* efficient. That is why two loops are used to deal with detecting           */
  1564. /* whitespace rather than a flag.                                             */
  1565. /* Upon return, the current character is the character following the text     */
  1566. /* sequence. This is guaranteed to be the special character or an EOF.        */
  1567. {
  1568.  ps_t ps_start;        /* Position of first character of text sequence.       */
  1569.  char *p_first = p_ch; /* Pointer  to first character of text sequence.       */
  1570.  
  1571.  /* Grab a copy of the position of this token. */
  1572.  grabchps(&ps_start);
  1573.  
  1574.  /* Scan whitespace. */
  1575.  while (ch==' ' || ch==EOL)
  1576.     NEXTCH;
  1577.  
  1578.  /* If we hit something that ends a text token */
  1579.  /* then we can transmit a white text token.   */
  1580.  if (ch==specialch || ch==EOFCH)
  1581.     {sendtext(&ps_start,p_first,p_ch-1,TRUE); return;}
  1582.  
  1583.  /* Otherwise we have some more (non-white) text to scan. */
  1584.  /* We can then send a non-white text token.              */
  1585.  while (ch!=specialch && ch!=EOFCH)
  1586.     NEXTCH;
  1587.  sendtext(&ps_start,p_first,p_ch-1,FALSE);
  1588. }
  1589.  
  1590. /******************************************************************************/
  1591.  
  1592. LOCAL void scan_file(p_fname)
  1593. /* This function scans a single file. It's argument is the name of the file   */
  1594. /* to be scanned. scan_file calls the mapper to map in the file and then      */
  1595. /* scans the text of the mapped file using the liner mini-package. The result */
  1596. /* of the scan is additions to the line and token list, and diagnostics sent  */
  1597. /* to the lister package. If an include directive is encountered, this        */
  1598. /* function is called recursively.                                            */
  1599. char *p_fname;
  1600. {
  1601.  char  *p_mapped;  /* Pointer to the mapped file.                             */
  1602.  ulong  length;    /* Number of bytes in the mapped file.                     */
  1603.  char  *errstr;    /* Error string returned by mapper.                        */
  1604.  bool   addedeol;  /* Did we have to add an EOL to the end of the last line?  */
  1605.  
  1606.  /* Check to see if the file exists. */
  1607.  if (!fexists(p_fname))
  1608.    {
  1609.     if (inclevel==0)
  1610.       {
  1611.        /* Failure to find the main file is a severe error. */
  1612.        if (option.op_b7_b)
  1613.           sprintf(linet1,"S: Error opening input file \"%s\".",SUPPNAME);
  1614.        else
  1615.           sprintf(linet1,"S: Error opening input file \"%s\".",p_fname);
  1616.        wl_l(linet1);
  1617.        /* Although strictly speaking we should suppress this error from the   */
  1618.        /* screen stream unless option.op_s_b is set, absence of an input file */
  1619.        /* is such an important error, that we write it out anyway.            */
  1620.        /* if (option.op_s_b) */
  1621.        wl_sj(linet1);
  1622.        num_sev++;
  1623.        return;
  1624.       }
  1625.     else
  1626.       {
  1627.        /* Failure to find an include file is an ordinary error. */
  1628.        ps_t ps;
  1629.        ps.ps_line   = globalno;
  1630.        ps.ps_column = 4;
  1631.        lr_err(&ps,"Error opening include file.");
  1632.        if (option.op_b7_b)
  1633.           sprintf(linet1,
  1634.              "The include file's expanded name was \"%s\".",SUPPNAME);
  1635.        else
  1636.           sprintf(linet1,
  1637.              "The include file's expanded name was \"%s\".",p_fname);
  1638.        lr_mes(&ps,linet1);
  1639.        return;
  1640.       }
  1641.    }
  1642.  
  1643.  /* Map the specified file into memory. We need to change from the scanner    */
  1644.  /* clock to the mapper clock to keep the time accounting correct here.       */
  1645.  ck_stop(p_scan);
  1646.  ck_start(p_mapp);
  1647.  errstr=map_file(p_fname,&p_mapped,&length);
  1648.  ck_stop(p_mapp);
  1649.  ck_start(p_scan);
  1650.  
  1651.  /* Abort if the mapping was not possible. */
  1652.  if (errstr != NULL)
  1653.     if (inclevel==0)
  1654.       {
  1655.        /* Failure to map the main file is a severe error. */
  1656.        if (option.op_b7_b)
  1657.           sprintf(linet1,"S: Error reading input file \"%s\".",SUPPNAME);
  1658.        else
  1659.           sprintf(linet1,"S: Error reading input file \"%s\".",p_fname);
  1660.        wl_l(linet1); if (option.op_s_b) wl_sj(linet1);
  1661.        wl_l(errstr); if (option.op_s_b) wl_sj(errstr);
  1662.        num_sev++;
  1663.        return;
  1664.       }
  1665.     else
  1666.       {
  1667.        /* Failure to find an include file is an ordinary error. */
  1668.        ps_t ps;
  1669.        ps.ps_line   = globalno;
  1670.        ps.ps_column = 4;
  1671.        lr_err(&ps,"Error reading include file.");
  1672.        lr_mes(&ps,errstr);
  1673.        if (option.op_b7_b)
  1674.           sprintf(linet1,"The include file's expanded name was \"%s\".",
  1675.                   SUPPNAME);
  1676.        else
  1677.           sprintf(linet1,"The include file's expanded name was \"%s\".",
  1678.                   p_fname);
  1679.        lr_mes(&ps,linet1);
  1680.        return;
  1681.       }
  1682.  
  1683.  /* Dump the mapped file if requested. */
  1684.  if (option.op_b1_b)
  1685.    {
  1686.     if (option.op_b7_b)
  1687.        sprintf(linet1,"Dump of mapped file \"%s\".",SUPPNAME);
  1688.     else
  1689.        sprintf(linet1,"Dump of mapped file \"%s\".",p_fname);
  1690.     wl_l(linet1);
  1691.     dm_mem(&f_l,p_mapped,length);
  1692.    }
  1693.  
  1694.  /* If the file is absolutely empty, we have to warn the user. Also, this is  */
  1695.  /* a special case we can do without, and so we return here if file is empty. */
  1696.  if (length==0)
  1697.    {
  1698.     ps_t ps;
  1699.     /* The empty file could be the main file or an include file.              */
  1700.     /* If the empty file is the main file, we want the diagnostic to point to */
  1701.     /*    the EOF marker which will appear as line 1.                         */
  1702.     /* If the empty file is an include file, we wish to point the diagnostic  */
  1703.     /*    to the line containing the include command. This is globalno.       */
  1704.     /* In both cases, we want the diagnostic to point to column 1.            */
  1705.     ps.ps_column=1;
  1706.     if (inclevel==0)
  1707.       {
  1708.        ps.ps_line=1;
  1709.        lr_war(&ps,"Input file is empty (not a byte in syte)!");
  1710.       }
  1711.     else
  1712.       {
  1713.        ps.ps_line=globalno;
  1714.        lr_war(&ps,"Include file is empty (not a byte in syte)!");
  1715.       }
  1716.     return;
  1717.    }
  1718.  
  1719.  /* Scanning is considerably simplified if we can guarantee that we will not  */
  1720.  /* run into an EOF without first hitting an EOL. The following code takes    */
  1721.  /* care of this by tacking one on the end if necessary and also adds an      */
  1722.  /* EOF character on the end, which also simplifies the scanning. We can get  */
  1723.  /* away with all this because the mapper purposefully leaves at least two    */
  1724.  /* bytes free for us at the end of the mapped file.                          */
  1725.  addedeol=FALSE;
  1726.  if (p_mapped[length-1] != EOL)
  1727.     {p_mapped[length++]=EOL; addedeol=TRUE;}
  1728.  p_mapped[length]=EOFCH;
  1729.  
  1730.  /* Initialize the variables "instantiated over a single file". */
  1731.  inln_max  = 80;
  1732.  specialch = CH_DSPE;
  1733.  localno   = 0;
  1734.  p_eof     = &p_mapped[length];
  1735.  
  1736.  /* Crank up the line subscanner system with a call to prepline. */
  1737.  /* Then enter the main scanning loop.                           */
  1738.  /* All input consists of alternating special and text sequences */
  1739.  /* terminated by EOF.                                           */
  1740.  prepline(p_mapped);
  1741.  while (ch!=EOFCH)
  1742.     if (ch==specialch)
  1743.        scanspec();
  1744.     else
  1745.        scantext();
  1746.  
  1747.  /* Now that we are at the end of the scanned file and the scanning markers   */
  1748.  /* are all sitting on the end of the file, it is a good time to issue        */
  1749.  /* diagnostics about problems at the end of the file.                        */
  1750.  if (addedeol)
  1751.    {
  1752.     ps_t ps;
  1753.     /* We want the diagnostic to point to the EOF line. Hence "global+1".     */
  1754.     ps.ps_line   = globalno+1;
  1755.     ps.ps_column = 1;
  1756.     if (inclevel==0)
  1757.        lr_war(&ps,"The last line of the input file was terminated by EOF.");
  1758.     else
  1759.        lr_war(&ps,"The last line of the include file was terminated by EOF.");
  1760.     lr_mes(&ps,"An EOL was inserted at the end of the last line.");
  1761.    }
  1762. }
  1763.  
  1764. /******************************************************************************/
  1765.  
  1766. EXPORT void scanner(p_amapp,p_ascan)
  1767. /* This is the scanner's main routine and the only exported function.         */
  1768. p_ck_t p_amapp; /* Mapper's clock (stopped).  */
  1769. p_ck_t p_ascan; /* Scanner's clock (running). */
  1770. {
  1771.  /* Copy the arguments into globals where we can get at them. */
  1772.  p_mapp=p_amapp;
  1773.  p_scan=p_ascan;
  1774.  
  1775.  /* Apart from diagnostic messages sent to the lister, the only output of     */
  1776.  /* the scanner is two global lists holding a list of lines and a list of     */
  1777.  /* tokens. The scanner creates these lists simultaneously.                   */
  1778.  /* We have to initialize them here before we get into 'scan_file' which      */
  1779.  /* calls itself recursively if an include file command is encountered.       */
  1780.  line_list =ls_cre(sizeof(ln_t));
  1781.  token_list=ls_cre(sizeof(tk_t));
  1782.  
  1783.  /* Initialize all the variables instantiated throughout the entire scan.     */
  1784.  globalno  = 0;
  1785.  inclevel  = 0;
  1786.  seenind   = FALSE;
  1787.  seentyp   = FALSE;
  1788.  seenlimo  = FALSE;
  1789.  
  1790.  /* We also have to initialize localno in case the input file is empty and    */
  1791.  /* it never gets initialized before being sucked into being used as the      */
  1792.  /* local number for the end of file marker.                                  */
  1793.  localno=0;
  1794.  
  1795.  /* Initialize the global indentation flag to the default value. */
  1796.  tgindent=TRUE;
  1797.  
  1798.  /* Initialize the global product line length limit to the default value. */
  1799.  tglinmax=80;
  1800.  
  1801.  /* Initialize the global typesetter flag to the default value. */
  1802.  tr_codes=TR_NONE;
  1803.  
  1804.  /* Scan the top level file whose name is obtained from the command line.     */
  1805.  as_cold(option.op_f_b,"scanner: -F!!!!");
  1806.  
  1807.  /* Work out what the input file name should be. */
  1808.  {
  1809.   fn_t fname;
  1810.   strcpy(fname,"");              /* Start with an empty string.               */
  1811.   fn_ins(fname,".fw");
  1812.   fn_ins(fname,option.op_f_s);
  1813.   scan_file(fname);
  1814.  }
  1815.  
  1816.  /* The scan_file function scans the main input file and all of its included  */
  1817.  /* files, but it does not append a TK_EOF token to the end. This call does   */
  1818.  /* this and also adds a line to the line list for EOF.                       */
  1819.  add_eof();
  1820. }
  1821.  
  1822. /******************************************************************************/
  1823. /*                              End of SCANNER.C                              */
  1824. /******************************************************************************/
  1825.