4.3BSD/usr/contrib/icon/lib/pret.s
#include "../h/config.h"
/*
* pret - returns a value from an Icon procedure. pret takes
* a single argument which is the value to return. The real
* work is in figuring out whether the return value needs to
* be dereferenced.
*/
Global(_deref) /* Dereference a variable */
Global(_rtrace) /* Return trace routine */
Global(_boundary) /* Icon/C boundary address */
Global(_current) /* Current expression stack */
Global(_file) /* Current file name */
Global(_k_level) /* Value of &level */
Global(_k_trace) /* Value of &trace */
Global(_line) /* Current line number */
Global(_pret)
#ifdef VAX
_pret:
Mask 0 # Don't need to save any registers because
# the current frame will be discarded.
movl fp,_boundary # The boundary is set because deref may
# cause garbage collection.
decl _k_level # A procedure is being exited, so &level
# must be decremented.
/*
* Calculate target address for return value in r11.
*/
# The frame of the caller is the procedure
# frame for the Icon procedure returning
movl 8(fp),r2 # a value. Put it's ap in r2.
# The return value will overwrite arg0,
# the address of arg0 is calculated via:
ashl $3,4(r2),r11 # r11 = 8 * nargs
addl2 $8,r11 # + 8
addl2 r2,r11 # + ap
# Note that nargs and ap belong to the
# returning Icon procedure.
/*
* Dereference the return value if it is a local variable or an
* argument.
*/
# The return value is on the stack as
# an argument, put type field of return
movl 8(ap),r1 # value in r1 for testing.
bitl $F_NQUAL,r1 # If return value is a string,
beql chktrace # it doesn't need dereferencing.
bitl $F_VAR,r1 # If return value isn't a variable,
beql chktrace # it doesn't need dereferencing.
bitl $F_TVAR,r1 # If return value is a trapped variable,
bneq chktv # it requires some work.
movl 12(ap),r1 # Otherwise, get the address of the
jmp chkloc # data block for more testing.
chktv: # A trapped variable is being returned,
# only substring trapped variables need
# dereferencing.
bicl2 $~TYPEMASK,r1 # "and" off all but bits in type field
cmpl $T_TVSUBS,r1 # If the variable isn't a substring t.v.,
bneq chktrace # it doesn't need dereferencing.
movl 12(ap),r1 # Point r1 at data block for s.s.t.v.
movl 16(r1),r1 # Then at actual address of variable
chkloc: #
# See if the variable is on the stack.
# If it is, it will lie between the
# sp and the base of the current
# expression stack. r1 holds address
# of variable.
cmpl r1,sp # If address is below the sp,
blssu chktrace # it's not a local or an argument
movl _current+4,r0 # Point r0 at data block for current
# expression.
cmpl r1,12(r0) # Fourth word is the base of the stack
# for the current expression. If the
# variable address is above the stack
bgtru chktrace # base, it's not a local or an argument.
# Otherwise, it is a local or an argument
# and must be dereferenced.
pushal 8(ap) # Push address of return value
calls $1,_deref # and dereference it.
/*
* Print trace message if &trace is set.
*/
chktrace:
tstl _k_trace # If &trace is zero,
beql tracedone # no tracing.
# Otherwise, set up to call rtrace
# with address of proc block and
# return value.
pushal 8(ap) # Push address of return value
pushl 4(r11) # Push address of procedure block
calls $2,_rtrace # rtrace(proc. block address,&return value)
tracedone: # The descriptor for the procedure block
# (arg0) must be replaced by the descriptor
# of the return value. r11 points at the
movq 8(ap),(r11) # procedure block, so a movq does the trick.
/*
* Return from the Icon procedure. What this really does is to return
* via the frame built by invoke. Thus, the return below returns from
* the call to invoke.
*/
movl 12(fp),fp # Get frame built by invoke on top of stack
movl -4(fp),_line # Restore _line,
movl -8(fp),_file # and _file from procedure block.
clrl _boundary # Reentering an Icon environment, so
# the boundary is cleared.
ret # Return. This is manifested as a
# return from invoke.
#endif VAX
#ifdef PORT
DummyFcn(_pret)
#endif PORT
#ifdef PDP11
/ pret - return from an Icon procedure.
/ Return value is argument to pret at 6(r5).
/ Register usage:
/ r1: type or pointer field of returned value
/ r2: returning procedure frame pointer
/ r3: address of argument #0 (place-holder for returned value)
/ r5: current procedure frame pointer
_pret:
mov r5,-(sp) / create new procedure frame
mov sp,r5
mov r4,-(sp)
mov r3,-(sp)
mov r2,-(sp)
mov r5,_boundary / set Icon/C boundary
/ Decrement &level and calculate address of eventual return value.
dec _k_level
mov (r5),r2 / compute address for
mov 4(r2),r3 / return value:
asl r3 / r3 = r2 + 6 + 4*nargs
asl r3
add r2,r3
add $6,r3
/ Dereference return value if necessary.
mov 6(r5),r1 / get type field of return value into r1
bit $F_NQUAL,r1 / if return value is the
beq 1f / name of a local variable
bit $F_VAR,r1 / or argument, then it
beq 1f / needs dereferencing
bit $F_TVAR,r1
bne 2f
mov 8.(r5),r1 / get pointer field into r1
br 3f
2:
bic $!TYPEMASK,r1 / check type code for substring t.v.
cmp $T_TVSUBS,r1 / if not, it doesn't need
bne 1f / dereferencing
mov 8.(r5),r1 / get pointer field from b_tvsubs
mov 8.(r1),r1 / block into r1
3:
cmp r1,sp / if pointer is between
blo 1f / sp and sbase, it is a local
mov _current+2,r0 / or an argument
cmp r1,6(r0)
bhi 1f
mov r5,-(sp) / dereference it
add $6,(sp)
jsr pc,_deref
tst (sp)+
/ Print trace message if &trace is set.
1:
tst _k_trace
beq 1f
mov r5,-(sp) / push address of return value
add $6,(sp)
mov 2(r3),-(sp) / push pointer to procedure block
jsr pc,_rtrace / call rtrace; other arguments are in frame
cmp (sp)+,(sp)+
/ Copy return value to the outer expression frame.
1:
mov r3,r1 / save r3 to pop stack to this point later
mov 6(r5),(r3)+ / move return value down from top of stack
mov 8.(r5),(r3)
/ Return.
mov r2,r5 / restore old values of registers
mov r2,r0
mov -(r0),r4
mov -(r0),r3
mov -(r0),r2
mov -(r0),_line
mov -(r0),_file
mov r5,sp
mov (sp)+,r5
mov (sp)+,r0 / pop return pc
mov r1,sp / pop stack to return value
clr _boundary / clear Icon/C boundary
jmp (r0) / return
#endif PDP11