Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume38/lout/part12

Text File | 1993-08-11 | 72.4 KB | 1,766 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Jeff Kingston)
Subject: v38i080:  lout - Lout document formatting system, v2.05, Part12/35
Message-ID: <[e-mail]>
X-Md4-Signature: 36024c84a55d1c1f6544ff8148e883fe
Sender: [e-mail] (Kent Landfield)
Organization: Sterling Software
Date: Sun, 8 Aug 1993 18:09:32 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Jeff Kingston)
Posting-number: Volume 38, Issue 80
Archive-name: lout/part12
Environment: UNIX
Supersedes: lout: Volume 37, Issue 99-128

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# Contents:  doc/tr.lout/ch4.00 z01.c z10.c z33.c
# Wrapped by kent@sparky on Sun Aug  8 12:29:24 1993
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 12 (of 35)."'
if test -f 'doc/tr.lout/ch4.00' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'doc/tr.lout/ch4.00'\"
else
  echo shar: Extracting \"'doc/tr.lout/ch4.00'\" \(397 characters\)
  sed "s/^X//" >'doc/tr.lout/ch4.00' <<'END_OF_FILE'
X@Chapter
X   @Title { Examples }
X   @Tag { examples }
X@Begin
X@LP
XThis chapter presents some examples taken from the various
Xpackages available with Basser Lout.  The reader who masters these
Xexamples will be well prepared to read the packages themselves.  The
Xexamples have not been simplified in any way, since an important part of
Xtheir purpose is to show Lout in actual practice.
X@BeginSections
END_OF_FILE
  if test 397 -ne `wc -c <'doc/tr.lout/ch4.00'`; then
    echo shar: \"'doc/tr.lout/ch4.00'\" unpacked with wrong size!
  fi
  # end of 'doc/tr.lout/ch4.00'
fi
if test -f 'z01.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'z01.c'\"
else
  echo shar: Extracting \"'z01.c'\" \(16834 characters\)
  sed "s/^X//" >'z01.c' <<'END_OF_FILE'
