|
|
1.1 root 1: /*
2: * File: oasgn.c
3: * Contents: asgn, rasgn, rswap, swap
4: */
5:
6: #include "../h/rt.h"
7:
8: /*
9: * x := y - assign y to x.
10: */
11:
12: /* >asgn */
13: OpDcl(asgn,2,":=")
14: {
15: /*
16: * Make sure that x is a variable.
17: */
18: if (Qual(Arg1) || !Var(Arg1))
19: runerr(111, &Arg1);
20:
21: /*
22: * The returned result is the variable to which assignment is being
23: * made.
24: */
25: Arg0 = Arg1;
26:
27: /*
28: * All the work is done by doasgn. Note that Arg1 is known
29: * to be a variable.
30: */
31: if (!doasgn(&Arg1, &Arg2))
32: Fail;
33:
34: Return;
35: }
36: /* <asgn */
37:
38:
39: /*
40: * x <- y - assign y to x.
41: * Reverses assignment if resumed.
42: */
43:
44: OpDcl(rasgn,2,"<-")
45: {
46:
47: /*
48: * x must be a variable.
49: */
50: if (Qual(Arg1) || !Var(Arg1))
51: runerr(111, &Arg1);
52: /*
53: * The return value is the variable x, so make a copy of it before
54: * it is dereferenced.
55: */
56: Arg0 = Arg1;
57: DeRef(Arg1);
58: /*
59: * Assign y to x and suspend.
60: */
61: if (!doasgn(&Arg0, &Arg2))
62: Fail;
63: Suspend;
64: /*
65: * <- has been resumed, reverse the assignment by assigning the old value
66: * of x (present as Arg1) back into x and fail.
67: */
68: doasgn(&Arg0, &Arg1);
69: Fail;
70: }
71:
72:
73:
74: /*
75: * x <-> y - swap values of x and y.
76: * Reverses swap if resumed.
77: */
78:
79: OpDclV(rswap,2,"<->")
80: {
81: register union block *bp1, *bp2;
82: word adj1, adj2;
83:
84: /*
85: * x and y must be variables.
86: */
87: if (Qual(Arg1) || !Var(Arg1))
88: runerr(111, &Arg1);
89: if (Qual(Arg2) || !Var(Arg2))
90: runerr(111, &Arg2);
91: /*
92: * Make copies of x and y as variables in Arg0 and Arg3.
93: */
94: Arg0 = Arg1;
95: Arg3 = Arg2;
96: adj1 = adj2 = 0;
97: if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
98: bp1 = BlkLoc(Arg1);
99: bp2 = BlkLoc(Arg2);
100: if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar)) {
101: /*
102: * x and y are both substrings of the same string, set
103: * adj1 and adj2 for use in locating the substrings after
104: * an assignment has been made. If x is to the right of y,
105: * set adj1 := *x - *y, otherwise if y is to the right of x,
106: * set adj2 := *y - *x. Note that the adjustment values may
107: * be negative.
108: */
109: if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
110: adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
111: else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
112: adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
113: }
114: }
115: DeRef(Arg1);
116: DeRef(Arg2);
117: /*
118: * Do x := y
119: */
120: if (!doasgn(&Arg0, &Arg2))
121: Fail;
122: if (adj2 != 0)
123: /*
124: * y is to the right of x and the assignment x := y has shifted
125: * the position of y. Add adj2 to the position of y to account
126: * for the replacement of x by y.
127: */
128: BlkLoc(Arg2)->tvsubs.sspos += adj2;
129: if (!doasgn(&Arg3, &Arg1))
130: Fail;
131: /*
132: * Do y := x
133: */
134: if (adj1 != 0)
135: /*
136: * x is to the right of y and the assignment y := x has shifted
137: * the position of x. Add adj2 to the position of x to account
138: * for the replacement of y by x.
139: */
140: BlkLoc(Arg1)->tvsubs.sspos += adj1;
141: /*
142: * Suspend x with the assignment in effect.
143: */
144: Suspend;
145: /*
146: * If resumed, the assignments are undone. Note that the string position
147: * adjustments are identical to those done earlier.
148: */
149: if (!doasgn(&Arg0, &Arg1)) /* restore x */
150: Fail;
151: if (adj2 != 0)
152: BlkLoc(Arg2)->tvsubs.sspos += adj2;
153: if (!doasgn(&Arg3, &Arg2)) /* restore y */
154: Fail;
155: if (adj1 != 0)
156: BlkLoc(Arg1)->tvsubs.sspos += adj1;
157: Fail;
158: }
159:
160:
161: /*
162: * x :=: y - swap values of x and y.
163: */
164:
165: OpDclV(swap,2,":=:")
166: {
167: register union block *bp1, *bp2;
168: word adj1, adj2;
169:
170: /*
171: * x and y must be variables.
172: */
173: if (Qual(Arg1) || !Var(Arg1))
174: runerr(111, &Arg1);
175: if (Qual(Arg2) || !Var(Arg2))
176: runerr(111, &Arg2);
177: /*
178: * Make copies of x and y as variables in Arg0 and Arg3.
179: */
180: Arg0 = Arg1;
181: Arg3 = Arg2;
182: adj1 = adj2 = 0;
183: if (Arg1.dword == D_Tvsubs && Arg2.dword == D_Tvsubs) {
184: bp1 = BlkLoc(Arg1);
185: bp2 = BlkLoc(Arg2);
186: if (VarLoc(bp1->tvsubs.ssvar) == VarLoc(bp2->tvsubs.ssvar)) {
187: /*
188: * x and y are both substrings of the same string, set
189: * adj1 and adj2 for use in locating the substrings after
190: * an assignment has been made. If x is to the right of y,
191: * set adj1 := *x - *y, otherwise if y is to the right of x,
192: * set adj2 := *y - *x. Note that the adjustment values may
193: * be negative.
194: */
195: if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
196: adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
197: else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
198: adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
199: }
200: }
201: DeRef(Arg1);
202: DeRef(Arg2);
203: /*
204: * Do x := y
205: */
206: if (!doasgn(&Arg0, &Arg2))
207: Fail;
208: if (adj2 != 0)
209: /*
210: * y is to the right of x and the assignment x := y has shifted
211: * the position of y. Add adj2 to the position of y to account
212: * for the replacement of x by y.
213: */
214: BlkLoc(Arg2)->tvsubs.sspos += adj2;
215: /*
216: * Do y := x
217: */
218: if (!doasgn(&Arg3, &Arg1))
219: Fail;
220: if (adj1 != 0)
221: /*
222: * x is to the right of y and the assignment y := x has shifted
223: * the position of x. Add adj2 to the position of x to account
224: * for the replacement of y by x.
225: */
226: BlkLoc(Arg1)->tvsubs.sspos += adj1;
227: Return;
228: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.