![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to psusp.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib|
Return to psusp.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 root 1: #include "../h/config.h"
2:
3: /* psusp - suspends a value from an Icon procedure. The procedure
4: * calling psusp is suspending and the value to suspend appears as
5: * an argument to psusp. The generator or expression frame
6: * immediately containing the frame of the suspending procedure is
7: * duplicated.
8: *
9: * psusp returns through the duplicated procedure frame and leaves the
10: * value being suspended on the top of the stack. When an alternative
11: * is needed, efail causes a return through the original procedure frame
12: * which was created by invoke.
13: */
14: Global(_deref) /* Dereference a variable */
15: Global(_strace) /* Trace procedure suspension */
16: Global(_boundary) /* Icon/C boundary address */
17: Global(_current) /* Current expression stack */
18: Global(_line) /* Current line number */
19: Global(_file) /* Current file name */
20: Global(_k_level) /* Value of &level */
21: Global(_k_trace) /* Value of &trace */
22:
23: Global(_psusp)
24: #ifdef VAX
25: _psusp:
26: /*
27: * Construct the generator frame.
28: */
29: Mask STDSV # Start new generator frame by saving
30: # registers upon entry to psusp.
31: movl fp,_boundary # Establish boundary value to be saved
32: # in frame. boundary is also needed
33: # because deref may be called.
34: pushl fp # Save the boundary in the frame.
35: /*
36: * Dereference the return value if it is a local variable or an
37: * argument.
38: */
39: # The return value is on the stack as
40: # an argument, put type field of return
41: movl 8(ap),r1 # value in r1 for testing.
42: bitl $F_NQUAL,r1 # If return value is a string,
43: beql cmpltfrm # it doesn't need dereferencing.
44: bitl $F_VAR,r1 # If return value isn't a variable,
45: beql cmpltfrm # it doesn't need dereferencing.
46: bitl $F_TVAR,r1 # If return value is a trapped variable,
47: bneq chktv # it requires some work.
48: movl 12(ap),r1 # Otherwise, get the address of the
49: jmp chkloc # data block for more testing.
50:
51: chktv: # A trapped variable is being returned,
52: # only substring trapped variables need
53: # dereferencing.
54: bicl2 $~TYPEMASK,r1 # "and" off all but bits in type field
55: cmpl $T_TVSUBS,r1 # If the variable isn't a substring t.v.,
56: bneq cmpltfrm # it doesn't need dereferencing.
57: movl 12(ap),r1 # Point r1 at data block for s.s.t.v.
58: movl 16(r1),r1 # Then at actual address of variable
59: chkloc: #
60: # See if the variable is on the stack.
61: # If it is, it will lie between the
62: # sp and the base of the current
63: # expression stack. r1 holds address
64: # of variable.
65: cmpl r1,sp # If address is below the sp,
66: blssu cmpltfrm # it's not a local or an argument
67: movl _current+4,r0 # Point r0 at data block for current
68: # expression.
69: cmpl r1,12(r0) # Fourth word is the base of the stack
70: # for the current expression. If the
71: # variable address is above the stack
72: bgtru cmpltfrm # base, it's not a local or an argument.
73: # Otherwise, it is a local or an argument
74: # and must be dereferenced.
75: pushal 8(ap) # Push address of return value
76: calls $1,_deref # and dereference it.
77: /*
78: * Complete the generator frame.
79: */
80: cmpltfrm:
81: movl sp,gfp # Boundary value is on top of stack,
82: # make it word 0 of generator frame
83: pushl _k_level # Push &level,
84: pushl _line # line number,
85: pushl _file # and file name to complete the frame.
86: /*
87: * Determine region to be duplicated and copy it.
88: */
89: # Note that because the call to psusp
90: # made a frame, the saved ap and fp
91: # values in that frame must be used.
92: movl 12(fp),r7 # Low word of region to be copied is the
93: # low word of procedure frame of suspending
94: # procedure.
95:
96: # If the saved gfp is non-zero, the
97: # generator frame marker serves as the
98: # upper bound of the expression frame.
99: # If it is zero, the expression frame
100: # marker pointed at by the saved
101: # efp is the upper bound of the frame
102: # to be copied.
103: # Note that the marker itself is not
104: # copied, the region only extends to
105: # the marker and not through it.
106: # This code counts on efp and gfp being
107: # saved in the frame of the suspender.
108: movl 8(fp),r2 # Get ap of suspending procedure in r2
109: movl -8(r2),r4 # Get gfp from procedure frame of suspending
110: # procedure.
111: bneq f1 # If it is zero,
112: movl -4(r2),r4 # get saved efp and
113: subl2 $8,r4 # use efp - 8.
114: jmp f2
115: f1: # gfp is not zero,
116: subl2 $12,r4 # use gfp - 12.
117: /*
118: * Copy region to be duplicated to top of stack.
119: */
120: # r7 points at the low word of the region
121: # to be copied. r4 points at the high end
122: # of the region. (i.e. r4 is the first
123: # word not_ to copy.)
124: f2:
125: subl2 r7,r4 # r4 = r4 - r7, giving r4 number of bytes
126: # in region.
127: subl2 r4,sp # Move stack pointer down to make space
128: # for region.
129: movc3 r4,(r7),(sp) # Copy the region by moving r4 bytes starting
130: # at r7 to the top of the stack.
131: /*
132: * Produce trace message if tracing is on.
133: */
134: decl _k_level # Decrement &level because a procedure
135: # is being "exited".
136: tstl _k_trace # If &trace is 0,
137: jeql tracedone # no tracing.
138: # Otherwise, call strace with address
139: # of suspending procedure block and
140: # value being suspended.
141: pushal 8(ap) # Push pointer to value being suspended.
142: # arg0 in the suspender's argument list
143: # is the descriptor for the suspending
144: # procedure.
145: movl 8(fp),r1 # Get suspender's ap into r1.
146: ashl $3,4(r1),r0 # &arg0 = nargs * 8
147: addl2 $8,r0 # + 8
148: addl2 r1,r0 # + ap
149: pushl 4(r0) # Push second word (the address) of
150: # the descriptor for the procedure block
151: calls $2,_strace # strace(&procblock,&suspending-value)
152: /*
153: * Return from suspending function; resumption will return from suspend.
154: */
155: tracedone:
156: movl 12(fp),r1 # Get fp of suspending procedure into r1 and
157: movl -4(r1),_line # restore _line and
158: movl -8(r1),_file # _file from the frame.
159: # The duplicated frame must be fixed up.
160: # Specifically, the saved gfp is replaced
161: # by the new gfp, and the value being
162: # suspended replaces arg0, the descriptor
163: # of the suspending procedure.
164: subl3 r1,8(fp),r0 # Calculate distance between fp and ap
165: # in suspender's frame, specifically,
166: # r0 = ap - fp
167: addl2 sp,r0 # sp points at the first word of the
168: # duplicated procedure frame on the
169: # stack. By adding it to r0, r0 points
170: # at nwords word in argument list of
171: # duplicated frame. That is, r0 is
172: # serving as a pseudo ap.
173: subl3 $8,r0,r1 # Point r1 at location of saved gfp
174: # in duplicated frame.
175: movl gfp,(r1) # Replace saved gfp with new gfp value
176: # Calculate address of arg0 via
177: # &arg0 =
178: ashl $2,(r0),r1 # nwords * 4
179: addl2 $4,r1 # + 4 (bytes for nwords word)
180: addl2 r1,r0 # + (pseudo) ap
181: movq 8(ap),(r0) # Replace arg0 with suspending value
182: #
183: movl sp,fp # Point fp at duplicated procedure frame
184: # in preparation for return through it.
185: clrl _boundary # Clear the boundary since control is
186: # going back into Icon code.
187: ret # Return through duplicated frame. This
188: # looks like the original invoke for the
189: # suspending procedure has returned. The
190: # suspended value is left on the top
191: # of the stack.
192:
193: #endif VAX
194:
195: #ifdef PORT
196: DummyFcn(_psusp)
197: #endif PORT
198: #ifdef PDP11
199: / psusp - suspend from an Icon procedure.
200: / Duplicates the most recent generator frame outside the
201: / calling procedure frame. The procedure calling psusp is
202: / suspending, and the saved value of r3 in its frame marker
203: / points to the beginning of the generator frame to be
204: / duplicated. Psusp does not return directly. The caller
205: / is reactivated when an alternative is needed; the return
206: / actually comes from efail.
207:
208: / Register usage:
209: / r0: pointer to top of stack region to be copied,
210: / which is just above the procedure descriptor (arg0) of the
211: / suspending procedure
212: / r2: suspending procedure frame pointer
213: / r3: new generator frame pointer
214: / r4: old generator frame pointer, indexed down to r0 during copy
215: / r5: current procedure frame pointer
216:
217: .globl _deref / dereference a variable
218: .globl _strace / suspend trace routine
219:
220: .globl _boundary / Icon/C boundary address
221: .globl _current / current expression stack
222: .globl _file / current file name
223: .globl _k_level / value of &level
224: .globl _k_trace / value of &trace
225: .globl _line / current line number
226:
227: .globl _psusp
228: _psusp:
229: mov r5,-(sp) / create new procedure frame
230: mov sp,r5
231: mov r4,-(sp) / save registers
232: mov r3,-(sp)
233: mov r2,-(sp)
234: mov r5,-(sp) / create Icon/C boundary
235: mov r5,_boundary
236:
237: / Dereference return value if necessary.
238:
239: mov 6(r5),r1 / get type field of return value into r1
240: bit $F_NQUAL,r1 / if return value is the
241: beq 1f / name of a local variable
242: bit $F_VAR,r1 / or argument, then it
243: beq 1f / needs dereferencing
244: bit $F_TVAR,r1
245: bne 2f
246: mov 8.(r5),r1 / get pointer field into r1
247: br 3f
248: 2:
249: bic $!TYPEMASK,r1 / check type code for substring t.v.
250: cmp $T_TVSUBS,r1 / if not, it doesn't need
251: bne 1f / dereferencing
252: mov 8.(r5),r1 / get pointer field from b_tvsubs
253: mov 8.(r1),r1 / block into r1
254: 3:
255: cmp r1,sp / if pointer is between
256: blo 1f / sp and sbase, it is a local
257: mov _current+2,r0 / or an argument
258: cmp r1,6(r0)
259: bhi 1f
260: mov r5,-(sp) / dereference it
261: add $6,(sp)
262: jsr pc,_deref
263: tst (sp)+
264: 1:
265:
266: / Calculate addresses of new generator frame.
267:
268: mov sp,r3 / r3 <- pointer to new generator frame
269: mov _k_level,-(sp) / save &level
270: mov _line,-(sp) / save current line number
271: mov _file,-(sp) / and file name
272: mov (r5),r2 / r2 <- pointer to calling procedure frame
273: mov 4(r2),r0 / r0 <- pointer to top of region to be copied
274: asl r0 / (= r2 + 10 + 4*nargs)
275: asl r0
276: add r2,r0
277: add $10.,r0
278: mov -4(r2),r4 / r4 <- generator frame pointer from caller
279: bne 1f / use saved r3 (gfp) - 6 if non-zero,
280: mov -2(r2),r4 / else use saved r4 (efp) - 4
281: cmp -(r4),-(r4)
282: br 2f
283: 1:
284: sub $6,r4
285: br 2f
286:
287: / Copy surrounding expression frame.
288:
289: 1:
290: mov -(r4),-(sp) / copy old generator frame
291: 2:
292: cmp r4,r0 / stop at end of frame
293: bhi 1b
294:
295: / Copy return value of suspending procedure.
296:
297: mov 8.(r5),-(sp)
298: mov 6(r5),-(sp)
299:
300: / Decrement &level; print trace message if &trace is set.
301:
302: dec _k_level
303: tst _k_trace / print trace if &trace != 0
304: beq 1f
305: mov r5,-(sp) / push address of suspending value
306: add $6,(sp)
307: mov -(r0),-(sp) / push address of procedure block
308: jsr pc,_strace / call strace
309: cmp (sp)+,(sp)+
310:
311: / Return from suspending procedure; reactivation will return from psusp.
312:
313: 1:
314: mov r2,r0
315: mov 2(r0),r1 / r1 <- return pc
316: mov (r0),r5 / restore old registers
317: mov -(r0),r4
318: tst -(r0) / except generator frame pointer
319: mov -(r0),r2
320: mov -(r0),_line
321: mov -(r0),_file
322: clr _boundary / returning to Icon code
323: jmp (r1) / this really suspends
324: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.