X/*@z01.c:Supervise:StartSym, AllowCrossDb, Encapsulated, etc.@****************/
X/*                                                                           */
X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
X/*                                                                           */
X/*  Jeffrey H. Kingston ([e-mail])                                   */
X/*  Basser Department of Computer Science                                    */
X/*  The University of Sydney 2006                                            */
X/*  AUSTRALIA                                                                */
X/*                                                                           */
X/*  This program is free software; you can redistribute it and/or modify     */
X/*  it under the terms of the GNU General Public License as published by     */
X/*  the Free Software Foundation; either version 1, or (at your option)      */
X/*  any later version.                                                       */
X/*                                                                           */
X/*  This program is distributed in the hope that it will be useful,          */
X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
X/*  GNU General Public License for more details.                             */
X/*                                                                           */
X/*  You should have received a copy of the GNU General Public License        */
X/*  along with this program; if not, write to the Free Software              */
X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
X/*                                                                           */
X/*  FILE:         z01.c                                                      */
X/*  MODULE:       Supervise                                                  */
X/*  EXTERNS:      main(), StartSym, GalleySym, InputSym, PrintSym,           */
X/*                AllowCrossDb, Encapsulated                                 */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  StartSym      the symbol table entry for \Start (overall scope)          */
X/*  GalleySym     the symbol table entry for @Galley                         */
X/*  InputSym      the symbol table entry for @LInput                         */
X/*  PrintSym      the symbol table entry for \Print (root target)            */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT StartSym, GalleySym, InputSym, PrintSym;
X
X/*****************************************************************************/
X/*                                                                           */
X/*  AllowCrossDb        Allow references to OldCrossDb and NewCrossDb        */
X/*  Encapsulated        Produce a one-page encapsulated PostScript file      */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN AllowCrossDb;
XBOOLEAN Encapsulated;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static OBJECT load(xstr, xpredefined, xleft, xright, xindef, xprec)      */
X/*                                                                           */
X/*  Load a predefined operator with these attributes into the symbol table.  */
X/*  If the operator has parameters, load symbols for those also.             */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic OBJECT load(xstr, xpre, xleft, xright, xindef, xprec)
XFULL_CHAR *xstr;  unsigned  xpre;  BOOLEAN xleft, xright, xindef;
Xunsigned char xprec;
X{ OBJECT s;
X  s = InsertSym(xstr, LOCAL, no_fpos, xprec, xindef, FALSE, xpre, StartSym,nil);
X  if( xleft )  InsertSym( AsciiToFull("pa"), LPAR, no_fpos, DEFAULT_PREC,
X    FALSE, FALSE, 0, s, nil);
X  if( xright )  InsertSym( AsciiToFull("pb"), RPAR, no_fpos, DEFAULT_PREC,
X    FALSE, FALSE, 0, s, nil);
X  if( xleft && xright )  right_assoc(s) = TRUE;
X  return s;
X} /* end load */
X
X
X/*@::GetArg(), main()@********************************************************/
X/*                                                                           */
X/*  GetArg(arg, message)                                                     */
X/*                                                                           */
X/*  Get the next argument from the command line and store it in arg.         */
X/*  Print message as a fatal error if it isn't there.                        */
X/*                                                                           */
X/*****************************************************************************/
X
X#define GetArg(arg, message)                        \
X{ if( !StringEqual(AsciiToFull(argv[i]+2), STR_EMPTY) )            \
X    arg = AsciiToFull(argv[i]+2);                    \
X  else if( i < argc-1 && *argv[i+1] != CH_HYPHEN )            \
X    arg = AsciiToFull(argv[i++ +1]);                    \
X  else                                    \
X    Error(FATAL, no_fpos, message);                    \
X} /* end GetArg */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  main(argc, argv)                                                         */
X/*                                                                           */
X/*  Read command line, initialise everything, read definitions, read         */
X/*  galleys, clean up and exit.                                              */
X/*                                                                           */
X/*****************************************************************************/
X
Xmain(argc, argv)
Xint argc; char *argv[];
X{ int i, len;  FULL_CHAR *arg;
X  OBJECT t, res, s;            /* current token, parser output      */
X  BOOLEAN stdin_seen;            /* TRUE when stdin file seen         */
X  FULL_CHAR *cross_db;            /* name of cross reference database  */
X  FULL_CHAR *outfile;            /* name of output file               */
X  FILE *out_fp;
X
X  /* initialise various modules, add current directory to search paths */
X  AllowCrossDb = TRUE;
X  Encapsulated = FALSE;
X  InitSym();
X  LexInit();
X  MemInit();
X  InitFiles();
X  AddToPath(SOURCE_PATH,   STR_EMPTY);
X  AddToPath(DATABASE_PATH, STR_EMPTY);
X  AddToPath(INCLUDE_PATH,  STR_EMPTY);
X
X  /* read command line */
X  stdin_seen = FALSE;
X  cross_db = CROSS_DB;
X  outfile = STR_STDOUT;
X  for( i = 1;  i < argc;  i++ )
X  { if( *argv[i] == CH_HYPHEN ) switch( *(argv[i]+1) )
X    {
X      case CH_FLAG_OUTFILE:
X
X    /* read name of output file */
X    GetArg(outfile, "usage: -o<filename>");
X    break;
X
X
X      case CH_FLAG_SUPPRESS:
X
X    /* suppress references to OldCrossDb and NewCrossDb */
X    AllowCrossDb = FALSE;
X    break;
X
X
X      case CH_FLAG_CROSS:
X
X    /* read name of cross reference database */
X    GetArg(cross_db, "usage: -c<filename>");
X    break;
X
X
X      case CH_FLAG_ERRFILE:
X
X    /* read log file name */
X    GetArg(arg, "usage: -e<filename>");
X    ErrorInit(arg);
X    break;
X
X
X      case CH_FLAG_EPSFIRST:
X
X    /* -EPS produces encapsulated PostScript output */
X    if( !StringEqual(AsciiToFull(argv[i]+1), STR_EPS) )
X      Error(FATAL, no_fpos, "usage: -EPS");
X    Encapsulated = TRUE;
X    break;
X
X
X      case CH_FLAG_DIRPATH:
X
X    /* add directory to database and sysdatabase paths */
X    GetArg(arg, "usage: -D<dirname>");
X    AddToPath(DATABASE_PATH, arg);
X    AddToPath(SYSDATABASE_PATH, arg);
X    break;
X
X
X      case CH_FLAG_ENCPATH:
X
X    /* add directory to encoding path */
X    GetArg(arg, "usage: -C<dirname>");
X    AddToPath(ENCODING_PATH, arg);
X    break;
X
X
X      case CH_FLAG_FNTPATH:
X
X    /* add directory to font path */
X    GetArg(arg, "usage: -F<dirname>");
X    AddToPath(FONT_PATH, arg);
X    break;
X
X
X      case CH_FLAG_INCPATH:
X
X    /* add directory to include and sysinclude paths */
X    GetArg(arg, "usage: -I<dirname>");
X    AddToPath(INCLUDE_PATH, arg);
X    AddToPath(SYSINCLUDE_PATH, arg);
X    break;
X
X
X      case CH_FLAG_INCLUDE:
X
X    /* read sysinclude file and strip any .lt suffix */
X    GetArg(arg, "usage: -i<filename>");
X    len = StringLength(arg) - StringLength(SOURCE_SUFFIX);
X    if( len >= 0 && StringEqual(&arg[len], SOURCE_SUFFIX) )
X      StringCopy(&arg[len], STR_EMPTY);
X    DefineFile(arg, STR_EMPTY, no_fpos,
X      SOURCE_FILE, SYSINCLUDE_PATH);
X    break;
X
X
X      case CH_FLAG_HYPHEN:
X
X    /* declare hyphenation file */
X    if( FirstFile(HYPH_FILE) != NO_FILE )
X      Error(FATAL, no_fpos, "two -h options illegal");
X    GetArg(arg, "usage: -h<filename>");
X    DefineFile(arg, STR_EMPTY, no_fpos,
X      HYPH_FILE, INCLUDE_PATH);
X    DefineFile(arg, HYPH_SUFFIX, no_fpos,
X      HYPH_PACKED_FILE, INCLUDE_PATH);
X    break;
X
X
X      case CH_FLAG_VERSION:
X
X    fprintf(stderr, "%s\n", LOUT_VERSION);
X    break;
X
X
X      case CH_FLAG_USAGE:
X
X    fprintf(stderr, "usage: lout [ -i<filename> ] files\n");
X    exit(0);
X    break;
X
X
X      case CH_FLAG_DEBUG:
X
X    debug_init(argv[i]);
X    break;
X
X
X      case '\0':
X
X    /* read stdin as file name */
X    if( stdin_seen )  Error(FATAL, no_fpos, "stdin read twice!");
X    stdin_seen = TRUE;
X    DefineFile(STR_STDIN, STR_EMPTY, no_fpos, SOURCE_FILE, SOURCE_PATH);
X    break;
X
X
X      default:
X
X    Error(FATAL, no_fpos, "unknown command line flag %s", argv[i]);
X    break;
X
X    }
X    else
X    {   /* argument is source file, strip any .lout suffix and define it */
X    arg = argv[i];
X    len = StringLength(arg) - StringLength(SOURCE_SUFFIX);
X    if( len >= 0 && StringEqual(&arg[len], SOURCE_SUFFIX) )
X      StringCopy(&arg[len], STR_EMPTY);
X    DefineFile(AsciiToFull(argv[i]), STR_EMPTY, no_fpos,
X        SOURCE_FILE, SOURCE_PATH);
X    }
X  } /* for */
X
X  /* define hyphenation file if not done already by -h flag */
X  if( FirstFile(HYPH_FILE) == NO_FILE )
X  { DefineFile(HYPH_FILENAME, STR_EMPTY, no_fpos, HYPH_FILE, SYSINCLUDE_PATH);
X    DefineFile(HYPH_FILENAME, HYPH_SUFFIX, no_fpos,
X      HYPH_PACKED_FILE, SYSINCLUDE_PATH);
X  }
X
X  /* start timing if required */
X  ifdebug(DPP, D, ProfileOn("main"));
X
X  /* open output file, or stdout if none specified, and initialize printer */
X  if( StringEqual(outfile, STR_STDOUT) )  out_fp = stdout;
X  else if( (out_fp = StringFOpen(outfile, "w")) == null )
X    Error(FATAL, no_fpos, "cannot open output file %s", outfile);
X  FontInit();
X  PrintInit(out_fp);
X
X  /* append default directories to file search paths */
X  AddToPath(FONT_PATH,         AsciiToFull(FONT_DIR));
X  AddToPath(ENCODING_PATH,     AsciiToFull(EVEC_DIR));
X  AddToPath(SYSDATABASE_PATH,  AsciiToFull(DATA_DIR));
X  AddToPath(DATABASE_PATH,     AsciiToFull(DATA_DIR));
X  AddToPath(SYSINCLUDE_PATH,   AsciiToFull(INCL_DIR));
X  AddToPath(INCLUDE_PATH,      AsciiToFull(INCL_DIR));
X
X  /* use stdin if no source files were mentioned */
X  if( FirstFile(SOURCE_FILE) == NO_FILE )
X    DefineFile(STR_STDIN, STR_EMPTY, no_fpos, SOURCE_FILE, SOURCE_PATH);
X
X  /* load predefined symbols into symbol table */
X  StartSym = nil;  /* Not a mistake */
X  StartSym  = load(KW_START,    0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  GalleySym = load(KW_GALLEY,   0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  InputSym  = load(KW_INPUT,    0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  PrintSym  = load(KW_PRINT,    0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X
X  load(KW_BEGIN,       BEGIN,          FALSE,  FALSE,  FALSE, BEGIN_PREC  );
X  load(KW_END,         END,            FALSE,  FALSE,  FALSE, END_PREC    );
X  load(KW_ENV,         ENV,            FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_CLOS,        CLOS,           FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_LVIS,        LVIS,           FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_LBR,         LBR,            FALSE,  FALSE,  FALSE, LBR_PREC    );
X  load(KW_RBR,         RBR,            FALSE,  FALSE,  FALSE, RBR_PREC    );
X  load(KW_INCLUDE,     INCLUDE,        FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSINCLUDE,  SYS_INCLUDE,    FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_PREPEND,     PREPEND,        FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSPREPEND,  SYS_PREPEND,    FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_DATABASE,    DATABASE,       FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSDATABASE, SYS_DATABASE,   FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_USE,         USE,            FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_CASE,        CASE,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_YIELD,       YIELD,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_XCHAR,       XCHAR,          FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_FONT,        FONT,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SPACE,       SPACE,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_BREAK,       BREAK,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_NEXT,        NEXT,           FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_OPEN,        OPEN,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_TAGGED,      TAGGED,         TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HIGH,        HIGH,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_WIDE,        WIDE,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ONE_COL,     ONE_COL,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ONE_ROW,     ONE_ROW,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HSCALE,      HSCALE,         FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VSCALE,      VSCALE,         FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SCALE,       SCALE,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HCONTRACT,   HCONTRACT,      FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VCONTRACT,   VCONTRACT,      FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HEXPAND,     HEXPAND,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VEXPAND,     VEXPAND,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_PADJUST,     PADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HADJUST,     HADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VADJUST,     VADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ROTATE,      ROTATE,         TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_INCGRAPHIC,  INCGRAPHIC,     FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SINCGRAPHIC, SINCGRAPHIC,    FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_GRAPHIC,     GRAPHIC,        TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_CROSS,       CROSS,          TRUE,   TRUE,   FALSE, CROSSOP_PREC);
X  load(KW_NULL,        NULL_CLOS,      FALSE,  FALSE,  TRUE,  NO_PREC     );
X
X#define setcat(s, mk, jn)  has_mark(s)=mk, has_join(s)=jn
X
X  s=load(KW_VCAT_NN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,FALSE);
X  s=load(KW_VCAT_MN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, FALSE);
X  s=load(KW_VCAT_NJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_VCAT_MJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, TRUE);
X  s=load(KW_HCAT_NN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,FALSE);
X  s=load(KW_HCAT_MN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, FALSE);
X  s=load(KW_HCAT_NJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_HCAT_MJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, TRUE);
X  s=load(KW_ACAT_NJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_ACAT_MJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,TRUE, TRUE);
X
X  /* intialize current time and load @Moment symbol */
X  InitTime();
X
X  /* initialise scope chain to <StartSym> */
X  PushScope(StartSym, FALSE, FALSE);
X
X  /* initialise lexical analyser */
X  LexPush(FirstFile(SOURCE_FILE), 0, SOURCE_FILE);
X
X  /* process input files */
X  InitParser(cross_db);
X  t = NewToken(BEGIN, no_fpos, 0, 0, BEGIN_PREC, StartSym);
X  res = Parse(&t, StartSym, TRUE, TRUE);
X  TransferEnd(res);
X  TransferClose();
X
X  /* close various  modules */
X  PrintClose();
X  CrossClose();
X  CloseFiles();
X
X  /* wrapup */
X  ifdebug(DST, D, CheckSymSpread() );
X  debug0(ANY, D, "commencing deletes");
X  ifdebug(ANY, D, DeleteEverySym() );
X  ifdebug(DMA, D, DebugMemory() );
X  ifdebug(DPP, D, ProfileOff("main"));
X  ifdebug(DPP, D, ProfilePrint());
X  exit(0);
X  return 0;
X} /* end main */
END_OF_FILE
  if test 16834 -ne `wc -c <'z01.c'`; then
    echo shar: \"'z01.c'\" unpacked with wrong size!
  fi
  # end of 'z01.c'
fi
if test -f 'z10.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'z10.c'\"
else
  echo shar: Extracting \"'z10.c'\" \(26605 characters\)
  sed "s/^X//" >'z10.c' <<'END_OF_FILE'
X/*@z10.c:Cross References:CrossInit(), CrossMake()@***************************/
X/*                                                                           */
X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
X/*                                                                           */
X/*  Jeffrey H. Kingston ([e-mail])                                   */
X/*  Basser Department of Computer Science                                    */
X/*  The University of Sydney 2006                                            */
X/*  AUSTRALIA                                                                */
X/*                                                                           */
X/*  This program is free software; you can redistribute it and/or modify     */
X/*  it under the terms of the GNU General Public License as published by     */
X/*  the Free Software Foundation; either version 1, or (at your option)      */
X/*  any later version.                                                       */
X/*                                                                           */
X/*  This program is distributed in the hope that it will be useful,          */
X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
X/*  GNU General Public License for more details.                             */
X/*                                                                           */
X/*  You should have received a copy of the GNU General Public License        */
X/*  along with this program; if not, write to the Free Software              */
X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
X/*                                                                           */
X/*  FILE:         z10.c                                                      */
X/*  MODULE:       Cross References                                           */
X/*  EXTERNS:      CrossInit(), CrossMake(), GallTargEval(), CrossAddTag(),   */
X/*                CrossExpand(), CrossSequence(), CrossClose()               */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X#define    CROSS_LIT    CROSS_TARG
X#define    NO_TARGET    0
X#define    SEEN_TARGET    1
X#define    WRITTEN_TARGET    2
Xstatic OBJECT RootCross = nil;            /* header for all crs        */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  CrossInit(sym)     Initialize cross_sym(sym).                            */
X/*                                                                           */
X/*****************************************************************************/
X
XCrossInit(sym)
XOBJECT sym;
X{ int i; OBJECT cs = New(CROSS_SYM);
X  target_state(cs) = NO_TARGET;  target_seq(cs) = 0;
X  cr_file(cs) = NO_FILE;
X  gall_seq(cs) = 0;  gall_tag(cs) = nil;
X  gall_tfile(cs) = NO_FILE;  gentag_file(cs) = NO_FILE;
X  symb(cs) = sym;  cross_sym(sym) = cs;
X  gentag_fseq(cs) = NewWord(WORD, MAX_FILES, no_fpos);
X  for( i = 0;  i < MAX_FILES;  i++ ) string(gentag_fseq(cs))[i] = 0;
X  if( RootCross == nil )  RootCross = New(CR_ROOT);  Link(RootCross, cs);
X}
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT CrossMake(sym, val, ctype)                                        */
X/*                                                                           */
X/*  Make a cross-reference with the given sym and tag value (NB no fpos).    */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT CrossMake(sym, val, ctype)
XOBJECT sym, val;  int ctype;
X{ OBJECT v1, res;
X  debug3(DCR, DD, "CrossMake(%s, %s, %s)", SymName(sym),
X    EchoObject(val), Image(ctype));
X  res = New(CROSS);  cross_type(res) = ctype;  threaded(res) = FALSE;
X  v1 = New(CLOSURE);  actual(v1) = sym;
X  Link(res, v1);  Link(res, val);
X  debug1(DCR, DD, "CrossMake returning %s", EchoObject(res));
X  return res;
X}
X
X/*@::GallTargEval(), CrossGenTag()@*******************************************/
X/*                                                                           */
X/*  OBJECT GallTargEval(sym, dfpos)                                          */
X/*                                                                           */
X/*  Produce a suitable cross-reference for a galley target.                  */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT GallTargEval(sym, dfpos)
XOBJECT sym; FILE_POS *dfpos;
X{ OBJECT cs, res;
X  FULL_CHAR buff[MAX_LINE], *str;
X  debug2(DCR, DD, "GallTargEval( %s,%s )", SymName(sym), EchoFilePos(dfpos));
X  if( cross_sym(sym) == nil )  CrossInit(sym);
X  cs = cross_sym(sym);
X  if( file_num(*dfpos) != gall_tfile(cs) )
X  { gall_tfile(cs) = file_num(*dfpos);
X    gall_seq(cs)   = 0;
X  }
X  str = FileName(gall_tfile(cs));
X  if( StringLength(str) + 6 >= MAX_LINE )
X    Error(FATAL, dfpos, "automatically generated tag %s&%d is too long",
X    str, ++gall_seq(cs));
X  ++gall_seq(cs);
X  StringCopy(buff, str);
X  StringCat(buff, AsciiToFull("&"));
X  StringCat(buff, StringInt(gall_seq(cs)));
X  res = CrossMake(sym, MakeWord(WORD, buff, dfpos), GALL_TARG);
X  debug1(DCR, DD, "GallTargEval returning %s", EchoObject(res));
X  return res;
X} /* end GallTargEval */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static OBJECT CrossGenTag(x)                                             */
X/*                                                                           */
X/*  Generate a tag suitable for labelling closure x, in such a way that      */
X/*  the same tag is likely to be generated on subsequent runs.               */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic OBJECT CrossGenTag(x)
XOBJECT x;
X{ FULL_CHAR buff[MAX_LINE], *str1, *str2;
X  OBJECT sym, cs, gt, res;  FILE_NUM fnum;
X  FULL_CHAR *sgt;
X  int seq;
X  debug1(DCR, D, "CrossGenTag( %s )", SymName(actual(x)));
X  sym = actual(x);
X  if( cross_sym(sym) == nil )  CrossInit(sym);
X  cs = cross_sym(sym);
X  fnum = file_num(fpos(x));
X  /* ***
X  if( fnum != gentag_file(cs) )
X  { gentag_file(cs) = fnum;
X    gentag_seq(cs)  = 0;
X  }
X  *** */
X  str1 = FullSymName(sym, AsciiToFull("."));
X  str2 = FileName(fnum);
X  gt = gentag_fseq(cs);
X  sgt = string(gt);
X  seq = ++(sgt[fnum]);
X  if( StringLength(str1) + StringLength(str2) + 10 >= MAX_LINE )
X    Error(FATAL,no_fpos, "automatically generated tag \"%s.%s.%d\" is too long",
X    str1, str2, seq);
X  StringCopy(buff, str1);
X  StringCat(buff, AsciiToFull("."));
X  StringCat(buff, str2);
X  StringCat(buff, AsciiToFull("."));
X  StringCat(buff, StringInt(seq));
X  res = MakeWord(QWORD, buff, &fpos(x));
X  debug1(DCR, DD, "CrossGenTag returning %s", string(res));
X  return res;
X} /* end CrossGenTag */
X
X
X/*@::CrossAddTag()@***********************************************************/
X/*                                                                           */
X/*  CrossAddTag(x)                                                           */
X/*                                                                           */
X/*  Add an automatically generated @Tag parameter to closure x if required.  */
X/*                                                                           */
X/*****************************************************************************/
X
XCrossAddTag(x)
XOBJECT x;
X{ OBJECT link, par, ppar, y;
X  if( has_tag(actual(x)) )
X  {
X    /* search the parameter list of x for a @Tag parameter */
X    for( link = Down(x);  link != x;  link = NextDown(link) )
X    { Child(par, link);
X      if( type(par) == PAR && is_tag(actual(par)) )  break;
X    }
X    if( link == x )
X    {
X      /* search the definition of x for name of its @Tag parameter */
X      ppar = nil;
X      for( link=Down(actual(x));  link != actual(x);  link = NextDown(link) )
X      {    Child(y, link);
X    if( is_par(type(y)) && is_tag(y) )
X    { ppar = y;
X      break;
X    }
X      }
X      if( ppar != nil ) /* should always hold */
X      {
X    /* prepare new PAR containing generated tag */
X    par = New(PAR);
X    actual(par) = ppar;
X    y = CrossGenTag(x);
X    Link(par, y);
X
X    /* find the right spot, then link it to x */
X    switch( type(ppar) )
X    {
X      case LPAR:    link = Down(x);
X            break;
X
X      case NPAR:    link = Down(x);
X            if( Down(x) != x )
X            { Child(y, Down(x));
X              if( type(y) == PAR && type(actual(par)) == LPAR )
X                link = NextDown(link);
X            }
X            break;
X
X      case RPAR:    for( link = Down(x); link != x; link = NextDown(link) )
X            { Child(y, link);
X              if( type(y) != PAR )  break;
X            }
X            break;
X    }
X    Link(link, par);
X      }
X    }
X  }
X} /* end CrossAddTag */
X
X
X/*@::CrossExpand()@***********************************************************/
X/*                                                                           */
X/*  OBJECT CrossExpand(x, env, style, crs_wanted, crs, res_env)              */
X/*                                                                           */
X/*  Return the value of cross-reference x, with environment *res_env.  If x  */
X/*  has a non-literal tag, it must be tracked, so an object is added to *crs */
X/*  for this purpose if crs_wanted.  Result replaces x, which is disposed.   */
X/*                                                                           */
X/*****************************************************************************/
Xstatic OBJECT nbt[2] = { nil, nil };
Xstatic OBJECT nft[2] = { nil, nil };
Xstatic OBJECT ntarget = nil;
X
XOBJECT CrossExpand(x, env, style, crs_wanted, crs, res_env)
XOBJECT x, env;  STYLE *style;  BOOLEAN crs_wanted; OBJECT *crs, *res_env;
X{ OBJECT sym, res, tag, y, cs, link, db, tmp, index;
X  int ctype;  FULL_CHAR buff[MAX_LINE], seq[MAX_LINE], *str;
X  FILE_NUM fnum, dfnum;
X  long cont, dfpos;
X  assert( type(x) == CROSS, "CrossExpand: x!" );
X  debug2(DCR, DD, "CrossExpand( %s, %s )", EchoObject(x), EchoObject(*crs));
X  assert( NextDown(Down(x)) == LastDown(x), "CrossExpand: #args!" );
X
X  /* manifest and tidy the right parameter */
X  Child(tag, LastDown(x));
X  tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X  tag = ReplaceWithTidy(tag);
X
X  /* extract sym (the symbol name) and tag (the tag value) from x */
X  Child(y, Down(x));
X  if( type(y) == CLOSURE )  sym = actual(y);
X  ctype = type(y) != CLOSURE ? 1 :
X      !is_word(type(tag)) ? 2 :
X      StringEqual(string(tag), STR_EMPTY) ? 3 :
X      StringEqual(string(tag), KW_PRECEDING) ? CROSS_PREC :
X      StringEqual(string(tag), KW_FOLLOWING) ? CROSS_FOLL : CROSS_LIT;
X
X  res = nil;
X  switch( ctype )
X  {
X
X    case 1:
X
X      Error(WARN, &fpos(y), "left parameter of %s is not a symbol", KW_CROSS);
X      break;
X
X
X    case 2:
X
X      Error(WARN, &fpos(tag),
X    "value of right parameter of %s is not a simple word", KW_CROSS);
X      break;
X
X
X    case 3:
X
X      Error(WARN, &fpos(tag),
X    "value of right parameter of %s is an empty word", KW_CROSS);
X      break;
X
X
X    case CROSS_LIT:
X
X      if( cross_sym(sym) == nil )  CrossInit(sym);
X      cs = cross_sym(sym);
X      if( sym == MomentSym && StringEqual(string(tag), KW_NOW) )
X      {    /* this is a request for the current time */
X    res = StartMoment();
X      }
X      else for( link = NextUp(Up(cs));  link != cs;  link = NextUp(link) )
X      {    Parent(db, link);
X    assert( is_word(type(db)), "CrossExpand: db!" );
X    if( DbRetrieve(db, FALSE, sym, string(tag), seq, &dfnum,&dfpos,&cont) )
X    { res = ReadFromFile(dfnum, dfpos, sym);
X      if( db != OldCrossDb )  AttachEnv(env, res);
X      break;
X    }
X      }
X      break;
X
X
X    case CROSS_PREC:
X    case CROSS_FOLL:
X
X      if( cross_sym(sym) == nil )  CrossInit(sym);
X      cs = cross_sym(sym);
X      assert( cs != nil, "CrossExpand/CROSS_FOLL: cs == nil!" );
X      assert( type(cs) == CROSS_SYM, "CrossExpand/CROSS_FOLL: type(cs)!" );
X      fnum = file_num(fpos(tag));
X      if( fnum != cr_file(cs) )
X      {    cr_file(cs) = fnum;
X    cr_seq(cs) = 0;
X      }
X      str = FileName(fnum);
X      ++cr_seq(cs);
X      if( StringLength(str) + 5 >= MAX_LINE )
X    Error(FATAL, &fpos(x), "automatically generated tag %s_%d is too long",
X      str, cr_seq(cs));
X      StringCopy(buff, str);
X      StringCat(buff, AsciiToFull("_"));
X      StringCat(buff, StringInt(cr_seq(cs)));
X      tmp = CrossMake(sym, MakeWord(WORD, buff, &fpos(tag)), ctype);
X      index = New(ctype);
X      actual(index) = tmp;
X      Link(index, tmp);
X      if( crs_wanted )
X      {    if( *crs == nil )  *crs = New(CR_LIST);
X    link = Link(*crs, index);
X      }
X      else Error(FATAL, &fpos(x), "%s or %s tag not allowed here",
X    KW_PRECEDING, KW_FOLLOWING);
X      if( AllowCrossDb &&
X      DbRetrieve(OldCrossDb, FALSE, sym, buff, seq, &dfnum, &dfpos,&cont) )
X    res = ReadFromFile(dfnum, dfpos, nil);
X      break;
X
X
X    default:
X
X      Error(INTERN, no_fpos, "CrossExpand switch!");
X      break;
X
X
X  } /* end switch */
X  if( res == nil )
X  { OBJECT envt;
X    if( ctype > 1 )  Error(WARN, &fpos(x), "%s%s%s unknown",
X        SymName(sym), KW_CROSS, string(tag));
X
X    /* build dummy result with environment attached */
X    /* nb at present we are not adding dummy import closures to this! */
X    res = New(CLOSURE);  actual(res) = sym;
X    y = res;
X    debug1(DCR, DD, "First y = %s", SymName(actual(y)));
X    while( enclosing(actual(y)) != StartSym )
X    { tmp = New(CLOSURE);
X      actual(tmp) = enclosing(actual(y));
X      debug0(DCR, DD, "  calling SetEnv from CrossExpand (a)");
X      envt = SetEnv(tmp, nil);
X      AttachEnv(envt, y);
X      y = tmp;
X      debug1(DCR, DD, "Later y = %s", SymName(actual(y)));
X    }
X    envt = New(ENV);  Link(y, envt);
X  }
X
X  /* set environment, replace x by res, debug and exit */
X  *res_env = DetachEnv(res);
X  ReplaceNode(res, x);
X  DisposeObject(x);
X  assert( type(res) == CLOSURE, "CrossExpand: type(res) != CLOSURE!" );
X  assert( actual(res) == sym, "CrossExpand: actual(res) != sym!" );
X  debug1(DCR, DD, "CrossExpand returning %s", EchoObject(res));
X  debug1(DCR, DD, "  *crs = %s", EchoObject(*crs));
X  debug1(DCR, DD, "  *res_env = %s", EchoObject(*res_env));
X  return res;
X} /* end CrossExpand */
X
X
X/*@::CrossSequence()@*********************************************************/
X/*                                                                           */
X/*  CrossSequence(x)                                                         */
X/*                                                                           */
X/*  Object x is an insinuated cross-reference that has just been popped off  */
X/*  the top of the root galley.  Resolve it with the sequence of others.     */
X/*                                                                           */
X/*****************************************************************************/
X
XCrossSequence(x)
XOBJECT x;
X{ OBJECT sym, tag, val, tmp, cs, par, key, link, y;
X  unsigned ctype;  FULL_CHAR buff[MAX_LINE], *str, *seq;
X  FILE_NUM dfnum;  int dfpos;
X
X  /* if suppressing cross-referencing, dispose x and quit */
X  if( !AllowCrossDb )
X  { if( Up(x) == x )  DisposeObject(x);
X    debug0(DCR, D, "CrossSequence returning (!AllowCrossDb).");
X    return;
X  }
X
X  /* get interesting fragments from x */
X  assert( type(x) == CROSS, "CrossSequence: type(x)!" );
X  ctype = cross_type(x);
X  Child(tmp, Down(x));
X  assert( type(tmp) == CLOSURE, "CrossSequence: type(tmp)!" );
X  sym = actual(tmp);
X  if( cross_sym(sym) == nil )  CrossInit(sym);
X  cs = cross_sym(sym);
X  assert( type(cs) == CROSS_SYM, "CrossSequence: cs!" );
X
X  /* debug output */
X  debug2(DCR, D, "CrossSequence %s %s", Image(ctype), SymName(sym));
X  debug1(DCR, DD, "  x = %s", EchoObject(x));
X  ifdebug(DCR, DD, DebugObject(cs));
X
X  /* delete as much of x as possible */
X  Child(tag, NextDown(Down(x)));
X  DeleteLink(NextDown(Down(x)));
X  if( Up(x) == x )  DisposeObject(x);
X
X  switch( ctype )
X  {
X    case GALL_FOLL:
X    case GALL_PREC:
X
X      /* find key of the galley, if any */
X      val = tag;  key = nil;
X      for( link = Down(val);  link != val;  link = NextDown(link) )
X      {    Child(par, link);
X    if( type(par) == PAR && (is_key(actual(par)) || is_tag(actual(par))) )
X    { assert( Down(par) != par, "CrossSequence: PAR child!" );
X      Child(key, Down(par));
X      key = ReplaceWithTidy(key);
X    }
X      }
X
X      /* write out the galley */
X      str = FileName(file_num(fpos(val)));
X      dfnum = FileNum(str, DATA_SUFFIX);
X      if( dfnum == NO_FILE )
X    dfnum = DefineFile(str, DATA_SUFFIX, &fpos(val),
X      DATABASE_FILE, SOURCE_PATH);
X      AppendToFile(val, dfnum, &dfpos);
X
X      /* determine the sequence number or string of this galley */
X      if( key == nil )
X      {    ++gall_seq(cs);
X    StringCopy(buff, StringFiveInt(gall_seq(cs)));
X    seq = buff;
X      }
X      else if( !is_word(type(key)) )
X      {    Error(WARN, &fpos(key), "%s parameter is not a word", KW_KEY);
X    seq = STR_BADKEY;
X      }
X      else if( StringEqual(string(key), STR_EMPTY) )
X      {    Error(WARN, &fpos(key), "%s parameter is empty word", KW_KEY);
X    seq = STR_BADKEY;
X      }
X      else seq = string(key);
X
X      /* either write out the index immediately or store it for later */
X      if( ctype == GALL_PREC )
X      {    if( gall_tag(cs) == nil )
X    { Error(WARN, &fpos(val), "no %s precedes this %s%s%s",
X        SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
X      debug0(DCR, DD, "  ... so substituting \"none\"");
X      gall_tag(cs) = MakeWord(WORD, STR_NONE, &fpos(val));
X    }
X    assert( is_word(type(gall_tag(cs))) &&
X        !StringEqual(string(gall_tag(cs)), STR_EMPTY),
X            "CrossSequence: gall_tag!" );
X    debug3(DCR, D, "  inserting galley (prec) %s&%s %s", SymName(sym),
X      string(gall_tag(cs)), seq);
X    DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), seq,
X            dfnum, (long) dfpos);
X      }
X      else
X      {    tmp = MakeWord(WORD, seq, &fpos(val));
X    gall_rec(tmp) = TRUE;
X    file_num(fpos(tmp)) = dfnum;
X    gall_pos(tmp) = dfpos;
X    Link(cs, tmp);
X    debug2(DCR, D, "  saving galley (foll) %s&? %s", SymName(sym), seq);
X      }
X      DisposeObject(val);
X      break;
X
X
X    case GALL_TARG:
X
X      if( gall_tag(cs) != nil )  DisposeObject(gall_tag(cs));
X      if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
X      {
X    debug2(DCR, DD, "  GALL_TARG %s put none for %s",
X      SymName(sym), EchoObject(tag));
X    DisposeObject(tag);
X    gall_tag(cs) = MakeWord(WORD, STR_NONE, no_fpos);
X      }
X      else gall_tag(cs) = tag;
X      debug2(DCR, D, "  have new %s gall_targ %s", SymName(sym),
X      EchoObject(gall_tag(cs)));
X      for( link = Down(cs);  link != cs;  link = NextDown(link) )
X      {    Child(y, link);
X    assert( is_word(type(y)) && !StringEqual(string(y), STR_EMPTY),
X                "CrossSequence: GALL_TARG y!" );
X    if( gall_rec(y) )
X    {
X      debug3(DCR, D, "  inserting galley (foll) %s&%s %s", SymName(sym),
X        string(gall_tag(cs)), string(y));
X      DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), string(y),
X            file_num(fpos(y)), (long) gall_pos(y));
X      link = PrevDown(link);
X      DisposeChild(NextDown(link));
X    }
X      }
X      break;
X
X
X    case CROSS_PREC:
X
X      if( target_state(cs) == NO_TARGET )
X      {    Error(WARN, &fpos(tag), "no invokation of %s precedes this %s%s%s",
X        SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
X    break;
X      }
X      if( target_state(cs) == SEEN_TARGET )
X      {
X    debug2(DCR, D, "  inserting %s cross_targ %s",
X      SymName(sym), target_val(cs));
X    AppendToFile(target_val(cs), target_file(cs), &target_pos(cs));
X    DisposeObject(target_val(cs));
X    target_val(cs) = nil;
X    target_state(cs) = WRITTEN_TARGET;
X      }
X      if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
X      {
X    debug2(DCR, DD, "  GALL_TARG %s put none for %s", SymName(sym),
X        EchoObject(tag));
X    DisposeObject(tag);
X    tag = MakeWord(WORD, STR_NONE, no_fpos);
X      }
X      debug3(DCR, D, "  inserting cross (prec) %s&%s %s", SymName(sym),
X        string(tag), "0");
X      DbInsert(NewCrossDb, FALSE, sym, string(tag), STR_ZERO,
X    target_file(cs), (long) target_pos(cs));
X      DisposeObject(tag);
X      break;
X
X
X    case CROSS_FOLL:
X
X      if( !is_word(type(tag)) )
X      {    Error(WARN, &fpos(tag), "tag of %s is not a simple word",
X        SymName(symb(cs)));
X    debug1(DCR, DD, "  tag = %s", EchoObject(tag));
X      }
X      else if( StringEqual(string(tag), STR_EMPTY) )
X      {
X        debug1(DCR, D, "  ignoring cross (foll) %s (empty tag)", SymName(sym));
X      }
X      else
X      { Link(cs, tag);
X    gall_rec(tag) = FALSE;
X        debug3(DCR, D, "  storing cross (foll) %s&%s %s", SymName(sym),
X        string(tag), "?");
X      }
X      break;
X
X
X    case CROSS_TARG:
X
X      /* get rid of old target, if any, and add new one */
X      if( target_state(cs) == SEEN_TARGET )
X      {
X    debug2(DCR, D, "  disposing unused %s cross_targ %s", SymName(sym),
X      target_val(cs));
X    DisposeObject(target_val(cs));
X      }
X      debug2(DCR, D, "  remembering new %s cross_targ %s", SymName(sym),
X    EchoObject(tag));
X      target_val(cs) = tag;
X      assert( Up(tag) == tag, "CrossSeq: Up(tag)!" );
X      str = FileName(file_num(fpos(tag)));
X      target_file(cs) = FileNum(str, DATA_SUFFIX);
X      if( target_file(cs) == NO_FILE )
X    target_file(cs) = DefineFile(str, DATA_SUFFIX, &fpos(tag),
X                    DATABASE_FILE, SOURCE_PATH);
X      target_state(cs) = SEEN_TARGET;
X
X      /* store tag of the galley, if any */
X      tag = nil;
X      assert( type(target_val(cs)) == CLOSURE, "CrossSequence: target_val!" );
X      link = Down(target_val(cs));
X      for( ;  link != target_val(cs);  link = NextDown(link) )
X      {    Child(par, link);
X    if( type(par) == PAR && is_tag(actual(par)) )
X    { assert( Down(par) != par, "CrossSequence: Down(PAR)!" );
X      Child(tag, Down(par));
X      tag = ReplaceWithTidy(tag);
X      if( !is_word(type(tag)) )
X      { Error(WARN, &fpos(tag), "%s tag is not a simple word",
X            SymName(actual(target_val(cs))));
X        debug1(DCR, DD, "  tag = %s", EchoObject(tag));
X      }
X      else if( StringEqual(string(tag), STR_EMPTY) )
X      {
X            debug1(DCR, D, "  ignoring cross (own tag) %s (empty tag)",
X        SymName(sym));
X      }
X      else
X      { Link(cs, tag);
X        gall_rec(tag) = FALSE;
X            debug3(DCR, D, "  storing cross (own tag) %s&%s %s", SymName(sym),
X        string(tag), "?");
X      }
X      break;
X    }
X      }
X
X      /* if new target is already writable, write it */
X      if( Down(cs) != cs )
X      {
X    debug2(DCR, D, "  writing %s cross_targ %s", SymName(sym),
X        EchoObject(target_val(cs)));
X    AppendToFile(target_val(cs), target_file(cs), &target_pos(cs));
X    DisposeObject(target_val(cs));
X    for( link = Down(cs);  link != cs;  link = NextDown(link) )
X    { Child(tag, link);
X      assert( is_word(type(tag)) && !StringEqual(string(tag), STR_EMPTY),
X            "CrossSeq: non-WORD or empty tag!" );
X      if( !gall_rec(tag) )
X      {
X        debug3(DCR, D, "  inserting cross (foll) %s&%s %s", SymName(sym),
X          string(tag), "0");
X        DbInsert(NewCrossDb, FALSE, sym, string(tag),
X          STR_ZERO, target_file(cs), (long) target_pos(cs));
X        link = PrevDown(link);
X        DisposeChild(NextDown(link));
X      }
X    }
X    target_state(cs) = WRITTEN_TARGET;
X      }
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(tag), "CrossSequence: ctype = %s", Image(ctype));
X      break;
X
X  } /* end switch */
X  debug0(DCR, D, "CrossSequence returning.");
X  debug0(DCR, DD, "   cs =");
X  ifdebug(DCR, DD, DebugObject(cs));
X} /* end CrossSequence */
X
X
X/*@::CrossClose()@************************************************************/
X/*                                                                           */
X/*  CrossClose()                                                             */
X/*                                                                           */
X/*  Check for dangling forward references, and convert old cross reference   */
X/*  database to new one.                                                     */
X/*                                                                           */
X/*****************************************************************************/
X
XCrossClose()
X{ OBJECT link, cs, ylink, y, sym;  BOOLEAN g;  int len, count;
X  FILE_NUM dfnum;  long dfpos, cont;
X  FULL_CHAR buff[MAX_LINE], seq[MAX_LINE], tag[MAX_LINE];
X  debug0(DCR, D, "CrossClose()");
X  ifdebug(DCR, DD, if( RootCross != nil ) DebugObject(RootCross));
X
X  /* if suppressing cross referencing, return */
X  if( !AllowCrossDb )
X  { debug0(DCR, D, "CrossClose returning (!AllowCrossDb).");
X    return;
X  }
X
X  /* check for dangling forward references and dispose cross ref structures */
X  if( RootCross != nil )
X  { for( link = Down(RootCross);  link != RootCross;  link = NextDown(link) )
X    { Child(cs, link);
X      assert( type(cs) == CROSS_SYM, "CrossClose: type(cs)!" );
X      count = 0;  ylink = Down(cs);
X      while( ylink != cs && count <= 5 )
X      {    Child(y, ylink);
X    Error(WARN, &fpos(y), "no invokation of %s follows this %s%s%s",
X      SymName(symb(cs)), SymName(symb(cs)), KW_CROSS, KW_FOLLOWING);
X    debug2(DCR, D, "gall_rec(y) = %s, y = %s",
X      bool(gall_rec(y)), EchoObject(y));
X    if( gall_rec(y) )
X      DbInsert(NewCrossDb, TRUE, symb(cs), STR_NONE,
X        string(y), file_num(fpos(y)), (long) gall_pos(y));
X    count++;  ylink = NextDown(ylink);
X      }
X      if( ylink != cs )  Error(WARN, no_fpos, "and more undefined %s%s%s",
X                SymName(symb(cs)), KW_CROSS, KW_FOLLOWING);
X      ifdebug(ANY, D,
X    if( target_state(cs) == SEEN_TARGET )  DisposeObject(target_val(cs));
X    if( gall_tag(cs) != nil )  DisposeObject(gall_tag(cs));
X      );
X    }
X    ifdebug(ANY, D, DisposeObject(RootCross); );
X  }
X
X  /* add to NewCrossDb those entries of OldCrossDb from other source files */
X  cont = 0L;  len = StringLength(DATA_SUFFIX);
X  while( DbRetrieveNext(OldCrossDb, &g, &sym, tag, seq, &dfnum, &dfpos, &cont) )
X  { if( g ) continue;
X    StringCopy(buff, FileName(dfnum));
X    StringCopy(&buff[StringLength(buff) - len], STR_EMPTY);
X    if( FileNum(buff, STR_EMPTY) == NO_FILE )
X      DbInsert(NewCrossDb, FALSE, sym, tag, seq, dfnum, dfpos);
X  }
X
X  /* close OldCrossDb's .li file so that NewCrossDb can use its name */
X  DbClose(OldCrossDb);
X
X  /* make NewCrossDb readable, for next run */
X  DbConvert(NewCrossDb, TRUE);
X
X  debug0(DCR, D, "CrossClose returning.");
X} /* end CrossClose */
END_OF_FILE
  if test 26605 -ne `wc -c <'z10.c'`; then
    echo shar: \"'z10.c'\" unpacked with wrong size!
  fi
  # end of 'z10.c'
fi
if test -f 'z33.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'z33.c'\"
else
  echo shar: Extracting \"'z33.c'\" \(25577 characters\)
  sed "s/^X//" >'z33.c' <<'END_OF_FILE'
X/*@z33.c:Database Service:OldCrossDb(), NewCrossDb(), SymToNum()@*************/
X/*                                                                           */
X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
X/*                                                                           */
X/*  Jeffrey H. Kingston ([e-mail])                                   */
X/*  Basser Department of Computer Science                                    */
X/*  The University of Sydney 2006                                            */
X/*  AUSTRALIA                                                                */
X/*                                                                           */
X/*  This program is free software; you can redistribute it and/or modify     */
X/*  it under the terms of the GNU General Public License as published by     */
X/*  the Free Software Foundation; either version 1, or (at your option)      */
X/*  any later version.                                                       */
X/*                                                                           */
X/*  This program is distributed in the hope that it will be useful,          */
X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
X/*  GNU General Public License for more details.                             */
X/*                                                                           */
X/*  You should have received a copy of the GNU General Public License        */
X/*  along with this program; if not, write to the Free Software              */
X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
X/*                                                                           */
X/*  FILE:         z33.c                                                      */
X/*  MODULE:       Database Service                                           */
X/*  EXTERNS:      OldCrossDb, NewCrossDb, DbCreate(), DbInsert(),            */
X/*                DbConvert(), DbClose(), DbLoad(), DbRetrieve(),            */
X/*                DbRetrieveNext()                                           */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OldCrossDb     Database containing cross references from previous run.   */
X/*  NewCrossDb     Writable database of cross references from this run.      */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT OldCrossDb, NewCrossDb;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  #define SymToNum(db, sym, num, gall)                                     */
X/*                                                                           */
X/*  Set num to the number used to refer to sym in database db.  If sym is    */
X/*  not currently referred to in db, create a new number and record sym.     */
X/*  If gall is true, sym is the target of galleys stored in this database.   */
X/*  Store in boolean fields db_targ(link) and is_extern_target(sym).         */
X/*                                                                           */
X/*****************************************************************************/
X
X#define SymToNum(db, sym, num, gall)                    \
X{ OBJECT link, yy;  int count;                        \
X  count = 0;                                \
X  for( link = Down(db);  link != db;  link = NextDown(link) )        \
X  { Child(yy, link);                            \
X    assert(type(yy)==CROSS_SYM || type(yy)==ACAT, "SymToNum: yy!");    \
X    if( type(yy) != CROSS_SYM )  continue;                \
X    if( symb(yy) == sym )  break;                    \
X    if( number(link) > count )  count = number(link);            \
X  }                                    \
X  if( link == db )                            \
X  { if( cross_sym(sym) == nil )  CrossInit(sym);            \
X    link = Link(db, cross_sym(sym));                    \
X    number(link) = count + 1;                        \
X    db_targ(link) = FALSE;                        \
X  }                                    \
X  num = number(link);                            \
X  if( gall )  db_targ(link) = is_extern_target(sym) =            \
X                uses_extern_target(sym) = TRUE;        \
X} /* end SymToNum */
X
X
X/*@::NumToSym(), DbCreate()@**************************************************/
X/*                                                                           */
X/*  #define NumToSym(db, num, sym)                                           */
X/*                                                                           */
X/*  Set sym to the symbol which is referred to in database db by num.        */
X/*                                                                           */
X/*****************************************************************************/
X
X#define NumToSym(db, num, sym)                        \
X{ OBJECT link, y;                            \
X  for( link = Down(db);  link != db;  link = NextDown(link) )        \
X  { Child(y, link);                            \
X    if( type(y) == CROSS_SYM && number(link) == num )  break;        \
X  }                                    \
X  if( link == db )  Error(INTERN, &fpos(db), "NumToSym: no sym!");    \
X  assert( type(y) == CROSS_SYM, "NumToSym: y!" );            \
X  sym = symb(y);                            \
X} /* end NumToSym */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT DbCreate(x)                                                       */
X/*                                                                           */
X/*  Create a new writable database with name (i.e. file stem) x and file     */
X/*  position fpos for error messages.                                        */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT DbCreate(x)
XOBJECT x;
X{ OBJECT db = x;
X  debug1(DBS, D, "DbCreate(%s)", string(db));
X  assert( is_word(type(x)), "DbCreate: !is_word(type(x))" );
X  reading(db) = FALSE;  filep(db) = null;
X  debug1(DBS, D, "DbCreate returning %s", EchoObject(db));
X  return db;
X} /* end DbCreate */
X
X
X/*@::DbInsert()@**************************************************************/
X/*                                                                           */
X/*  DbInsert(db, gall, sym, tag, seq, dfnum, dfpos)                          */
X/*                                                                           */
X/*  Insert a new entry into writable database db.  The primary key of the    */
X/*  entry has these three parts:                                             */
X/*                                                                           */
X/*      gall        TRUE if inserting a galley                               */
X/*      sym         The symbol which is the target of this entry             */
X/*      tag         The tag of this target (must be a non-null string)       */
X/*                                                                           */
X/*  There is also an auxiliary key, seq, which enforces an ordering on       */
X/*  entries with equal primary keys but is not itself ever retrieved.  This  */
X/*  ordering is used for sorted galleys.  The value of the entry has the     */
X/*  following parts:                                                         */
X/*                                                                           */
X/*      dfnum       The file containing the object                           */
X/*      dfpos       The position of the object in that file                  */
X/*                                                                           */
X/*****************************************************************************/
X
XDbInsert(db, gall, sym, tag, seq, dfnum, dfpos)
XOBJECT db;  BOOLEAN gall;  OBJECT sym;  FULL_CHAR *tag, *seq;
XFILE_NUM dfnum;  long dfpos;
X{ int symnum;
X  FULL_CHAR buff[MAX_LINE];
X  assert( is_word(type(db)), "DbInsert: db!" );
X  assert( tag[0] != '\0', "DbInsert: null tag!" );
X  assert( seq[0] != '\0', "DbInsert: null seq!" );
X  ifdebug(DPP, D, ProfileOn("DbInsert"));
X  debug6(DBS, D, "DbInsert(%s, %s, %s, %s, %s, %s, dfpos)",
X    string(db), bool(gall), SymName(sym), tag, seq,
X    dfnum == NO_FILE ? AsciiToFull(".") : FileName(dfnum));
X  if( reading(db) )  Error(INTERN, &fpos(db), "insert into reading database!");
X  if( filep(db) == null )
X  { if( StringLength(string(db)) + StringLength(NEW_INDEX_SUFFIX) >= MAX_LINE )
X      Error(FATAL, no_fpos, "database file name %s%s is too long",
X    string(db), NEW_INDEX_SUFFIX);
X    StringCopy(buff, string(db));
X    StringCat(buff, NEW_INDEX_SUFFIX);
X    filep(db) = StringFOpen(buff, "w");
X    if( filep(db) == null )
X      Error(FATAL, &fpos(db), "cannot write to database file %s", buff);
X  }
X  if( dfnum != NO_FILE )
X  { StringCopy(buff, FileName(dfnum));
X    StringCopy(&buff[StringLength(buff)-StringLength(DATA_SUFFIX)], STR_EMPTY);
X  }
X  else StringCopy(buff, AsciiToFull("."));
X  SymToNum(db, sym, symnum, gall);
X  ifdebug(DBS, D,
X  fprintf(stderr, "  -> %s%d&%s\t%s\t%ld\t%s\n", gall ? "&" : "", symnum,
X    tag, seq, dfpos, buff);
X  );
X  fprintf(filep(db), "%s%d&%s\t%s\t%ld\t%s\n", gall ? "&" : "", symnum,
X    tag, seq, dfpos, buff);
X  debug0(DBS, D, "DbInsert returning.");
X  ifdebug(DPP, D, ProfileOff("DbInsert"));
X} /* end DbInsert */
X
X
X/*@::DbConvert(), DbClose()@**************************************************/
X/*                                                                           */
X/*  DbConvert(db, full_name)                                                 */
X/*                                                                           */
X/*  Convert database db from writable to readable, then dispose it.          */
X/*  full_name is TRUE if symbols are to be known by their full path name.    */
X/*                                                                           */
X/*****************************************************************************/
X
XDbConvert(db, full_name)
XOBJECT db;  BOOLEAN full_name;
X{ FULL_CHAR oldname[MAX_LINE+10], newname[MAX_LINE];
X  char buff[2*MAX_LINE + 20];
X  OBJECT link, y;
X  ifdebug(DPP, D, ProfileOn("DbConvert"));
X  debug2(DBS, D, "DbConvert( %d %s )", (int) db,string(db));
X  if( reading(db) )  Error(INTERN, &fpos(db), "DbConvert: reading database!");
X  StringCopy(newname, string(db));
X  StringCat(newname, INDEX_SUFFIX);
X  StringCopy(oldname, string(db));
X  StringCat(oldname, NEW_INDEX_SUFFIX);
X  if( filep(db) != null )
X  { for( link = Down(db);  link != db;  link = NextDown(link) )
X    { Child(y, link);
X      assert( type(y) == CROSS_SYM || type(y) == ACAT, "DbConvert: y!" );
X      if( type(y) != CROSS_SYM )  continue;
X      fprintf(filep(db), "%s %d %s\n",
X    db_targ(link) ? "#target" : "#symbol",
X    number(link),
X    full_name ? FullSymName(symb(y), AsciiToFull(" ")) : SymName(symb(y)));
X    }
X    fclose(filep(db));
X    sprintf(buff, "sort -o %s %s", newname, oldname);
X    system(buff);
X  }
X  else StringUnlink(newname);
X  StringUnlink(oldname);
X  DeleteNode(db);
X  debug0(DBS, D, "DbConvert returning.");
X  ifdebug(DPP, D, ProfileOff("DbConvert"));
X} /* end DbConvert */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  DbClose(db)                                                              */
X/*                                                                           */
X/*  Close readable database db.                                              */
X/*                                                                           */
X/*****************************************************************************/
X
XDbClose(db)
XOBJECT db;
X{ if( db != nil && filep(db) != NULL )
X  {  fclose(filep(db));
X     filep(db) = NULL;
X  }
X} /* end DbClose */
X
X
X/*@::DbLoad()@****************************************************************/
X/*                                                                           */
X/*  OBJECT DbLoad(stem, fpath, create, symbs)                                */
X/*                                                                           */
X/*  Open for reading the database whose index file name is string(stem).li.  */
X/*  This file has not yet been defined; its search path is fpath.  If it     */
X/*  will not open and create is true, try creating it from string(stem).ld.  */
X/*                                                                           */
X/*  symbs is an ACAT of CLOSUREs showing the symbols that the database may   */
X/*  contain; or nil if the database may contain any symbol.                  */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT DbLoad(stem, fpath, create, symbs)
XOBJECT stem;  int fpath;  BOOLEAN create;  OBJECT symbs;
X{ FILE *fp;  OBJECT db, t, res, tag, par, sym, link, y;
X  int i, lnum, num, count;  FILE_NUM index_fnum, dfnum;  long dfpos;
X  BOOLEAN gall;  FULL_CHAR line[MAX_LINE], sym_name[MAX_LINE];
X  ifdebug(DPP, D, ProfileOn("DbLoad"));
X  debug3(DBS, D, "DbLoad(%s, %d, %s, -)", string(stem), fpath, bool(create));
X
X  /* open or else create index file fp */
X  index_fnum = DefineFile(string(stem), INDEX_SUFFIX, &fpos(stem), INDEX_FILE,
X         fpath);
X  fp = OpenFile(index_fnum, create, FALSE);
X  if( fp == null && create )
X  { db = nil;
X    dfnum = DefineFile(string(stem), DATA_SUFFIX, &fpos(stem),
X      DATABASE_FILE, DATABASE_PATH);
X    dfpos = 0L;  LexPush(dfnum, 0, DATABASE_FILE);  t = LexGetToken();
X    while( type(t) == LBR )
X    { res = Parse(&t, StartSym, FALSE, FALSE);
X      if( t != nil || type(res) != CLOSURE )  Error(FATAL, &fpos(res),
X    "syntax error in database file %s", FileName(dfnum));
X      assert( symbs != nil, "DbLoad: create && symbs == nil!" );
X      if( symbs != nil )
X      {    for( link = Down(symbs);  link != symbs;  link = NextDown(link) )
X    { Child(y, link);
X      if( type(y) == CLOSURE && actual(y) == actual(res) )  break;
X    }
X    if( link == symbs )  Error(FATAL, &fpos(res),
X      "%s found in database but not declared in %s line",
X      SymName(actual(res)), KW_DATABASE);
X      }
X      for( tag = nil, link = Down(res);  link != res;  link = NextDown(link) )
X      {    Child(par, link);
X    if( type(par) == PAR && is_tag(actual(par)) && Down(par) != par )
X    { Child(tag, Down(par));
X      break;
X    }
X      }
X      if( tag == nil )
X    Error(FATAL, &fpos(res), "database symbol %s has no tag", SymName(res));
X      tag = ReplaceWithTidy(tag);
X      if( !is_word(type(tag)) )
X    Error(FATAL, &fpos(res), "database symbol tag is not a simple word");
X      if( StringEqual(string(tag), STR_EMPTY) )
X    Error(FATAL, &fpos(res), "database symbol tag is an empty word");
X      if( db == nil )
X      {    StringCopy(line, FileName(dfnum));
X    i = StringLength(line) - StringLength(INDEX_SUFFIX);
X    assert( i > 0, "DbLoad: FileName(dfnum) (1)!" );
X    StringCopy(&line[i], STR_EMPTY);
X    db = DbCreate(MakeWord(WORD, line, &fpos(stem)));
X      }
X      DbInsert(db, FALSE, actual(res), string(tag), STR_ZERO, NO_FILE, dfpos);
X      DisposeObject(res);  dfpos = LexNextTokenPos();  t = LexGetToken();
X    }
X    if( type(t) != END )
X      Error(FATAL, &fpos(t), "%s or end of file expected here", KW_LBR);
X    LexPop();
X    if( db == nil )
X    { StringCopy(line, FileName(dfnum));
X      i = StringLength(line) - StringLength(INDEX_SUFFIX);
X      assert( i > 0, "DbLoad: FileName(dfnum) (2)!" );
X      StringCopy(&line[i], STR_EMPTY);
X      db = DbCreate(MakeWord(WORD, line, &fpos(stem)));
X    }
X    DbConvert(db, FALSE);
X    if( (fp = OpenFile(index_fnum, FALSE, FALSE)) == null )
X      Error(FATAL, &fpos(db), "cannot open database file %s",
X      FileName(index_fnum));
X  }
X
X  /* set up database record */
X  StringCopy(line, FileName(index_fnum));
X  i = StringLength(line) - StringLength(INDEX_SUFFIX);
X  assert( i > 0, "DbLoad: FileName(index_fnum)!" );
X  StringCopy(&line[i], STR_EMPTY);
X  db = MakeWord(WORD, line, &fpos(stem));
X  reading(db) = TRUE;  filep(db) = fp;
X  if( symbs != nil )
X  { assert( type(symbs) = ACAT, "DbLoad: type(symbs)!" );
X    Link(db, symbs);
X  }
X  if( fp == null )
X  { debug1(DBS, D, "DbLoad returning (empty) %s", string(db));
X    ifdebug(DPP, D, ProfileOff("DbLoad"));
X    return db;
X  }
X
X  /* read header lines of index file, find its symbols */
X  left_pos(db) = 0;  lnum = 0;
X  while( StringFGets(line, MAX_LINE, fp) != NULL && line[0] == '#' )
X  { lnum++;
X    left_pos(db) = (int) ftell(fp);
X    gall = StringBeginsWith(line, AsciiToFull("#target "));
X    sscanf( (char *) line, gall ? "#target %d" : "#symbol %d", &num);
X    for( i = 8;  line[i] != CH_SPACE && line[i] != '\0';  i++ );
X    if( symbs == nil )
X    {
X      /* any symbols are possible, full path names in index file required */
X      count = 0;  sym = StartSym;
X      while( line[i] != CH_NEWLINE && line[i] != '\0' )
X      {    PushScope(sym, FALSE, FALSE);  count++;
X    sscanf( (char *) &line[i+1], "%s", sym_name);
X    sym = SearchSym(sym_name, StringLength(sym_name));
X    i += StringLength(sym_name) + 1;
X      }
X      for( i = 1;  i <= count;  i++ )  PopScope();
X    }
X    else
X    {
X      /* only symbs symbols possible, full path names not required */
X      sym = nil;
X      sscanf( (char *) &line[i+1], "%s", sym_name);
X      for( link = Down(symbs);  link != symbs;  link = NextDown(link) )
X      {    Child(y, link);
X    assert( type(y) == CLOSURE, "DbLoad: type(y) != CLOSURE!" );
X    if( StringEqual(sym_name, SymName(actual(y))) )
X    { sym = actual(y);
X      break;
X    }
X      }
X    }
X    if( sym != nil && sym != StartSym )
X    { if( cross_sym(sym) == nil )  CrossInit(sym);
X      link = Link(db, cross_sym(sym));
X      number(link) = num;  db_targ(link) = gall;
X      if( gall )  is_extern_target(sym) = uses_extern_target(sym) = TRUE;
X    }
X    else
X    { Error(WARN, &fpos(db), "undefined symbol in database file %s (line %d)",
X            FileName(index_fnum), lnum);
X      debug1(DBS, D, "DbLoad returning %s (error)", string(db));
X      fclose(filep(db));  filep(db) = null;  /* effectively an empty database */
X      ifdebug(DPP, D, ProfileOff("DbLoad"));
X      return db;
X    }
X  }
X  debug1(DBS, D, "DbLoad returning %s", string(db));
X  ifdebug(DPP, D, ProfileOff("DbLoad"));
X  return db;
X} /* end DbLoad */
X
X
X/*@::SearchFile()@************************************************************/
X/*                                                                           */
X/*  static BOOLEAN SearchFile(fp, left, right, str, line)                    */
X/*                                                                           */
X/*  File fp is a text file.  left is the beginning of a line, right is the   */
X/*  end of a line.   Search the file by binary search for a line beginning   */
X/*  with str.  If found, return it in line, else return FALSE.               */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic BOOLEAN SearchFile(fp, left, right, str, line)
XFILE *fp;  int left, right;  FULL_CHAR *str, *line;
X{ int l, r, mid, mid_end;  FULL_CHAR buff[MAX_LINE];  BOOLEAN res;
X  ifdebug(DPP, D, ProfileOn("SearchFile"));
X  debug3(DBS, DD, "SearchFile(fp, %d, %d, %s, line)", left, right, str);
X
X  l = left;  r = right;
X  while( l <= r )
X  {
X    /* loop invt: (l==0 or fp[l-1]==CH_NEWLINE) and (fp[r] == CH_NEWLINE)    */
X    /* and first key >= str lies in the range fp[l..r+1]                     */
X
X    /* find line near middle of the range; mid..mid_end brackets it */
X    debug2(DBS, DD, "  start loop: l = %d, r = %d", l, r);
X    mid = (l + r)/2;
X    fseek(fp, (long) mid, 0);
X    do { mid++; } while( getc(fp) != CH_NEWLINE );
X    if( mid == r + 1 )
X    { mid = l;
X      fseek(fp, (long) mid, 0);
X    }
X    StringFGets(line, MAX_LINE, fp);
X    mid_end = (int) ftell(fp) - 1;
X    debug3(DBS, DD, "  mid: %d, mid_end: %d, line: %s", mid, mid_end, line);
X    assert( l <= mid,      "SearchFile: l > mid!"        );
X    assert( mid < mid_end, "SearchFile: mid >= mid_end!" );
X    assert( mid_end <= r,  "SearchFile: mid_end > r!"    );
X
X    /* compare str with this line and prepare next step */
X    debug2(DBS, DD, "  comparing key %s with line %s", str, line);
X    if( StringLessEqual(str, line) )  r = mid - 1;
X    else l = mid_end + 1;
X  } /* end while */
X
X  /* now first key >= str lies in fp[l]; compare it with str */
X  if( l < right )
X  { fseek(fp, (long) l, 0);
X    StringFGets(line, MAX_LINE, fp);
X    sscanf( (char *) line, "%s", buff);
X    res = StringEqual(str, buff);
X  }
X  else res = FALSE;
X  debug1(DBS, DD, "SearchFile returning %s", bool(res));
X  ifdebug(DPP, D, ProfileOff("SearchFile"));
X  return res;
X} /* end SearchFile */
X
X
X/*@::DbRetrieve()@************************************************************/
X/*                                                                           */
X/*  BOOLEAN DbRetrieve(db, gall, sym, tag, seq, dfnum, dfpos, cont)          */
X/*                                                                           */
X/*  Retrieve the first entry of database db with the given gall, sym and     */
X/*  tag.  Set *seq, *dfnum, *dfpos to the associated value.                  */
X/*  Set *cont to a private value for passing to DbRetrieveNext.              */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN DbRetrieve(db, gall, sym, tag, seq, dfnum, dfpos, cont)
XOBJECT db;  BOOLEAN gall;  OBJECT sym;  FULL_CHAR *tag, *seq;
XFILE_NUM *dfnum;  long *dfpos;  long *cont;
X{ int symnum;  FULL_CHAR line[MAX_LINE], buff[MAX_LINE];  OBJECT y;
X  ifdebug(DPP, D, ProfileOn("DbRetrieve"));
X  debug4(DBS, D, "DbRetrieve(%s, %s%s&%s)", string(db), gall ? "&" : "",
X    SymName(sym), tag);
X  if( !reading(db) || filep(db) == null )
X  { debug0(DBS, D, "DbRetrieve returning FALSE (empty or not reading)");
X    ifdebug(DPP, D, ProfileOff("DbRetrieve"));
X    return FALSE;
X  }
X  SymToNum(db, sym, symnum, FALSE);
X  sprintf( (char *) buff, "%s%d&%s", gall ? "&" : "", symnum, tag);
X  fseek(filep(db), 0L, 2);
X  if( !SearchFile(filep(db), (int) left_pos(db), (int) ftell(filep(db)) - 1,
X    buff, line) )
X  { debug0(DBS, D, "DbRetrieve returning FALSE (key not present)");
X    ifdebug(DPP, D, ProfileOff("DbRetrieve"));
X    return FALSE;
X  }
X  sscanf( (char *) line, "%*s\t%s\t%ld\t%[^\n]", seq, dfpos, buff);
X  if( StringEqual(buff, AsciiToFull(".")) )
X  { StringCopy(buff, string(db));
X  }
X  *dfnum = FileNum(buff, DATA_SUFFIX);
X  if( *dfnum == NO_FILE )  /* can only occur in cross reference database */
X    *dfnum = DefineFile(buff, DATA_SUFFIX, &fpos(db),
X      DATABASE_FILE, SOURCE_PATH);
X  *cont = ftell(filep(db));
X  Child(y, Down(db));
X  debug2(DBS, D, "DbRetrieve returning TRUE (in %s at %ld)",
X    FileName(*dfnum), *dfpos);
X  ifdebug(DPP, D, ProfileOff("DbRetrieve"));
X  return TRUE;
X} /* end DbRetrieve */
X
X
X/*@::DbRetrieveNext()@********************************************************/
X/*                                                                           */
X/*  BOOLEAN DbRetrieveNext(db, gall, sym, tag, seq, dfnum, dfpos, cont)      */
X/*                                                                           */
X/*  Retrieve the entry of database db pointed to by *cont.                   */
X/*  Set *gall, *sym, *tag, *seq, *dfnum, *dfpos to the value of the entry.   */
X/*  Reset *cont to the next entry for passing to the next DbRetrieveNext.    */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN DbRetrieveNext(db, gall, sym, tag, seq, dfnum, dfpos, cont)
XOBJECT db;  BOOLEAN *gall;  OBJECT *sym;  FULL_CHAR *tag, *seq;
XFILE_NUM *dfnum;  long *dfpos;  long *cont;
X{ FULL_CHAR line[MAX_LINE], fname[MAX_LINE]; int symnum;
X  ifdebug(DPP, D, ProfileOn("DbRetrieveNext"));
X  debug2(DBS, D, "DbRetrieveNext( %s, %ld )", string(db), *cont);
X  if( !reading(db) )  Error(INTERN, &fpos(db), "DbRetrieveNext: writing!");
X  if( filep(db) == null )
X  { debug0(DBS, D, "DbRetrieveNext returning FALSE (empty database)");
X    ifdebug(DPP, D, ProfileOff("DbRetrieveNext"));
X    return FALSE;
X  }
X  fseek(filep(db), *cont == 0L ? (long) left_pos(db) : *cont, 0);
X  if( StringFGets(line, MAX_LINE, filep(db)) == NULL )
X  { debug0(DBS, D, "DbRetrieveNext returning FALSE (no successor)");
X    ifdebug(DPP, D, ProfileOff("DbRetrieveNext"));
X    return FALSE;
X  }
X  *gall = (line[0] == '&' ? 1 : 0);
X  sscanf( (char *) &line[*gall], "%d&%s\t%s\t%ld\t%[^\n]",
X    &symnum, tag, seq,dfpos,fname);
X  if( StringEqual(fname, AsciiToFull(".")) )
X  { StringCopy(fname, string(db));
X  }
X  *dfnum = FileNum(fname, DATA_SUFFIX);
X  if( *dfnum == NO_FILE )  /* can only occur in cross reference database */
X    *dfnum = DefineFile(fname, DATA_SUFFIX, &fpos(db),
X      DATABASE_FILE, SOURCE_PATH);
X  NumToSym(db, symnum, *sym);  *cont = ftell(filep(db));
X  debug2(DBS, D, "DbRetrieveNext returning TRUE (in %s at %ld)",
X    FileName(*dfnum), *dfpos);
X  ifdebug(DPP, D, ProfileOff("DbRetrieveNext"));
X  return TRUE;
X} /* end DbRetrieveNext */
END_OF_FILE
  if test 25577 -ne `wc -c <'z33.c'`; then
    echo shar: \"'z33.c'\" unpacked with wrong size!
  fi
  # end of 'z33.c'
fi
echo shar: End of archive 12 \(of 35\).
cp /dev/null ark12isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 35 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...