home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / lout2.lzh / LOUT2 / z22.c < prev    next >
Text File  |  1994-01-23  |  28KB  |  767 lines
  1. /*@z22.c:Galley Service:Interpose()@******************************************/
  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:         z22.c                                                      */
  26. /*  MODULE:       Galley Service                                             */
  27. /*  EXTERNS:      Interpose(), FlushInners(), ExpandRecursives(),            */
  28. /*                Promote(),K illGalley(), FreeGalley(),                     */
  29. /*                TargetSymbol(), CheckConstraint()                          */
  30. /*                                                                           */
  31. /*****************************************************************************/
  32. #include "externs"
  33. #define    LAST_ADJUST    1
  34. #define    ALL_ADJUST    2
  35.  
  36.  
  37. /*****************************************************************************/
  38. /*                                                                           */
  39. /*  Interpose(z, typ, x, y)                                                  */
  40. /*                                                                           */
  41. /*  Insert a new typ object above z.  Its sizes are to be taken from x       */
  42. /*  (column) and y (row).                                                    */
  43. /*                                                                           */
  44. /*****************************************************************************/
  45.  
  46. Interpose(z, typ, x, y)
  47. OBJECT z;  int typ;  OBJECT x, y;
  48. { OBJECT encl = New(typ);
  49.   FposCopy(fpos(encl), fpos(y));
  50.   ReplaceNode(encl, z);  Link(encl, z);
  51.   back(encl, COL) = back(x, COL);
  52.   fwd(encl, COL) = fwd(x, COL);
  53.   back(encl, ROW) = back(y, ROW);
  54.   fwd(encl, ROW) = fwd(y, ROW);
  55. } /* end Interpose */
  56.  
  57.  
  58. /*@::FlushInners()@***********************************************************/
  59. /*                                                                           */
  60. /*  FlushInners(inners, hd)                                                  */
  61. /*                                                                           */
  62. /*  Flush each galley on the list inners.  These have become flushable       */
  63. /*  by being promoted off the top of galley hd; if hd is the root galley,    */
  64. /*  identifiable by having PrintSym as target, do not flush inners at all.   */
  65. /*                                                                           */
  66. /*****************************************************************************/
  67.  
  68. FlushInners(inners, hd)
  69. OBJECT inners, hd;
  70. { OBJECT y, z, tmp, dest_index;
  71.  
  72.   /* check for root galley case */
  73.   if( hd != nil )
  74.   { assert( Up(hd) != hd, "FlushInners: Up(hd)!" );
  75.     Parent(dest_index, Up(hd));
  76.     if( actual(actual(dest_index)) == PrintSym )
  77.     { DisposeObject(inners);
  78.       return;
  79.     }
  80.   }
  81.  
  82.   while( Down(inners) != inners )
  83.   { Child(y, Down(inners));
  84.     DeleteLink(Down(inners));
  85.     switch( type(y) )
  86.     {
  87.  
  88.       case DEAD:
  89.       
  90.     break;
  91.  
  92.  
  93.       case RECEIVING:
  94.       case UNATTACHED:
  95.       
  96.     assert( Down(y) != y, "FlushInners: UNATTACHED!");
  97.     Child(z, Down(y));
  98.     debug0(DGF, D, "  calling FlushGalley from FlushInners (a)");
  99.     FlushGalley(z);
  100.     break;
  101.  
  102.  
  103.       case PRECEDES:
  104.       
  105.     Child(tmp, Down(y));
  106.     if( Up(tmp) != LastUp(tmp) )
  107.     { Parent(tmp, LastUp(tmp));
  108.       assert(type(tmp)==FOLLOWS, "FlushInners: FOLLOWS!");
  109.       if( blocked(tmp) )
  110.       { blocked(tmp) = FALSE;
  111.         Parent(z, Up(tmp));
  112.         debug0(DGF, D, "  calling FlushGalley from FlushInners (b)");
  113.         FlushGalley(z);
  114.       }
  115.     }
  116.     break;
  117.  
  118.  
  119.       default:
  120.       
  121.     Error(INTERN,&fpos(y),"FlushInners %s", Image(type(y)));
  122.     break;
  123.     }
  124.   }
  125.   Dispose(inners);
  126. } /* end FlushInners */
  127.  
  128.  
  129. /*@::ExpandRecursives()@******************************************************/
  130. /*                                                                           */
  131. /*  ExpandRecursives(recs)                                                   */
  132. /*                                                                           */
  133. /*  Expand each of the recursive definite objects in the list recs.          */
  134. /*                                                                           */
  135. /*****************************************************************************/
  136.  
  137. ExpandRecursives(recs)
  138. OBJECT recs;
  139. { CONSTRAINT non_c, hc, vc;
  140.   OBJECT target_index, target, z, n1, inners, newrecs, hd, tmp, env;
  141.   debug0(DCR, D, "ExpandRecursives(recs)");
  142.   SetConstraint(non_c, MAX_LEN, MAX_LEN, MAX_LEN);  n1 = nil;
  143.   assert(recs != nil, "ExpandRecursives: recs == nil!");
  144.   while( Down(recs) != recs )
  145.   { Child(target_index, Down(recs));  DeleteLink( Down(recs) );
  146.     assert( type(target_index) == RECURSIVE, "ExpandRecursives: index!" );
  147.     target = actual(target_index);
  148.     debug2(DCR, DD, "  expanding %s %s", Image(type(target_index)),
  149.       EchoObject(target));
  150.  
  151.     /* expand body of target, convert to galley, and check size */
  152.     hd = New(HEAD);  actual(hd) = actual(target);  must_expand(hd) = TRUE;
  153.     whereto(hd) = ready_galls(hd) = nil;  backward(hd) = sized(hd) = FALSE;
  154.     tmp =  CopyObject(target, &fpos(target));  env = DetachEnv(tmp);
  155.     Link(hd, tmp);  Link(target_index, hd);
  156.     SizeGalley(hd, env, external(target), threaded(target), FALSE, FALSE,
  157.       &save_style(target), &non_c, nil, &n1, &newrecs, &inners);
  158.     debug0(DCR, DDD, "    as galley:");
  159.     ifdebug(DCR, DDD, DebugObject(hd));
  160.     Constrained(target, &hc, COL);
  161.     debug2(DSC, D, "Constrained( %s, COL ) = %s",
  162.       EchoObject(target), EchoConstraint(&hc));
  163.     debug3(DCR, DD, "    horizontal size: (%s, %s); constraint: %s",
  164.       EchoLength(back(hd, COL)), EchoLength(fwd(hd, COL)), EchoConstraint(&hc));
  165.     if( !FitsConstraint(back(hd, COL), fwd(hd, COL), hc) )
  166.     { DisposeChild(Up(hd));
  167.       if( inners != nil ) DisposeObject(inners);
  168.       if( newrecs != nil ) DisposeObject(newrecs);
  169.       DeleteNode(target_index);
  170.       debug0(DCR, DD, "    rejecting (too wide)");
  171.       continue;
  172.     }
  173.     if( !external(target) )
  174.     { Constrained(target, &vc, ROW);
  175.       debug2(DSC, D, "Constrained( %s, ROW ) = %s",
  176.     EchoObject(target), EchoConstraint(&vc));
  177.       Child(z, LastDown(hd));
  178.       debug3(DCR, DD, "    vsize: (%s, %s); constraint: %s",
  179.     EchoLength(back(z, ROW)), EchoLength(fwd(z, ROW)), EchoConstraint(&vc));
  180.       if( !FitsConstraint(back(z, ROW), fwd(z, ROW), vc) )
  181.       {    DisposeChild(Up(hd));
  182.     if( inners != nil ) DisposeObject(inners);
  183.     if( newrecs != nil ) DisposeObject(newrecs);
  184.     DeleteNode(target_index);
  185.     debug0(DCR, DD, "    rejecting (too high)");
  186.     continue;
  187.       }
  188.     }
  189.  
  190.     /* object fits; adjust sizes and promote */
  191.     debug0(DSA, D, "calling AdjustSize from ExpandRecursives (a)");
  192.     AdjustSize(target, back(hd, COL), fwd(hd, COL), COL);
  193.     if( !external(target) )
  194.     { debug0(DSA, D, "calling AdjustSize from ExpandRecursives (b)");
  195.       AdjustSize(target, back(z, ROW), fwd(z, ROW), ROW);
  196.       Interpose(target, VCAT, z, z);
  197.     }
  198.     Promote(hd, hd, target_index);  DeleteNode(hd);
  199.     DeleteNode(target_index);
  200.     if( inners != nil )  FlushInners(inners, nil);
  201.     if( newrecs != nil )  MergeNode(recs, newrecs);
  202.   } /* end while */
  203.   Dispose(recs);
  204.   debug0(DCR, D, "ExpandRecursives returning.");
  205. } /* end ExpandRecursives */
  206.  
  207. /*@::FindSplitInGalley()@*****************************************************/
  208. /*                                                                           */
  209. /*  static OBJECT FindSplitInGalley(hd)                                      */
  210. /*                                                                           */
  211. /*  Search simply joined galley hd for a SPLIT object, which must be there.  */
  212. /*                                                                           */
  213. /*****************************************************************************/
  214.  
  215. static OBJECT FindSplitInGalley(hd)
  216. OBJECT hd;
  217. { OBJECT link, y;
  218.   debug0(DGF, D, "FindSplitInGalley(hd)");
  219.   for( link = Down(hd);  link != hd;  link = NextDown(link) )
  220.   { Child(y, link);
  221.     if( is_definite(type(y)) )  break;
  222.   }
  223.   if( link == hd )
  224.   { debug0(DGF, D, "FindSplitInGalley failing, no definite component; hd =");
  225.     ifdebug(DGF, D, DebugObject(hd));
  226.     Error(INTERN, &fpos(hd), "missing galley component");
  227.   }
  228.   while( type(y) != SPLIT )  switch( type(y) )
  229.   {
  230.     case VCAT:
  231.     case ONE_ROW:
  232.     case WIDE:
  233.     case HIGH:
  234.     case VCONTRACT:
  235.     case VEXPAND:
  236.     case PADJUST:
  237.     case VADJUST:
  238.  
  239.       Child(y, Down(y));
  240.       break;
  241.  
  242.  
  243.     case CLOSURE:
  244.     case NULL_CLOS:
  245.     case HCAT:
  246.     case WORD:
  247.     case QWORD:
  248.     case ACAT:
  249.     case ROW_THR:
  250.     case COL_THR:
  251.     case ONE_COL:
  252.     case SCALE:
  253.     case HSCALE:
  254.     case VSCALE:
  255.     case HCONTRACT:
  256.     case HEXPAND:
  257.     case HADJUST:
  258.     case ROTATE:
  259.     case INCGRAPHIC:
  260.     case SINCGRAPHIC:
  261.     case GRAPHIC:
  262.  
  263.       debug0(DGF, D, "FindSplitInGalley(hd) failing, hd =");
  264.       ifdebug(DGF, D, DebugObject(hd));
  265.       Error(INTERN, &fpos(y), "FindSplitInGalley failed", Image(type(y)));
  266.       break;
  267.  
  268.  
  269.     default:
  270.     
  271.       Error(INTERN, &fpos(y), "FindSplitInGalley found %s", Image(type(y)));
  272.       break;
  273.  
  274.   }
  275.   debug0(DGF, D, "FindSplitInGalley returning.");
  276.   return y;
  277. } /* end FindSplitInGalley */
  278.  
  279. /*@::Promote()@***************************************************************/
  280. /*                                                                           */
  281. /*  Promote(x, stop_link, dest_index)                                        */
  282. /*                                                                           */
  283. /*  Promote components of galley x into its destination (dest), up to but    */
  284. /*  not including the one linked to x by link stop_link, which always        */
  285. /*  follows a component.  No size adjustments are made, except that when     */
  286. /*  two col_thr nodes are merged, a COL adjustment is made to the result.    */
  287. /*                                                                           */
  288. /*****************************************************************************/
  289.  
  290. Promote(x, stop_link, dest_index)
  291. OBJECT x, stop_link, dest_index;
  292. {
  293.   /* these four variables refer to the root galley only */
  294.   static BOOLEAN first = TRUE;    /* TRUE when the first component not written */
  295.   static int    prec_back;    /* back value of preceding component         */
  296.   static int    prec_fwd;    /* fwd value of preceding component          */
  297.   static GAP    prec_gap;    /* preceding gap                             */
  298.  
  299.   OBJECT dest, link, y, z, tmp1, tmp2;
  300.   int dim;
  301.   debug1(DGS, D, "Promote(%s, stop_link)", SymName(actual(x)));
  302.  
  303.   assert( type(x) == HEAD, "Promote: x!" );
  304.   assert( type(stop_link) == LINK || stop_link == x, "Promote: stop_link!" );
  305.   assert( stop_link != Down(x), "Promote: stop_link == Down(x)!" );
  306.   type(dest_index) = RECEIVING;
  307.   dest = actual(dest_index);
  308.  
  309.   /* insert final gap if galley is ending */
  310.   if( stop_link != x )
  311.   { Child(y, stop_link);
  312.     assert( type(y) == GAP_OBJ, "Promote: missing GAP_OBJ!" );
  313.     stop_link = NextDown(stop_link);
  314.   }
  315.   else
  316.   { y = New(GAP_OBJ);
  317.     FposCopy(fpos(y), fpos(x));
  318.     hspace(y) = 0;  vspace(y) = 1;
  319.     ClearGap(gap(y));
  320.     Link(stop_link, y);
  321.   }
  322.  
  323.   /* error if promoting a seen_nojoin galley into a threaded destination */
  324.   if( seen_nojoin(x) && threaded(dest) )
  325.     Error(FATAL, &fpos(x), "galley %s must have a single column mark",
  326.     SymName(actual(x)));
  327.   if( seen_nojoin(x) )  join(gap(y)) = FALSE; /* to make nojoin status clear */
  328.  
  329.   /* if promoting out of root galley, do special things */
  330.   if( actual(dest) == PrintSym )
  331.   { CONSTRAINT c;
  332.     link = x;
  333.     while( NextDown(link) != stop_link )
  334.     { Child(y, NextDown(link));
  335.       debug1(DGS, D, "root promote %s", EchoObject(y));
  336.       if( type(y) == SPLIT )  Child(y, DownDim(y, ROW));
  337.       switch( type(y) )
  338.       {
  339.  
  340.     case PRECEDES:
  341.       
  342.       DisposeChild(NextDown(link));
  343.       break;
  344.     
  345.  
  346.     case UNATTACHED:
  347.       
  348.       assert( Down(y) != y, "FlushRootGalley: UNATTACHED!" );
  349.       Child(z, Down(y));
  350.       assert( type(z) == HEAD, "FlushRootGalley: unattached HEAD!" );
  351.       if( sized(z) )
  352.       {
  353.         /* galley is part flushed, leave it here */
  354.         link = NextDown(link);
  355.       }
  356.       else if( backward(z) )
  357.       {
  358.         /* galley is preceding, send to CrossSequence */
  359.         OBJECT t;
  360.         type(y) = GALL_PREC;
  361.         Child(t, Down(z));
  362.         actual(y) = CrossMake(whereto(z), t, GALL_PREC);
  363.         DisposeChild(Down(y));
  364.         CrossSequence(actual(y));
  365.         DisposeChild(NextDown(link));
  366.       }
  367.       else
  368.       {
  369.         /* galley was never attached, print message and kill it */
  370.         Error(WARN, &fpos(z), "Galley %s deleted - never attached",
  371.             SymName(actual(z)));
  372.         KillGalley(z);
  373.       }
  374.       break;
  375.  
  376.  
  377.     case EXPAND_IND:
  378.       
  379.       /* expand @HExpand or @VExpand to occupy everything possible */
  380.       dim = type(actual(y)) == HEXPAND ? COL : ROW;
  381.           debug1(DGP, D, " flushing %s", EchoObject(y));
  382.       Constrained(actual(y), &c, dim);
  383.       if( constrained(c) )
  384.       { LENGTH b = back(actual(y), dim);
  385.         LENGTH f = fwd(actual(y), dim);
  386.         EnlargeToConstraint(&b, &f, &c);
  387.         debug2(DGP, D, "FlushRoot call AdjustSize(x, %s,%s, dim)",
  388.             EchoLength(b), EchoLength(f));
  389.         debug1(DSA, D, "Promote %s AdjustSize", Image(type(actual(y))));
  390.         AdjustSize(actual(y), b, f, dim);
  391.       }
  392.       DisposeChild(NextDown(link));
  393.       break;
  394.  
  395.  
  396.     case GALL_PREC:
  397.     case GALL_FOLL:
  398.     case GALL_TARG:
  399.     case CROSS_PREC:
  400.     case CROSS_FOLL:
  401.     case CROSS_TARG:
  402.           
  403.       CrossSequence(actual(y));
  404.       DisposeChild(NextDown(link));
  405.       break;
  406.  
  407.  
  408.     case WORD:
  409.     case QWORD:
  410.     case ONE_COL:
  411.     case ONE_ROW:
  412.     case WIDE:
  413.     case HIGH:
  414.     case HSCALE:
  415.     case VSCALE:
  416.     case HCONTRACT:
  417.     case VCONTRACT:
  418.     case HEXPAND:
  419.     case VEXPAND:
  420.     case PADJUST:
  421.     case HADJUST:
  422.     case VADJUST:
  423.     case ROTATE:
  424.     case SCALE:
  425.     case INCGRAPHIC:
  426.     case SINCGRAPHIC:
  427.     case GRAPHIC:
  428.     case ACAT:
  429.     case HCAT:
  430.     case ROW_THR:
  431.  
  432.     case CLOSURE:
  433.     case NULL_CLOS:
  434.     case CROSS:
  435.  
  436.       /* print this component */
  437.       debug0(DCR, D, "Promote --");
  438.       if( !is_indefinite(type(y)) && size(y, ROW) != 0 )
  439.       {
  440.         /* move down as specified by the gap */
  441.         if( first )
  442.         { PrintPrologue(size(x, COL), size(y, ROW));
  443.           first = FALSE;
  444.         }
  445.         else PrintOriginIncrement(prec_back - back(y, ROW)
  446.               + MinGap(prec_fwd, back(y, ROW), fwd(y, ROW), &prec_gap));
  447.         debug1(DGF,D, "  Promote calling FixAndPrint %s", Image(type(y)));
  448.         FixAndPrintObject(y, back(x, COL), back(x, COL), fwd(x, COL),
  449.           COL, LAST_ADJUST, FALSE, LAST_ADJUST, 0, 0);
  450.         FixAndPrintObject(y, back(y,ROW), back(y, ROW), fwd(y, ROW),
  451.           ROW, LAST_ADJUST, FALSE, LAST_ADJUST, size(y,ROW), 0);
  452.         prec_back = back(y, ROW);  prec_fwd = fwd(y, ROW);
  453.       }
  454.       DisposeChild(NextDown(link));
  455.       break;
  456.  
  457.  
  458.     case GAP_OBJ:
  459.  
  460.       GapCopy(prec_gap, gap(y));
  461.       DisposeChild(NextDown(link));
  462.       break;
  463.  
  464.  
  465.     default:
  466.       
  467.       Error(INTERN, &fpos(y), "Promote (root): %s", Image(type(y)));
  468.       break;
  469.     
  470.       }
  471.     }
  472.     debug0(DGS, D, "Promote returning (root galley).");
  473.     return;
  474.   }
  475.  
  476.   /* prepare the promotion */
  477.   if( external(dest) )
  478.   { if( threaded(dest) )
  479.     { Parent(tmp1, UpDim(dest, COL));
  480.       assert( type(tmp1) == COL_THR, "Promote: tmp1 not COL_THR!" );
  481.       y = FindSplitInGalley(x);
  482.       assert( type(y) == SPLIT, "Promote: FindSplitInGalley!" );
  483.       Child(tmp2, DownDim(y, COL));
  484.       assert( type(tmp2) == COL_THR, "Promote: tmp2 not COL_THR!" );
  485.       if( tmp1 != tmp2 )
  486.       { LENGTH b = max(back(tmp1, COL), back(tmp2, COL));
  487.     LENGTH f = max(fwd(tmp1, COL),  fwd(tmp2, COL));
  488.     debug0(DSA, D, "calling AdjustSize(tmp1) from Promote (node merging)");
  489.     AdjustSize(tmp1, b, f, COL);
  490.     debug0(DSA, D, "calling AdjustSize(tmp2) from Promote (node merging)");
  491.     AdjustSize(tmp2, b, f, COL);
  492.     MergeNode(tmp1, tmp2);
  493.       }
  494.     }
  495.     link = Up(dest_index);
  496.   }
  497.   else
  498.   { for( link = x;  NextDown(link) != stop_link;  )
  499.     { Child(y, NextDown(link));
  500.       if( is_index(type(y)) )  MoveLink(NextDown(link), Up(dest_index), PARENT);
  501.       else link = NextDown(link);
  502.     }
  503.     assert( Down(x) != stop_link, "Promote: Down(x) == stop_link!" );
  504.     assert( UpDim(dest, ROW) == UpDim(dest, COL), "Promote: dims!" );
  505.     link = Up(dest);
  506.   }
  507.   
  508.   /* promote components */
  509.   TransferLinks(Down(x), stop_link, link);
  510.  
  511.   debug0(DGS, D, "Promote returning.");
  512. } /* end Promote */
  513.  
  514.  
  515. /*@::MakeDead(), KillGalley()@************************************************/
  516. /*                                                                           */
  517. /*  static MakeDead(y)                                                       */
  518. /*                                                                           */
  519. /*  Convert object y into a DEAD object and remove it to the dead store.     */
  520. /*                                                                           */
  521. /*****************************************************************************/
  522.  
  523. static MakeDead(y)
  524. OBJECT y;
  525. { static int    dead_count = 0;        /* number of DEAD objects seen       */
  526.   static OBJECT    dead_store = nil;    /* where DEAD objects are kept       */
  527.  
  528.   debug1(DGS, DDD, "MakeDead( %s )", Image(type(y)));
  529.   if( dead_store == nil )  dead_store = New(ACAT);
  530.   type(y) = DEAD;
  531.   MoveLink(Up(y), dead_store, PARENT);
  532.   if( dead_count >= 100 )  DisposeChild(Down(dead_store));
  533.   else dead_count++;
  534.   debug1(DGS, DDD, "MakeDead returning (dead_count = %d).", dead_count);
  535. } /* end MakeDead */
  536.  
  537.  
  538. /*****************************************************************************/
  539. /*                                                                           */
  540. /*  KillGalley(hd)                                                           */
  541. /*                                                                           */
  542. /*  Kill galley hd, which may be sized or unsized.  The index of hd must     */
  543. /*  be UNATTACHED; it is moved out of its present location to a secret spot. */
  544. /*                                                                           */
  545. /*****************************************************************************/
  546.  
  547. KillGalley(hd)
  548. OBJECT hd;
  549. { OBJECT prnt, link, y, z;
  550.   debug2(DGA, D, "[ KillGalley(Galley %s into %s)",
  551.     SymName(actual(hd)), SymName(whereto(hd)));
  552.   assert( type(hd) == HEAD && Up(hd) != hd, "KillGalley: precondition!" );
  553.   Parent(prnt, Up(hd));
  554.   assert( type(prnt) == UNATTACHED, "KillGalley: UNATTACHED precondition!" );
  555.   assert( Up(prnt) != prnt, "KillGalley: prnt!" );
  556.  
  557.   if( ready_galls(hd) != nil )
  558.   { DisposeObject(ready_galls(hd));
  559.     ready_galls(hd) = nil;
  560.   }
  561.   for( link = hd; NextDown(link) != hd; )
  562.   { Child(y, NextDown(link));
  563.     switch( type(y) )
  564.     {
  565.       case RECEIVING:    while( Down(y) != y )
  566.             { Child(z, Down(y));
  567.               DetachGalley(z);
  568.             }
  569.             DeleteNode(y);
  570.             break;
  571.         
  572.       case RECEPTIVE:    assert( Down(y) == y, "KillGalley: RECEPTIVE!" );
  573.             DeleteNode(y);
  574.             break;
  575.  
  576.       case UNATTACHED:    assert( Down(y) != y, "KillGalley: UNATTACHED!" );
  577.             Child(z, Down(y));  KillGalley(z);
  578.             break;
  579.  
  580.       case HEAD:    Error(INTERN, &fpos(y), "KillGalley: HEAD!");
  581.             break;
  582.  
  583.       default:        DisposeChild(NextDown(link));
  584.             break;
  585.     }
  586.   }
  587.  
  588.   /* move index into dead_store */
  589.   MakeDead(prnt);
  590.   debug0(DGA, D, "] KillGalley returning.");
  591. } /* end KillGalley */
  592.  
  593.  
  594. /*@::FreeGalley()@************************************************************/
  595. /*                                                                           */
  596. /*  FreeGalley(hd, stop_link, inners, relocate_link, sym)                    */
  597. /*                                                                           */
  598. /*  Free galley hd up to but not including stop_link.  *Inners is well-      */
  599. /*  defined, either nil or an ACAT of galleys to be flushed.                 */
  600. /*                                                                           */
  601. /*  Relocate_link defines what to do any galley attached to one of the       */
  602. /*  freed targets.  If it is non-nil, galley hd is searched onwards from     */
  603. /*  it to see if a target can be found there.  If so, the galley is          */
  604. /*  relocated to just before that point.  If not, or if relocate_link is     */
  605. /*  nil, the galley is freed and added to *inners for flushing.  If the      */
  606. /*  whereto() of such galley is sym, it is freed, not relocated, because the */
  607. /*  cause of this call to FreeGalley is also targeted to sym, and it will    */
  608. /*  consume all possible targets of sym.                                     */
  609. /*                                                                           */
  610. /*****************************************************************************/
  611.  
  612. FreeGalley(hd, stop_link, inners, relocate_link, sym)
  613. OBJECT hd, stop_link, *inners, relocate_link, sym;
  614. { OBJECT link, y, z, zlink, srch, index;
  615.   assert( type(hd) == HEAD && sized(hd), "FreeGalley: pre!");
  616.   assert( Up(hd) != hd, "FreeGalley: Up(hd)!" );
  617.   assert( *inners == nil || type(*inners) == ACAT, "FreeGalley: ACAT!" );
  618.   debug3(DGA, D, "[ FreeGalley(Galley %s into %s); rl %s nil",
  619.     SymName(actual(hd)), SymName(whereto(hd)), relocate_link==nil ? "==":"!=");
  620.  
  621.   /* close targets and move or flush any inner galleys */
  622.   for( link = Down(hd);  link != stop_link;  link = NextDown(link) )
  623.   { Child(y, link);
  624.     if( type(y) == RECEIVING && actual(actual(y)) == InputSym )
  625.       Error(WARN, &fpos(actual(y)), "forcing galley past input point");
  626.     else if( type(y) == RECEIVING )
  627.     {
  628.       /* either relocate or free each galley */
  629.       for( zlink = Down(y);  zlink != y; )
  630.       {    Child(z, zlink);
  631.     zlink = NextDown(zlink);
  632.     assert( type(z) == HEAD, "FreeGalley/RECEIVING: type(z) != HEAD!" );
  633.     debug1(DGA, D, "FreeGalley examining galley %s", SymName(actual(z)));
  634.     if( relocate_link != nil && whereto(z) != sym &&
  635.         (srch = SearchGalley(relocate_link, whereto(z), TRUE,
  636.         FALSE, TRUE, FALSE)) != nil )
  637.     { DetachGalley(z);
  638.       Parent(index, Up(z));
  639.       MoveLink(Up(index), Up(srch), PARENT);  /* just before new dest */
  640.     }
  641.     else
  642.     { debug0(DGA, D, "  calling FreeGalley from FreeGalley");
  643.       FreeGalley(z, z, inners, nil, sym);
  644.       if( *inners == nil )  *inners = New(ACAT);
  645.       Link(*inners, y);
  646.     }
  647.       }
  648.       non_blocking(y) = TRUE;
  649.     }
  650.     else if( type(y) == RECEPTIVE )  non_blocking(y) = TRUE;
  651.   }
  652.   debug0(DGA, D, "] FreeGalley returning.");
  653. } /* end FreeGalley */
  654.  
  655.  
  656. /*@::TargetSymbol()@**********************************************************/
  657. /*                                                                           */
  658. /*  BOOLEAN TargetSymbol(x, sym)                                             */
  659. /*                                                                           */
  660. /*  Examine the parameters of closure x, which is known to have a @Target.   */
  661. /*  Return TRUE if the target is preceding, and set sym to the symbol value. */
  662. /*                                                                           */
  663. /*****************************************************************************/
  664.  
  665. BOOLEAN TargetSymbol(x, sym)
  666. OBJECT x, *sym;
  667. { OBJECT y, link, cr, lpar, rpar;
  668.   debug1(DGS, D, "TargetSymbol( %s )", EchoObject(x));
  669.   assert( type(x) == CLOSURE, "TargetSymbol: type(x) != CLOSURE!" );
  670.   assert( has_target(actual(x)), "TargetSymbol: x has no target!" );
  671.  
  672.   /* search the free variable list of x for @Target */
  673.   cr = nil;
  674.   for( link = Down(x);  link != x;  link = NextDown(link) )
  675.   { Child(y, link);
  676.     if( type(y) == PAR && is_target(actual(y)) )
  677.     { assert( Down(y) != y, "TargetSymbol: Down(PAR)!" );
  678.       Child(cr, Down(y));
  679.       break;
  680.     }
  681.   }
  682.  
  683.   /* search the children list of actual(x) for a default value of @Target */
  684.   if( cr == nil )
  685.   for( link = Down(actual(x));  link != actual(x);  link = NextDown(link) )
  686.   { Child(y, link);
  687.     if( is_target(y) )
  688.     { cr = sym_body(y);
  689.       break;
  690.     }
  691.   }
  692.   
  693.   if( cr != nil )
  694.   {
  695.     /* check that cr is indeed a cross-reference object */
  696.     debug1(DGS, DD, "TargetSymbol examining %s", EchoObject(cr));
  697.     debug1(DGS, DD, "  type(cr) = %s", Image( (int) type(cr)) );
  698.     if( type(cr) != CROSS )
  699.       Error(FATAL, &fpos(cr), "target of %s is not a cross-reference",
  700.     SymName(actual(x)));
  701.  
  702.     /* extract *sym from the left parameter */
  703.     Child(lpar, Down(cr));
  704.     if( type(lpar) != CLOSURE )
  705.       Error(FATAL,&fpos(lpar),"left parameter of %s is not a symbol",KW_CROSS);
  706.     *sym = actual(lpar);
  707.  
  708.     /* extract direction from the right parameter */
  709.     Child(rpar, NextDown(Down(cr)));
  710.     if( !is_word(type(rpar)) || !StringEqual(string(rpar), KW_PRECEDING) &&
  711.     !StringEqual(string(rpar), KW_FOLLOWING) )
  712.       Error(WARN, &fpos(rpar), "replacing %s%s? by %s%s%s",
  713.     SymName(actual(lpar)), KW_CROSS, SymName(actual(lpar)),
  714.     KW_CROSS, KW_FOLLOWING);
  715.     return is_word(type(rpar)) && StringEqual(string(rpar), KW_PRECEDING);
  716.   }
  717.   else
  718.   { Error(INTERN, &fpos(x), "TargetSymbol: could not find @Target of x");
  719.     return FALSE;
  720.   }
  721. } /* end TargetSymbol */
  722.  
  723.  
  724. /*@::CheckConstraint()@*******************************************************/
  725. /*                                                                           */
  726. /*  int CheckConstraint(preceder, follower)                                  */
  727. /*                                                                           */
  728. /*  Check the ordering relation between components preceder and follower,    */
  729. /*  and return its current status:                                           */
  730. /*                                                                           */
  731. /*      CLEAR     follower definitely follows preceder, and always will;     */
  732. /*      PROMOTE   follower is not prevented from following preceder;         */
  733. /*      CLOSE     follower must move down its galley to follow preceder;     */
  734. /*      BLOCK     follower cannot be guaranteed to follow preceder.          */
  735. /*                                                                           */
  736. /*****************************************************************************/
  737.  
  738. int CheckConstraint(preceder, follower)
  739. OBJECT preceder, follower;
  740. { OBJECT prec_galley, foll_galley, z;  int res;
  741.   debug2(DGS, D, "CheckConstraint( %s, %s )",
  742.     EchoObject(preceder), EchoObject(follower));
  743.   Parent(prec_galley, Up(preceder));
  744.   Parent(foll_galley, Up(follower));
  745.   if( prec_galley == foll_galley )
  746.   { res = CLOSE;
  747.     for( z = Up(follower);  z != foll_galley;  z = pred(z, CHILD) )
  748.     if( z == Up(preceder) )
  749.     { res = CLEAR;
  750.       break;
  751.     }
  752.   }
  753.   else
  754.   { res = PROMOTE;
  755.     while( Up(prec_galley) != prec_galley )
  756.     { Parent(z, Up(prec_galley));    /* index of galley */
  757.       Parent(prec_galley, Up(z));    /* enclosing galley */
  758.       if( prec_galley == foll_galley )
  759.       {    res = BLOCK;
  760.     break;
  761.       }
  762.     }
  763.   }
  764.   debug1(DGS, D, "CheckConstraint returning %s", Image(res));
  765.   return res;
  766. } /* end CheckConstraint */
  767.