home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / lout2.lzh / LOUT2 / z03.c < prev    next >
Text File  |  1994-02-26  |  37KB  |  903 lines
  1. /*@z03.c:File Service:Declarations, no_fpos@******************************** */
  2. /*                                                                           */
  3. /*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
  4. /*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
  5. /*                                                                           */
  6. /*  Jeffrey H. Kingston (jeff@cs.su.oz.au)                                   */
  7. /*  Basser Department of Computer Science                                    */
  8. /*  The University of Sydney 2006                                            */
  9. /*  AUSTRALIA                                                                */
  10. /*                                                                           */
  11. /*  This program is free software; you can redistribute it and/or modify     */
  12. /*  it under the terms of the GNU General Public License as published by     */
  13. /*  the Free Software Foundation; either version 1, or (at your option)      */
  14. /*  any later version.                                                       */
  15. /*                                                                           */
  16. /*  This program is distributed in the hope that it will be useful,          */
  17. /*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
  18. /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
  19. /*  GNU General Public License for more details.                             */
  20. /*                                                                           */
  21. /*  You should have received a copy of the GNU General Public License        */
  22. /*  along with this program; if not, write to the Free Software              */
  23. /*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
  24. /*                                                                           */
  25. /*  FILE:         z03.c                                                      */
  26. /*  MODULE:       File Service                                               */
  27. /*  EXTERNS:      InitFiles(), AddToPath(), DefineFile(), FirstFile(),       */
  28. /*                NextFile(), FileNum(), FileName(), EchoFilePos(),          */
  29. /*                PosOfFile(), OpenFile(), OpenIncGraphicFile(),             */
  30. /*                ReadFromFile(), AppendToFile(), CloseFiles()               */
  31. /*                                                                           */
  32. /*****************************************************************************/
  33. #include "externs"
  34. #define MAX_TYPES     10            /* number of file types      */
  35. #define MAX_PATHS      7            /* number of search paths    */
  36. #define    TAB_MASK    0xFF            /* mask forces <= MAX_FILES  */
  37.  
  38. #define    file_number(x)    word_font(x)        /* file number of file x     */
  39. #define    updated(x)    broken(x)        /* TRUE when x is updated    */
  40. #define    path(x)        back(x, COL)        /* search path for file x    */
  41.  
  42. static    int    file_count;            /* total number of files     */
  43. static    OBJECT    fvec[MAX_FILES] = { nil };    /* the file table            */
  44. static    OBJECT    file_list[MAX_TYPES];        /* files of each type        */
  45. static    OBJECT    file_path[MAX_PATHS];        /* the search paths          */
  46. #if DEBUG_ON
  47. static    char    *file_types[]        /* the type names for debug  */
  48.         = { "source", "include", "incgraphic", "database", "index",
  49.             "font", "prepend", "hyph", "hyphpacked", "encoding" };
  50. #endif
  51.  
  52.  
  53. /*****************************************************************************/
  54. /*                                                                           */
  55. /*  no_fpos                                                                  */
  56. /*                                                                           */
  57. /*  A null file position value.                                              */
  58. /*                                                                           */
  59. /*****************************************************************************/
  60.  
  61. static FILE_POS no_file_pos = {0, 0, 0};
  62. FILE_POS *no_fpos = &no_file_pos;
  63.  
  64. /*****************************************************************************/
  65. /*                                                                           */
  66. /*  #define hash(str, val)                                                   */
  67. /*                                                                           */
  68. /*  Hash the string str and return its value in val.                         */
  69. /*                                                                           */
  70. /*****************************************************************************/
  71.  
  72. #define hash(str, val)                            \
  73. { p = str;                                \
  74.   val = *p++;                                \
  75.   while( *p ) val += *p++;                        \
  76.   val = (val * 8) & TAB_MASK;                        \
  77. }
  78.  
  79. /*@::InitFiles(), AddToPath(), DefineFile()@**********************************/
  80. /*                                                                           */
  81. /*  InitFiles()                                                              */
  82. /*                                                                           */
  83. /*  Initialize this module.                                                  */
  84. /*                                                                           */
  85. /*****************************************************************************/
  86.  
  87. InitFiles()
  88. { int i;
  89.   for( i = 0;  i < MAX_TYPES; i++ )  file_list[i]  = New(ACAT);
  90.   for( i = 0;  i < MAX_PATHS; i++ )  file_path[i] = New(ACAT);
  91.   fvec[0] = file_list[0];    /* so that no files will be given slot 0 */
  92.   file_count = 1;
  93. } /* end InitFiles */
  94.  
  95.  
  96. /*****************************************************************************/
  97. /*                                                                           */
  98. /*  AddToPath(fpath, dirname)                                                */
  99. /*                                                                           */
  100. /*  Add the directory dirname to the end of search path fpath.               */
  101. /*                                                                           */
  102. /*****************************************************************************/
  103.  
  104. AddToPath(fpath, dirname)
  105. int fpath; FULL_CHAR *dirname;
  106. { OBJECT x;
  107.   x = MakeWord(WORD, dirname, no_fpos);
  108.   Link(file_path[fpath], x);
  109. } /* end AddToPath */
  110.  
  111.  
  112. /*****************************************************************************/
  113. /*                                                                           */
  114. /*  FILE_NUM DefineFile(str, suffix, xfpos, ftype, fpath)                    */
  115. /*                                                                           */
  116. /*  Declare a file whose name is str plus suffix and whose fpos is xfpos.    */
  117. /*  The file type is ftype, and its search path is fpath.                    */
  118. /*                                                                           */
  119. /*****************************************************************************/
  120.  
  121. FILE_NUM DefineFile(str, suffix, xfpos, ftype, fpath)
  122. FULL_CHAR *str, *suffix; FILE_POS *xfpos;  int ftype, fpath;
  123. { register FULL_CHAR *p;
  124.   register int i;
  125.   assert( ftype < MAX_TYPES, "DefineFile: ftype!" );
  126.   debug5(DFS, D, "DefineFile(%s, %s,%s, %s, %d)",
  127.     str, suffix, EchoFilePos(xfpos), file_types[ftype], fpath);
  128.   if( ftype == SOURCE_FILE && (i = StringLength(str)) >= 3 )
  129.   {
  130.     /* check that file name does not end in ".li" or ".ld" */
  131.     if( StringEqual(&str[i-StringLength(DATA_SUFFIX)], DATA_SUFFIX) )
  132.       Error(FATAL, xfpos,
  133.     "database file %s where source file expected", str);
  134.     if( StringEqual(&str[i-StringLength(INDEX_SUFFIX)], INDEX_SUFFIX) )
  135.       Error(FATAL, xfpos,
  136.     "database index file %s where source file expected", str);
  137.   }
  138.   if( ++file_count >= MAX_FILES ) Error(FATAL, xfpos, "too many file names");
  139.   hash(str, i);
  140.   while( fvec[i] != nil )
  141.     if( ++i >= MAX_FILES ) i = 0;
  142.   if( StringLength(str) + StringLength(suffix) >= MAX_LINE )
  143.     Error(FATAL, no_fpos, "file name %s%s too long", str, suffix);
  144.   fvec[i] = MakeWordTwo(WORD, str, suffix, xfpos);
  145.   Link(file_list[ftype], fvec[i]);
  146.   file_number(fvec[i]) = i;
  147.   path(fvec[i]) = fpath;
  148.   debug1(DFS, D, "DefineFile returning %s",
  149.     i == NO_FILE ? STR_NONE : FileName( (FILE_NUM) i));
  150.   return (FILE_NUM) i;
  151. } /* end DefineFile */
  152.  
  153.  
  154. /*@::FirstFile(), NextFile(), FileNum()@**************************************/
  155. /*                                                                           */
  156. /*  FILE_NUM FirstFile(ftype)                                                */
  157. /*                                                                           */
  158. /*  Returns first file of type ftype, else NO_FILE.                          */
  159. /*                                                                           */
  160. /*****************************************************************************/
  161.  
  162. FILE_NUM FirstFile(ftype)
  163. int ftype;
  164. { FILE_NUM i;
  165.   OBJECT link, y;
  166.   debug1(DFS, D, "FirstFile( %s )", file_types[ftype]);
  167.   link = Down(file_list[ftype]);
  168.   if( type(link) == ACAT )  i = NO_FILE;
  169.   else
  170.   { Child(y, link);
  171.     i = file_number(y);
  172.   }
  173.   debug1(DFS, D, "FirstFile returning %s", i==NO_FILE ? STR_NONE : FileName(i));
  174.   return i;
  175. } /* end FirstFile */
  176.  
  177.  
  178. /*****************************************************************************/
  179. /*                                                                           */
  180. /*  FILE_NUM NextFile(i)                                                     */
  181. /*                                                                           */
  182. /*  Returns the next file after file i of the type of i, else NO_FILE.       */
  183. /*                                                                           */
  184. /*****************************************************************************/
  185.  
  186. FILE_NUM NextFile(i)
  187. FILE_NUM i;
  188. { OBJECT link, y;
  189.   debug1(DFS, D, "NextFile( %s )", EchoObject(fvec[i]));
  190.   link = NextDown(Up(fvec[i]));
  191.   if( type(link) == ACAT )  i = NO_FILE;
  192.   else
  193.   { Child(y, link);
  194.     i = file_number(y);
  195.   }
  196.   debug1(DFS, D, "NextFile returning %s", i==NO_FILE ? STR_NONE : FileName(i));
  197.   return i;
  198. } /* end NextFile */
  199.  
  200.  
  201. /*****************************************************************************/
  202. /*                                                                           */
  203. /*  FILE_NUM FileNum(str, suffix)                                            */
  204. /*                                                                           */
  205. /*  Return the number of the file with name str plus suffix, else NO_FILE.   */
  206. /*                                                                           */
  207. /*****************************************************************************/
  208.  
  209. FILE_NUM FileNum(str, suffix)
  210. FULL_CHAR *str, *suffix;
  211. { register FULL_CHAR *p;
  212.   register int i;
  213.   FULL_CHAR buff[MAX_LINE];
  214.   debug2(DFS, D, "FileNum(%s, %s)", str, suffix);
  215.   hash(str, i);
  216.   if( StringLength(str) + StringLength(suffix) >= MAX_LINE )
  217.     Error(FATAL, no_fpos, "file name %s%s too long", str, suffix);
  218.   StringCopy(buff, str);
  219.   StringCat(buff, suffix);
  220.   while( fvec[i] != nil && !StringEqual(string(fvec[i]), buff) )
  221.     if( ++i >= MAX_FILES ) i = 0;
  222.   if( fvec[i] == nil ) i = 0;
  223.   debug1(DFS, D, "FileNum returning %s",
  224.     i == NO_FILE ? STR_NONE : FileName( (FILE_NUM) i));
  225.   return (FILE_NUM) i;
  226. } /* end FileNum */
  227.  
  228.  
  229. /*@::FileName(), EchoFilePos(), PosOfFile()@**********************************/
  230. /*                                                                           */
  231. /*  FULL_CHAR *FileName(fnum)                                                */
  232. /*                                                                           */
  233. /*  Return the string name of this file.  This is as given to DefineFile     */
  234. /*  until OpenFile is called, after which it is the full path name.          */
  235. /*                                                                           */
  236. /*****************************************************************************/
  237.  
  238. FULL_CHAR *FileName(fnum)
  239. FILE_NUM fnum;
  240. { OBJECT x;
  241.   assert( fnum > 0 && fvec[fnum] != nil, "FileName: fvec[fnum] == nil!" );
  242.   x = fvec[fnum];  if( Down(x) != x )  Child(x, Down(x));
  243.   return string(x);
  244. } /* end FileName */
  245.  
  246.  
  247. /*****************************************************************************/
  248. /*                                                                           */
  249. /*  FULL_CHAR *EchoFilePos(pos)                                              */
  250. /*                                                                           */
  251. /*  Returns a string reporting the value of file position pos.               */
  252. /*                                                                           */
  253. /*****************************************************************************/
  254.  
  255. static FULL_CHAR buff[2][MAX_LINE];  static bp = 1;
  256.  
  257. static append_fpos(pos)
  258. FILE_POS *pos;
  259. { OBJECT x;
  260.   x = fvec[file_num(*pos)];
  261.   assert( x != nil, "EchoFilePos: fvec[] entry is nil!" );
  262.   if( file_num(fpos(x)) > 0 )
  263.   { append_fpos( &fpos(x) );
  264.     if( StringLength(buff[bp]) + 2 >= MAX_LINE )
  265.       Error(FATAL,no_fpos,"file position %s... is too long to print", buff[bp]);
  266.     StringCat(buff[bp], STR_SPACE);
  267.     StringCat(buff[bp], AsciiToFull("/"));
  268.   }
  269.   if( StringLength(buff[bp]) + StringLength(string(x)) + 13 >= MAX_LINE )
  270.     Error(FATAL, no_fpos, "file position %s... is too long to print", buff[bp]);
  271.   StringCat(buff[bp], STR_SPACE);
  272.   StringCat(buff[bp], STR_QUOTE);
  273.   StringCat(buff[bp], string(x));
  274.   StringCat(buff[bp], STR_QUOTE);
  275.   if( line_num(*pos) != 0 )
  276.   { StringCat(buff[bp], STR_SPACE);
  277.     StringCat(buff[bp], StringInt(line_num(*pos)));
  278.     StringCat(buff[bp], AsciiToFull(","));
  279.     StringCat(buff[bp], StringInt( (int) col_num(*pos)));
  280.   }
  281. } /* end append_fpos */
  282.  
  283. FULL_CHAR *EchoFilePos(pos)
  284. FILE_POS *pos;
  285. { bp = (bp + 1) % 2;
  286.   StringCopy(buff[bp], STR_EMPTY);
  287.   if( file_num(*pos) > 0 )  append_fpos(pos);
  288.   return buff[bp];
  289. } /* end EchoFilePos */
  290.  
  291.  
  292. /*****************************************************************************/
  293. /*                                                                           */
  294. /*  FILE_POS *PosOfFile(fnum)                                                */
  295. /*                                                                           */
  296. /*  Returns a pointer to the file position where file fnum was encountered.  */
  297. /*                                                                           */
  298. /*****************************************************************************/
  299.  
  300. FILE_POS *PosOfFile(fnum)
  301. FILE_NUM fnum;
  302. { OBJECT  x = fvec[fnum];
  303.   assert( x != nil, "PosOfFile: fvec[] entry is nil!" );
  304.   return &fpos(x);
  305. }
  306.  
  307. /*@::SearchPath()@************************************************************/
  308. /*                                                                           */
  309. /*  static FILE *SearchPath(str, fpath, check_ld, check_lt, full_name, xfpos)*/
  310. /*                                                                           */
  311. /*  Search the given path for a file whose name is str.  If found, open      */
  312. /*  it; return the resulting FILE *.                                         */
  313. /*                                                                           */
  314. /*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
  315. /*  and OpenFile() is required to check whether the corresponding .ld file   */
  316. /*  is present.  If it is, then the search must stop.                        */
  317. /*                                                                           */
  318. /*  If check_lt is TRUE, it means that the file to be opened is a source     */
  319. /*  file and OpenFile() is required to check for a .lt suffix version if     */
  320. /*  the file does not open.                                                  */
  321. /*                                                                           */
  322. /*  Also return the full path name in object *full_name if reqd, else nil.   */
  323. /*                                                                           */
  324. /*****************************************************************************/
  325.  
  326. static FILE *SearchPath(str, fpath, check_ld, check_lt, full_name, xfpos)
  327. FULL_CHAR *str;  OBJECT fpath;  BOOLEAN check_ld, check_lt;
  328. OBJECT *full_name;  FILE_POS *xfpos;
  329. { 
  330.   FULL_CHAR buff[MAX_LINE];  OBJECT link, y;  FILE *fp;
  331.   debug4(DFS, DD, "SearchPath(%s, %s, %s, %s, -)", str, EchoObject(fpath),
  332.     bool(check_ld), bool(check_lt));
  333.   *full_name = nil;
  334.   if( StringEqual(str, STR_STDIN) )
  335.   { fp = stdin;
  336.     debug0(DFS, DD, "  opened stdin");
  337.   }
  338.   else if( StringBeginsWith(str, AsciiToFull("/")) )
  339.   { fp = StringFOpen(str, "r");
  340.     debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
  341.   }
  342.   else
  343.   { fp = null;
  344.     for( link = Down(fpath);  fp==null && link != fpath; link = NextDown(link) )
  345.     { Child(y, link);
  346.       if( StringLength(string(y)) == 0 )
  347.       { StringCopy(buff, str);
  348.     fp = StringFOpen(str, "r");
  349.     debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
  350.       }
  351.       else
  352.       {    if( StringLength(string(y)) + 1 + StringLength(str) >= MAX_LINE )
  353.       Error(FATAL, &fpos(y), "file path name %s/%s is too long",
  354.         string(y), str);
  355.     StringCopy(buff, string(y));
  356.     StringCat(buff, AsciiToFull("/"));
  357.     StringCat(buff, str);
  358.     fp = StringFOpen(buff, "r");
  359.     debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s",buff);
  360.     if( fp != null ) *full_name = MakeWord(WORD, buff, xfpos);
  361.       }
  362.       if( fp == null && check_ld )
  363.       {    StringCopy(&buff[StringLength(buff) - StringLength(INDEX_SUFFIX)],
  364.       DATA_SUFFIX);
  365.     fp = StringFOpen(buff, "r");
  366.     debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", buff);
  367.     if( fp != null )
  368.     { fclose(fp);
  369.       debug0(DFS, D, "SearchPath returning null (adjacent .ld file)");
  370.       return null;
  371.     }
  372.       }
  373.       if( fp == null && check_lt )
  374.       {    StringCopy(&buff[StringLength(buff)], SOURCE_SUFFIX);
  375.     fp = StringFOpen(buff, "r");
  376.     debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", buff);
  377.     StringCopy(&buff[StringLength(buff) - StringLength(SOURCE_SUFFIX)], STR_EMPTY);
  378.     if( fp != null ) *full_name = MakeWord(WORD, buff, xfpos);
  379.       }
  380.     }
  381.   }
  382.   debug1(DFS, DD, "SearchPath returning (fp %s null)", fp==null ? "==" : "!=");
  383.   return fp;
  384. } /* end SearchPath */
  385.  
  386.  
  387. /*@::OpenFile(), OpenIncGraphicFile()@****************************************/
  388. /*                                                                           */
  389. /*  FILE *OpenFile(fnum, check_ld, check_lt)                                 */
  390. /*                                                                           */
  391. /*  Open for reading the file whose number is fnum.  This involves           */
  392. /*  searching for it along its path if not previously opened.                */
  393. /*                                                                           */
  394. /*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
  395. /*  and OpenFile() is required to check whether the corresponding .ld file   */
  396. /*  is present.  If it is, then the search must stop.                        */
  397. /*                                                                           */
  398. /*  If check_lt is TRUE, it means that the file to be opened is a source     */
  399. /*  file and OpenFile() is required to check for a .lout suffix version      */
  400. /*  if the file does not open without it.                                    */
  401. /*                                                                           */
  402. /*****************************************************************************/
  403.  
  404. FILE *OpenFile(fnum, check_ld, check_lt)
  405. FILE_NUM fnum;  BOOLEAN check_ld, check_lt;
  406. { FILE *fp;  OBJECT full_name, y;
  407.   ifdebug(DPP, D, ProfileOn("OpenFile"));
  408.   debug2(DFS, D, "OpenFile(%s, %s)", FileName(fnum), bool(check_ld));
  409.   if( Down(fvec[fnum]) != fvec[fnum] )
  410.   { Child(y, Down(fvec[fnum]));
  411.     fp = StringFOpen(string(y), "r");
  412.     debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", string(y));
  413.   }
  414.   else
  415.   { fp = SearchPath(string(fvec[fnum]), file_path[path(fvec[fnum])],
  416.        check_ld, check_lt, &full_name, &fpos(fvec[fnum]));
  417.     if( full_name != nil )  Link(fvec[fnum], full_name);
  418.   }
  419.   ifdebug(DPP, D, ProfileOff("OpenFile"));
  420.   debug1(DFS, D, "OpenFile returning (fp %s null)", fp==null ? "==" : "!=");
  421.   return fp;
  422. } /* end OpenFile */
  423.  
  424.  
  425. /*****************************************************************************/
  426. /*                                                                           */
  427. /*  FILE *OpenIncGraphicFile(str, typ, full_name, xfpos)                     */
  428. /*                                                                           */
  429. /*  Open for reading the @IncludeGraphic file str; typ is INCGRAPHIC or      */
  430. /*  SINCGRAPHIC.  Return the full name in full_name.                         */
  431. /*                                                                           */
  432. /*****************************************************************************/
  433.  
  434. FILE *OpenIncGraphicFile(str, typ, full_name, xfpos)
  435. FULL_CHAR *str;  unsigned char typ;  OBJECT *full_name;  FILE_POS *xfpos;
  436. { FILE *fp;  int p;
  437.   debug2(DFS, D, "OpenIncGraphicFile(%s, %s, -)", str, Image(typ));
  438.   assert( typ == INCGRAPHIC || typ == SINCGRAPHIC, "OpenIncGraphicFile!" );
  439.   p = (typ == INCGRAPHIC ? INCLUDE_PATH : SYSINCLUDE_PATH);
  440.   fp = SearchPath(str, file_path[p], FALSE, FALSE, full_name, xfpos);
  441.   if( *full_name == nil )  *full_name = MakeWord(WORD, str, xfpos);
  442.   debug2(DFS, D, "OpenIncGraphicFile returning (fp %s null, *full_name = %s)",
  443.     fp==null ? "==" : "!=", string(*full_name));
  444.   return fp;
  445. } /* end OpenIncGraphicFile */
  446.  
  447.  
  448. /*@::ReadFromFile()@**********************************************************/
  449. /*                                                                           */
  450. /*  OBJECT ReadFromFile(fnum, pos, sym)                                      */
  451. /*                                                                           */
  452. /*  Read an object from file fnum starting at position pos.                  */
  453. /*  The object may include @Env operators defining its environment.          */
  454. /*  If sym != nil, sym is the symbol which is to be read in.                 */
  455. /*                                                                           */
  456. /*****************************************************************************/
  457.  
  458. OBJECT ReadFromFile(fnum, pos, sym)
  459. FILE_NUM fnum; long pos;  OBJECT sym;
  460. { OBJECT t, res; int ipos;
  461.   ifdebug(DPP, D, ProfileOn("ReadFromFile"));
  462.   ifdebug(DFS, D, ipos = (int) pos);
  463.   debug3(DFS, D, "ReadFromFile(%s, %d, %s)", FileName(fnum), ipos,SymName(sym));
  464.   LexPush(fnum, (int) pos, DATABASE_FILE);
  465.   SwitchScope(sym);
  466.   t = LexGetToken();
  467.   if( type(t) != LBR )
  468.   { debug1(DFS, D, "  following because type(t) = %s", Image(type(t)));
  469.     Error(FATAL, &fpos(t),"syntax error (missing %s) in database file", KW_LBR);
  470.   }
  471.   res = Parse(&t, StartSym, FALSE, FALSE);
  472.   if( t != nil || type(res) != CLOSURE )
  473.   { debug1(DFS, D, "  following because of %s", t != nil ? "t" : "type(res)");
  474.     Error(FATAL, &fpos(res), "syntax error in database file");
  475.   }
  476.   UnSwitchScope(sym);
  477.   LexPop();
  478.   debug1(DFS, D, "ReadFromFile returning %s", EchoObject(res));
  479.   ifdebug(DPP, D, ProfileOff("ReadFromFile"));
  480.   return res;
  481. } /* end ReadFromFile */
  482.  
  483.  
  484. static FILE_NUM    last_write_fnum = NO_FILE;
  485. static FILE    *last_write_fp  = null;
  486.  
  487.  
  488. /*@::WriteClosure()@**********************************************************/
  489. /*                                                                           */
  490. /*  static WriteClosure(x)                                                   */
  491. /*                                                                           */
  492. /*  Write closure x to file last_write_fp, without enclosing braces and      */
  493. /*  without any environment attached.                                        */
  494. /*                                                                           */
  495. /*****************************************************************************/
  496.  
  497. static BOOLEAN need_lvis(sym)        /* true if @LVis needed before sym */
  498. OBJECT sym;
  499. { return !visible(sym) &&
  500.      enclosing(sym) != StartSym &&
  501.      type(enclosing(sym)) == LOCAL;
  502. } /* end need_lvis */
  503.  
  504. static WriteClosure(x)
  505. OBJECT x;
  506. { OBJECT y, link, z, sym;
  507.   BOOLEAN npar_seen, name_printed;
  508.   static WriteObject();
  509.  
  510.   sym = actual(x);  npar_seen = FALSE;  name_printed = FALSE;
  511.   for( link = Down(x);  link != x;  link = NextDown(link) )
  512.   { Child(y, link);
  513.     if( type(y) == PAR )  switch( type(actual(y)) )
  514.     {
  515.       case LPAR:
  516.       
  517.     assert( Down(y) != y, "WriteObject/CLOSURE: LPAR!" );
  518.     Child(z, Down(y));
  519.     WriteObject(z, (int) precedence(sym));
  520.     StringFPuts(STR_SPACE, last_write_fp);
  521.     break;
  522.  
  523.  
  524.       case NPAR:
  525.       
  526.     assert( Down(y) != y, "WriteObject/CLOSURE: NPAR!" );
  527.     Child(z, Down(y));
  528.     if( !name_printed )
  529.     { if( need_lvis(sym) )
  530.       { StringFPuts(KW_LVIS, last_write_fp);
  531.         StringFPuts(STR_SPACE, last_write_fp);
  532.       }
  533.       StringFPuts(SymName(sym), last_write_fp);
  534.       name_printed = TRUE;
  535.     }
  536.     StringFPuts(STR_NEWLINE, last_write_fp);
  537.     StringFPuts(STR_SPACE, last_write_fp);
  538.     StringFPuts(STR_SPACE, last_write_fp);
  539.     StringFPuts(STR_SPACE, last_write_fp);
  540.     StringFPuts(SymName(actual(y)), last_write_fp);
  541.     StringFPuts(STR_SPACE, last_write_fp);
  542.     StringFPuts(KW_LBR, last_write_fp);
  543.     StringFPuts(STR_SPACE, last_write_fp);
  544.     WriteObject(z, NO_PREC);
  545.     StringFPuts(STR_SPACE, last_write_fp);
  546.     StringFPuts(KW_RBR, last_write_fp);
  547.     npar_seen = TRUE;
  548.     break;
  549.  
  550.  
  551.       case RPAR:
  552.       
  553.     assert( Down(y) != y, "WriteObject/CLOSURE: RPAR!" );
  554.     Child(z, Down(y));
  555.     if( !name_printed )
  556.     { if( need_lvis(sym) )
  557.       { StringFPuts(KW_LVIS, last_write_fp);
  558.         StringFPuts(STR_SPACE, last_write_fp);
  559.       }
  560.       StringFPuts(SymName(sym), last_write_fp);
  561.       name_printed = TRUE;
  562.     }
  563.     StringFPuts(npar_seen ? STR_NEWLINE : STR_SPACE, last_write_fp);
  564.     if( has_body(sym) )
  565.     {
  566.       StringFPuts(KW_LBR, last_write_fp);
  567.       StringFPuts(STR_SPACE, last_write_fp);
  568.       WriteObject(z, NO_PREC);
  569.       StringFPuts(STR_SPACE, last_write_fp);
  570.       StringFPuts(KW_RBR, last_write_fp);
  571.     }
  572.     else WriteObject(z, (int) precedence(sym));
  573.     break;
  574.  
  575.  
  576.       default:
  577.       
  578.     Error(INTERN, &fpos(y), "WriteClosure: %s", Image(type(actual(y))) );
  579.     break;
  580.  
  581.     } /* end switch */
  582.   } /* end for each parameter */
  583.   if( !name_printed )
  584.   { if( need_lvis(sym) )
  585.     { StringFPuts(KW_LVIS, last_write_fp);
  586.       StringFPuts(STR_SPACE, last_write_fp);
  587.     }
  588.     StringFPuts(SymName(sym), last_write_fp);
  589.     name_printed = TRUE;
  590.   }
  591. } /* end WriteClosure */
  592.  
  593.  
  594. /*@::WriteObject()@***********************************************************/
  595. /*                                                                           */
  596. /*  static WriteObject(x, outer_prec)                                        */
  597. /*                                                                           */
  598. /*  Write object x to file last_write_fp, assuming it is a subobject of an   */
  599. /*  object and the precedence of operators enclosing it is outer_prec.       */
  600. /*                                                                           */
  601. /*****************************************************************************/
  602.  
  603. static WriteObject(x, outer_prec)
  604. OBJECT x;  int outer_prec;
  605. { OBJECT link, y, gap_obj, sym, env;  FULL_CHAR *name;
  606.   int prec, i, last_prec;  BOOLEAN braces_needed;
  607.   switch( type(x) )
  608.   {
  609.  
  610.     case WORD:
  611.  
  612.       if( StringLength(string(x)) == 0 && outer_prec > ACAT_PREC )
  613.       { StringFPuts(KW_LBR, last_write_fp);
  614.     StringFPuts(KW_RBR, last_write_fp);
  615.       }
  616.       else StringFPuts(string(x), last_write_fp);
  617.       break;
  618.  
  619.     
  620.     case QWORD:
  621.  
  622.       StringFPuts(StringQuotedWord(x), last_write_fp);
  623.       break;
  624.  
  625.     
  626.     case VCAT:  prec = VCAT_PREC;  goto ETC;
  627.     case HCAT:  prec = HCAT_PREC;  goto ETC;
  628.     case ACAT:  prec = ACAT_PREC;  goto ETC;
  629.  
  630.       ETC:
  631.       if( prec < outer_prec )  StringFPuts(KW_LBR, last_write_fp);
  632.       last_prec = prec;
  633.       for( link = Down(x);  link != x;  link = NextDown(link) )
  634.       {    Child(y, link);
  635.     if( type(y) == GAP_OBJ )
  636.     { if( Down(y) == y )
  637.       { assert( type(x) == ACAT, "WriteObject: Down(y) == y!" );
  638.         for( i = 1;  i <= vspace(y);  i++ )
  639.           StringFPuts(STR_NEWLINE, last_write_fp);
  640.         for( i = 1;  i <= hspace(y);  i++ )
  641.           StringFPuts(STR_SPACE,  last_write_fp);
  642.         last_prec = (vspace(y) + hspace(y) == 0) ? JUXTA_PREC : ACAT_PREC;
  643.       }
  644.       else
  645.       { Child(gap_obj, Down(y));
  646.         StringFPuts(type(x)==ACAT ? STR_SPACE : STR_NEWLINE, last_write_fp);
  647.         StringFPuts(EchoCatOp(type(x), mark(gap(y)), join(gap(y))),
  648.           last_write_fp);
  649.         if( !is_word(type(gap_obj)) || StringLength(string(gap_obj)) != 0 )
  650.         WriteObject(gap_obj, FORCE_PREC);
  651.         StringFPuts(STR_SPACE, last_write_fp);
  652.         last_prec = prec;
  653.       }
  654.     }
  655.     else
  656.     { if( type(x) == ACAT )
  657.       { OBJECT next_gap;  int next_prec;
  658.         if( NextDown(link) != x )
  659.         { Child(next_gap, NextDown(link));
  660.           assert( type(next_gap) == GAP_OBJ, "WriteObject: next_gap!" );
  661.           next_prec = (vspace(next_gap) + hspace(next_gap) == 0)
  662.                 ? JUXTA_PREC : ACAT_PREC;
  663.         }
  664.         else next_prec = prec;
  665.         WriteObject(y, max(last_prec, next_prec));
  666.       }
  667.       else WriteObject(y, prec);
  668.     }
  669.       }
  670.       if( prec < outer_prec )  StringFPuts(KW_RBR, last_write_fp);
  671.       break;
  672.  
  673.  
  674.     case ENV:
  675.  
  676.       if( Down(x) == x )
  677.       { /* do nothing */
  678.       }
  679.       else if( Down(x) == LastDown(x) )
  680.       {    Child(y, Down(x));
  681.     assert( type(y) == CLOSURE, "WriteObject: ENV/CLOSURE!" );
  682.     assert( LastDown(y) != y, "WriteObject: ENV/LastDown(y)!" );
  683.     Child(env, LastDown(y));
  684.     assert( type(env) == ENV, "WriteObject: ENV/env!" );
  685.     WriteObject(env, NO_PREC);
  686.     StringFPuts(KW_LBR, last_write_fp);
  687.     WriteClosure(y);
  688.     StringFPuts(KW_RBR, last_write_fp);
  689.     StringFPuts(STR_NEWLINE, last_write_fp);
  690.       }
  691.       else
  692.       {    Child(env, LastDown(x));
  693.     assert( type(env) == ENV, "WriteObject: ENV/ENV!" );
  694.     WriteObject(env, NO_PREC);
  695.     Child(y, Down(x));
  696.     assert( type(y) == CLOSURE, "WriteObject: ENV/ENV+CLOSURE!" );
  697.     WriteObject(y, NO_PREC);
  698.       }
  699.       break;
  700.  
  701.  
  702.     case CLOSURE:
  703.  
  704.       sym = actual(x);  env = nil;
  705.       if( LastDown(x) != x )
  706.       {    Child(y, LastDown(x));
  707.     if( type(y) == ENV )  env = y;
  708.       }
  709.  
  710.       braces_needed = env != nil ||
  711.     (precedence(sym) <= outer_prec && (has_lpar(sym) || has_rpar(sym)));
  712.  
  713.       /* print environment */
  714.       if( env != nil )
  715.       {    StringFPuts(KW_ENV, last_write_fp);
  716.           StringFPuts(STR_NEWLINE, last_write_fp);
  717.     WriteObject(env, NO_PREC);
  718.       }
  719.  
  720.       /* print left brace if needed */
  721.       if( braces_needed )  StringFPuts(KW_LBR, last_write_fp);
  722.     
  723.       /* print the closure proper */
  724.       WriteClosure(x);
  725.  
  726.       /* print closing brace if needed */
  727.       if( braces_needed )  StringFPuts(KW_RBR, last_write_fp);
  728.  
  729.       /* print closing environment if needed */
  730.       if( env != nil )
  731.       { StringFPuts(STR_NEWLINE, last_write_fp);
  732.     StringFPuts(KW_CLOS, last_write_fp);
  733.           StringFPuts(STR_NEWLINE, last_write_fp);
  734.       }
  735.       break;
  736.  
  737.  
  738.     case CROSS:
  739.  
  740.       Child(y, Down(x));
  741.       assert( type(y) == CLOSURE, "WriteObject/CROSS: type(y) != CLOSURE!" );
  742.       StringFPuts(SymName(actual(y)), last_write_fp);
  743.       StringFPuts(KW_CROSS, last_write_fp);
  744.       Child(y, LastDown(x));
  745.       WriteObject(y, FORCE_PREC);
  746.       break;
  747.  
  748.  
  749.     case NULL_CLOS:    name = KW_NULL;        goto SETC;
  750.     case ONE_COL:    name = KW_ONE_COL;    goto SETC;
  751.     case ONE_ROW:    name = KW_ONE_ROW;    goto SETC;
  752.     case WIDE:        name = KW_WIDE;        goto SETC;
  753.     case HIGH:        name = KW_HIGH;        goto SETC;
  754.     case HSCALE:    name = KW_HSCALE;    goto SETC;
  755.     case VSCALE:    name = KW_VSCALE;    goto SETC;
  756.     case SCALE:        name = KW_SCALE;    goto SETC;
  757.     case HCONTRACT:    name = KW_HCONTRACT;    goto SETC;
  758.     case VCONTRACT:    name = KW_VCONTRACT;    goto SETC;
  759.     case HEXPAND:    name = KW_HEXPAND;    goto SETC;
  760.     case VEXPAND:    name = KW_VEXPAND;    goto SETC;
  761.     case PADJUST:    name = KW_PADJUST;    goto SETC;
  762.     case HADJUST:    name = KW_HADJUST;    goto SETC;
  763.     case VADJUST:    name = KW_VADJUST;    goto SETC;
  764.     case ROTATE:    name = KW_ROTATE;    goto SETC;
  765.     case CASE:        name = KW_CASE;        goto SETC;
  766.     case YIELD:        name = KW_YIELD;    goto SETC;
  767.     case XCHAR:        name = KW_XCHAR;    goto SETC;
  768.     case FONT:        name = KW_FONT;        goto SETC;
  769.     case SPACE:        name = KW_SPACE;    goto SETC;
  770.     case BREAK:        name = KW_BREAK;    goto SETC;
  771.     case NEXT:        name = KW_NEXT;        goto SETC;
  772.     case OPEN:        name = KW_OPEN;        goto SETC;
  773.     case TAGGED:    name = KW_TAGGED;    goto SETC;
  774.     case INCGRAPHIC:    name = KW_INCGRAPHIC;    goto SETC;
  775.     case SINCGRAPHIC:    name = KW_SINCGRAPHIC;    goto SETC;
  776.     case GRAPHIC:    name = KW_GRAPHIC;    goto SETC;
  777.  
  778.       /* print left parameter, if present */
  779.       SETC:
  780.       if( DEFAULT_PREC <= outer_prec )  StringFPuts(KW_LBR, last_write_fp);
  781.       if( Down(x) != LastDown(x) )
  782.       {    Child(y, Down(x));
  783.     WriteObject(y, DEFAULT_PREC);
  784.     StringFPuts(STR_SPACE, last_write_fp);
  785.       }
  786.  
  787.       /* print the name of the symbol */
  788.       StringFPuts(name, last_write_fp);
  789.  
  790.       /* print right parameter, if present */
  791.       if( LastDown(x) != x )
  792.       {    Child(y, LastDown(x));
  793.     StringFPuts(STR_SPACE, last_write_fp);
  794.     if( type(x) == OPEN )
  795.     { StringFPuts(KW_LBR, last_write_fp);
  796.       WriteObject(y, NO_PREC);
  797.       StringFPuts(KW_RBR, last_write_fp);
  798.     }
  799.     else WriteObject(y, DEFAULT_PREC);
  800.       }
  801.       if( DEFAULT_PREC <= outer_prec )
  802.     StringFPuts(KW_RBR, last_write_fp);
  803.       break;
  804.  
  805.  
  806.     default:
  807.  
  808.       Error(INTERN, &fpos(x), "WriteObject: type(x) = %s", Image(type(x)));
  809.       break;
  810.  
  811.   } /* end switch */
  812. } /* end WriteObject */
  813.  
  814.  
  815. /*@::AppendToFile(), CloseFiles()@********************************************/
  816. /*                                                                           */
  817. /*  AppendToFile(x, fnum, pos)                                               */
  818. /*                                                                           */
  819. /*  Append object x to file fnum, returning its fseek position in *pos.      */
  820. /*  Record the fact that this file has been updated.                         */
  821. /*                                                                           */
  822. /*****************************************************************************/
  823.  
  824. AppendToFile(x, fnum, pos)
  825. OBJECT x;  FILE_NUM fnum;  int *pos;
  826. { FULL_CHAR buff[MAX_LINE], *str;
  827.   debug2(DFS, D, "AppendToFile( %s, %s )", EchoObject(x), FileName(fnum));
  828.  
  829.   /* open file fnum for writing */
  830.   if( last_write_fnum != fnum )
  831.   { if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
  832.     str = FileName(fnum);
  833.     if( StringLength(str) + StringLength(NEW_DATA_SUFFIX) >= MAX_LINE )
  834.       Error(FATAL, PosOfFile(fnum), "file name %s%s is too long",
  835.     str, NEW_DATA_SUFFIX);
  836.     StringCopy(buff, str);  StringCat(buff, NEW_DATA_SUFFIX);
  837.     last_write_fp = StringFOpen(buff, "a");
  838.     if( last_write_fp == null )  Error(FATAL, &fpos(fvec[fnum]),
  839.         "cannot append to database file %s", buff);
  840.     last_write_fnum = fnum;
  841.   }
  842.  
  843.   /* write x out and record the fact that fnum has changed */
  844.   *pos = (int) ftell(last_write_fp);
  845.   StringFPuts(KW_LBR, last_write_fp);
  846.   WriteObject(x, NO_PREC);
  847.   StringFPuts(KW_RBR, last_write_fp);
  848.   StringFPuts(STR_NEWLINE, last_write_fp);
  849.   StringFPuts(STR_NEWLINE, last_write_fp);
  850.   updated(fvec[fnum]) = TRUE;
  851.   debug0(DFS, D, "AppendToFile returning.");
  852. } /* end AppendToFile */
  853.  
  854.  
  855. /*****************************************************************************/
  856. /*                                                                           */
  857. /*  CloseFiles()                                                             */
  858. /*                                                                           */
  859. /*  Close all files and move new versions to the names of old versions.      */
  860. /*                                                                           */
  861. /*****************************************************************************/
  862.  
  863. CloseFiles()
  864. { FILE_NUM fnum;  FULL_CHAR buff[MAX_LINE];
  865.   ifdebug(DPP, D, ProfileOn("CloseFiles"));
  866.   debug0(DFS, D, "CloseFiles()");
  867.  
  868.   /* close off last file opened by AppendToFile above */
  869.   if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
  870.  
  871.   /* get rid of old database files */
  872.   for( fnum = FirstFile(SOURCE_FILE);  fnum != NO_FILE;  fnum = NextFile(fnum) )
  873.   { StringCopy(buff, FileName(fnum));
  874.     StringCat(buff, DATA_SUFFIX);  StringUnlink(buff);
  875.   }
  876.  
  877.   /* move any new database files to the old names, if updated */
  878.   for( fnum = FirstFile(DATABASE_FILE); fnum != NO_FILE; fnum = NextFile(fnum) )
  879.   { if( updated(fvec[fnum]) )
  880.     { StringCopy(buff, string(fvec[fnum]));
  881.       StringCat(buff, NEW_DATA_SUFFIX);
  882.       debug1(DFS, D, "unlink(%s)", string(fvec[fnum]));
  883.       StringUnlink(string(fvec[fnum])); /* may fail if no old version */
  884.       debug2(DFS, D, "link(%s, %s)", buff, string(fvec[fnum]));
  885. #ifndef OSK
  886.       if( StringLink(buff, string(fvec[fnum])) != 0 )
  887.         Error(INTERN, no_fpos, "link(%s, %s) failed", buff, string(fvec[fnum]));
  888.       debug1(DFS, D, "unlink(%s)", buff);
  889.       if( StringUnlink(buff) != 0 )  Error(INTERN, no_fpos, "unlink(%s)", buff);
  890. #else
  891.         sprintf(buff, "rename %s%s %s", string(fvec[fnum]), 
  892.             NEW_DATA_SUFFIX, (index(string(fvec[fnum]),'/') == NULL)
  893.             ? string(fvec[fnum]) : rindex(string(fvec[fnum]),'/')+1);
  894.         system(buff);
  895. #endif
  896.     }
  897.   }
  898.   debug0(DFS, D, "CloseFiles returning.");
  899.   ifdebug(DPP, D, ProfileOff("CloseFiles"));
  900. } /* end CloseFiles */
  901.  
  902.  
  903.