Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / unix / volume26 / funnlweb / part17 < prev next >

Wrap

Text File | 1993-04-10 | 71.0 KB | 1,873 lines

Newsgroups: comp.sources.unix From: ross@spam.adelaide.edu.au (Ross Williams) Subject: v26i137: funnelweb - a tool for literate programming in C, Part17/20 Sender: unix-sources-moderator@vix.com Approved: paul@vix.com Submitted-By: ross@spam.adelaide.edu.au (Ross Williams) Posting-Number: Volume 26, Issue 137 Archive-Name: funnelweb/part17 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 17 (of 20)." # Contents: sources/scanner.c # Wrapped by vixie@gw.home.vix.com on Sun Apr 11 11:00:33 1993 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'sources/scanner.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'sources/scanner.c'\" else echo shar: Extracting \"'sources/scanner.c'\" $69225 characters$ sed "s/^X//" >'sources/scanner.c' <<'END_OF_FILE' X/*############################################################################## X XFUNNNELWEB COPYRIGHT X==================== XFunnelWeb is a literate-programming macro preprocessor. X Copyright (C) 1992 Ross N. Williams. X X Ross N. Williams X ross@spam.adelaide.edu.au X 16 Lerwick Avenue, Hazelwood Park 5066, Australia. X This program is free software; you can redistribute it and/or modify it under the terms of Version 2 of the GNU General Public License as published by the Free Software Foundation. X This program is distributed WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See Version 2 of the GNU General Public License for more details. X You should have received a copy of Version 2 of the GNU General Public License along with this program. If not, you can FTP the license from prep.ai.mit.edu/pub/gnu/COPYING-2 or write to the Free Software XFoundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. X Section 2a of the license requires that all changes to this file be recorded prominently in this file. Please record all changes here. X Programmers: X RNW Ross N. Williams ross@spam.adelaide.edu.au X Changes: X 07-May-1992 RNW Program prepared for release under GNU GPL V2. X X##############################################################################*/ X X X/******************************************************************************/ X/* SCANNER.C */ X/******************************************************************************/ X/* */ X/* Introduction */ X/* ------------ */ X/* The FunnelWeb scanner is a little messy because it deals with two */ X/* structures at the same time while attempting to be efficient. On the one */ X/* hand it is busy constructing the line list. This means that it has to keep */ X/* an eye out for end of line characters ('\n'=EOL) so that it can add a line */ X/* record whenever it sees one. On the other hand, it has to scan the input */ X/* file into a token stream consisting of text tokens and special tokens */ X/* which usually have no regard for end of lines. It is tempting to divide */ X/* these two functions up (into perhaps a LINER and a TOKENIZER). However, */ X/* the presence of the include file facility would make this messy. Also, the */ X/* tokenizer has to count end of line markers so that it can generate */ X/* correctly positioned diagnostics. */ X/* */ X/* The long and short of it all is that the best way to do the scanning seems */ X/* to be to run a liner and a tokenizer as parallel layers. The liner */ X/* extracts characters from the input file and hands them to the tokenizer. */ X/* It also keeps an eye out for newline characters, sending a line record off */ X/* whenever it sees one, and counting lines. The tokenizer receives the */ X/* characters from the liner and performs the tokenize operation. */ X/* */ X/* Notes */ X/* ----- */ X/* - Currently FunnelWeb recognises only two characters as whitespace. */ X/* These are ' ' and EOL. */ X/* */ X/******************************************************************************/ X X#include <ctype.h> X#include <limits.h> X#include "style.h" X X#include "as.h" X#include "clock.h" X#include "data.h" X#include "dump.h" X#include "list.h" X#include "lister.h" X#include "machin.h" X#include "mapper.h" X#include "memory.h" X#include "misc.h" X#include "option.h" X#include "scanner.h" X X/******************************************************************************/ X X/* The "special" character is the character that is used to introduce a */ X/* "special sequence". FunnelWeb allows the user to change this character so */ X/* as to cater for documents where the "default" character is common. This */ X/* definition defines what the default character is. */ X#define CH_DSPE ('@') X X/* FunnelWeb allows include files which are handled by the scanner by placing */ X/* recursive calls to scan_file. A maximum is placed on the level of nested */ X/* includes. This acts as a good sanity check as well as catching recursive */ X/* include files which are never a sensible construct in FunnelWeb as */ X/* FunnelWeb does not provide any conditional construct. */ X#define MAX_INCL (10) X X/* FunnelWeb is very conservative about what characters it will allow in its */ X/* input and output files. Currently the only characters allowed are */ X/* printables and end of lines. When FunnelWeb does spot an illegal character */ X/* it needs to be able to draw the user's attention to the character. The */ X/* best way to do this is to point to it in the listing file. However, if the */ X/* character is banned, it cannot appear in the listing file! The problem is */ X/* solved by having the scanner replace all illegal characters in each mapped */ X/* file by the following character. This eliminates further problems. */ X#define CENSORCH ('?') X X/* Following the Unix convention, mapped in files are not terminated with an */ X/* end-of-file character. However, the presence of such a character at the */ X/* end of the mapped file simplifies scanning and so we add one. This */ X/* definition defines what the character is to be. It doesn't matter what the */ X/* character is, so long as it cannot legally appear in the file. A control */ X/* character is a good choice as these are filtered out by the liner (see */ X/* above). */ X/* We undef EOF (from <stdio.h>) because it is too dangerously close to EOFCH.*/ X/* (EOF wasn't redefined as that might confuse readers used to <stdio.h>. */ X/* However, we still use EOF as an acronym for End Of File. */ X#define EOFCH (26) X#undef EOF X X/* Tokens have a field for a general attribute which has meaning for some */ X/* token kinds. For other kinds, it has no meaning. This constant is used to */ X/* indicate a "don't care" value. */ X#define DONTCARE 0 X X/* A nominal maximum value for the maximum length of an input line. */ X#define INMAXINF (ULONG_MAX) X X/******************************************************************************/ X X/* The following type is used in the suite of pragma routines for parsing. */ typedef X struct X { X ps_t pt_ps; /* Position of the start of this argument. */ X char *pt_pstr; /* Pointer to a string containing the argument. */ X char *pt_pinl; /* Pointer to first byte of the argument in commndline. */ X } pt_t; typedef pt_t *p_pt_t; X X/******************************************************************************/ X X /* Variables Instantiated Over The Entire Scan */ X /* ------------------------------------------- */ LOCVAR p_ck_t p_mapp; /* Pointer to mapper's clock. */ LOCVAR p_ck_t p_scan; /* Pointer to scanner's clock. */ LOCVAR ulong globalno; /* Global line number of line being scanned. */ LOCVAR ulong inclevel; /* Include level of current file. Top file is zero. */ LOCVAR bool seenind; /* TRUE iff we have seen an indentation pragma. */ LOCVAR ps_t ps_ind; /* seenind==TRUE => ps_ind is position of pragma. */ LOCVAR bool seentyp; /* TRUE iff we have seen a typesetter pragma. */ LOCVAR ps_t ps_typ; /* seentyp==TRUE => ps_typ is position of pragma. */ LOCVAR bool seenlimo; /* TRUE iff we have seen an out lin len limit pragma. */ LOCVAR ps_t ps_limo; /* seenlimo==TRUE => ps_limo is position of pragma. */ X X /* Variables Instantiated Over The Current File */ X /* -------------------------------------------- */ LOCVAR ulong inln_max; /* Maximum permitted length of an input line. */ LOCVAR char specialch; /* Current special (escape) character. */ LOCVAR char *p_eof; /* Pointer to EOFCH byte at the end of current file. */ LOCVAR ulong localno; /* Local line number of line being scanned. */ X X /* Variables Instantiated Over The Current Line */ X /* -------------------------------------------- */ LOCVAR char *p_sol; /* Pointer to Start (first char) Of current Line. */ LOCVAR char *p_ch; /* Pointer to current character in current line. */ LOCVAR char ch; /* *p_ch. */ X X/******************************************************************************/ X/* Line Processing Layer */ X/******************************************************************************/ X/* */ X/* This mini-section contains the two routines (prepline and NEXTCH) that */ X/* take care of the line based-scanning and feed characters to the */ X/* token-based scanner routines which have the top level of control. */ X/* After mapping in a file to be read, place a call to prepline passing the */ X/* address of the first byte of the mapped file as an argument. At that */ X/* point the current position will be the first byte on the first line and */ X/* the "variables instantiated over the current line" will be well defined. */ X/* Calls to NEXTCH then move the position through the mapped file one byte at */ X/* a time, stopping at the end of file at which point calls will not move the */ X/* marker which will point to the EOF character. */ X/* */ X/******************************************************************************/ X LOCAL void prepline P_((char *)); LOCAL void prepline(p_line) X/* This function should be called at the end of each line to prepare the next */ X/* line for scanning. The user of the liner mini-package should place a */ X/* single call to this function at the start of scanning a mapped file. */ X/* The user should then place calls to NEXTCH (which calls prepline when */ X/* necessary). */ X/* This function serves two purposes: */ X/* 1. It looks at the next line and converts all non-printables into */ X/* CENSORCH and issues errors for each non-printable. */ X/* 2. It initializes the line scanning variables for the next line. */ X/* The argument is a pointer to the first byte of the next line. */ char *p_line; X{ X char *p; /* Scans through the line and winds up sitting on the EOL. */ X X /* Test to see if the "line" we have been given is the end of file marker. */ X /* We have to be careful here because the byte we are using to mark the end */ X /* of file could appear as an illegal unprintable. This is the reason for */ X /* the test p_line==p_eof. */ X if (*p_line==EOFCH && p_line==p_eof) X { X /* The line we have to process is in fact the end of file marker. */ X p_sol = p_line; X p_ch = p_line; X ch = EOFCH; X return; X } X X /* At this point we know that we are faced with a run of bytes terminated by */ X /* an EOL character (we know this cos we put an EOL before EOF earlier on). */ X /* We know that we have a line, so we can now bump up the line counters. */ X globalno++; X localno++; X X /* Run through the line checking for non-printables and issuing errors. */ X p = p_line; X while (*p != EOL) X { X /* The following test tests to see if the character is a printable in */ X /* seven bit ascii. FunnelWeb is not currently designed to work with */ X /* any character set other than seven-bit ascii and so we flag and */ X /* convert all out-of-range characters here before they are exposed to */ X /* the rest of the scanner code which assumes that each line that it is */ X /* handed consists entirely of printables except for the EOL char on the */ X /* end and possibly an EOF char at the "Start" of a line. */ X /* In particular, the NEXTCH macro will fail on machines with siged */ X /* chars if non-printables are not removed. It goes into an infinite */ X /* loop. */ X /* Note: I don't use library function "isprint" here because on the vax */ X /* it's definition is too loose (seems to accept characters with the top */ X /* bit set as printable). */ X if (!isascprn(*p)) /* If not a printable character. */ X { X ps_t ps; X char c = *p; X ubyte_ uc = *((ubyte_ *) p); X ps.ps_line = globalno; X ps.ps_column = p-p_line+1; X if (strlen(chabbrev(c))==0) X sprintf(linet1, X "Non printable character (Sym=<none>, Dec=%03u, Hex=%02X, Oct=%03o).", X (unsigned) uc,(unsigned) uc,(unsigned) uc); X else X sprintf(linet1, X "Non printable character (Sym=%s, Dec=%03u, Hex=%02X, Oct=%03o).", X chabbrev(c),(unsigned) uc,(unsigned) uc,(unsigned) uc); X lr_err(&ps,linet1); X *p=CENSORCH; X } X p++; X } X /* Assert: p_line points to the start of the current line. */ X /* Assert: p points to the EOL at the end of the current line. */ X X /* Check that the line is not too long. */ X if ((p-p_line)>inln_max) X { X ps_t ps; X ps.ps_line = globalno; X ps.ps_column = inln_max+1; X lr_err(&ps,"Input line is too long (this character is the first offender)."); X sprintf(linet1,"Currently, the maximum allowable input line length is %lu.", X (unsigned long) inln_max); X lr_mes(&ps,linet1); X lr_mes(&ps,"Note: You can change this using a pragma directive (@p)."); X } X X /* Now check for trailing spaces. */ X if ((p != p_line) && (*(p-1) == ' ')) X { X ps_t ps; X ps.ps_line = globalno; X ps.ps_column = p-p_line; X lr_war(&ps,"Line has trailing spaces up to and including this space."); X } X X /* Construct a line record and append the record to the line list. */ X /* Note that the line scrap encompasses the trailing EOL. */ X { X ln_t line; X line.ln_global = globalno; X line.ln_local = localno; X line.ln_body.sc_first = p_line; X line.ln_body.sc_last = p; X /* Note: We do not set sc_white as it is not used in lines. */ X ls_add(line_list,PV &line); X } X X /* Finally, set the line scanning variables to the start of the line. */ X /* We can't do this earlier in case the start of the line was a */ X /* non-printable and got substituted (ch might pick it up). */ X p_sol = p_line; X p_ch = p_line; X ch = *p_line; X X} /* End of prepline. */ X X/* NEXTCH can be called continuously after an initializing call to prepline. */ X/* After a call to NEXTCH, p_sol, p_ch, ch are all well-defined. p_sol points */ X/* to the start of the current line, p_ch points to the current character, */ X/* and ch contains *p_ch. NEXTCH can be called repeatedly forever. When it */ X/* hits the EOF character, it sticks on it and returns it forever. */ X/* Note: The "ch<' '" is an optimized form of "(ch==EOL)||(ch=EOFCH)". Speed */ X/* is very important here as this macro is called in scanning tightloops. */ X/* This line of code is a little tricky so read it carefully. */ X/* WARNING: The ch<' ' will cause an infinite loop if a character appears */ X/* that satisfies this condition without being EOF or EOL (e.g. a control */ X/* char (meant to be filtered out earlier) or a top-bit-set character on */ X/* machines with signed character type. */ X#define NEXTCH {if (ch<' ') {if (ch==EOL) prepline(p_ch+1);} else ch= *++p_ch;} X X/******************************************************************************/ X/* Scanner Support Routines */ X/******************************************************************************/ X LOCAL ps_t *psofch P_((void)); LOCAL ps_t *psofch() X/* Returns a pointer to an internal static ps structure holding the line and */ X/* column number of the current character ch. */ X{ X STAVAR ps_t chps; X chps.ps_line = globalno; X chps.ps_column = p_ch-p_sol+1; X return &chps; X} X X/******************************************************************************/ X LOCAL void grabchps P_((p_ps_t)); LOCAL void grabchps(p_ps) X/* Writes the position of the current ch into the argument position struct. */ p_ps_t p_ps; X{ X p_ps->ps_line = globalno; X p_ps->ps_column = p_ch-p_sol+1; X} X X/******************************************************************************/ X LOCAL void sendspec P_((p_ps_t,tk_k_t,ubyte)); LOCAL void sendspec(p_tkps,tk_kind,tk_gen) X/* Appends a non-text token of kind tk_kind to the end of the token list. */ X/* p_ps is a pointer to a position structure giving the position of the */ X/* first character of the token. tk_gen is the general token attribute. */ p_ps_t p_tkps; tk_k_t tk_kind; ubyte tk_gen; X{ X tk_t token; X token.tk_kind = tk_kind; X ASSIGN(token.tk_ps,*p_tkps); X token.tk_sc.sc_first = NULL; X token.tk_sc.sc_last = NULL; X token.tk_sc.sc_white = TRUE; X token.tk_gen = tk_gen; X ls_add(token_list,PV &token); X} X X/******************************************************************************/ X LOCAL void sendtext P_((p_ps_t,char *,char *,bool)); LOCAL void sendtext(p_tkps,p_first,p_last,is_white) X/* Appends a text token to the end of the token list. */ X/* IN: p_ps is a pointer to a position structure giving the position of the */ X/* first character of the token. */ X/* IN: p_first and p_last point to the first and last byte of the text scrap. */ X/* IN: is_white should be set to TRUE iff scrap is entirely whitespace. */ p_ps_t p_tkps; char *p_first; char *p_last; bool is_white; X{ X tk_t token; X X /* Empty text scraps should never be generated. */ X as_cold(p_first<=p_last,"sendtext: Text scrap bounds are bad."); X X /* If ch=EOL then we should be scanning more text, not shipping it! */ X as_cold(ch!=EOL,"senttext: Shipping text while still more to scan."); X X /* Send the text token. */ X token.tk_kind = TK_TEXT; X ASSIGN(token.tk_ps,*p_tkps); X token.tk_sc.sc_first = p_first; X token.tk_sc.sc_last = p_last; X token.tk_sc.sc_white = is_white; X token.tk_gen = DONTCARE; X ls_add(token_list,PV &token); X} X X/******************************************************************************/ X LOCAL void add_eof P_((void)); LOCAL void add_eof() X/* This function adds terminators to the line and token list. */ X/* 1. It adds a TK_EOF token to the end of the token list. */ X/* 2. It adds a visible <eof> line to the end of the line list. */ X/* This assists the parser by allowing it to point diagnostic messages to a */ X/* visible EOF marker rather than pointing vaguely to the end of the last */ X/* line of the input file which (by the way) may not even exist! */ X{ X STAVAR char *eofstr = "<End-Of-File>\n"; X ln_t line; X ps_t ps; X X /* When the liner mini package encounters an end of file marker, it stops */ X /* dead on the marker and returns EOFCH forever. scan_file() eventually gets */ X /* the message and drops out. However, in all of this, the line numbers are */ X /* not incremented to indicate that we have moved to an EOF line. This is */ X /* intended, as we do not want EOFs to appear in the listing for include */ X /* files; only at the end of the main input file. Thus, here we effectively */ X /* perform the liner function of moving from the last line of the input file */ X /* to the imaginary line containing the EOF marker. This is done by */ X /* incrementing the line numbers. Note that the fact that these line number */ X /* variables are incorrect from the point of detection of the final EOF to */ X /* here doesn't matter as no tokens or diagnostics are ever added after an */ X /* EOF is detected. */ X globalno++; X localno++; X X /* Add a line to represent the EOF marker. */ X line.ln_global = globalno; X line.ln_local = localno; X line.ln_body.sc_first = eofstr; X line.ln_body.sc_last = eofstr+strlen(eofstr)-1; X /* Note: We do not set sc_white as it is not used in lines. */ X ls_add(line_list,PV &line); X X /* Add a TK_EOF token to the end of the token list. */ X ps.ps_line = globalno; X ps.ps_column = 1; X sendspec(&ps,TK_EOF,DONTCARE); X} X X/******************************************************************************/ X/* The Scanner Proper */ X/******************************************************************************/ X LOCAL void skiptoeol P_((void)); LOCAL void skiptoeol() X{ X while (ch != EOL) X NEXTCH; X} X X/******************************************************************************/ X X/* The incl_fil function calls this, so we have to declare it in advance. */ LOCAL void scan_file P_((char *)); X LOCAL void incl_fil P_((p_ps_t)); LOCAL void incl_fil(p_ps) X/* Upon entry, the current character is the "i" of an "@i" sequence. Our task */ X/* is first to see if the sequence occurred at the start of a line (the only */ X/* point at which it is legal) and issue an error if it isn't. If it is legal,*/ X/* we have to read in the specified file and scan that. The included file */ X/* replaces exactly the line starting with the "@i" command and we return */ X/* to the "calling" file with the current position being the EOL character of */ X/* the include line. */ p_ps_t p_ps; X{ X /* Complain if the include directive was not at the start of a line. */ X if (p_ch-1 != p_sol) X { X lr_err(p_ps,"Include sequence must be at the beginning of a line."); X lr_mes(p_ps,"Include ignored."); X skiptoeol(); X return; X } X X /* The include command should be followed by a blank. Get the next char. */ X NEXTCH; X X /* Complain if the next character is not a blank. */ X if (ch != ' ') X { X ps_t ps; X ASSIGN(ps,*p_ps); X ps.ps_column+=2; X lr_err(&ps,"Include sequence (@i) must be followed by a blank."); X lr_mes(&ps,"Example include: @i macros.fwi"); X lr_mes(&ps,"Include ignored."); X skiptoeol(); X return; X } X X /* Complain if the include level is too high. */ X if (inclevel == MAX_INCL) X { X lr_err(p_ps,"This include file is nested too deeply. It's probably recursive."); X sprintf(linet1,"The maximum level of nested includes is %u.", X (unsigned) MAX_INCL); X lr_mes(p_ps,linet1); X lr_mes(p_ps,"Include ignored."); X skiptoeol(); X return; X } X X {/* This construct does the work of the include. */ X /* Warning: The following variables MUST be declared automatic. */ X char *p_filename; X char *p_tempname; X ulong length; X char *p; X ulong xinln_max; X char xspecial; X char *xp_eof; X ulong xlocalno; X char *xp_sol; X char *xp_ch; X char xch; X X /* We save stack space by sticking this filename in the heap. */ X p_filename=mm_temp((size_t) FILENAME_MAX+1+10); /* 10 is for paranoia. */ X p_tempname=mm_temp((size_t) FILENAME_MAX+1+10); /* 10 is for paranoia. */ X X /* The rest of the line is supposed to hold a filename. Copy it. */ X NEXTCH; X p=p_tempname; X length=0; X while (ch!=EOL) X { X if (++length > FILENAME_MAX) X { X lr_err(p_ps, X "This include command's file specification is too long."); X if (option.op_b7_b) X sprintf(linet1,"The maximum file name length is %s characters.", X SUPPVAL); X else X sprintf(linet1,"The maximum file name length is %u characters.", X (unsigned) FILENAME_MAX); X lr_mes(p_ps,linet1); X lr_mes(p_ps,"Include ignored."); X skiptoeol(); X return; X } X *p++=ch; X NEXTCH; X } X *p=EOS; X /* Note: Current position is now on the EOL at the end of the @i line. */ X X /* Complain if the user has not specified a filename. */ X if (strlen(p_tempname) ==0) X { X lr_err(psofch(),"Expecting the name of a file to include."); X return; X } X X /* Perform the necessary filename inheritance. */ X strcpy(p_filename,""); X fn_ins(p_filename,option.op_f_s); X fn_ins(p_filename,".fwi"); X fn_ins(p_filename,option.op_i_s); X fn_ins(p_filename,p_tempname); X X /* Include the included file by calling scan_file recursively. */ X /* Save and restore all variables in instantiation scope. */ X xinln_max = inln_max; X xspecial = specialch; X xp_eof = p_eof; X xlocalno = localno; X xp_sol = p_sol; X xp_ch = p_ch; X xch = ch; X inclevel++; X scan_file(p_filename); X inclevel--; X ch = xch; X p_ch = xp_ch; X p_sol = xp_sol; X localno = xlocalno; X p_eof = xp_eof; X specialch = xspecial; X inln_max = xinln_max; X } X} X X/******************************************************************************/ X LOCAL void do_ascii P_((p_ps_t)); LOCAL void do_ascii(p_psspec) X/* Upon entry, the current character is the '^' of a @^ sequence. The task is */ X/* to parse the following ascii code and generate a text token. */ p_ps_t p_psspec; X{ X ubyte base; /* Base of the number we are scanning. */ X ubyte digits; /* Number of digits expected. */ X uword val; /* Value of target character. */ X ubyte i; /* Looping variable. */ X STAVAR char alphab[256]; /* Static alphabet array to which to point scraps. */ X STAVAR bool init=FALSE; /* Tells if alphab has been initialized. */ X X /* Establish an array containing the ascii character set. Later on we can */ X /* point the sc_first and sc_last pointers to particular characters. */ X if (!init) {uword i; for (i=0;i<256;i++) alphab[i]=(char) i; init=TRUE;} X X /* Make sure that the base character is legal. */ X NEXTCH; X switch(toupper(ch)) X { X case 'B': base= 2; digits=8; break; X case 'O': X case 'Q': base= 8; digits=3; break; X case 'D': base=10; digits=3; break; X case 'H': X case 'X': base=16; digits=2; break; X default : lr_err(psofch(),"Expecting one of 'B', 'Q', 'D', 'H'."); X lr_mes(psofch(),"(For Binary, Octal, Decimal, and Hexadecimal)."); X base=10; X goto trouble; X } X X /* Parse opening parenthesis. */ X NEXTCH; X if (ch!='(') X {lr_err(psofch(),"Expecting '('.");goto trouble;} X X val=0; X for (i=0;i<digits;i++) X { X char uch; X ubyte d; X X NEXTCH; X uch=toupper(ch); X if (('0'<=uch) && (uch<='9')) X d=uch-'0'; X else X if ('A'<=uch && uch<='F') X d=10+uch-'A'; X else X d=100; X if (d>=base) X {lr_err(psofch(),"Illegal digit."); goto trouble;} X val = base*val + d; X } X X /* Parse closing parenthesis. */ X NEXTCH; X if (ch!=')') X {lr_err(psofch(),"Expecting ')'.");goto trouble;} X X /* Make sure that the number is not too big (this is possible in decimal). */ X if (val>255) X { X lr_err(psofch(),"Character number is too large."); X lr_mes(psofch(),"Character number must be in the range [0,255] (decimal)."); X goto trouble; X } X X /* Success! Now we can parcel it up into a scrap! */ X sendtext(p_psspec,&alphab[val],&alphab[val],ch==' ' || ch==EOL); X return; X X trouble: X /* Jump here after a specific diagnostic to give the user a reminder of */ X /* how to specify an ascii character constant. */ X switch (base) X { X case 2: X lr_mes(psofch(), X "A binary character representation takes the form \"@^B(dddddddd)\"."); X lr_mes(psofch(), X "(exactly 8 digits) where each digit d is either 0 or 1."); X break; X case 8: X lr_mes(psofch(), X "An octal character representation takes the form \"@^Q(ddd)\" (or \"@^O(ddd)\")."); X lr_mes(psofch(), X "(exactly 3 digits) where each digit d is in the range 0..7."); X break; X case 10: X lr_mes(psofch(), X "A decimal character representation takes the form \"@^D(ddd)\"."); X lr_mes(psofch(), X "(exactly 3 digits) where each digit d is in the range 0..9."); X break; X case 16: X lr_mes(psofch(), X "A hexadecimal character representation takes the form \"@^X(dd)\" (or \"@^H(dd)\")."); X lr_mes(psofch(), X "(exactly 2 digits) where each digit d is in the range 0..9,A..F."); X break; X default: as_bomb("do_ascii: trouble base switch defaulted."); X } X} X X/******************************************************************************/ X LOCAL void do_name P_((p_ps_t)); LOCAL void do_name (p_psspec) X/* Upon entry, the current character is the # of a @#. The task is to parse */ X/* it and transmit a name token. */ p_ps_t p_psspec; X{ X as_cold(ch=='#',"do_name: character is wrong."); X NEXTCH; X if ((ch==EOL) || (ch==' ')) X {lr_err(psofch(),"Expecting a printable character."); return;} X X /* Transmit a name token. */ X sendspec(p_psspec,TK_NAME,(ubyte) ch); X} X X/******************************************************************************/ X LOCAL void do_pgind P_((uword,p_pt_t)); LOCAL void do_pgind(numarg,arg) X/* Parse an indentation pragma. */ uword numarg; p_pt_t arg; X{ X bool pragind; X ps_t psprag; X X /* Make sure that there are exactly three arguments. */ X if (numarg != 3) /* "indentation" "none|blank". */ X { X lr_err(&arg[0].pt_ps, X "This indentation pragma has the wrong number of arguments."); X goto help; X } X X /* Make sure that the second argument is an "=". */ X if (0 != strcmp(arg[2].pt_pstr,"=")) X { X lr_err(&arg[2].pt_ps,"Expecting \"=\"."); X goto help; X } X X /* Check the third argument. */ X if (strcmp(arg[3].pt_pstr,"none" )==0) pragind=FALSE; X else if (strcmp(arg[3].pt_pstr,"blank")==0) pragind=TRUE; X else X { X lr_err(&arg[3].pt_ps,"Expecting either \"none\" or \"blank\"."); X goto help; X } X X /* Construct a shorthand for the start of the pragma. */ X ASSIGN(psprag,arg[0].pt_ps); X X /* Make sure that the pragma does not contradict an earlier pragma. */ X if (seenind && (tgindent!=pragind)) X { X sprintf(linet1,"This pragma is opposed by the pragma at line %lu.", X (unsigned long) psprag.ps_line); X lr_mes(&ps_ind,linet1); X sprintf(linet1,"This pragma opposes the pragma at line %lu.", X (unsigned long) ps_ind.ps_line); X lr_err(&psprag,linet1); X lr_mes(&psprag,"You can have as many indentation pragmas as you like,"); X lr_mes(&psprag,"but they all have to be the same!"); X lr_mes(&psprag,"Pragma ignored."); X return; X } X X /* Success: Record the pragma information. */ X seenind = TRUE; /* Record that we have seen a pragma. */ X tgindent = pragind; /* Record what the pragma said. */ X ASSIGN(ps_ind,psprag); /* Record where the pragma was. */ X return; X X help: X lr_mes(&arg[0].pt_ps, X "The correct format is: \"@p indentation = none|blank\"."); X lr_mes(&arg[0].pt_ps,"Pragma ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pginl P_((uword,p_pt_t)); LOCAL void do_pginl(numarg,arg) X/* Parse a maximum input line length pragma. */ uword numarg; p_pt_t arg; X{ X char *numstr; X uword spn; X X /* Make sure that there are exactly three arguments. */ X if (numarg != 3) /* "max..length = <num>". */ X { X lr_err(&arg[0].pt_ps,"This pragma has the wrong number of arguments."); X goto help; X } X X /* Make sure that the second argument is "=". */ X if (0 != strcmp(arg[2].pt_pstr,"=")) X {lr_err(&arg[2].pt_ps,"Expecting \"=\"."); goto help;} X X /* Set up an abbreviation. */ X numstr=arg[3].pt_pstr; X X /* See if the value is "infinity". */ X if (strcmp(numstr,"infinity")==0) X {inln_max=INMAXINF; return;} X X /* Calculate length of longest prefix containing all decimal digits. */ X /* Check that there are no illegal digits. */ X spn=strspn(numstr,"0123456789"); X if (spn != strlen(numstr)) X { X ps_t ps; X ASSIGN(ps,arg[3].pt_ps); X ps.ps_column+=spn; X lr_err(&ps,"Illegal digit. Value must consist entirely of decimal digits."); X lr_mes(&ps,"You can also use the value \"infinity\"."); X lr_mes(&ps,"Pragma ignored."); X return; X } X X /* Check that the number is not too long. */ X if (strlen(numstr)>8) X { X lr_err(&arg[3].pt_ps,"Too many digits. The maximum is eight."); X lr_mes(&arg[3].pt_ps,"Pragma ignored."); X return; X } X X /* Convert the argument into an integer. */ X { X ulong val; X int result; X /* Note: Should really be %lu, but the Vax doesn't know about the %u */ X /* in sscanf and so we make do with %ld. */ X result=sscanf(numstr,"%ld",&val); X as_cold(result==1,"do_pginl:sscanf failed."); X inln_max=val; X } X return; X X help: X lr_mes(&arg[0].pt_ps, X "The correct format is: \"@p maximum_input_line_length = <num>|infinity\"."); X lr_mes(&arg[0].pt_ps,"Pragma ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pgotl P_((uword,p_pt_t)); LOCAL void do_pgotl(numarg,arg) X/* Parse a maximum product file line length pragma. */ uword numarg; p_pt_t arg; X{ X char *numstr; X uword spn; X ulong val; X ps_t psprag; X X /* Set up an abbreviation. */ X ASSIGN(psprag,arg[0].pt_ps); X X /* Make sure that there are exactly three arguments. */ X if (numarg != 3) /* "max..length" "=" "value". */ X { X lr_err(&arg[0].pt_ps,"This pragma has the wrong number of arguments."); X goto help; X } X X /* Make sure that the second argument is an "=". */ X if (0 != strcmp(arg[2].pt_pstr,"=")) X {lr_err(&arg[2].pt_ps,"Expecting \"=\"."); goto help;} X X /* Set up an abbreviation. */ X numstr=arg[3].pt_pstr; X X /* See if the value is "infinity". */ X if (strcmp(numstr,"infinity")==0) X {val=TGMAXINF; goto gotvalue;} X X /* Calculate length of longest prefix containing all decimal digits. */ X /* Check that there are no illegal digits. */ X spn=strspn(numstr,"0123456789"); X if (spn != strlen(numstr)) X { X ps_t ps; X ASSIGN(ps,arg[3].pt_ps); X ps.ps_column+=spn; X lr_err(&ps,"Illegal digit. Value must consist entirely of decimal digits."); X lr_mes(&ps,"You can also use the value \"infinity\"."); X lr_mes(&ps,"Pragma ignored."); X return; X } X X /* Check that the number is not too long. */ X if (strlen(numstr)>8) X { X lr_err(&arg[3].pt_ps,"Too many digits. The maximum is eight."); X lr_mes(&arg[3].pt_ps,"Pragma ignored."); X return; X } X X /* Convert the argument into an integer. */ X { X int result=sscanf(numstr,"%ld",&val); X as_cold(result==1,"do_pgotl:sscanf failed."); X } X X gotvalue: X /* Make sure that the pragma does not contradict an earlier pragma. */ X if (seenlimo && (tglinmax!=val)) X { X sprintf(linet1,"This pragma is opposed by the pragma at line %lu.", X (unsigned long) psprag.ps_line); X lr_mes(&ps_limo,linet1); X sprintf(linet1,"This pragma opposes the pragma at line %lu.", X (unsigned long) ps_limo.ps_line); X lr_err(&psprag,linet1); X lr_mes(&psprag,"You can have as many output line length pragmas"); X lr_mes(&psprag,"as you like, but they all have to be the same!"); X lr_mes(&psprag,"Pragma ignored."); X return; X } X X /* If we got this far then the pragma is just the same as an earlier one. */ X /* We don't want to set the pragma position to the later pragma so we */ X /* return now. */ X if (seenlimo) return; X X /* Success. Set the variables. */ X tglinmax=val; X seenlimo=TRUE; X ASSIGN(ps_limo,psprag); X return; X X help: X lr_mes(&arg[0].pt_ps, X "The correct format is: \"@p maximum_output_line_length = <num>|infinity\"."); X lr_mes(&arg[0].pt_ps,"Pragma ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pgnpg P_((uword,p_pt_t)); LOCAL void do_pgnpg(numarg,arg) X/* Parse a newpage typesetter directive. */ uword numarg; p_pt_t arg; X{ X /* Make sure that there is exactly one argument. */ X if (numarg > 1) /* "new_page" */ X { X lr_err(&arg[2].pt_ps,"The new_page directive does not take arguments."); X lr_mes(&arg[2].pt_ps,"Directive ignored."); X return; X } X sendspec(&arg[0].pt_ps,TK_NPAG,DONTCARE); X} X X/******************************************************************************/ X LOCAL void do_pgtoc P_((uword,p_pt_t)); LOCAL void do_pgtoc(numarg,arg) X/* Parse a table of contents typesetter directive. */ uword numarg; /* Number of arguments to table of contents directive. */ p_pt_t arg; /* Array describing arguments. */ X{ X /* Make sure that there is exactly one argument. */ X if (numarg > 1) /* "table_of_contents" */ X { X lr_err(&arg[2].pt_ps, X "The table_of_contents directive does not take arguments."); X lr_mes(&arg[2].pt_ps,"Directive ignored."); X return; X } X sendspec(&arg[0].pt_ps,TK_TOCS,DONTCARE); X} X X/******************************************************************************/ X LOCAL void do_pgvsk P_((uword,p_pt_t)); LOCAL void do_pgvsk(numarg,arg) X/* Parse a vskip typesetter directive. */ uword numarg; /* Number of arguments to indentation directive. */ p_pt_t arg; /* Array describing arguments. */ X{ X char *numstr; X uword spn; X X /* Make sure that there are exactly three arguments. */ X if (numarg != 3) /* "vskip" n "mm". */ X { X lr_err(&arg[0].pt_ps,"This directive has the wrong number of arguments."); X goto help; X } X X /* Make sure that the third argument is "mm". */ X if (0 != strcmp(arg[3].pt_pstr,"mm")) X {lr_err(&arg[3].pt_ps,"Expecting \"mm\"."); goto help;} X X /* Set up an abbreviation. */ X numstr=arg[2].pt_pstr; X X /* Calculate length of longest prefix containing all decimal digits. */ X /* Check that there are no illegal digits. */ X spn=strspn(numstr,"0123456789"); X if (spn != strlen(numstr)) X { X ps_t ps; X ASSIGN(ps,arg[2].pt_ps); X ps.ps_column+=spn; X lr_err(&ps,"Illegal digit."); X lr_mes(&ps,"Value must consist entirely of decimal digits."); X lr_mes(&ps,"Directive ignored."); X return; X } X X /* Check that the number is not too long. */ X if (strlen(numstr)>3) X { X lr_err(&arg[2].pt_ps,"Too many digits. The maximum is three."); X lr_mes(&arg[2].pt_ps,"Directive ignored."); X return; X } X X /* Convert the argument into an integer. */ X { X ulong val; X int result; X result=sscanf(numstr,"%ld",&val); X as_cold(result==1,"do_pginl:sscanf failed."); X if (val>255) X { X lr_err(&arg[2].pt_ps,"Value too large. Maximum is 255."); X lr_mes(&arg[2].pt_ps,"Directive ignored."); X return; X } X sendspec(&arg[0].pt_ps,TK_SKIP,(ubyte) val); X } X return; X X help: X lr_mes(&arg[0].pt_ps,"The correct format is: \"@t vskip <num> mm\"."); X lr_mes(&arg[0].pt_ps,"Directive ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pgtit P_((uword,p_pt_t)); LOCAL void do_pgtit(numarg,arg) X/* Parse a title typesetter directive. */ uword numarg; /* Number of arguments to title directive. */ p_pt_t arg; /* Array describing arguments. */ X{ X uword align; X uword font; X char *p_sot,*p_eot; X X /* Make sure that there are at least three arguments. */ X if (numarg < 4) /* "title <font> <align> <text>". */ X {lr_err(&arg[0].pt_ps,"This directive has too few arguments."); goto help;} X X /* Check the font argument. */ X if (strcmp(arg[2].pt_pstr,"normalfont" )==0) font=FT_NORM; X else if (strcmp(arg[2].pt_pstr,"titlefont" )==0) font=FT_TITL; X else if (strcmp(arg[2].pt_pstr,"smalltitlefont")==0) font=FT_STIT; X else X { X lr_err(&arg[2].pt_ps, X "Expecting one of {titlefont,smalltitlefont,normalfont}."); X lr_mes(&arg[2].pt_ps,"Directive ignored."); X return; X } X X /* Check the alignment argument. */ X if (strcmp(arg[3].pt_pstr,"left" )==0) align=LR_LEFT; X else if (strcmp(arg[3].pt_pstr,"right" )==0) align=LR_RIGH; X else if (strcmp(arg[3].pt_pstr,"centre")==0) align=LR_CENT; X else X { X lr_err(&arg[3].pt_ps,"Expecting one of {left,right,centre}."); X if (strcmp(arg[3].pt_pstr,"center")==0) X { X lr_mes(&arg[3].pt_ps,"Note: Centre is spelt centRE, not centER."); X lr_mes(&arg[3].pt_ps," This is my revenge for years of getting error messages"); X lr_mes(&arg[3].pt_ps," from TeX whenever I accidentally wrote \\centreline - Ross Williams."); X } X lr_mes(&arg[3].pt_ps,"Directive ignored."); X return; X } X X /* Now make sure that the remainder of the line is delimited by quotes. */ X p_sot=arg[4].pt_pinl; X p_eot=p_sot+strlen(p_sot)-1; X if (*p_sot!='"' || *p_eot!='"' || p_sot==p_eot) X { X lr_err(&arg[4].pt_ps,"Text argument must be delimited by double quotes."); X lr_mes(&arg[4].pt_ps,"Directive ignored."); X return; X } X p_sot++; p_eot--; X X /* Ship out a token whose fields are all fully laden. */ X { X tk_t token; X token.tk_kind = TK_TITL; X ASSIGN(token.tk_ps,arg[0].pt_ps); X token.tk_sc.sc_first = p_sol+ (3+(p_sot-arg[1].pt_pinl)); X token.tk_sc.sc_last = p_sol+ (3+(p_eot-arg[1].pt_pinl)); X token.tk_sc.sc_white = FALSE; X token.tk_gen = LRFT_PACK*font+align; X ls_add(token_list,PV &token); X } X return; X X help: X lr_mes(&arg[0].pt_ps, X "The correct format is: \"@t title <font> <align> <text>\"."); X lr_mes(&arg[0].pt_ps, X " where <font> = titlefont | smalltitlefont | normalfont."); X lr_mes(&arg[0].pt_ps, X " and <align> = left | centre | right."); X lr_mes(&arg[0].pt_ps, X " and <text> = text delimited by double quotes."); X lr_mes(&arg[0].pt_ps,"Directive ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pgtyp P_((uword,p_pt_t)); LOCAL void do_pgtyp(numarg,arg) X/* Parse a typesetter pragma. */ uword numarg; p_pt_t arg; X{ X tr_k_t pragtyp; X ps_t psprag; X X /* Make sure that there are exactly three arguments. */ X if (numarg != 3) /* "typesetter" "=" "name". */ X { X lr_err(&arg[0].pt_ps, X "This typesetter pragma has the wrong number of arguments."); X goto help; X } X X /* Make sure that the second argument is "=". */ X if (0 != strcmp(arg[2].pt_pstr,"=")) X { X lr_err(&arg[2].pt_ps,"Expecting \"=\"."); X goto help; X } X X /* Check the third argument. */ X if (strcmp(arg[3].pt_pstr,"none")==0) pragtyp=TR_NONE; X else if (strcmp(arg[3].pt_pstr,"tex" )==0) pragtyp=TR_TEX; X else X { X lr_err(&arg[3].pt_ps,"Expecting either \"none\" or \"tex\"."); X goto help; X } X X /* Construct a shorthand for the start of the pragma. */ X ASSIGN(psprag,arg[0].pt_ps); X X /* Make sure that the pragma does not contradict an earlier pragma. */ X if (seentyp && (tr_codes != pragtyp)) X { X sprintf(linet1,"This pragma is opposed by the pragma at line %lu.", X (unsigned long) psprag.ps_line); X lr_mes(&ps_typ,linet1); X sprintf(linet1,"This pragma opposes the pragma at line %lu.", X (unsigned long) ps_typ.ps_line); X lr_err(&psprag,linet1); X lr_mes(&psprag,"You can have as many typesetter pragmas as you like,"); X lr_mes(&psprag,"but they all have to be the same!"); X lr_mes(&psprag,"Pragma ignored."); X return; X } X X /* Success: Record the pragma information. */ X seentyp = TRUE; /* Record that we have seen a pragma. */ X tr_codes = pragtyp; /* Record what the pragma said. */ X ASSIGN(ps_typ,psprag); /* Record where the pragma was. */ X return; X X help: X lr_mes(&arg[0].pt_ps, X "The correct format is: \"@p typesetter = none|tex\"."); X lr_mes(&arg[0].pt_ps,"Pragma ignored."); X return; X} X X/******************************************************************************/ X LOCAL void do_pragma P_((p_ps_t,bool)); LOCAL void do_pragma(p_ps,is_typ) X/* Upon entry, the current character is: */ X/* is_typ=FALSE => The P of a @p. */ X/* is_typ=TRUE => The T of a @t. */ X/* This function processes these contructs. */ p_ps_t p_ps; bool is_typ; X{ X#define MAXPARG 10 /* Maximum recorded arguments to a pragma. */ X#define PRAGMA_MAX 100 /* Maximum length of a pragma. */ X char praglin[PRAGMA_MAX+1]; /* Array to hold pragma as a complete line. */ X char pragstr[PRAGMA_MAX+1]; /* Array to hold pragma as strings. */ X pt_t pragarg[MAXPARG+1]; /* Array of pragma arguments. */ X uword length; /* Helps prevent scanning overrun. */ X char *p,*q; /* Temporary. */ X uword numarg,na; /* Number of arguments seen so far. */ X X /* Complain if the pragma directive is not at the start of a line. */ X if (p_ch-1 != p_sol) X { X if (is_typ) X { X lr_err(p_ps,"Typesetter directive @t must be at the start of a line."); X lr_mes(p_ps,"The rest of this line will be ignored."); X } X else X { X lr_err(p_ps,"Pragma sequence @p must be at the start of a line."); X lr_mes(p_ps,"The rest of this line will be ignored."); X } X skiptoeol(); X goto help; X } X X /* The include command should be followed by a blank. Get the next char. */ X NEXTCH; X X /* Complain if the next character is not a blank. */ X if (ch != ' ') X { X /* Note: If we position this error correctly, it gets put after the */ X /* help message! */ X if (is_typ) X lr_err(p_ps,"Typesetter directive @t must be followed by a blank."); X else X lr_err(p_ps,"Pragma sequence @p must be followed by a blank."); X skiptoeol(); X goto help; X } X X /* Copy the rest of the line to the pragma arrays. */ X NEXTCH; X p = &praglin[0]; X q = &pragstr[0]; X length=0; X while (ch!=EOL) X { X if (++length > PRAGMA_MAX-3) /* 3 is for "@p " or "@t " */ X { X if (is_typ) X { X lr_err(p_ps,"This typestter directive line is too long."); X sprintf(linet1,"The maximum typesetter directive line length is %u characters.", X (unsigned) PRAGMA_MAX); X lr_mes(p_ps,linet1); X } X else X { X lr_err(p_ps,"This pragma line is too long."); X sprintf(linet1,"The maximum pragma line length is %u characters.", X (unsigned) PRAGMA_MAX); X lr_mes(p_ps,linet1); X } X skiptoeol(); X goto help; X } X *p++=ch; X *q++=ch; X NEXTCH; X } X *p=EOS; X *q=EOS; X /* Note: Current position is now on the EOL at the end of the @p line. */ X /* That is the way we want to leave it for the scanspec() routine. */ X X /* So far we have copied the body of the pragma line into two arrays. The */ X /* next lump of code parses that line into a sequence of non-blank arguments.*/ X /* The result is an array of pt_t objects each of which contains the */ X /* position of each argument, a pointer to the first character of each */ X /* argument in praglin, and also a pointer to a string containing the arg. */ X /* The string resides in the array pragstr which is the same as praglin */ X /* except that some blanks have been replaced by EOSs so as to allow us to */ X /* point into it to form strings. All this probably seems rather overdone */ X /* for the analysis of a "simple" pragma, but I have found that pulling the */ X /* different kinds of pragma lines apart separately is very messy. Far */ X /* better to suffer here in what is at least reasonably neat code than */ X /* later in the specific pragma routines. */ X numarg=0; X p= &praglin[0]; X q= &pragstr[0]; X while (TRUE) X { X /* Skip whitespace between arguments. */ X while (*p==' ') {p++;q++;} X X /* Exit if we have hit the end of the line. */ X if ((numarg==MAXPARG) || (*p==EOS)) break; X X /* We have found another argument! */ X numarg++; X X /* Record the argument. */ X ASSIGN(pragarg[numarg].pt_ps,*p_ps); X pragarg[numarg].pt_ps.ps_column=4+(p-praglin); X pragarg[numarg].pt_pinl=p; X pragarg[numarg].pt_pstr=q; X X /* Skip to the end of the argument. */ X while (*p!=' ' && *p!=EOS) {p++;q++;} X X /* Drop a null in the string array to complete string rep of argument. */ X *q=EOS; X } X X /* At this point numarg is MIN(arguments,MAXPARG), and pragargs contains an */ X /* entry for each of the numarg arguments. */ X X /* It is handy to have the position of the pragma itself handy. */ X ASSIGN(pragarg[0].pt_ps,*p_ps); X X /* CHECK: Make sure that the line and string arrays square up. */ X { X uword i; X for (i=1;i<=numarg;i++) X { X uword j; X uword t=strlen(pragarg[i].pt_pstr); X for (j=0;j<t;j++) X { X as_cold(pragarg[i].pt_pstr[j]==pragarg[i].pt_pinl[j], X "do_pragma: String and line arrays are not equal."); X as_cold((pragarg[i].pt_pstr-pragstr)==(pragarg[i].pt_pinl-praglin), X "do_pragma: String and line arrays are out of synch."); X } X } X } X X /* Complain if there are no arguments at all. */ X if (numarg==0) X { X if (is_typ) X lr_err(p_ps,"Typesetter directive @t must be followed by a keyword."); X else X lr_err(p_ps,"Pragma sequence @p must be followed by a keyword."); X skiptoeol(); X goto help; X } X X /* Branch off to specific routines based on the first argument. */ X p=pragarg[1].pt_pstr; na=numarg; X if (is_typ) X { X if (0==strcmp(p,"new_page" )) {do_pgnpg(na,pragarg);return;} X if (0==strcmp(p,"table_of_contents" )) {do_pgtoc(na,pragarg);return;} X if (0==strcmp(p,"title" )) {do_pgtit(na,pragarg);return;} X if (0==strcmp(p,"vskip" )) {do_pgvsk(na,pragarg);return;} X } X else X { X if (0==strcmp(p,"indentation" )) {do_pgind(na,pragarg);return;} X if (0==strcmp(p,"maximum_input_line_length" )) {do_pginl(na,pragarg);return;} X if (0==strcmp(p,"maximum_output_line_length")) {do_pgotl(na,pragarg);return;} X if (0==strcmp(p,"typesetter" )) {do_pgtyp(na,pragarg);return;} X } X X help: X if (is_typ) X { X lr_err(p_ps,"Unrecognised typesetter directive. Legal ones are:"); X lr_mes(p_ps," @t new_page"); X lr_mes(p_ps," @t table_of_contents"); X lr_mes(p_ps," @t title <font> <align> <string>"); X lr_mes(p_ps," @t vskip <num> mm"); X lr_mes(p_ps,"The blanks between arguments are important."); X lr_mes(p_ps,"Typesetter directive ignored."); X } X else X { X lr_err(p_ps,"Unrecognised pragma. Possible legal pragmas are:"); X lr_mes(p_ps," @p indentation = none | blank"); X lr_mes(p_ps," @p maximum_input_line_length = <num>|infinity"); X lr_mes(p_ps," @p maximum_output_line_length = <num>|infinity"); X lr_mes(p_ps," @p typesetter = none | tex"); X lr_mes(p_ps,"The blanks between arguments are important."); X lr_mes(p_ps,"Pragma ignored."); X } X} X X/******************************************************************************/ X LOCAL void chksol P_((void)); LOCAL void chksol() X/* This function is called when the current character is the character after */ X/* an @. The function checks to see if the @ was at the start of a line and */ X/* issues a error message if it isn't. */ X{ X ps_t ps; X grabchps(&ps); X if (ps.ps_column != 2) X { X ps.ps_column--; X sprintf(linet1,"@%c is legal only at the start of a line.",ch); X lr_err(&ps,linet1); X } X} X X/******************************************************************************/ X LOCAL void scanspec P_((void)); LOCAL void scanspec() X/* Upon entry the current character is the special character (usually '@'). */ X/* The task is to scan the special sequence. Upon exit, the current character */ X/* is the character following the special sequence. */ X{ X ps_t ps_spec; /* Position of start of special sequence. */ X X /* Make a note of where the special sequence starts. */ X grabchps(&ps_spec); X X /* Move onto the character following the special (escape) character. */ X NEXTCH; X X /* Now react to the character. In most cases, the special sequence is simply */ X /* a marker in the input and we can simply transmit it. The nasty special */ X /* case sequences are left until the end of the switch statement. */ X /* Purists will complain about how all the case options are hardwired and */ X /* say that symbols should have been used. They once were, but were taken */ X /* out when it was discovered that the symbols had cryptic names (because of */ X /* the portability eight-character rule) and were only used here anyway. */ X switch (toupper(ch)) X { X case '<': sendspec(&ps_spec,TK_ONAM,DONTCARE); break; X case '>': sendspec(&ps_spec,TK_CNAM,DONTCARE); break; X case '{': sendspec(&ps_spec,TK_ODEF,DONTCARE); break; X case '}': sendspec(&ps_spec,TK_CDEF,DONTCARE); break; X case '(': sendspec(&ps_spec,TK_OPAR,DONTCARE); break; X case ')': sendspec(&ps_spec,TK_CPAR,DONTCARE); break; X case ',': sendspec(&ps_spec,TK_COMA,DONTCARE); break; X case '"': sendspec(&ps_spec,TK_QUOT,DONTCARE); break; X case '/': sendspec(&ps_spec,TK_EMPH,DONTCARE); break; X case 'A': sendspec(&ps_spec,TK_NSEC,1); chksol(); break; X case 'B': sendspec(&ps_spec,TK_NSEC,2); chksol(); break; X case 'C': sendspec(&ps_spec,TK_NSEC,3); chksol(); break; X case 'D': sendspec(&ps_spec,TK_NSEC,4); chksol(); break; X case 'E': sendspec(&ps_spec,TK_NSEC,5); chksol(); break; X case '1': sendspec(&ps_spec,TK_PARM,1); break; X case '2': sendspec(&ps_spec,TK_PARM,2); break; X case '3': sendspec(&ps_spec,TK_PARM,3); break; X case '4': sendspec(&ps_spec,TK_PARM,4); break; X case '5': sendspec(&ps_spec,TK_PARM,5); break; X case '6': sendspec(&ps_spec,TK_PARM,6); break; X case '7': sendspec(&ps_spec,TK_PARM,7); break; X case '8': sendspec(&ps_spec,TK_PARM,8); break; X case '9': sendspec(&ps_spec,TK_PARM,9); break; X case 'M': sendspec(&ps_spec,TK_MANY,DONTCARE); break; X case 'Z': sendspec(&ps_spec,TK_ZERO,DONTCARE); break; X case 'O': sendspec(&ps_spec,TK_FDEF,DONTCARE); chksol(); break; X case '$': sendspec(&ps_spec,TK_MDEF,DONTCARE); chksol(); break; X case EOL: X lr_err(&ps_spec,"<special><endofline> is not a legal special sequence."); X break; X case ' ': X lr_err(&ps_spec,"<special><space> is not a legal special sequence."); X break; X case '@': X /* @ instructs FunnelWeb to replace the special construct with the */ X /* special character. Luckily one appears just before the @ !! */ X /* Note: FALSE is OK because space is not a legal specialch. */ X sendtext(&ps_spec,p_ch-1,p_ch-1,FALSE); X break; X case '-': X /* - instructs FunnelWeb to suppress the following end of line. */ X if (*(p_ch+1) == EOL) X NEXTCH X else X lr_err(&ps_spec, X "Suppress EOL sequence is legal only at the end of a line."); X break; X case '+': X /* + instructs FunnelWeb to insert an EOL. We can't look to the end of */ X /* the previous line to find an EOL as this might be the first line. */ X /* Running ahead to the end of the line is expensive, and having the */ X /* liner mini-package maintain a variable for it would be extra */ X /* housekeeping. Instead of all this, we just point to a static. */ X {STAVAR char stateol = EOL; X sendtext(&ps_spec,&stateol,&stateol,TRUE);} X break; X case '=': X /* = instructs FunnelWeb to change the special character to the */ X /* character following the <special>= sequence. */ X NEXTCH; X if (ch == ' ') X { X lr_err(&ps_spec,"You cannot set the special character to <space>!"); X lr_mes(&ps_spec,"Special sequence ignored."); X } X else if (ch == EOL) X { X lr_err(&ps_spec, X "You cannot set the special character to <endofline>!"); X lr_mes(&ps_spec,"Special sequence ignored."); X } X else X specialch=ch; X break; X case '!': X /* ! instructs FunnelWeb to ignore the rest of the line (a comment). */ X skiptoeol(); X break; X case 'I': X /* i instructs FunnelWeb to include a file. */ X incl_fil(&ps_spec); X break; X case '^': X /* ^ instructs FunnelWeb to insert a specific ascii character. */ X do_ascii(&ps_spec); X break; X case '#': X /* # instructs FunnelWeb to transmit a two character name "#c". */ X do_name(&ps_spec); X break; X case 'P': X /* P is used as a miscellaneous PRAGMA. */ X do_pragma(&ps_spec,FALSE); X break; X case 'T': X /* T introduces a one-line typesetting directive. */ X do_pragma(&ps_spec,TRUE); X break; X default: X lr_err(&ps_spec,"Unknown special sequence."); X break; X } X X /* The switch statment absorbs the special sequence and its effects. */ X /* This NEXTCH places us on the character following the special sequence. */ X NEXTCH; X} X X/******************************************************************************/ X LOCAL void scantext P_((void)); LOCAL void scantext() X/* Upon entry, we know that the current character is not EOF and that it is */ X/* not the special character. Our task is to parse as much text as we can and */ X/* ship it off as a text token. The scanner will probably spend most of its */ X/* time in the loops in this function so it is important that they be */ X/* efficient. That is why two loops are used to deal with detecting */ X/* whitespace rather than a flag. */ X/* Upon return, the current character is the character following the text */ X/* sequence. This is guaranteed to be the special character or an EOF. */ X{ X ps_t ps_start; /* Position of first character of text sequence. */ X char *p_first = p_ch; /* Pointer to first character of text sequence. */ X X /* Grab a copy of the position of this token. */ X grabchps(&ps_start); X X /* Scan whitespace. */ X while (ch==' ' || ch==EOL) X NEXTCH; X X /* If we hit something that ends a text token */ X /* then we can transmit a white text token. */ X if (ch==specialch || ch==EOFCH) X {sendtext(&ps_start,p_first,p_ch-1,TRUE); return;} X X /* Otherwise we have some more (non-white) text to scan. */ X /* We can then send a non-white text token. */ X while (ch!=specialch && ch!=EOFCH) X NEXTCH; X sendtext(&ps_start,p_first,p_ch-1,FALSE); X} X X/******************************************************************************/ X LOCAL void scan_file(p_fname) X/* This function scans a single file. It's argument is the name of the file */ X/* to be scanned. scan_file calls the mapper to map in the file and then */ X/* scans the text of the mapped file using the liner mini-package. The result */ X/* of the scan is additions to the line and token list, and diagnostics sent */ X/* to the lister package. If an include directive is encountered, this */ X/* function is called recursively. */ char *p_fname; X{ X char *p_mapped; /* Pointer to the mapped file. */ X ulong length; /* Number of bytes in the mapped file. */ X char *errstr; /* Error string returned by mapper. */ X bool addedeol; /* Did we have to add an EOL to the end of the last line? */ X X /* Check to see if the file exists. */ X if (!fexists(p_fname)) X { X if (inclevel==0) X { X /* Failure to find the main file is a severe error. */ X if (option.op_b7_b) X sprintf(linet1,"S: Error opening input file \"%s\".",SUPPNAME); X else X sprintf(linet1,"S: Error opening input file \"%s\".",p_fname); X wl_l(linet1); X /* Although strictly speaking we should suppress this error from the */ X /* screen stream unless option.op_s_b is set, absence of an input file */ X /* is such an important error, that we write it out anyway. */ X /* if (option.op_s_b) */ X wl_sj(linet1); X num_sev++; X return; X } X else X { X /* Failure to find an include file is an ordinary error. */ X ps_t ps; X ps.ps_line = globalno; X ps.ps_column = 4; X lr_err(&ps,"Error opening include file."); X if (option.op_b7_b) X sprintf(linet1, X "The include file's expanded name was \"%s\".",SUPPNAME); X else X sprintf(linet1, X "The include file's expanded name was \"%s\".",p_fname); X lr_mes(&ps,linet1); X return; X } X } X X /* Map the specified file into memory. We need to change from the scanner */ X /* clock to the mapper clock to keep the time accounting correct here. */ X ck_stop(p_scan); X ck_start(p_mapp); X errstr=map_file(p_fname,&p_mapped,&length); X ck_stop(p_mapp); X ck_start(p_scan); X X /* Abort if the mapping was not possible. */ X if (errstr != NULL) X if (inclevel==0) X { X /* Failure to map the main file is a severe error. */ X if (option.op_b7_b) X sprintf(linet1,"S: Error reading input file \"%s\".",SUPPNAME); X else X sprintf(linet1,"S: Error reading input file \"%s\".",p_fname); X wl_l(linet1); if (option.op_s_b) wl_sj(linet1); X wl_l(errstr); if (option.op_s_b) wl_sj(errstr); X num_sev++; X return; X } X else X { X /* Failure to find an include file is an ordinary error. */ X ps_t ps; X ps.ps_line = globalno; X ps.ps_column = 4; X lr_err(&ps,"Error reading include file."); X lr_mes(&ps,errstr); X if (option.op_b7_b) X sprintf(linet1,"The include file's expanded name was \"%s\".", X SUPPNAME); X else X sprintf(linet1,"The include file's expanded name was \"%s\".", X p_fname); X lr_mes(&ps,linet1); X return; X } X X /* Dump the mapped file if requested. */ X if (option.op_b1_b) X { X if (option.op_b7_b) X sprintf(linet1,"Dump of mapped file \"%s\".",SUPPNAME); X else X sprintf(linet1,"Dump of mapped file \"%s\".",p_fname); X wl_l(linet1); X dm_mem(&f_l,p_mapped,length); X } X X /* If the file is absolutely empty, we have to warn the user. Also, this is */ X /* a special case we can do without, and so we return here if file is empty. */ X if (length==0) X { X ps_t ps; X /* The empty file could be the main file or an include file. */ X /* If the empty file is the main file, we want the diagnostic to point to */ X /* the EOF marker which will appear as line 1. */ X /* If the empty file is an include file, we wish to point the diagnostic */ X /* to the line containing the include command. This is globalno. */ X /* In both cases, we want the diagnostic to point to column 1. */ X ps.ps_column=1; X if (inclevel==0) X { X ps.ps_line=1; X lr_war(&ps,"Input file is empty (not a byte in syte)!"); X } X else X { X ps.ps_line=globalno; X lr_war(&ps,"Include file is empty (not a byte in syte)!"); X } X return; X } X X /* Scanning is considerably simplified if we can guarantee that we will not */ X /* run into an EOF without first hitting an EOL. The following code takes */ X /* care of this by tacking one on the end if necessary and also adds an */ X /* EOF character on the end, which also simplifies the scanning. We can get */ X /* away with all this because the mapper purposefully leaves at least two */ X /* bytes free for us at the end of the mapped file. */ X addedeol=FALSE; X if (p_mapped[length-1] != EOL) X {p_mapped[length++]=EOL; addedeol=TRUE;} X p_mapped[length]=EOFCH; X X /* Initialize the variables "instantiated over a single file". */ X inln_max = 80; X specialch = CH_DSPE; X localno = 0; X p_eof = &p_mapped[length]; X X /* Crank up the line subscanner system with a call to prepline. */ X /* Then enter the main scanning loop. */ X /* All input consists of alternating special and text sequences */ X /* terminated by EOF. */ X prepline(p_mapped); X while (ch!=EOFCH) X if (ch==specialch) X scanspec(); X else X scantext(); X X /* Now that we are at the end of the scanned file and the scanning markers */ X /* are all sitting on the end of the file, it is a good time to issue */ X /* diagnostics about problems at the end of the file. */ X if (addedeol) X { X ps_t ps; X /* We want the diagnostic to point to the EOF line. Hence "global+1". */ X ps.ps_line = globalno+1; X ps.ps_column = 1; X if (inclevel==0) X lr_war(&ps,"The last line of the input file was terminated by EOF."); X else X lr_war(&ps,"The last line of the include file was terminated by EOF."); X lr_mes(&ps,"An EOL was inserted at the end of the last line."); X } X} X X/******************************************************************************/ X XEXPORT void scanner(p_amapp,p_ascan) X/* This is the scanner's main routine and the only exported function. */ p_ck_t p_amapp; /* Mapper's clock (stopped). */ p_ck_t p_ascan; /* Scanner's clock (running). */ X{ X /* Copy the arguments into globals where we can get at them. */ X p_mapp=p_amapp; X p_scan=p_ascan; X X /* Apart from diagnostic messages sent to the lister, the only output of */ X /* the scanner is two global lists holding a list of lines and a list of */ X /* tokens. The scanner creates these lists simultaneously. */ X /* We have to initialize them here before we get into 'scan_file' which */ X /* calls itself recursively if an include file command is encountered. */ X line_list =ls_cre(sizeof(ln_t)); X token_list=ls_cre(sizeof(tk_t)); X X /* Initialize all the variables instantiated throughout the entire scan. */ X globalno = 0; X inclevel = 0; X seenind = FALSE; X seentyp = FALSE; X seenlimo = FALSE; X X /* We also have to initialize localno in case the input file is empty and */ X /* it never gets initialized before being sucked into being used as the */ X /* local number for the end of file marker. */ X localno=0; X X /* Initialize the global indentation flag to the default value. */ X tgindent=TRUE; X X /* Initialize the global product line length limit to the default value. */ X tglinmax=80; X X /* Initialize the global typesetter flag to the default value. */ X tr_codes=TR_NONE; X X /* Scan the top level file whose name is obtained from the command line. */ X as_cold(option.op_f_b,"scanner: -F!!!!"); X X /* Work out what the input file name should be. */ X { X fn_t fname; X strcpy(fname,""); /* Start with an empty string. */ X fn_ins(fname,".fw"); X fn_ins(fname,option.op_f_s); X scan_file(fname); X } X X /* The scan_file function scans the main input file and all of its included */ X /* files, but it does not append a TK_EOF token to the end. This call does */ X /* this and also adds a line to the line list for EOF. */ X add_eof(); X} X X/******************************************************************************/ X/* End of SCANNER.C */ X/******************************************************************************/ END_OF_FILE if test 69225 -ne `wc -c <'sources/scanner.c'`; then echo shar: \"'sources/scanner.c'\" unpacked with wrong size! fi # end of 'sources/scanner.c' fi echo shar: End of archive 17 $of 20$. cp /dev/null ark17isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 20 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0