home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Lscan < prev    next >
Encoding:
Text File  |  1990-07-19  |  4.2 KB  |  194 lines
  1. /*
  2.  * File: lscan.c
  3.  *  Contents: bscan, escan
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9.  
  10.  
  11. /*
  12.  * bscan - set &subject and &pos upon entry to a scanning expression.
  13.  *
  14.  *  Arguments are:
  15.  *    Arg0 - new value for &subject
  16.  *    Arg1 - saved value of &subject
  17.  *    Arg2 - saved value of &pos
  18.  *
  19.  * A variable pointing to the saved &subject and &pos is returned to be
  20.  *  used by escan.
  21.  */
  22.  
  23. LibDcl(bscan,2,"?")
  24.    {
  25.    char sbuf[MaxCvtLen];
  26.    int rc;
  27.    struct pf_marker *cur_pfp;
  28.  
  29. #if MACINTOSH
  30. #if MPW
  31. /* #pragma unused(nargs) */
  32. #endif                    /* MPW */
  33. #endif                    /* MACINTOSH */
  34.  
  35.    /*
  36.     * Convert the new value for &subject to a string.
  37.     */
  38.    if (DeRef(Arg0) == Error) 
  39.       RunErr(0, NULL);
  40.  
  41.    switch (cvstr(&Arg0, sbuf)) {
  42.       case Cvt:
  43.      /*
  44.       * The new value for &subject wasn't a string.  Allocate the
  45.       *  new value and fall through.
  46.       */
  47.          if (strreq(StrLen(Arg0)) == Error) 
  48.             RunErr(0, NULL);
  49.      StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  50.  
  51.       case NoCvt:
  52.      /*
  53.       * Establish a new &subject value and set &pos to 1.
  54.       */
  55.      k_subject = Arg0;
  56.      k_pos = 1;
  57.          break;
  58.  
  59.       default:
  60.          RunErr(103, &Arg0);
  61.       }
  62.  
  63.    /* If the saved scanning environment belongs to the current procedure
  64.     *  call, put a reference to it in the procedure frame.
  65.     */
  66.    if (pfp->pf_scan == NULL)
  67.       pfp->pf_scan = &Arg1;
  68.    cur_pfp = pfp;
  69.  
  70.    /*
  71.     * Suspend with a variable pointing to the saved &subject and &pos.
  72.     */
  73.    ArgType(0) = D_Var;
  74.    VarLoc(Arg0) = &Arg1;
  75.  
  76.    rc = interp(G_Csusp,cargp);
  77.  
  78.    if (pfp != cur_pfp)
  79.       return rc;
  80.  
  81.    /*
  82.     * Leaving scanning environment. Restore the old &subject and &pos values.
  83.     */
  84.    k_subject = Arg1;
  85.    k_pos = IntVal(Arg2);
  86.    if (pfp->pf_scan == &Arg1)
  87.       pfp->pf_scan = NULL;
  88.  
  89.    if (rc == A_Resumption)
  90.       return A_Failure;
  91.    else
  92.       return rc;
  93.  
  94.    }
  95.  
  96.  
  97. /*
  98.  * escan - restore &subject and &pos at the end of a scanning expression.
  99.  *
  100.  *  Arguments:
  101.  *    Arg0 - variable pointing to old values of &subject and &pos
  102.  *    Arg1 - result of the scanning expression
  103.  *
  104.  * The two arguments are reversed, so that the result of the scanning
  105.  *  expression becomes the result of escan. This result is dereferenced
  106.  *  if it refers to &subject or &pos. Then the saved values of &subject
  107.  *  and &pos are exchanged with the current ones.
  108.  *
  109.  * Escan suspends once it has restored the old &subject; on failure
  110.  *  the new &subject and &pos are "unrestored", and the failure is
  111.  *  propagated into the using clause.
  112.  */
  113.  
  114. LibDcl(escan,1,"escan")
  115.    {
  116.    struct descrip tmp;
  117.    int rc;
  118.    struct pf_marker *cur_pfp;
  119.  
  120. #if MACINTOSH
  121. #if MPW
  122. /* #pragma unused(nargs) */
  123. #endif                    /* MPW */
  124. #endif                    /* MACINTOSH */
  125.  
  126.    /*
  127.     * Copy the result of the scanning expression into Arg0, which will
  128.     *  be the result of the scan.
  129.     */
  130.    tmp = Arg0;
  131.    Arg0 = Arg1;
  132.    Arg1 = tmp;
  133.  
  134.    /*
  135.     * If the result of the scanning expression is &subject or &pos,
  136.     *  it is dereferenced.
  137.     */
  138.    if (((char *)BlkLoc(Arg0) == (char *)&tvky_sub) ||
  139.       ((char *)BlkLoc(Arg0) == (char *)&tvky_pos))
  140.          if (DeRef(Arg0) == Error) 
  141.             RunErr(0, NULL);
  142.  
  143.    /*
  144.     * Swap new and old values of &subject
  145.     */
  146.    tmp = k_subject;
  147.    k_subject = *VarLoc(Arg1);
  148.    *VarLoc(Arg1) = tmp;
  149.  
  150.    /*
  151.     * Swap new and old values of &pos
  152.     */
  153.    tmp = *(VarLoc(Arg1) + 1);
  154.    IntVal(*(VarLoc(Arg1) + 1)) = k_pos;
  155.    k_pos = IntVal(tmp);
  156.  
  157.    /*
  158.     * If we are returning to the scanning environment of the current 
  159.     *  procedure call, indicate that it is no longed in a saved state.
  160.     */
  161.    if (pfp->pf_scan == VarLoc(Arg1))
  162.       pfp->pf_scan = NULL;
  163.    cur_pfp = pfp;
  164.  
  165.    /*
  166.     * Suspend the value of the scanning expression.
  167.     */
  168.  
  169.    rc = interp(G_Csusp,cargp);
  170.  
  171.    if (pfp != cur_pfp)
  172.       return rc;
  173.  
  174.    /*
  175.     * Re-entering scanning environment, exchange the values of &subject
  176.     *  and &pos again
  177.     */
  178.    tmp = k_subject;
  179.    k_subject = *VarLoc(Arg1);
  180.    *VarLoc(Arg1) = tmp;
  181.  
  182.    tmp = *(VarLoc(Arg1) + 1);
  183.    IntVal(*(VarLoc(Arg1) +1)) = k_pos;
  184.    k_pos = IntVal(tmp);
  185.  
  186.    if (pfp->pf_scan == NULL)
  187.       pfp->pf_scan = VarLoc(Arg1);
  188.  
  189.    if (rc == A_Resumption)
  190.       return A_Failure;
  191.    else
  192.       return rc;
  193.    }
  194.