home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Oasgn < prev    next >
Encoding:
Text File  |  1990-07-19  |  6.8 KB  |  291 lines
  1. /*
  2.  * File: oasgn.c
  3.  *  Contents: asgn, rasgn, rswap, swap
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9.  
  10.  
  11. /*
  12.  * x := y - assign y to x.
  13.  */
  14.  
  15. OpDcl(asgn,2,":=")
  16.    {
  17.    /*
  18.     * Make sure that Arg1 is a variable.
  19.     */
  20.    if (!Var(Arg1)) 
  21.       RunErr(111, &Arg1);
  22.  
  23.    /*
  24.     * The returned result is the variable to which assignment is being
  25.     *  made.
  26.     */
  27.    Arg0 = Arg1;
  28.  
  29.    /*
  30.     * All the work is done by doasgn.  Note that Arg1 is known
  31.     *  to be a variable.
  32.     */
  33.    switch (doasgn(&Arg1, &Arg2)) {
  34.       case Success:
  35.          Return;
  36.       case Failure:
  37.          Fail;
  38.       case Error:
  39.          RunErr(0, NULL);
  40.       }
  41.    }
  42.  
  43. /*
  44.  * x <- y - assign y to x.
  45.  * Reverses assignment if resumed.
  46.  */
  47.  
  48. OpDcl(rasgn,2,"<-")
  49.    {
  50.  
  51.    /*
  52.     * Arg1 must be a variable.
  53.     */
  54.    if (!Var(Arg1)) 
  55.       RunErr(111, &Arg1);
  56.  
  57.    /*
  58.     * The return value is the variable Arg1, so make a copy of it before
  59.     *  it is dereferenced.
  60.     */
  61.    Arg0 = Arg1;
  62.    if (DeRef(Arg1) == Error) 
  63.       RunErr(0, NULL);
  64.  
  65.    /*
  66.     * Assign Arg2 to Arg1 and suspend.
  67.     */
  68.    switch (doasgn(&Arg0, &Arg2)) {
  69.       case Success:
  70.          Suspend;
  71.          break;
  72.       case Failure:
  73.          Fail;
  74.       case Error:
  75.          RunErr(0, NULL);
  76.       }
  77.    /*
  78.     * Reverse the assignment by assigning the old value
  79.     *  of back and fail.
  80.     */
  81.    if (doasgn(&Arg0, &Arg1) == Error) 
  82.       RunErr(0, NULL);
  83.    Fail;
  84.    }
  85.  
  86. /*
  87.  * x <-> y - swap values of x and y.
  88.  * Reverses swap if resumed.
  89.  */
  90.  
  91. OpDcl(rswap,2,"<->")
  92.    {
  93.    register union block *bp1, *bp2;
  94.    word adj1, adj2;
  95.  
  96.    /*
  97.     * Arg1 and Arg2 must be variables.
  98.     */
  99.    if (!Var(Arg1)) {
  100.       RunErr(111, &Arg1);
  101.       }
  102.    if (!Var(Arg2)) {
  103.       RunErr(111, &Arg2);
  104.       }
  105.  
  106.    /*
  107.     * Make copies of Arg1 and Arg2 as variables in Arg0 and Arg3.
  108.     */
  109.    Arg0 = Arg1;
  110.    Arg3 = Arg2;
  111.    adj1 = adj2 = 0;
  112.    if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
  113.       bp1 = BlkLoc(Arg1);
  114.       bp2 = BlkLoc(Arg2);
  115.       if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar) &&
  116.       Offset(bp1->tvsubs.ssvar) == Offset(bp2->tvsubs.ssvar)) {
  117.          /*
  118.           * Arg1 and Arg2 are both substrings of the same string; set
  119.           *  adj1 and adj2 for use in locating the substrings after
  120.           *  an assignment has been made.  If Arg1 is to the right of Arg2,
  121.           *  set adj1 := *Arg1 - *Arg2, otherwise if Arg2 is to the right of
  122.           *  Arg1, set adj2 := *Arg2 - *Arg1.  Note that the adjustment values
  123.           *  may be negative.
  124.           */
  125.          if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
  126.             adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
  127.          else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
  128.             adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
  129.             }
  130.       }
  131.    if (DeRef(Arg1) == Error) {
  132.       RunErr(0, NULL);
  133.       }
  134.    if (DeRef(Arg2) == Error) {
  135.       RunErr(0, NULL);
  136.       }
  137.    /*
  138.     * Do Arg1 := Arg2
  139.     */
  140.    switch (doasgn(&Arg0, &Arg2)) {
  141.       case Success:
  142.          break;
  143.       case Failure:
  144.          Fail;
  145.       case Error:
  146.          RunErr(0, NULL);
  147.       }
  148.    if (adj2 != 0)
  149.       /*
  150.        * Arg2 is to the right of Arg1 and the assignment Arg := Arg2 has
  151.        *  shifted the position of Arg2.  Add adj2 to the position of Arg2
  152.        *  to account for the replacement of Arg1 by Arg2.
  153.        */
  154.       BlkLoc(Arg3)->tvsubs.sspos += adj2;
  155.    /*
  156.     * Do Arg2 := Arg1
  157.     */
  158.    switch (doasgn(&Arg3, &Arg1)) {
  159.       case Success:
  160.          break;
  161.       case Failure:
  162.          Fail;
  163.       case Error:
  164.          RunErr(0, NULL);
  165.       }
  166.    if (adj1 != 0)
  167.       /*
  168.        * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1 has
  169.        *  shifted  the position of Arg1.  Add adj2 to the position of Arg1
  170.        *  to account for the replacement of Arg2 by Arg1.
  171.        */
  172.       BlkLoc(Arg0)->tvsubs.sspos += adj1;
  173.    /*
  174.     * Suspend Arg1 with the assignment in effect.
  175.     */
  176.    Suspend;
  177.    /*
  178.     * If resumed, the assignments are undone.  Note that the string position
  179.     *  adjustments are opposite those done earlier.
  180.     */
  181.    switch (doasgn(&Arg0, &Arg1)) {        /* restore Arg1 */
  182.       case Success:
  183.          break;
  184.       case Failure:
  185.          Fail;
  186.       case Error:
  187.          RunErr(0, NULL);
  188.       }
  189.    if (adj2 != 0)
  190.       BlkLoc(Arg3)->tvsubs.sspos -= adj2;
  191.    switch (doasgn(&Arg3, &Arg2))  {       /* restore Arg2 */
  192.       case Success:
  193.          break;
  194.       case Failure:
  195.          Fail;
  196.       case Error:
  197.          RunErr(0, NULL);
  198.       }
  199.    if (adj1 != 0)
  200.       BlkLoc(Arg0)->tvsubs.sspos -= adj1;
  201.    Fail;
  202.    }
  203.  
  204. /*
  205.  * x :=: y - swap values of x and y.
  206.  */
  207.  
  208. OpDcl(swap,2,":=:")
  209.    {
  210.    register union block *bp1, *bp2;
  211.    word adj1, adj2;
  212.  
  213.    /*
  214.     * Arg1 and Arg2 must be variables.
  215.     */
  216.    if (!Var(Arg1)) {
  217.       RunErr(111, &Arg1);
  218.       }
  219.    if (!Var(Arg2)) {
  220.       RunErr(111, &Arg2);
  221.       }
  222.    /*
  223.     * Make copies of Arg1 and Arg2 as variables in Arg0 and Arg3.
  224.     */
  225.    Arg0 = Arg1;
  226.    Arg3 = Arg2;
  227.    adj1 = adj2 = 0;
  228.    if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
  229.       bp1 = BlkLoc(Arg1);
  230.       bp2 = BlkLoc(Arg2);
  231.       if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar) &&
  232.       Offset(bp1->tvsubs.ssvar) == Offset(bp2->tvsubs.ssvar)) {
  233.          /*
  234.       * Arg1 and Arg2 are both substrings of the same string, set
  235.       *  adj1 and adj2 for use in locating the substrings after
  236.       *  an assignment has been made.  If Arg1 is to the right of Arg2,
  237.       *  set adj1 := *Arg1 - *Arg2, otherwise if Arg2 is to the right of
  238.           *  Arg1, set adj2 := *Arg2 - *Arg1.  Note that the adjustment
  239.           *  values may be negative.
  240.       */
  241.          if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
  242.             adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
  243.          else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
  244.             adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
  245.         }
  246.       }
  247.    if (DeRef(Arg1) == Error) {
  248.       RunErr(0, NULL);
  249.       }
  250.    if (DeRef(Arg2) == Error) {
  251.       RunErr(0, NULL);
  252.       }
  253.    /*
  254.     * Do Arg1 := Arg2
  255.     */
  256.    switch (doasgn(&Arg0, &Arg2)) {
  257.       case Success:
  258.          break;
  259.       case Failure:
  260.          Fail;
  261.       case Error:
  262.          RunErr(0, NULL);
  263.       }
  264.    if (adj2 != 0)
  265.       /*
  266.        * Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
  267.        *  shifted the position of Arg2.  Add adj2 to the position of Arg2
  268.        *  to account for the replacement of Arg1 by Arg2.
  269.        */
  270.       BlkLoc(Arg3)->tvsubs.sspos += adj2;
  271.    /*
  272.     * Do Arg2 := Arg1
  273.     */
  274.    switch (doasgn(&Arg3, &Arg1)) {
  275.       case Success:
  276.          break;
  277.       case Failure:
  278.          Fail;
  279.       case Error:
  280.          RunErr(0, NULL);
  281.       }
  282.    if (adj1 != 0)
  283.       /*
  284.        * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1 has
  285.        *  shifted the position of Arg1.  Add adj2 to the position of Arg1 to
  286.        *  account for the replacement of Arg2 by Arg1.
  287.        */
  288.       BlkLoc(Arg0)->tvsubs.sspos += adj1;
  289.    Return;
  290.    }
  291.