static FULL_CHAR *GetArg(char *argv[], int argc, int *i) { if( !StringEqual(AsciiToFull(argv[*i]+2), STR_EMPTY) ) return AsciiToFull(argv[*i]+2); else if( *i < argc-1 && *argv[*i + 1] != CH_HYPHEN ) return AsciiToFull(argv[(*i)++ +1]); else return (FULL_CHAR *) NULL; } /* end GetArg */
void DebugInit(FULL_CHAR *str) { int j, urg; for( urg = 0; urg < 2 && str[urg+2] == CH_FLAG_DEBUG; urg++ ); for( j = 1; ; j++ ) { if( StringEqual(AsciiToFull(dbg[j].flag), &str[urg+2]) ) break; if( StringEqual(AsciiToFull(dbg[j].flag), STR_EMPTY) ) Error(27, 1, "unknown debug flag %s", FATAL, no_fpos, str); } for( ; urg >= 0; urg-- ) dbg[j].on[urg] = dbg[ANY].on[urg] = TRUE; } /* end DebugInit */
static OBJECT load(FULL_CHAR *xstr, unsigned xpre, BOOLEAN xleft, BOOLEAN xright, BOOLEAN xindef, unsigned char xprec) { OBJECT s; s = InsertSym(xstr, LOCAL, no_fpos, xprec, xindef, FALSE, xpre, StartSym, nilobj); if( xleft ) InsertSym( AsciiToFull("pa"), LPAR, no_fpos, DEFAULT_PREC, FALSE, FALSE, 0, s, nilobj); if( xright ) InsertSym( AsciiToFull("pb"), RPAR, no_fpos, DEFAULT_PREC, FALSE, FALSE, 0, s, nilobj); if( xleft && xright && xpre != PLUS && xpre != MINUS ) right_assoc(s) = TRUE; return s; } /* end load */
FULL_CHAR *SymName(OBJECT s) { OBJECT p; if( s == nilobj ) return AsciiToFull("<nilobj>"); Parent(p, Up(s)); assert( is_word(type(p)), "SymName: !is_word(type(p))!" ); return string(p); } /* end SymName */
void InitTime(void) { time_t raw_time; struct tm *now; FULL_CHAR buff[20]; OBJECT par, tmp, sym, env; OBJECT tag, second, minute, hour, weekday, monthday, yearday, month, year, century, dst; debug0(DTK, D, "InitTime()"); /* define @Moment symbol with its host of named parameters */ MomentSym = load(KW_MOMENT, LOCAL, StartSym); tag = load(KW_TAG, NPAR, MomentSym); second = load(KW_SECOND, NPAR, MomentSym); minute = load(KW_MINUTE, NPAR, MomentSym); hour = load(KW_HOUR, NPAR, MomentSym); monthday = load(KW_DAY, NPAR, MomentSym); month = load(KW_MONTH, NPAR, MomentSym); year = load(KW_YEAR, NPAR, MomentSym); century = load(KW_CENTURY, NPAR, MomentSym); weekday = load(KW_WEEKDAY, NPAR, MomentSym); yearday = load(KW_YEARDAY, NPAR, MomentSym); dst = load(KW_DAYLIGHTSAVING, NPAR, MomentSym); /* get current time and convert to ASCII */ if( time(&raw_time) == -1 ) Error(35, 1, "unable to obtain the current time", WARN, no_fpos); now = localtime(&raw_time); StringCopy(time_string, AsciiToFull(asctime(now))); time_string[StringLength(time_string) - 1] = '\0'; /* start of current_moment */ New(current_moment, CLOSURE); actual(current_moment) = MomentSym; /* attach its many parameters */ add_par("%s", KW_NOW, tag); add_par("%.2d", now->tm_sec, second); add_par("%.2d", now->tm_min, minute); add_par("%.2d", now->tm_hour, hour); add_par("%d", now->tm_mday, monthday); add_par("%d", now->tm_mon + 1, month); add_par("%.2d", now->tm_year % 100, year); add_par("%d", (now->tm_year+1900) / 100, century); add_par("%d", now->tm_wday + 1, weekday); add_par("%d", now->tm_yday, yearday); add_par("%d", now->tm_isdst, dst); /* add a null environment */ New(env, ENV); AttachEnv(env, current_moment); debug0(DTK, D, "InitTime() returning."); debug0(DTK, DD, "current_moment ="); ifdebug(DTK, DD, DebugObject(current_moment)); } /* end InitTime */
void AppendString(FULL_CHAR *str) { int len; assert(instring, "AppendString: no current string"); assert( 0 <= curr && curr < MULTI, "BeginString: curr!" ); if( bp == MAX_BUFF ) return; /* no space, do nothing */ len = StringLength(str); if( len + bp >= MAX_BUFF ) { StringCopy( &buff[curr][MAX_BUFF/2], AsciiToFull(" ... <too long>") ); bp = MAX_BUFF; } else { StringCopy(&buff[curr][bp], str); while( buff[curr][bp] != '\0' ) bp++; if( bp >= MAX_BUFF ) Error(26, 1, "AppendString abort", INTERN, no_fpos); } } /* end AppendString */
FULL_CHAR *FullSymName(OBJECT x, FULL_CHAR *str) { OBJECT stack[20]; int i; static FULL_CHAR buff[MAX_BUFF], *sname; if( x == nilobj ) return AsciiToFull("<nilobj>"); assert( enclosing(x) != nilobj, "FullSymName: enclosing(x) == nilobj!" ); for( i = 0; enclosing(x) != nilobj && i < 20; i++ ) { stack[i] = x; x = enclosing(x); } StringCopy(buff, STR_EMPTY); for( i--; i > 0; i-- ) { sname = SymName(stack[i]); if( StringLength(sname)+StringLength(str)+StringLength(buff) >= MAX_BUFF ) Error(29, 8, "full name of symbol is too long", FATAL, &fpos(x)); StringCat(buff, sname); StringCat(buff, str); } sname = SymName(stack[0]); if( StringLength(sname) + StringLength(buff) >= MAX_BUFF ) Error(29, 9, "full name of symbol is too long", FATAL, &fpos(x)); StringCat(buff, sname); return buff; } /* end FullSymName */
int startup(int argc, char *argv[]) { int i, len; FULL_CHAR *arg; OBJECT t, y, res, s; /* current token, parser output */ BOOLEAN stdin_seen; /* TRUE when stdin file seen */ int source_file_count; /* number of source files in command */ FULL_CHAR *cross_db; /* name of cross reference database */ FULL_CHAR *outfile; /* name of output file */ FULL_CHAR *lib; /* name of library directory */ FILE *out_fp; long MemCheckLong; FULL_CHAR oname[MAX_BUFF], oval[MAX_BUFF], buff[MAX_BUFF], *p; int bp; OBJECT z; BOOLEAN seen_wordcount; #if LOCALE_ON char catname[MAX_BUFF], *loc; #endif /* find the name of the library directory, from envt or else from -D */ lib = AsciiToFull(getenv("LOUTLIB")); if( lib == (FULL_CHAR *) NULL ) lib = AsciiToFull(LIB_DIR); /* set locale if that's what we are doing */ #if LOCALE_ON loc = setlocale(LC_MESSAGES, ""); if( loc == (char *) NULL ) { Error(1, 6, "unable to initialize locale", WARN, no_fpos); loc = "C"; } sprintf(catname, "%s/%s/%s/LC_MESSAGES/errors.%s", lib, LOCALE_DIR, loc, loc); MsgCat = catopen(catname, 0); #endif /* initialise various modules, add current directory to search paths */ TotalWordCount = 0; seen_wordcount = FALSE; BackEnd = PS_BackEnd; PlainCharWidth = PLAIN_WIDTH; PlainCharHeight = PLAIN_HEIGHT; PlainFormFeed = FALSE; InitializeAll = FALSE; UseCollate = COLLATE; AllowCrossDb = TRUE; InMemoryDbIndexes = TRUE; Encapsulated = FALSE; SafeExecution = SAFE_DFT ? TRUE : FALSE; Kern = TRUE; MemInit(); InitSym(); LexInit(); InitFiles(); AddToPath(SOURCE_PATH, MakeWord(WORD, STR_EMPTY, no_fpos)); AddToPath(DATABASE_PATH, MakeWord(WORD, STR_EMPTY, no_fpos)); AddToPath(INCLUDE_PATH, MakeWord(WORD, STR_EMPTY, no_fpos)); /* read command line */ stdin_seen = FALSE; AltErrorFormat = FALSE; cross_db = CROSS_DB; outfile = STR_STDOUT; source_file_count = 0; New(CommandOptions, ACAT); for( i = 1; i < argc; i++ ) { if( *argv[i] == CH_HYPHEN ) switch( *(argv[i]+1) ) { case CH_FLAG_OUTFILE: /* read name of output file */ if( (outfile = GetArg(argv, argc, &i)) == NULL ) Error(1, 7, "usage: -o <filename>", FATAL, no_fpos); if( StringEndsWith(outfile, SOURCE_SUFFIX) ) Error(1, 28, "-o: output file name %s ends with %s", FATAL, no_fpos, outfile, SOURCE_SUFFIX); break; case CH_FLAG_SUPPRESS: /* suppress references to OldCrossDb and NewCrossDb */ AllowCrossDb = FALSE; break; case CH_FLAG_MEMCR: /* don't use in-memory database indexes */ InMemoryDbIndexes = FALSE; break; case CH_FLAG_NOKERN: /* suppress kerning */ Kern = FALSE; break; case CH_FLAG_NOCOLLATE: /* suppress local collation */ UseCollate = FALSE; break; case CH_FLAG_COLLATE: /* invoke local collation */ UseCollate = TRUE; break; case CH_FLAG_CROSS: /* read name of cross reference database */ if( (cross_db = GetArg(argv, argc, &i)) == NULL ) Error(1, 8, "usage: -c <filename>", FATAL, no_fpos); break; case CH_FLAG_ERRFILE: /* read log file name */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 9, "usage: -e <filename>", FATAL, no_fpos); ErrorInit(arg); break; case CH_FLAG_ALTERR: /* alternative error message format */ AltErrorFormat = TRUE; break; case CH_FLAG_EPSFIRST: /* -EPS produces encapsulated PostScript output */ if( !StringEqual(AsciiToFull(argv[i]+1), STR_EPS) ) Error(1, 10, "usage: -EPS", FATAL, no_fpos); Encapsulated = TRUE; break; case CH_FLAG_DIRPATH: /* add directory to database and sysdatabase paths */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 11, "usage: -D <directoryname>", FATAL, no_fpos); AddToPath(DATABASE_PATH, MakeWord(WORD, arg, no_fpos)); AddToPath(SYSDATABASE_PATH, MakeWord(WORD, arg, no_fpos)); break; case CH_FLAG_ENCPATH: /* add directory to character mapping path */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 12, "usage: -C <directoryname>", FATAL, no_fpos); AddToPath(MAPPING_PATH, MakeWord(WORD, arg, no_fpos)); break; case CH_FLAG_FNTPATH: /* add directory to font path */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 13, "usage: -F <directoryname>", FATAL, no_fpos); AddToPath(FONT_PATH, MakeWord(WORD, arg, no_fpos)); break; case CH_FLAG_HYPPATH: /* add directory to hyph path */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 14, "usage: -H <directoryname>", FATAL, no_fpos); AddToPath(HYPH_PATH, MakeWord(WORD, arg, no_fpos)); break; case CH_FLAG_INCPATH: /* add directory to include and sysinclude paths */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 15, "usage: -I <directoryname>", FATAL, no_fpos); AddToPath(INCLUDE_PATH, MakeWord(WORD, arg, no_fpos)); AddToPath(SYSINCLUDE_PATH, MakeWord(WORD, arg, no_fpos)); break; case CH_FLAG_INCLUDE: /* read sysinclude file and strip any .lt suffix */ if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 16, "usage: -i <filename>", FATAL, no_fpos); len = StringLength(arg) - StringLength(SOURCE_SUFFIX); if( len >= 0 && StringEqual(&arg[len], SOURCE_SUFFIX) ) StringCopy(&arg[len], STR_EMPTY); debug0(DFS, D, " calling DefineFile from main (1)"); DefineFile(arg, STR_EMPTY, no_fpos, SOURCE_FILE, SYSINCLUDE_PATH); break; case CH_FLAG_HYPHEN: /* declare hyphenation file */ if( FirstFile(HYPH_FILE) != NO_FILE ) Error(1, 17, "two -h options illegal", FATAL, no_fpos); if( (arg = GetArg(argv, argc, &i)) == NULL ) Error(1, 18, "usage: -h <filename>", FATAL, no_fpos); debug0(DFS, D, " calling DefineFile from main (2)"); DefineFile(arg, STR_EMPTY, no_fpos, HYPH_FILE, INCLUDE_PATH); DefineFile(arg, HYPH_SUFFIX, no_fpos, HYPH_PACKED_FILE, INCLUDE_PATH); break; case CH_FLAG_VERSION: fprintf(stderr, "%s\n", LOUT_VERSION); fprintf(stderr, "%-28s %s\n", "Basser Lout written by:", "Jeffrey H. Kingston ([email protected])"); fprintf(stderr, "%-28s %s\n", "Free source available from:", "ftp://ftp.cs.usyd.edu.au/jeff/lout"); fprintf(stderr, "%-28s %s %s\n", "This executable compiled:", __TIME__, __DATE__); fprintf(stderr, "%-28s %s%s%s\n", "System include directory:", lib, STR_DIR, INCL_DIR); fprintf(stderr, "%-28s %s%s%s\n", "System database directory:", lib, STR_DIR, DATA_DIR); fprintf(stderr, "Database index files created afresh automatically:%s\n", USE_STAT ? " yes" : " no"); fprintf(stderr, "Safe execution (disabling system()) is default:%s\n", SAFE_DFT ? " yes" : " no"); fprintf(stderr, "strcoll() used for sorting by default:%s\n", COLLATE ? " yes" : " no"); fprintf(stderr, "PDF compression on:%s\n", PDF_COMPRESSION ? " yes" : " no"); fprintf(stderr, "Debugging (-d, -dd, -ddd flags) available:%s\n", DEBUG_ON ? " yes" : " no"); fprintf(stderr, "\n"); fprintf(stderr, "Basser Lout comes with ABSOLUTELY NO WARRANTY.\n"); fprintf(stderr, "This is free software, and you are welcome to\n"); fprintf(stderr, "redistribute it under certain conditions. For\n"); fprintf(stderr, "details on both points, consult the GNU General\n"); fprintf(stderr, "Public License (distributed with this software).\n"); exit(0); break; case CH_FLAG_WORDS: seen_wordcount = TRUE; break; case CH_FLAG_PDF: BackEnd = PDF_BackEnd; break; case CH_FLAG_FFPLAIN: if( StringEqual(AsciiToFull(argv[i]+1), STR_PDF) ) { BackEnd = PDF_BackEnd; break; } PlainFormFeed = TRUE; /* NB NO BREAK */ case CH_FLAG_PLAIN: BackEnd = Plain_BackEnd; if( *(argv[i]+2) != '\0' ) { float len1, len2; FULL_CHAR units1, units2; if( sscanf(argv[i]+2, "%f%c%f%c",&len1,&units1,&len2,&units2) != 4 ) { Error(1, 19, "usage: lout -%c<length><length>", FATAL, no_fpos, *(argv[i]+1)); } switch( units1 ) { case CH_UNIT_CM: PlainCharWidth = len1 * CM; break; case CH_UNIT_IN: PlainCharWidth = len1 * IN; break; case CH_UNIT_PT: PlainCharWidth = len1 * PT; break; case CH_UNIT_EM: PlainCharWidth = len1 * EM; break; default: Error(1, 20, "lout -%c: units must be c, i, p, or m", FATAL, no_fpos, *(argv[i]+1)); break; } switch( units2 ) { case CH_UNIT_CM: PlainCharHeight = len2 * CM; break; case CH_UNIT_IN: PlainCharHeight = len2 * IN; break; case CH_UNIT_PT: PlainCharHeight = len2 * PT; break; case CH_UNIT_EM: PlainCharHeight = len2 * EM; break; default: Error(1, 21, "lout -%c: units must be c, i, p, or m", FATAL, no_fpos, *(argv[i]+1)); break; } } break; case CH_FLAG_INITALL: InitializeAll = TRUE; AllowCrossDb = FALSE; break; case CH_FLAG_USAGE: PrintUsage(stderr); exit(0); break; case CH_FLAG_DEBUG: debug_init(AsciiToFull(argv[i])); break; case CH_FLAG_MEMCHECK: sscanf(argv[i], "-m%ld", &MemCheckLong); MemCheck = (POINTER) MemCheckLong; fprintf(stderr, "checking memory location %ld\n", (long) MemCheck); break; case '\0': /* read stdin as file name */ if( stdin_seen ) Error(1, 23, "standard input specified twice", FATAL, no_fpos); stdin_seen = TRUE; debug0(DFS, D, " calling DefineFile from main (3)"); DefineFile(STR_STDIN, STR_EMPTY, no_fpos, SOURCE_FILE, SOURCE_PATH); break; case CH_FLAG_OPTION: /* read command-line document option */ if( sscanf(argv[i]+2, "%[^{ ] { %[^}] }", oname, oval) != 2 || StringLength(oname) == 0 || StringLength(oval) == 0 ) Error(1, 24, "error in command-line option %s", FATAL, no_fpos, argv[i]+2); y = MakeWord(WORD, oname, no_fpos); Link(CommandOptions, y); New(y, ACAT); Link(CommandOptions, y); bp = 0; for( p = oval; *p != '\0'; p++ ) switch( *p ) { case ' ': case '\t': case '\n': case '{': case '}': if( bp > 0 ) { buff[bp++] = '\0'; if( Down(y) != y ) { OBJECT g; New(g, GAP_OBJ); hspace(g) = 1; vspace(g) = 0; FposCopy(fpos(g), *no_fpos); Link(y, g); } z = MakeWord(WORD, buff, no_fpos); Link(y, z); bp = 0; } break; default: buff[bp++] = *p; break; } if( bp > 0 ) { buff[bp++] = '\0'; z = MakeWord(WORD, buff, no_fpos); Link(y, z); } if( Down(y) == y ) Error(1, 25, "error in command-line option %s", FATAL, no_fpos, argv[i]+2); break; case CH_FLAG_SAFE: /* ensure safe execution by disabling system calls */ SafeExecution = TRUE; break; case CH_FLAG_UNSAFE: /* allow unsafe execution */ SafeExecution = FALSE; break; default: PrintUsage(stderr); Error(1, 26, "unknown command line flag %s", FATAL, no_fpos, argv[i]); break; } else { /* argument is source file, strip any .lout suffix and define it */ arg = AsciiToFull(argv[i]); len = StringLength(arg) - StringLength(SOURCE_SUFFIX); if( len >= 0 && StringEqual(&arg[len], SOURCE_SUFFIX) ) StringCopy(&arg[len], STR_EMPTY); debug0(DFS, D, " calling DefineFile from main (4)"); DefineFile(AsciiToFull(argv[i]), STR_EMPTY, no_fpos, SOURCE_FILE, SOURCE_PATH); source_file_count++; } } /* for */ if( UseCollate ) { if (!setlocale (LC_COLLATE, "")) Error(1, 30, "unable to initialize collation", WARN, no_fpos); } /* start timing if required */ ifdebug(DPP, D, ProfileOn("main")); /* open output file, or stdout if none specified, and initialize printer */ if( StringEqual(outfile, STR_STDOUT) ) { #if OS_DOS /* For DOS/Win32 we need to set binary mode on stdout to prevent PDF compressed streams and xrefs from being corrupted - Uwe 12/98 */ if( BackEnd->code != PLAINTEXT && _setmode(_fileno(stdout), _O_BINARY) == -1 ) Error(1, 31, "cannot set binary mode on stdout", FATAL, no_fpos); #endif out_fp = stdout; } else { out_fp = StringFOpen(outfile, BackEnd->code == PLAINTEXT ? WRITE_TEXT : WRITE_BINARY); if( out_fp == null ) Error(1, 27, "cannot open output file %s", FATAL, no_fpos, outfile); } /* initialize miscellaneous modules */ ColourInit(); LanguageInit(); BackEnd->PrintInitialize(out_fp); /* append default directories to file search paths */ AddToPath(FONT_PATH, MakeWordThree(lib, STR_DIR, AsciiToFull(FONT_DIR))); AddToPath(HYPH_PATH, MakeWordThree(lib, STR_DIR, AsciiToFull(HYPH_DIR))); AddToPath(MAPPING_PATH, MakeWordThree(lib, STR_DIR, AsciiToFull(MAPS_DIR))); AddToPath(SYSDATABASE_PATH,MakeWordThree(lib,STR_DIR, AsciiToFull(DATA_DIR))); AddToPath(DATABASE_PATH, MakeWordThree(lib, STR_DIR, AsciiToFull(DATA_DIR))); AddToPath(SYSINCLUDE_PATH,MakeWordThree(lib, STR_DIR, AsciiToFull(INCL_DIR))); AddToPath(INCLUDE_PATH, MakeWordThree(lib, STR_DIR, AsciiToFull(INCL_DIR))); /* use stdin if no source files were mentioned */ if( source_file_count == 0 ) { debug0(DFS, D, " calling DefineFile from main (5)"); DefineFile(STR_STDIN, STR_EMPTY, no_fpos, SOURCE_FILE, SOURCE_PATH); } /* load predefined symbols into symbol table */ StartSym = nilobj; /* Not a mistake */ StartSym = load(KW_START, 0, FALSE, FALSE, TRUE, NO_PREC ); GalleySym = load(KW_GALLEY, 0, FALSE, FALSE, TRUE, NO_PREC ); ForceGalleySym= load(KW_FORCE_GALLEY, 0, FALSE, FALSE, TRUE, NO_PREC ); InputSym = load(KW_INPUT, 0, FALSE, FALSE, TRUE, NO_PREC ); PrintSym = load(KW_PRINT, 0, FALSE, FALSE, TRUE, NO_PREC ); FilterInSym = load(KW_FILTERIN, 0, FALSE, FALSE, FALSE, NO_PREC ); FilterOutSym = load(KW_FILTEROUT, 0, FALSE, FALSE, FALSE, NO_PREC ); FilterErrSym = load(KW_FILTERERR, 0, FALSE, FALSE, FALSE, NO_PREC ); OptGallSym = load(KW_OPTGALL, 0, FALSE, TRUE, FALSE, DEFAULT_PREC); VerbatimSym = load(KW_VERBATIM,VERBATIM,FALSE, TRUE, FALSE, DEFAULT_PREC); RawVerbatimSym= load(KW_RAWVERBATIM,RAW_VERBATIM,FALSE,TRUE,FALSE,DEFAULT_PREC); load(KW_BEGIN, BEGIN, FALSE, FALSE, FALSE, BEGIN_PREC ); load(KW_END, END, FALSE, FALSE, FALSE, END_PREC ); load(KW_ENV, ENV, FALSE, FALSE, FALSE, NO_PREC ); load(KW_ENVA, ENVA, FALSE, FALSE, FALSE, NO_PREC ); load(KW_ENVB, ENVB, FALSE, FALSE, FALSE, NO_PREC ); load(KW_ENVC, ENVC, FALSE, FALSE, FALSE, NO_PREC ); load(KW_ENVD, ENVD, FALSE, FALSE, FALSE, NO_PREC ); load(KW_CENV, CENV, FALSE, FALSE, FALSE, NO_PREC ); load(KW_CLOS, CLOS, FALSE, FALSE, FALSE, NO_PREC ); load(KW_LVIS, LVIS, FALSE, FALSE, FALSE, NO_PREC ); load(KW_LUSE, LUSE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_LEO, LEO, FALSE, FALSE, FALSE, NO_PREC ); load(KW_LBR, LBR, FALSE, FALSE, FALSE, LBR_PREC ); load(KW_RBR, RBR, FALSE, FALSE, FALSE, RBR_PREC ); load(KW_INCLUDE, INCLUDE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_SYSINCLUDE, SYS_INCLUDE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_PREPEND, PREPEND, FALSE, FALSE, FALSE, NO_PREC ); load(KW_SYSPREPEND, SYS_PREPEND, FALSE, FALSE, FALSE, NO_PREC ); load(KW_DATABASE, DATABASE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_SYSDATABASE, SYS_DATABASE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_USE, USE, FALSE, FALSE, FALSE, NO_PREC ); load(KW_NOT_REVEALED, NOT_REVEALED, FALSE, FALSE, FALSE, NO_PREC ); load(KW_CASE, CASE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_YIELD, YIELD, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_BACKEND, BACKEND, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_XCHAR, XCHAR, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_FONT, FONT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_SPACE, SPACE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_YUNIT, YUNIT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_ZUNIT, ZUNIT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_BREAK, BREAK, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_UNDERLINE, UNDERLINE, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_COLOUR, COLOUR, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_COLOR, COLOUR, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_OUTLINE, OUTLINE, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_LANGUAGE, LANGUAGE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_CURR_LANG, CURR_LANG, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_CURR_FAMILY, CURR_FAMILY, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_CURR_FACE, CURR_FACE, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_CURR_YUNIT, CURR_YUNIT, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_CURR_ZUNIT, CURR_ZUNIT, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_COMMON, COMMON, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_RUMP, RUMP, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_MELD, MELD, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_INSERT, INSERT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_ONE_OF, ONE_OF, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_NEXT, NEXT, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_PLUS, PLUS, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_MINUS, MINUS, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_OPEN, OPEN, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_TAGGED, TAGGED, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_WIDE, WIDE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_HIGH, HIGH, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_HSHIFT, HSHIFT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_VSHIFT, VSHIFT, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_BEGIN_HEADER, BEGIN_HEADER, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_END_HEADER, END_HEADER, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_SET_HEADER, SET_HEADER, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_CLEAR_HEADER, CLEAR_HEADER, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_ONE_COL, ONE_COL, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_ONE_ROW, ONE_ROW, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HSCALE, HSCALE, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VSCALE, VSCALE, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HCOVER, HCOVER, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VCOVER, VCOVER, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_KERN_SHRINK, KERN_SHRINK, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_SCALE, SCALE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_HCONTRACT, HCONTRACT, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VCONTRACT, VCONTRACT, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HLIMITED, HLIMITED, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VLIMITED, VLIMITED, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HEXPAND, HEXPAND, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VEXPAND, VEXPAND, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_STARTHVSPAN, START_HVSPAN, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_STARTHSPAN, START_HSPAN, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_STARTVSPAN, START_VSPAN, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HSPAN, HSPAN, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_VSPAN, VSPAN, FALSE, FALSE, FALSE, DEFAULT_PREC); load(KW_PADJUST, PADJUST, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_HADJUST, HADJUST, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_VADJUST, VADJUST, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_ROTATE, ROTATE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_BACKGROUND, BACKGROUND, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_INCGRAPHIC, INCGRAPHIC, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_SINCGRAPHIC, SINCGRAPHIC, FALSE, TRUE, FALSE, DEFAULT_PREC); load(KW_PLAINGRAPHIC, PLAIN_GRAPHIC, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_GRAPHIC, GRAPHIC, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_LINK_SOURCE, LINK_SOURCE, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_LINK_DEST, LINK_DEST, TRUE, TRUE, FALSE, DEFAULT_PREC); load(KW_CROSS, CROSS, TRUE, TRUE, FALSE, CROSSOP_PREC); load(KW_FORCE_CROSS, FORCE_CROSS, TRUE, TRUE, FALSE, CROSSOP_PREC); load(KW_NULL, NULL_CLOS, FALSE, FALSE, TRUE, NO_PREC ); load(KW_PAGE_LABEL, PAGE_LABEL, FALSE, TRUE, TRUE, DEFAULT_PREC); #define setcat(s, mk, jn) has_mark(s)=mk, has_join(s)=jn s=load(KW_VCAT_NN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,FALSE); s=load(KW_VCAT_MN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, FALSE); s=load(KW_VCAT_NJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,TRUE); s=load(KW_VCAT_MJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, TRUE); s=load(KW_HCAT_NN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,FALSE); s=load(KW_HCAT_MN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, FALSE); s=load(KW_HCAT_NJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,TRUE); s=load(KW_HCAT_MJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, TRUE); s=load(KW_ACAT_NJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,FALSE,TRUE); s=load(KW_ACAT_MJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,TRUE, TRUE); /* intialize fonts and load @FontDef symbol */ FontInit(); /* intialize current time and load @Moment symbol */ InitTime(); /* initialize filter module */ FilterInit(); /* initialize enviroment table module */ EnvInit(); /* initialise scope chain to <StartSym> */ PushScope(StartSym, FALSE, FALSE); /* initialise lexical analyser */ LexPush(FirstFile(SOURCE_FILE), 0, SOURCE_FILE, 1, FALSE); /* process input files */ InitParser(cross_db); t = NewToken(BEGIN, no_fpos, 0, 0, BEGIN_PREC, StartSym); res = Parse(&t, StartSym, TRUE, TRUE); debug0(DGT, D, "calling TransferEnd(res) from main()"); DisposeObject(CommandOptions); TransferEnd(res); TransferClose(); /* close various modules */ BackEnd->PrintAfterLastPage(); BackEnd->LinkCheck(); CrossClose(); CloseFiles(); /* remove any leftover filter temporary files */ FilterScavenge(TRUE); /* print word count, if required */ if( seen_wordcount ) Error(1, 29, "total of all words printed: %d", WARN,no_fpos,TotalWordCount); /* check for unbalanced error blocks */ CheckErrorBlocks(); /* wrapup */ ifdebug(DST, DD, CheckSymSpread() ); ifdebug(ANY, D, DeleteEverySym() ); debug0(DMA, D, "at end of run:"); ifdebug(DMA, D, DebugMemory() ); ifdebug(DPP, D, ProfileOff("main")); ifdebug(DPP, D, ProfilePrint()); ifdebug(DET, D, EnvDebug()); #if LOCALE_ON catclose(MsgCat); #endif exit(0); return 0; } /* end main */
OBJECT ClosureExpand(OBJECT x, OBJECT env, BOOLEAN crs_wanted, OBJECT *crs, OBJECT *res_env) { OBJECT link, y, res, prnt_env, par, prnt; debug3(DCE, D, "[ ClosureExpand( %s, %s, %s, crs, res_env )", EchoObject(x), EchoObject(env), bool(crs_wanted)); assert( type(x) == CLOSURE, "ClosureExpand given non-CLOSURE!"); assert( predefined(actual(x)) == FALSE, "ClosureExpand given predefined!" ); /* add tag to x if needed but not provided; add cross-reference to crs */ if( has_tag(actual(x)) ) CrossAddTag(x); if( crs_wanted && has_tag(actual(x)) ) { OBJECT tmp = CopyObject(x, no_fpos); AttachEnv(env, tmp); y = CrossMake(actual(x), tmp, CROSS_TARG); New(tmp, CROSS_TARG); actual(tmp) = y; Link(tmp, y); if( *crs == nilobj ) New(*crs, CR_LIST); Link(*crs, tmp); } /* case x is a parameter */ res = *res_env = nilobj; if( is_par(type(actual(x))) ) { prnt = SearchEnv(env, enclosing(actual(x))); if( prnt != nilobj ) { prnt_env = GetEnv(prnt); for( link = Down(prnt); link != prnt; link = NextDown(link) ) { Child(par, link); if( type(par) == PAR && actual(par) == actual(x) ) { assert( Down(par) != par, "ExpandCLosure: Down(par)!"); Child(res, Down(par)); if( dirty(enclosing(actual(par))) || is_enclose(actual(par)) ) { debug2(DCE, DD, "copy %s %s", SymName(actual(par)), EchoObject(res)); res = CopyObject(res, no_fpos); } else { debug2(DCE, DD, "link %s %s", FullSymName(actual(par), AsciiToFull(".")), EchoObject(res)); DeleteLink(Down(par)); y = MakeWord(WORD, STR_NOCROSS, &fpos(res)); Link(par, y); } ReplaceNode(res, x); if( type(actual(x)) == RPAR && has_body(enclosing(actual(x))) ) { debug0(DCR, DDD, " calling SetEnv from ClosureExpand (a)"); *res_env = SetEnv(prnt, nilobj); DisposeObject(x); } else if( type(actual(x)) == NPAR && imports_encl(actual(x)) ) { debug0(DCR, DDD, " calling SetEnv from ClosureExpand (x)"); AttachEnv(env, x); *res_env = SetEnv(x, nilobj); } else { AttachEnv(env, x); debug0(DCR, DDD, " calling SetEnv from ClosureExpand (b)"); *res_env = SetEnv(x, prnt_env); } break; } } } else { /* fail only if there is no default value available */ if( sym_body(actual(x)) == nilobj ) { debug3(DCE, D, "failing ClosureExpand( %s, crs, %s, %s, res_env )", EchoObject(x), bool(crs_wanted), EchoObject(env)); Error(9, 2, "no value for parameter %s of symbol %s:", WARN, &fpos(x), SymName(actual(x)), SymName(enclosing(actual(x)))); Error(9, 1, "symbol with import list misused", FATAL, &fpos(x)); } } } /* case x is a user-defined symbol or default parameter */ if( res == nilobj ) { if( sym_body(actual(x)) == nilobj ) res = MakeWord(WORD, STR_NOCROSS, &fpos(x)); else res = CopyObject(sym_body(actual(x)), &fpos(x)); ReplaceNode(res, x); AttachEnv(env, x); debug0(DCR, DDD, " calling SetEnv from ClosureExpand (c)"); *res_env = SetEnv(x, nilobj); } assert( *res_env!=nilobj && type(*res_env)==ENV, "ClosureExpand: *res_env!"); debug0(DCE, D, "] ClosureExpand returning, res ="); ifdebug(DCE, D, DebugObject(res)); debug1(DCE, D, " environment = %s", EchoObject(*res_env)); return res; } /* end ClosureExpand */
FULL_CHAR *Image(unsigned int c) { static FULL_CHAR b[20]; switch(c) { case LINK: return AsciiToFull("link"); case SPLIT: return AsciiToFull("split"); case HEAD: return AsciiToFull("head"); case PAR: return AsciiToFull("par"); case WORD: return AsciiToFull("word"); case QWORD: return AsciiToFull("qword"); case GAP_OBJ: return AsciiToFull("gap_obj"); case ROW_THR: return AsciiToFull("row_thr"); case COL_THR: return AsciiToFull("col_thr"); case CLOSURE: return AsciiToFull("closure"); case NULL_CLOS: return KW_NULL; case PAGE_LABEL: return KW_PAGE_LABEL; case CROSS: return KW_CROSS; case FORCE_CROSS: return KW_FORCE_CROSS; case BEGIN_HEADER: return KW_BEGIN_HEADER; case END_HEADER: return KW_END_HEADER; case SET_HEADER: return KW_SET_HEADER; case CLEAR_HEADER: return KW_CLEAR_HEADER; case ONE_COL: return KW_ONE_COL; case ONE_ROW: return KW_ONE_ROW; case WIDE: return KW_WIDE; case HIGH: return KW_HIGH; case HSHIFT: return KW_HSHIFT; case VSHIFT: return KW_VSHIFT; case HMIRROR: return KW_HMIRROR; case VMIRROR: return KW_VMIRROR; case HSCALE: return KW_HSCALE; case VSCALE: return KW_VSCALE; case HCOVER: return KW_HCOVER; case VCOVER: return KW_VCOVER; case HCONTRACT: return KW_HCONTRACT; case VCONTRACT: return KW_VCONTRACT; case HLIMITED: return KW_HLIMITED; case VLIMITED: return KW_VLIMITED; case HEXPAND: return KW_HEXPAND; case VEXPAND: return KW_VEXPAND; case START_HVSPAN: return KW_STARTHVSPAN; case START_HSPAN: return KW_STARTHSPAN; case START_VSPAN: return KW_STARTVSPAN; case HSPAN: return KW_HSPAN; case VSPAN: return KW_VSPAN; case HSPANNER: return AsciiToFull("hspannner"); case VSPANNER: return AsciiToFull("vspannner"); case PADJUST: return KW_PADJUST; case HADJUST: return KW_HADJUST; case VADJUST: return KW_VADJUST; case ROTATE: return KW_ROTATE; case BACKGROUND: return KW_BACKGROUND; case SCALE: return KW_SCALE; case KERN_SHRINK: return KW_KERN_SHRINK; case RAW_VERBATIM: return KW_RAWVERBATIM; case VERBATIM: return KW_VERBATIM; case CASE: return KW_CASE; case YIELD: return KW_YIELD; case BACKEND: return KW_BACKEND; case FILTERED: return AsciiToFull("filtered"); case XCHAR: return KW_XCHAR; case FONT: return KW_FONT; case SPACE: return KW_SPACE; case YUNIT: return KW_YUNIT; case ZUNIT: return KW_ZUNIT; case SET_CONTEXT: return KW_SET_CONTEXT; case GET_CONTEXT: return KW_GET_CONTEXT; case BREAK: return KW_BREAK; case UNDERLINE: return KW_UNDERLINE; case UNDERLINE_COLOUR: return KW_UNDERLINE_COLOUR; case COLOUR: return KW_COLOUR; case TEXTURE: return KW_TEXTURE; case OUTLINE: return KW_OUTLINE; case LANGUAGE: return KW_LANGUAGE; case CURR_LANG: return KW_CURR_LANG; case CURR_FAMILY: return KW_CURR_FAMILY; case CURR_FACE: return KW_CURR_FACE; case CURR_YUNIT: return KW_CURR_YUNIT; case CURR_ZUNIT: return KW_CURR_ZUNIT; case COMMON: return KW_COMMON; case RUMP: return KW_RUMP; case MELD: return KW_MELD; case INSERT: return KW_INSERT; case ONE_OF: return KW_ONE_OF; case NEXT: return KW_NEXT; case PLUS: return KW_PLUS; case MINUS: return KW_MINUS; case ENV_OBJ: return AsciiToFull("env_obj"); case ENV: return KW_ENV; case ENVA: return KW_ENVA; case ENVB: return KW_ENVB; case ENVC: return KW_ENVC; case ENVD: return KW_ENVD; case CENV: return KW_CENV; case CLOS: return KW_CLOS; case LVIS: return KW_LVIS; case LUSE: return KW_LUSE; case LEO: return KW_LEO; case OPEN: return KW_OPEN; case TAGGED: return KW_TAGGED; case INCGRAPHIC: return KW_INCGRAPHIC; case SINCGRAPHIC: return KW_SINCGRAPHIC; case PLAIN_GRAPHIC: return KW_PLAINGRAPHIC; case GRAPHIC: return KW_GRAPHIC; case LINK_SOURCE: return KW_LINK_SOURCE; case LINK_DEST: return KW_LINK_DEST; case LINK_DEST_NULL: return KW_LINK_DEST; case LINK_URL: return KW_LINK_URL; case ACAT: return AsciiToFull("acat"); case HCAT: return AsciiToFull("hcat"); case VCAT: return AsciiToFull("vcat"); case TSPACE: return AsciiToFull("tspace"); case TJUXTA: return AsciiToFull("tjuxta"); case LBR: return AsciiToFull("lbr"); case RBR: return AsciiToFull("rbr"); case UNEXPECTED_EOF: return AsciiToFull("unexpected_eof"); case BEGIN: return KW_BEGIN; case END: return KW_END; case USE: return KW_USE; case NOT_REVEALED: return KW_NOT_REVEALED; case GSTUB_NONE: return AsciiToFull("gstub_none"); case GSTUB_INT: return AsciiToFull("gstub_int"); case GSTUB_EXT: return AsciiToFull("gstub_ext"); case INCLUDE: return KW_INCLUDE; case SYS_INCLUDE: return KW_SYSINCLUDE; case PREPEND: return KW_PREPEND; case SYS_PREPEND: return KW_SYSPREPEND; case INCG_REPEATED: return KW_INCG_REPEATED; case SINCG_REPEATED: return KW_SINCG_REPEATED; case DATABASE: return KW_DATABASE; case SYS_DATABASE: return KW_SYSDATABASE; /* case START: return AsciiToFull("start"); unused */ case DEAD: return AsciiToFull("dead"); case UNATTACHED: return AsciiToFull("unattached"); case RECEPTIVE: return AsciiToFull("receptive"); case RECEIVING: return AsciiToFull("receiving"); case RECURSIVE: return AsciiToFull("recursive"); case PRECEDES: return AsciiToFull("precedes"); case FOLLOWS: return AsciiToFull("follows"); case CROSS_LIT: return AsciiToFull("cross_lit"); case CROSS_FOLL: return AsciiToFull("cross_foll"); case CROSS_FOLL_OR_PREC: return AsciiToFull("cross_foll_or_prec"); case GALL_FOLL: return AsciiToFull("gall_foll"); case GALL_FOLL_OR_PREC: return AsciiToFull("gall_foll_or_prec"); case CROSS_TARG: return AsciiToFull("cross_targ"); case GALL_TARG: return AsciiToFull("gall_targ"); case GALL_PREC: return AsciiToFull("gall_prec"); case CROSS_PREC: return AsciiToFull("cross_prec"); case PAGE_LABEL_IND: return AsciiToFull("page_label_ind"); case SCALE_IND: return AsciiToFull("scale_ind"); case COVER_IND: return AsciiToFull("cover_ind"); case EXPAND_IND: return AsciiToFull("expand_ind"); case THREAD: return AsciiToFull("thread"); case CROSS_SYM: return AsciiToFull("cross_sym"); case CR_ROOT: return AsciiToFull("cr_root"); case MACRO: return KW_MACRO; case LOCAL: return AsciiToFull("local"); case LPAR: return AsciiToFull("lpar"); case NPAR: return AsciiToFull("npar"); case RPAR: return AsciiToFull("rpar"); case CR_LIST: return AsciiToFull("cr_list"); case EXT_GALL: return AsciiToFull("ext_gall"); case DISPOSED: return AsciiToFull("disposed"); case BACK: return AsciiToFull("back"); case ON: return AsciiToFull("on"); case FWD: return AsciiToFull("fwd"); case PROMOTE: return AsciiToFull("promote"); case CLOSE: return AsciiToFull("close"); case BLOCK: return AsciiToFull("block"); case CLEAR: return AsciiToFull("clear"); case GAP_ABS: return AsciiToFull("abs"); case GAP_INC: return AsciiToFull("inc"); case GAP_DEC: return AsciiToFull("dec"); default: sprintf( (char *) b, "?? (%d)", c); return b; } /* end switch */ } /* end Image */