4.3BSD/usr/contrib/icon/lib/psusp.s
#include "../h/config.h"
/* psusp - suspends a value from an Icon procedure. The procedure
* calling psusp is suspending and the value to suspend appears as
* an argument to psusp. The generator or expression frame
* immediately containing the frame of the suspending procedure is
* duplicated.
*
* psusp returns through the duplicated procedure frame and leaves the
* value being suspended on the top of the stack. When an alternative
* is needed, efail causes a return through the original procedure frame
* which was created by invoke.
*/
Global(_deref) /* Dereference a variable */
Global(_strace) /* Trace procedure suspension */
Global(_boundary) /* Icon/C boundary address */
Global(_current) /* Current expression stack */
Global(_line) /* Current line number */
Global(_file) /* Current file name */
Global(_k_level) /* Value of &level */
Global(_k_trace) /* Value of &trace */
Global(_psusp)
#ifdef VAX
_psusp:
/*
* Construct the generator frame.
*/
Mask STDSV # Start new generator frame by saving
# registers upon entry to psusp.
movl fp,_boundary # Establish boundary value to be saved
# in frame. boundary is also needed
# because deref may be called.
pushl fp # Save the boundary in the frame.
/*
* 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 cmpltfrm # it doesn't need dereferencing.
bitl $F_VAR,r1 # If return value isn't a variable,
beql cmpltfrm # 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 cmpltfrm # 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 cmpltfrm # 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 cmpltfrm # 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.
/*
* Complete the generator frame.
*/
cmpltfrm:
movl sp,gfp # Boundary value is on top of stack,
# make it word 0 of generator frame
pushl _k_level # Push &level,
pushl _line # line number,
pushl _file # and file name to complete the frame.
/*
* Determine region to be duplicated and copy it.
*/
# Note that because the call to psusp
# made a frame, the saved ap and fp
# values in that frame must be used.
movl 12(fp),r7 # Low word of region to be copied is the
# low word of procedure frame of suspending
# procedure.
# If the saved gfp is non-zero, the
# generator frame marker serves as the
# upper bound of the expression frame.
# If it is zero, the expression frame
# marker pointed at by the saved
# efp is the upper bound of the frame
# to be copied.
# Note that the marker itself is not
# copied, the region only extends to
# the marker and not through it.
# This code counts on efp and gfp being
# saved in the frame of the suspender.
movl 8(fp),r2 # Get ap of suspending procedure in r2
movl -8(r2),r4 # Get gfp from procedure frame of suspending
# procedure.
bneq f1 # If it is zero,
movl -4(r2),r4 # get saved efp and
subl2 $8,r4 # use efp - 8.
jmp f2
f1: # gfp is not zero,
subl2 $12,r4 # use gfp - 12.
/*
* Copy region to be duplicated to top of stack.
*/
# r7 points at the low word of the region
# to be copied. r4 points at the high end
# of the region. (i.e. r4 is the first
# word not_ to copy.)
f2:
subl2 r7,r4 # r4 = r4 - r7, giving r4 number of bytes
# in region.
subl2 r4,sp # Move stack pointer down to make space
# for region.
movc3 r4,(r7),(sp) # Copy the region by moving r4 bytes starting
# at r7 to the top of the stack.
/*
* Produce trace message if tracing is on.
*/
decl _k_level # Decrement &level because a procedure
# is being "exited".
tstl _k_trace # If &trace is 0,
jeql tracedone # no tracing.
# Otherwise, call strace with address
# of suspending procedure block and
# value being suspended.
pushal 8(ap) # Push pointer to value being suspended.
# arg0 in the suspender's argument list
# is the descriptor for the suspending
# procedure.
movl 8(fp),r1 # Get suspender's ap into r1.
ashl $3,4(r1),r0 # &arg0 = nargs * 8
addl2 $8,r0 # + 8
addl2 r1,r0 # + ap
pushl 4(r0) # Push second word (the address) of
# the descriptor for the procedure block
calls $2,_strace # strace(&procblock,&suspending-value)
/*
* Return from suspending function; resumption will return from suspend.
*/
tracedone:
movl 12(fp),r1 # Get fp of suspending procedure into r1 and
movl -4(r1),_line # restore _line and
movl -8(r1),_file # _file from the frame.
# The duplicated frame must be fixed up.
# Specifically, the saved gfp is replaced
# by the new gfp, and the value being
# suspended replaces arg0, the descriptor
# of the suspending procedure.
subl3 r1,8(fp),r0 # Calculate distance between fp and ap
# in suspender's frame, specifically,
# r0 = ap - fp
addl2 sp,r0 # sp points at the first word of the
# duplicated procedure frame on the
# stack. By adding it to r0, r0 points
# at nwords word in argument list of
# duplicated frame. That is, r0 is
# serving as a pseudo ap.
subl3 $8,r0,r1 # Point r1 at location of saved gfp
# in duplicated frame.
movl gfp,(r1) # Replace saved gfp with new gfp value
# Calculate address of arg0 via
# &arg0 =
ashl $2,(r0),r1 # nwords * 4
addl2 $4,r1 # + 4 (bytes for nwords word)
addl2 r1,r0 # + (pseudo) ap
movq 8(ap),(r0) # Replace arg0 with suspending value
#
movl sp,fp # Point fp at duplicated procedure frame
# in preparation for return through it.
clrl _boundary # Clear the boundary since control is
# going back into Icon code.
ret # Return through duplicated frame. This
# looks like the original invoke for the
# suspending procedure has returned. The
# suspended value is left on the top
# of the stack.
#endif VAX
#ifdef PORT
DummyFcn(_psusp)
#endif PORT
#ifdef PDP11
/ psusp - suspend from an Icon procedure.
/ Duplicates the most recent generator frame outside the
/ calling procedure frame. The procedure calling psusp is
/ suspending, and the saved value of r3 in its frame marker
/ points to the beginning of the generator frame to be
/ duplicated. Psusp does not return directly. The caller
/ is reactivated when an alternative is needed; the return
/ actually comes from efail.
/ Register usage:
/ r0: pointer to top of stack region to be copied,
/ which is just above the procedure descriptor (arg0) of the
/ suspending procedure
/ r2: suspending procedure frame pointer
/ r3: new generator frame pointer
/ r4: old generator frame pointer, indexed down to r0 during copy
/ r5: current procedure frame pointer
.globl _deref / dereference a variable
.globl _strace / suspend trace routine
.globl _boundary / Icon/C boundary address
.globl _current / current expression stack
.globl _file / current file name
.globl _k_level / value of &level
.globl _k_trace / value of &trace
.globl _line / current line number
.globl _psusp
_psusp:
mov r5,-(sp) / create new procedure frame
mov sp,r5
mov r4,-(sp) / save registers
mov r3,-(sp)
mov r2,-(sp)
mov r5,-(sp) / create Icon/C boundary
mov r5,_boundary
/ 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)+
1:
/ Calculate addresses of new generator frame.
mov sp,r3 / r3 <- pointer to new generator frame
mov _k_level,-(sp) / save &level
mov _line,-(sp) / save current line number
mov _file,-(sp) / and file name
mov (r5),r2 / r2 <- pointer to calling procedure frame
mov 4(r2),r0 / r0 <- pointer to top of region to be copied
asl r0 / (= r2 + 10 + 4*nargs)
asl r0
add r2,r0
add $10.,r0
mov -4(r2),r4 / r4 <- generator frame pointer from caller
bne 1f / use saved r3 (gfp) - 6 if non-zero,
mov -2(r2),r4 / else use saved r4 (efp) - 4
cmp -(r4),-(r4)
br 2f
1:
sub $6,r4
br 2f
/ Copy surrounding expression frame.
1:
mov -(r4),-(sp) / copy old generator frame
2:
cmp r4,r0 / stop at end of frame
bhi 1b
/ Copy return value of suspending procedure.
mov 8.(r5),-(sp)
mov 6(r5),-(sp)
/ Decrement &level; print trace message if &trace is set.
dec _k_level
tst _k_trace / print trace if &trace != 0
beq 1f
mov r5,-(sp) / push address of suspending value
add $6,(sp)
mov -(r0),-(sp) / push address of procedure block
jsr pc,_strace / call strace
cmp (sp)+,(sp)+
/ Return from suspending procedure; reactivation will return from psusp.
1:
mov r2,r0
mov 2(r0),r1 / r1 <- return pc
mov (r0),r5 / restore old registers
mov -(r0),r4
tst -(r0) / except generator frame pointer
mov -(r0),r2
mov -(r0),_line
mov -(r0),_file
clr _boundary / returning to Icon code
jmp (r1) / this really suspends
#endif PDP11