/*@z02.c:Lexical Analyser:Declarations@***************************************/
/* */
/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.26) */
/* COPYRIGHT (C) 1991, 2002 Jeffrey H. Kingston */
/* */
/* Jeffrey H. Kingston (jeff@cs.usyd.edu.au) */
/* Basser Department of Computer Science */
/* The University of Sydney 2006 */
/* AUSTRALIA */
/* */
/* This program is free software; you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* the Free Software Foundation; either Version 2, or (at your option) */
/* any later version. */
/* */
/* This program is distributed in the hope that it will be useful, */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
/* GNU General Public License for more details. */
/* */
/* You should have received a copy of the GNU General Public License */
/* along with this program; if not, write to the Free Software */
/* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */
/* */
/* FILE: z02.c */
/* MODULE: Lexical Analyser */
/* EXTERNS: LexLegalName(), LexInit(), LexPush(), LexPop(), */
/* LexNextTokenPos(), LexGetToken() */
/* */
/* Implementation note: this fast and cryptic lexical analyser is adapted */
/* from Waite, W. M.: The Cost of Lexical Analysis, in Software - Practice */
/* and Experience, v16, pp473-488 (May 1986). */
/* */
/*****************************************************************************/
#include "externs.h"
#define BUFFER_SIZE 8192 /* size of buffer for block read */
#define OTHER 0 /* punctuation or other character */
#define LETTER 1 /* letter type */
#define QUOTE 2 /* quoted string delimiter type */
#define ESCAPE 3 /* escape character inside strings */
#define COMMENT 4 /* comment delimiter type */
#define CSPACE 5 /* space character type */
#define FORMFEED 6 /* formfeed character type */
#define TAB 7 /* tab character type */
#define NEWLINE 8 /* newline character type */
#define ENDFILE 9 /* end of file character type */
static unsigned char chtbl[256]; /* type table indexed by a FULL_CHAR */
static FULL_CHAR *chpt; /* pointer to current text character */
static FULL_CHAR *frst; /* address of first buffer character */
static FULL_CHAR *limit; /* just past last char in buffer */
static FULL_CHAR *buf; /* the character buffer start pos */
static int blksize; /* size of block read; others too */
static FULL_CHAR last_char; /* last char read in from file */
static FULL_CHAR *startline; /* position in buff of last newline */
static FILE_NUM this_file; /* number of currently open file */
static FILE *fp; /* current input file */
static FILE_POS file_pos; /* current file position */
static short ftype; /* the type of the current file */
static OBJECT next_token; /* next token if already read */
static int offset; /* where to start reading in file */
static int first_line_num; /* number of first line (if offset) */
static BOOLEAN same_file; /* TRUE if same file as preceding */
static FULL_CHAR *mem_block; /* file buffer */
static int stack_free; /* first free slot in lexical stack */
static struct {
FULL_CHAR *chpt; /* pointer to current text character */
FULL_CHAR *frst; /* address of first buffer character */
FULL_CHAR *limit; /* just past last char in buffer */
FULL_CHAR *buf; /* the character buffer start pos */
int blksize; /* size of block read; others too */
FULL_CHAR last_char; /* last char read in from file */
FULL_CHAR *startline; /* position in buff of last newline */
FILE_NUM this_file; /* number of currently open file */
FILE *fp; /* current input file */
FILE_POS file_pos; /* current file position */
short ftype; /* the type of the current file */
OBJECT next_token; /* next token if already read */
int offset; /* where to start reading in file */
int first_line_num; /* number of first line (if offset) */
BOOLEAN same_file; /* TRUE if same file as preceding */
long save_ftell; /* ftell() position if same_file */
FULL_CHAR *mem_block; /* file buffer */
} lex_stack[MAX_LEX_STACK];
/*@::LexLegalName(), LexInit()@***********************************************/
/* */
/* BOOLEAN LexLegalName(str) */
/* */
/* Check whether str is a valid name for a symbol table entry. */
/* Valid names have the BNF form */
/* */
/* <name> ::= <letter> { <letter> } */
/* <name> ::= <special> { <special> } */
/* <name> ::= <escape> { <letter> } */
/* */
/* The third form is inaccessible to users and is for internal use only. */
/* */
/*****************************************************************************/
BOOLEAN LexLegalName(FULL_CHAR *str)
{ int i; BOOLEAN res;
debug1(DLA, DDD, "LexLegalName( %s )", str);
switch( chtbl[str[0]] )
{
case ESCAPE:
case LETTER:
for( i = 1; chtbl[str[i]] == LETTER; i++ );
res = str[i] == '\0';
break;
case OTHER:
for( i = 1; chtbl[str[i]] == OTHER; i++ );
res = str[i] == '\0';
break;
default:
res = FALSE;
break;
}
debug1(DLA, DDD, "LexLegalName returning %s", bool(res));
return res;
} /* end LexLegalName */
/*****************************************************************************/
/* */
/* LexInit() */
/* */
/* Initialise character types. Those not touched are 0 (OTHER). */
/* The function initchtbl() assists in initializing the chtbl. */
/* */
/*****************************************************************************/
static void initchtbl(val, str)
int val; FULL_CHAR *str;
{ int i;
for( i = 0; str[i] != '\0'; i++ )
chtbl[ str[i] ] = val;
} /* end initchtbl */
void LexInit(void)
{ initchtbl(LETTER, STR_LETTERS_LOWER);
initchtbl(LETTER, STR_LETTERS_UPPER);
initchtbl(LETTER, STR_LETTERS_SYMSTART);
initchtbl(LETTER, STR_LETTERS_UNDERSCORE);
initchtbl(LETTER, STR_LETTERS_EXTRA0);
initchtbl(LETTER, STR_LETTERS_EXTRA1);
initchtbl(LETTER, STR_LETTERS_EXTRA2);
initchtbl(LETTER, STR_LETTERS_EXTRA3);
initchtbl(LETTER, STR_LETTERS_EXTRA4);
initchtbl(LETTER, STR_LETTERS_EXTRA5);
initchtbl(LETTER, STR_LETTERS_EXTRA6);
initchtbl(LETTER, STR_LETTERS_EXTRA7);
initchtbl(QUOTE, STR_QUOTE);
initchtbl(ESCAPE, STR_ESCAPE);
initchtbl(COMMENT, STR_COMMENT);
initchtbl(CSPACE, STR_SPACE);
initchtbl(FORMFEED,STR_FORMFEED);
initchtbl(TAB, STR_TAB);
initchtbl(NEWLINE, STR_NEWLINE);
chtbl['\0'] = ENDFILE;
stack_free = -1;
} /* end LexInit */
/*@::LexPush(), LexPop()@*****************************************************/
/* */
/* LexPush(x, offs, ftype, lnum, same) */
/* */
/* Start reading from the file sequence whose first file is x (subsequent */
/* files are obtained from NextFile). The first file (x) is to be fseeked */
/* to offs. When the sequence is done, ftype determines how to continue: */
/* */
/* ftype action */
/* */
/* SOURCE_FILE last input file ends, return @End \Input */
/* DATABASE_FILE database file, return @End \Input */
/* INCLUDE_FILE include file, must pop lexical analyser and continue */
/* FILTER_FILE filter file, return @End @FilterOut */
/* */
/* lnum is the line number at offs, to be used when creating file pos's */
/* in the tokens returned. same is TRUE when this file is the same as */
/* the file currently being read, in which case there is no need to */
/* close that file and open this one; just an fseek is required. */
/* */
/*****************************************************************************/
void LexPush(FILE_NUM x, int offs, int ftyp, int lnum, BOOLEAN same)
{ int i;
debug5(DLA, DD, "LexPush(%s, %d, %s, %d, %s)", FileName(x), offs,
ftyp==SOURCE_FILE ? "source" : ftyp==INCLUDE_FILE ? "include":"database",
lnum, bool(same));
if( stack_free >= MAX_LEX_STACK - 1 )
{ if( ftyp == INCLUDE_FILE )
Error(2, 1, "too many open files when opening include file %s; open files are:",
WARN, PosOfFile(x), FullFileName(x));
else
Error(2, 2, "too many open files when opening database file %s; open files are:",
WARN, PosOfFile(x), FileName(x));
for( i = stack_free - 1; i >= 0; i-- )
{
Error(2, 23, " %s", WARN, no_fpos,
EchoFileSource(lex_stack[i].this_file));
}
Error(2, 24, "exiting now", FATAL, no_fpos);
}
if( stack_free >= 0 ) /* save current state */
{ lex_stack[stack_free].chpt = chpt;
lex_stack[stack_free].frst = frst;
lex_stack[stack_free].limit = limit;
lex_stack[stack_free].buf = buf;
lex_stack[stack_free].blksize = blksize;
lex_stack[stack_free].last_char = last_char;
lex_stack[stack_free].startline = startline;
lex_stack[stack_free].this_file = this_file;
lex_stack[stack_free].fp = fp;
lex_stack[stack_free].ftype = ftype;
lex_stack[stack_free].next_token = next_token;
lex_stack[stack_free].offset = offset;
lex_stack[stack_free].first_line_num = first_line_num;
lex_stack[stack_free].same_file = same_file;
lex_stack[stack_free].mem_block = mem_block;
FposCopy( lex_stack[stack_free].file_pos, file_pos );
}
stack_free += 1;
ifdebug(DMA, D,
DebugRegisterUsage(MEM_LEX,1, (MAX_LINE+BUFFER_SIZE+2)*sizeof(FULL_CHAR)));
mem_block = (FULL_CHAR *) malloc((MAX_LINE+BUFFER_SIZE+2)*sizeof(FULL_CHAR));
if( mem_block == NULL )
Error(2, 3, "run out of memory when opening file %s",
FATAL, PosOfFile(x), FullFileName(x));
buf = chpt = &mem_block[MAX_LINE];
last_char = CH_NEWLINE;
this_file = x; offset = offs;
first_line_num = lnum; same_file = same;
ftype = ftyp; next_token = nilobj;
*chpt = '\0';
if( same_file )
{ lex_stack[stack_free-1].save_ftell = ftell(fp);
}
else
{ fp = null;
}
} /* end LexPush */
/*****************************************************************************/
/* */
/* LexPop() - pop lexical analyser. */
/* */
/*****************************************************************************/
void LexPop(void)
{ debug0(DLA, DD, "LexPop()");
assert( stack_free > 0, "LexPop: stack_free <= 0!" );
stack_free--;
if( same_file )
{ fseek(fp, lex_stack[stack_free].save_ftell, SEEK_SET);
}
else
{ if( fp != null ) fclose(fp);
}
ifdebug(DMA, D,
DebugRegisterUsage(MEM_LEX,-1,-(MAX_LINE+BUFFER_SIZE+2)* (int) sizeof(FULL_CHAR))
);
free( (char *) mem_block);
mem_block = lex_stack[stack_free].mem_block;
chpt = lex_stack[stack_free].chpt;
frst = lex_stack[stack_free].frst;
limit = lex_stack[stack_free].limit;
buf = lex_stack[stack_free].buf;
blksize = lex_stack[stack_free].blksize;
last_char = lex_stack[stack_free].last_char;
startline = lex_stack[stack_free].startline;
this_file = lex_stack[stack_free].this_file;
fp = lex_stack[stack_free].fp;
ftype = lex_stack[stack_free].ftype;
next_token = lex_stack[stack_free].next_token;
offset = lex_stack[stack_free].offset;
first_line_num = lex_stack[stack_free].first_line_num;
same_file = lex_stack[stack_free].same_file;
FposCopy( file_pos, lex_stack[stack_free].file_pos );
} /* end LexPop */
/*@::setword(), LexNextTokenPos(), srcnext()@*********************************/
/* */
/* setword(typ, res, file_pos, str, len) */
/* */
/* Set variable res to a WORD or QWORD token containing string str, etc. */
/* */
/*****************************************************************************/
#define setword(typ, res, file_pos, str, len) \
{ NewWord(res, typ, len, &file_pos); \
FposCopy(fpos(res), file_pos); \
for( c = 0; c < len; c++ ) string(res)[c] = str[c]; \
string(res)[c] = '\0'; \
}
/*****************************************************************************/
/* */
/* long LexNextTokenPos() */
/* */
/* Equivalent to ftell() on the (buffered) current lex file. */
/* */
/*****************************************************************************/
long LexNextTokenPos(void)
{ long res;
if( next_token != nilobj )
Error(2, 4, "illegal macro invocation in database",
FATAL, &fpos(next_token));
res = ftell(fp) - (limit - chpt) - (buf - frst);
#if DB_FIX
/* uwe: 1997-11-04
*
* On NT under Visual C++ ftell() and fseek() always use binary
* positions, even if the file was opened in text mode. This means
* that every LF in between the CHPT and LIMIT was counted by
* ftell() as *TWO* bytes. The pointer arithmetic above adjusts the
* ftold value as lout has not yet read chars past CHPT, but it
* counts each LF as *ONE* byte, naturally.
*
* The code below compensates for this binary/text brain death.
*
* PS: gcc from Cygnus' gnuwin32 has sane ftell() and does *NOT*
* need this workaround (I haven't tried compiling lout with gcc
* though, as the result will need cygwin.dll to run).
*/
{
register FULL_CHAR *p;
for (p = chpt; p < limit; ++p) {
if (*p == (FULL_CHAR) CH_NEWLINE)
--res;
}
}
#endif /* DB_FIX */
debug1(DLA, DD, "LexNextTokenPos() returning %ld", res);
return res;
}
/*****************************************************************************/
/* */
/* static srcnext() */
/* */
/* Move to new line of input file. May need to recharge buffer. */
/* */
/*****************************************************************************/
static void srcnext(void)
{ register FULL_CHAR *col;
debugcond4(DLA, DD, stack_free <= 1,
"srcnext(); buf: %d, chpt: %d, frst: %d, limit: %d",
buf - mem_block, chpt - mem_block, frst - mem_block, limit - mem_block);
/* if time to transfer last line to area preceding buffer, do so */
if( blksize != 0 && chpt < limit )
{ debugcond0(DLA, DD, stack_free <= 1, "srcnext: transferring.");
col = buf;
while( (*--col = *--limit) != CH_NEWLINE );
frst = col + 1; limit++; blksize = 0;
}
/* if buffer is empty, read next block */
/*** changed by JK 9/92 from "if( chpt == limit )" to fix long lines bug */
if( chpt >= limit )
{ if( chpt > limit )
{ col_num(file_pos) = 1;
Error(2, 5, "line is too long (or final newline missing)",
FATAL, &file_pos);
}
chpt = frst;
blksize = fread( (char *) buf, sizeof(char), BUFFER_SIZE, fp);
if( blksize > 0 )
last_char = *(buf + blksize - 1);
if( blksize < BUFFER_SIZE && last_char != CH_NEWLINE )
{
/* at end of file since blksize = 0; so add missing newline char */
blksize++;
last_char = *(buf+blksize-1) = CH_NEWLINE;
/* this adjustment breaks LexNextTokenPos, so fatal error if database */
if( ftype == DATABASE_FILE )
{
line_num(file_pos) = col_num(file_pos) = 0;
Error(2, 25, "a database file must end with a newline; this one doesn't",
FATAL, &file_pos);
}
}
debugcond4(DLA, DD, stack_free <= 1,
"srcnext: %d = fread(0x%x, %d, %d, fp)",
blksize, buf, sizeof(char), BUFFER_SIZE);
frst = buf; limit = buf + blksize; *limit = CH_NEWLINE;
}
/* if nothing more to read, make this clear */
if( chpt >= limit )
{ debugcond0(DLA, DD, stack_free <= 1, "srcnext: nothing more to read");
chpt = limit = buf; *limit = '\0';
}
debugcond4(DLA, DD, stack_free <= 1,
"srcnext returning; buf: %d, chpt: %d, frst: %d, limit: %d",
buf - mem_block, chpt - mem_block, frst - mem_block, limit - mem_block);
} /* end srcnext */
/*@::LexGetToken()@***********************************************************/
/* */
/* OBJECT LexGetToken() */
/* */
/* Get next token from input. Look it up in symbol table. */
/* */
/*****************************************************************************/
OBJECT LexGetToken(void)
{
FULL_CHAR *startpos; /* where the latest token started */
register FULL_CHAR *p, *q; /* pointer to current input char */
register int c; /* temporary character (really char) */
OBJECT res; /* result token */
int vcount, hcount; /* no. of newlines and spaces seen */
if( next_token != nilobj )
{ next_token = Delete(res = next_token, PARENT);
debugcond4(DLA, DD, stack_free <= 1,
"LexGetToken%s (in macro) returning %d.%d %s",
EchoFilePos(&file_pos), vspace(res), hspace(res), EchoToken(res));
return res;
}
res = nilobj; p = chpt;
vcount = hcount = 0;
do switch( chtbl[*p++] )
{
case ESCAPE:
if( ftype==DATABASE_FILE && *p>='a' && *p<='z' && *(p+1) == '{' /*}*/ )
{ res = NewToken(LBR, &file_pos, 0, 0, (unsigned) *p, StartSym);
p += 2;
}
else
{
col_num(file_pos) = (startpos = p-1) - startline;
Error(2, 6, "character %c outside quoted string",
WARN, &file_pos, *startpos);
}
break;
case COMMENT:
debug1(DLA, DDD, "LexGetToken%s: comment", EchoFilePos(&file_pos));
while( (c = *p++) != CH_NEWLINE && c != '\0' );
if( c == CH_NEWLINE )
{
/* do NEWLINE action, only preserve existing horizontal space */
/* and don't count the newline in the vcount. */
chpt = p; srcnext();
line_num(file_pos)++;
col_num(file_pos) = 0;
startline = (p = chpt) - 1;
}
else
{
--p;
}
break;
case CSPACE:
case FORMFEED:
hcount++;
break;
case TAB:
hcount += 8;
break;
case NEWLINE:
chpt = p; srcnext();
line_num(file_pos)++;
col_num(file_pos) = 0;
vcount++; hcount = 0;
startline = (p = chpt) - 1;
break;
case ENDFILE:
debug0(DLA, DDD, "LexGetToken: endfile");
if( !same_file )
{
/* close current file, if any */
if( fp != null )
{ fclose(fp); fp = null;
this_file = ftype == SOURCE_FILE ? NextFile(this_file) : NO_FILE;
}
/* open next file */
while( this_file != NO_FILE )
{ file_num(file_pos) = this_file;
line_num(file_pos) = 1;
col_num(file_pos) = 0;
fp = OpenFile(this_file, FALSE, TRUE);
if( fp != null ) break;
Error(2, 7, "cannot open file %s",
WARN, &file_pos, FullFileName(this_file));
this_file = ftype == SOURCE_FILE ? NextFile(this_file) : NO_FILE;
}
}
if( fp != null )
{ if( offset != 0 )
{ debugcond1(DLA, DD, stack_free <= 1, "fseek(fp, %d, SEEK_SET)", offset);
fseek(fp, (long) offset, SEEK_SET);
offset = 0L;
line_num(file_pos) = first_line_num;
}
frst = limit = chpt = buf;
blksize = 0; last_char = CH_NEWLINE;
srcnext();
startline = (p = chpt) - 1;
hcount = 0;
}
/* no next file, so take continuation */
else switch( ftype )
{
case SOURCE_FILE:
case DATABASE_FILE:
/* input ends with "@End \Input" then UNEXPECTED_EOF */
res = NewToken(END, &file_pos, 0, 0, END_PREC, StartSym);
next_token = NewToken(UNEXPECTED_EOF, &file_pos,0,0,NO_PREC,nilobj);
--p; startline = p;
break;
case FILTER_FILE:
/* input ends with "@End @FilterOut" */
res = NewToken(END, &file_pos, 0, 0, END_PREC, FilterOutSym);
/* ***
next_token = NewToken(CLOSURE,&file_pos,0,0,NO_PREC,FilterOutSym);
*** */
--p; startline = p;
break;
case INCLUDE_FILE:
LexPop();
p = chpt;
hcount = 0;
break;
default:
assert(FALSE, "unknown file type");
break;
} /* end switch */
break;
case OTHER:
col_num(file_pos) = (startpos = p-1) - startline;
while( chtbl[*p++] == OTHER );
c = p - startpos - 1;
do
{ res = SearchSym(startpos, c);
--c; --p;
} while( c > 0 && res == nilobj );
goto MORE; /* 7 lines down */
case LETTER:
col_num(file_pos) = (startpos = p-1) - startline;
while( chtbl[*p++] == LETTER ); --p;
res = SearchSym(startpos, p - startpos);
MORE: if( res == nilobj )
{ setword(WORD, res, file_pos, startpos, p-startpos);
}
else if( type(res) == MACRO )
{ if( recursive(res) )
{ Error(2, 8, "recursion in macro", WARN, &file_pos);
setword(WORD, res, file_pos, startpos, p-startpos);
}
else
{ res = CopyTokenList( sym_body(res), &file_pos );
if( res != nilobj ) next_token = Delete(res, PARENT);
else hcount = 0;
}
}
else if( predefined(res) == 0 )
{ res = NewToken(CLOSURE, &file_pos, 0, 0, precedence(res), res);
}
else if( predefined(res) == INCLUDE || predefined(res) == SYS_INCLUDE )
{ OBJECT t, fname; FILE_NUM fnum; int len; BOOLEAN scope_suppressed;
chpt = p;
t = LexGetToken();
scope_suppressed = (type(t)==WORD && StringEqual(string(t), KW_LBR));
if( type(t)!=LBR && !scope_suppressed )
{ Error(2, 9, "%s expected (after %s)",
WARN, &fpos(t), KW_LBR, SymName(res));
Dispose(t);
res = nilobj;
break;
}
if( scope_suppressed )
{ UnSuppressScope();
Dispose(t);
New(t, LBR);
}
fname = Parse(&t, nilobj, FALSE, FALSE);
fname = ReplaceWithTidy(fname, FALSE);
if( scope_suppressed ) SuppressScope();
if( !is_word(type(fname)) )
{ Error(2, 10, "name of include file expected here",
WARN, &fpos(fname));
Dispose(fname);
res = nilobj;
break;
}
len = StringLength(string(fname)) - StringLength(SOURCE_SUFFIX);
if( len >= 0 && StringEqual(&string(fname)[len], SOURCE_SUFFIX) )
StringCopy(&string(fname)[len], STR_EMPTY);
debug0(DFS, D, " calling DefineFile from LexGetToken");
fnum = DefineFile(string(fname), STR_EMPTY, &fpos(fname),
INCLUDE_FILE,
predefined(res)==INCLUDE ? INCLUDE_PATH : SYSINCLUDE_PATH);
Dispose(fname);
LexPush(fnum, 0, INCLUDE_FILE, 1, FALSE);
res = LexGetToken();
vcount++; /** TEST ADDITION! **/
p = chpt;
}
else if( predefined(res) == END )
res = NewToken(predefined(res), &file_pos,0,0,precedence(res),nilobj);
else
res = NewToken(predefined(res), &file_pos,0,0,precedence(res),res);
break;
case QUOTE:
col_num(file_pos) = (startpos = q = p) - 1 - startline;
do switch( chtbl[*q++ = *p++] )
{
case OTHER:
case LETTER:
case COMMENT:
case CSPACE:
case FORMFEED:
case TAB: break;
case NEWLINE:
case ENDFILE: --p;
Error(2, 11, "unterminated string", WARN, &file_pos);
setword(QWORD, res, file_pos, startpos, q-1-startpos);
break;
case QUOTE: setword(QWORD, res, file_pos, startpos, q-1-startpos);
break;
case ESCAPE: q--;
if( chtbl[*p] == NEWLINE || chtbl[*p] == ENDFILE )
{ Error(2, 12, "unterminated string", WARN, &file_pos);
setword(QWORD, res, file_pos, startpos, q-startpos);
}
else if( octaldigit(*p) )
{ int count, ch;
count = ch = 0;
do
{ ch = ch * 8 + digitchartonum(*p++);
count++;
} while( octaldigit(*p) && count < 3 );
if( ch == '\0' )
Error(2, 13, "skipping null character in string",
WARN, &file_pos);
else *q++ = ch;
}
else *q++ = *p++;
break;
default: Error(2, 14, "LexGetToken: error in quoted string",
INTERN, &file_pos);
break;
} while( res == nilobj );
break;
default:
assert(FALSE, "LexGetToken: bad chtbl[]");
break;
} while( res == nilobj );
if( p - startline >= MAX_LINE )
{ col_num(file_pos) = 1;
Error(2, 15, "line is too long (or final newline missing)",FATAL,&file_pos);
}
chpt = p;
vspace(res) = vcount;
hspace(res) = hcount;
debugcond5(DLA, DD, stack_free <= 1, "LexGetToken%s returning %s %s %d.%d",
EchoFilePos(&file_pos), Image(type(res)), EchoToken(res),
vspace(res), hspace(res));
return res;
} /* end LexGetToken */
/*@::LexScanVerbatim@*********************************************************/
/* */
/* OBJECT LexScanVerbatim(fp, end_stop, err_pos, lessskip) */
/* */
/* Scan input file and transfer to filter file fp, or if that is NULL, make */
/* a VCAT of objects, one per line (or just a WORD if one line only), and */
/* return that object as the result. If end_stop, terminate at @End, else */
/* terminate at matching right brace. */
/* */
/* If lessskip is true it means that we should skip only up to and */
/* including the first newline character, as opposed to the usual */
/* skipping of all initial white space characters. */
/* */
/*****************************************************************************/
#define print(ch) \
{ debug2(DLA, D, "print(%c), bufftop = %d", ch, bufftop); \
if( fp == NULL ) \
{ if( bufftop < MAX_BUFF ) \
{ if( chtbl[ch] == NEWLINE ) \
{ res = BuildLines(res, buff, &bufftop); \
} \
else buff[bufftop++] = ch; \
} \
} \
else putc(ch, fp); \
}
#define clear() \
{ int i; \
for( i = 0; i < hs_top; i++ ) print(hs_buff[i]); \
hs_top = 0; \
}
#define hold(ch) \
{ if( hs_top == MAX_BUFF ) clear(); \
hs_buff[hs_top++] = ch; \
}
static OBJECT BuildLines(OBJECT current, FULL_CHAR *buff, int *bufftop)
{ OBJECT wd, res, gp, gpword; int c;
/* build a new word and reset the buffer */
setword(WORD, wd, file_pos, buff, *bufftop);
debug1(DLA, D, "BuildLines(current, %s)", EchoObject(wd));
*bufftop = 0;
if( current == nilobj )
{
/* if this is the first word, make it the result */
res = wd;
}
else
{
/* if this is the second word, make the result a VCAT */
if( type(current) == WORD )
{ New(res, VCAT);
FposCopy(fpos(res), fpos(current));
Link(res, current);
}
else res = current;
/* now attach the new word to res, preceded by a one-line gap */
New(gp, GAP_OBJ);
mark(gap(gp)) = FALSE;
join(gap(gp)) = FALSE;
FposCopy(fpos(gp), file_pos);
gpword = MakeWord(WORD, AsciiToFull("1vx"), &file_pos);
Link(gp, gpword);
Link(res, gp);
Link(res, wd);
}
debug1(DLA, D, "BuildLines returning %s", EchoObject(res));
return res;
}
OBJECT LexScanVerbatim(fp, end_stop, err_pos, lessskip)
FILE *fp; BOOLEAN end_stop; FILE_POS *err_pos; BOOLEAN lessskip;
{
register FULL_CHAR *p; /* pointer to current input char */
int depth; /* depth of nesting of { ... } */
BOOLEAN finished; /* TRUE when finished */
BOOLEAN skipping; /* TRUE when skipping initial spaces */
FULL_CHAR hs_buff[MAX_BUFF]; /* hold spaces here in case last */
int hs_top; /* next free spot in hs_buff */
FULL_CHAR buff[MAX_BUFF]; /* hold line here if not to file */
int bufftop; /* top of buff */
OBJECT res = nilobj; /* result object if not to file */
debug3(DLA, D, "LexScanVerbatim(fp, %s, %s, %s)",
bool(end_stop), EchoFilePos(err_pos), bool(lessskip));
if( next_token != nilobj )
{ Error(2, 16, "filter parameter in macro", FATAL, err_pos);
}
p = chpt; depth = 0;
finished = FALSE;
skipping = TRUE;
hs_top = 0;
bufftop = 0;
while( !finished ) switch( chtbl[*p++] )
{
case ESCAPE:
case COMMENT:
case QUOTE:
skipping = FALSE;
clear();
print(*(p-1));
break;
case CSPACE:
case TAB:
case FORMFEED:
if( !skipping ) hold(*(p-1));
break;
case NEWLINE:
if( !skipping ) hold(*(p-1));
if( lessskip ) skipping = FALSE;
chpt = p; srcnext();
line_num(file_pos)++;
col_num(file_pos) = 0;
startline = (p = chpt) - 1;
break;
case ENDFILE:
if( fp == NULL )
Error(2, 22, "end of file reached while reading %s",
FATAL, err_pos, lessskip ? KW_RAWVERBATIM : KW_VERBATIM);
else
Error(2, 17, "end of file reached while reading filter parameter",
FATAL, err_pos);
break;
case OTHER:
skipping = FALSE;
if( *(p-1) == '{' /*}*/ )
{ clear();
print(*(p-1));
depth++;
}
else if( *(p-1) == /*{*/ '}' )
{ if( !end_stop && depth == 0 )
{ p--;
finished = TRUE;
}
else
{ clear();
print(*(p-1));
depth--;
}
}
else
{ clear();
print(*(p-1));
}
break;
case LETTER:
skipping = FALSE;
if( *(p-1) == '@' )
{
p--;
if( end_stop && StringBeginsWith(p, KW_END) )
{ finished = TRUE;
}
else if( StringBeginsWithWord(p, KW_INCLUDE) ||
StringBeginsWithWord(p, KW_SYSINCLUDE) )
{
OBJECT incl_fname, t; FILE *incl_fp; int ch; FILE_NUM fnum;
BOOLEAN sysinc = StringBeginsWith(p, KW_SYSINCLUDE);
clear();
p += sysinc ? StringLength(KW_SYSINCLUDE):StringLength(KW_INCLUDE);
chpt = p;
t = LexGetToken();
if( type(t) != LBR ) Error(2, 18, "expected %s here (after %s)",
FATAL, &fpos(t), KW_LBR, sysinc ? KW_SYSINCLUDE : KW_INCLUDE);
incl_fname = Parse(&t, nilobj, FALSE, FALSE);
p = chpt;
incl_fname = ReplaceWithTidy(incl_fname, FALSE);
if( !is_word(type(incl_fname)) )
Error(2, 19, "expected file name here", FATAL,&fpos(incl_fname));
debug0(DFS, D, " calling DefineFile from LexScanVerbatim");
fnum = DefineFile(string(incl_fname), STR_EMPTY, &fpos(incl_fname),
INCLUDE_FILE, sysinc ? SYSINCLUDE_PATH : INCLUDE_PATH);
Dispose(incl_fname);
incl_fp = OpenFile(fnum, FALSE, TRUE);
if( incl_fp == NULL )
Error(2, 20, "cannot open include file %s",
FATAL, PosOfFile(fnum), FullFileName(fnum));
while( (ch = getc(incl_fp)) != EOF )
print(ch);
fclose(incl_fp);
}
else
{ clear();
print(*p);
p++;
}
}
else
{ clear();
print(*(p-1));
}
break;
default:
Error(2, 22, "unreadable character (octal %o)",INTERN,&file_pos,*(p-1));
assert(FALSE, "LexScanVerbatim: bad chtbl[]");
break;
};
print('\n');
if( p - startline >= MAX_LINE )
{ col_num(file_pos) = 1;
Error(2, 21, "line is too long (or final newline missing)",FATAL,&file_pos);
}
chpt = p;
if( fp == NULL && res == nilobj )
res = MakeWord(WORD, STR_EMPTY, &file_pos);
debug2(DLA, D, "LexScanVerbatim returning %s at %s",
EchoObject(res), EchoFilePos(&file_pos));
return res;
} /* end LexScanVerbatim */
