4.3BSD - /usr/src/new/icon/lib/pret.s

   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

Defined functions