![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pret.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 pret.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 root 1: #include "../h/config.h"
2: /*
3: * pret - returns a value from an Icon procedure. pret takes
4: * a single argument which is the value to return. The real
5: * work is in figuring out whether the return value needs to
6: * be dereferenced.
7: */
8:
9: Global(_deref) /* Dereference a variable */
10: Global(_rtrace) /* Return trace routine */
11: Global(_boundary) /* Icon/C boundary address */
12: Global(_current) /* Current expression stack */
13: Global(_file) /* Current file name */
14: Global(_k_level) /* Value of &level */
15: Global(_k_trace) /* Value of &trace */
16: Global(_line) /* Current line number */
17:
18: Global(_pret)
19: #ifdef VAX
20: _pret:
21: Mask 0 # Don't need to save any registers because
22: # the current frame will be discarded.
23: movl fp,_boundary # The boundary is set because deref may
24: # cause garbage collection.
25: decl _k_level # A procedure is being exited, so &level
26: # must be decremented.
27: /*
28: * Calculate target address for return value in r11.
29: */
30: # The frame of the caller is the procedure
31: # frame for the Icon procedure returning
32: movl 8(fp),r2 # a value. Put it's ap in r2.
33: # The return value will overwrite arg0,
34: # the address of arg0 is calculated via:
35: ashl $3,4(r2),r11 # r11 = 8 * nargs
36: addl2 $8,r11 # + 8
37: addl2 r2,r11 # + ap
38: # Note that nargs and ap belong to the
39: # returning Icon procedure.
40: /*
41: * Dereference the return value if it is a local variable or an
42: * argument.
43: */
44: # The return value is on the stack as
45: # an argument, put type field of return
46: movl 8(ap),r1 # value in r1 for testing.
47: bitl $F_NQUAL,r1 # If return value is a string,
48: beql chktrace # it doesn't need dereferencing.
49: bitl $F_VAR,r1 # If return value isn't a variable,
50: beql chktrace # it doesn't need dereferencing.
51: bitl $F_TVAR,r1 # If return value is a trapped variable,
52: bneq chktv # it requires some work.
53: movl 12(ap),r1 # Otherwise, get the address of the
54: jmp chkloc # data block for more testing.
55:
56: chktv: # A trapped variable is being returned,
57: # only substring trapped variables need
58: # dereferencing.
59: bicl2 $~TYPEMASK,r1 # "and" off all but bits in type field
60: cmpl $T_TVSUBS,r1 # If the variable isn't a substring t.v.,
61: bneq chktrace # it doesn't need dereferencing.
62: movl 12(ap),r1 # Point r1 at data block for s.s.t.v.
63: movl 16(r1),r1 # Then at actual address of variable
64: chkloc: #
65: # See if the variable is on the stack.
66: # If it is, it will lie between the
67: # sp and the base of the current
68: # expression stack. r1 holds address
69: # of variable.
70: cmpl r1,sp # If address is below the sp,
71: blssu chktrace # it's not a local or an argument
72: movl _current+4,r0 # Point r0 at data block for current
73: # expression.
74: cmpl r1,12(r0) # Fourth word is the base of the stack
75: # for the current expression. If the
76: # variable address is above the stack
77: bgtru chktrace # base, it's not a local or an argument.
78: # Otherwise, it is a local or an argument
79: # and must be dereferenced.
80: pushal 8(ap) # Push address of return value
81: calls $1,_deref # and dereference it.
82:
83: /*
84: * Print trace message if &trace is set.
85: */
86: chktrace:
87: tstl _k_trace # If &trace is zero,
88: beql tracedone # no tracing.
89: # Otherwise, set up to call rtrace
90: # with address of proc block and
91: # return value.
92: pushal 8(ap) # Push address of return value
93: pushl 4(r11) # Push address of procedure block
94: calls $2,_rtrace # rtrace(proc. block address,&return value)
95:
96: tracedone: # The descriptor for the procedure block
97: # (arg0) must be replaced by the descriptor
98: # of the return value. r11 points at the
99: movq 8(ap),(r11) # procedure block, so a movq does the trick.
100: /*
101: * Return from the Icon procedure. What this really does is to return
102: * via the frame built by invoke. Thus, the return below returns from
103: * the call to invoke.
104: */
105:
106: movl 12(fp),fp # Get frame built by invoke on top of stack
107: movl -4(fp),_line # Restore _line,
108: movl -8(fp),_file # and _file from procedure block.
109: clrl _boundary # Reentering an Icon environment, so
110: # the boundary is cleared.
111: ret # Return. This is manifested as a
112: # return from invoke.
113: #endif VAX
114:
115: #ifdef PORT
116: DummyFcn(_pret)
117: #endif PORT
118: #ifdef PDP11
119: / pret - return from an Icon procedure.
120: / Return value is argument to pret at 6(r5).
121:
122: / Register usage:
123: / r1: type or pointer field of returned value
124: / r2: returning procedure frame pointer
125: / r3: address of argument #0 (place-holder for returned value)
126: / r5: current procedure frame pointer
127: _pret:
128: mov r5,-(sp) / create new procedure frame
129: mov sp,r5
130: mov r4,-(sp)
131: mov r3,-(sp)
132: mov r2,-(sp)
133: mov r5,_boundary / set Icon/C boundary
134:
135: / Decrement &level and calculate address of eventual return value.
136:
137: dec _k_level
138: mov (r5),r2 / compute address for
139: mov 4(r2),r3 / return value:
140: asl r3 / r3 = r2 + 6 + 4*nargs
141: asl r3
142: add r2,r3
143: add $6,r3
144:
145: / Dereference return value if necessary.
146:
147: mov 6(r5),r1 / get type field of return value into r1
148: bit $F_NQUAL,r1 / if return value is the
149: beq 1f / name of a local variable
150: bit $F_VAR,r1 / or argument, then it
151: beq 1f / needs dereferencing
152: bit $F_TVAR,r1
153: bne 2f
154: mov 8.(r5),r1 / get pointer field into r1
155: br 3f
156: 2:
157: bic $!TYPEMASK,r1 / check type code for substring t.v.
158: cmp $T_TVSUBS,r1 / if not, it doesn't need
159: bne 1f / dereferencing
160: mov 8.(r5),r1 / get pointer field from b_tvsubs
161: mov 8.(r1),r1 / block into r1
162: 3:
163: cmp r1,sp / if pointer is between
164: blo 1f / sp and sbase, it is a local
165: mov _current+2,r0 / or an argument
166: cmp r1,6(r0)
167: bhi 1f
168: mov r5,-(sp) / dereference it
169: add $6,(sp)
170: jsr pc,_deref
171: tst (sp)+
172:
173: / Print trace message if &trace is set.
174:
175: 1:
176: tst _k_trace
177: beq 1f
178: mov r5,-(sp) / push address of return value
179: add $6,(sp)
180: mov 2(r3),-(sp) / push pointer to procedure block
181: jsr pc,_rtrace / call rtrace; other arguments are in frame
182: cmp (sp)+,(sp)+
183:
184: / Copy return value to the outer expression frame.
185:
186: 1:
187: mov r3,r1 / save r3 to pop stack to this point later
188: mov 6(r5),(r3)+ / move return value down from top of stack
189: mov 8.(r5),(r3)
190:
191: / Return.
192:
193: mov r2,r5 / restore old values of registers
194: mov r2,r0
195: mov -(r0),r4
196: mov -(r0),r3
197: mov -(r0),r2
198: mov -(r0),_line
199: mov -(r0),_file
200: mov r5,sp
201: mov (sp)+,r5
202: mov (sp)+,r0 / pop return pc
203: mov r1,sp / pop stack to return value
204: clr _boundary / clear Icon/C boundary
205: jmp (r0) / return
206: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.