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

   1: /*
   2:  * coret(coexpr,value) - suspend current co-expression and activate
   3:  *  activator with value, without changing activator's activator.
   4:  *
   5:  * Outline:
   6:  *    create procedure frame
   7:  *    save sp and boundary in current co-expression stack header
   8:  *    change current stack to coexpr
   9:  *    get sp and boundary from new co-expression stack header
  10:  *    return value in new stack
  11:  */
  12: Global(_boundary)       /* Icon/C boundary */
  13: Global(_current)        /* current co-expression */
  14: Global(_file)           /* current file name */
  15: Global(_line)           /* current line number */
  16: Global(_deref)          /* dereference */
  17: 
  18: Global(_coret)
  19: #ifdef VAX
  20: _coret:
  21:         Mask    STDSV
  22:         calls   $0,_setbound
  23:         subl2   $8,sp           # Make room on stack for line and file
  24:         movl    _line,-4(fp)    # and put them in the frame
  25:         movl    _file,-8(fp)
  26:         movl    _current+4,r2   # r2  <- pointer to current stack header
  27:         movl    sp,16(r2)       # save the stack pointer,
  28:         movl    ap,20(r2)       #  address pointer,
  29:         movl    _boundary,24(r2) #  and boundary for the current co-expression
  30:                                 #  in its stack header
  31:         movl    ap,r4           # save ap for later use (to get the
  32:                                 #  result that we were passed
  33:         movl    8(r2),r3        # r3 points to activator
  34:         movl    r3,_current+4   # make new stack header current
  35:         movl    16(r3),sp       # get new sp,
  36:         movl    20(r3),ap       #  ap,
  37:         movl    24(r3),fp       #  fp,
  38:         movl    fp,_boundary    #  and boundary
  39:         movq    8(r4),16(ap)    # copy arg0 of caller to our arg0, apparently
  40:                                 #  because we have two fake arguments (?)
  41:         moval   16(ap),r4       # point r4 at our new result
  42: 
  43:         movl    (r4),r1         # get type field of new result
  44:         bitl    $F_NQUAL,r1     # if return value points into the old
  45:         jeql    f1              #   co-expression, then it needs
  46:         bitl    $F_VAR,r1       #   dereferencing
  47:         jeql    f1
  48:         bitl    $F_TVAR,r1
  49:         jneq    f2
  50:         movl    4(r4),r1        # get pointer field of result into r1
  51:         jbr     f3
  52: f2:
  53:         bicl2   $~TYPEMASK,r1   # isolate type bits by turning off others
  54:         cmpl    $T_TVSUBS,r1    # if we have a substring t.v., we have
  55:         jneq    f1              #  to dereference it.
  56:         movl    4(r4),r1        # point r1 at the string of the
  57:         movl    16(r1),r1       #  trapped variable
  58: f3:
  59:         cmpl    r1,16(r2)       # if pointer is between old sp and sbase,
  60:         jlss    f1              #  it needs dereferencing
  61:         cmpl    r1,12(r2)
  62:         jgtr    f1
  63:         pushl   r4
  64:         calls   $1,_deref       # so, dereference it
  65: f1:
  66:         movl    -4(fp),_line    # restore line number
  67:         movl    -8(fp),_file    #  and file name
  68:         calls   $0,_clrbound
  69:         ret                     # return.  This return will use the dummy
  70:                                 #  frame built above and we should land in
  71: #endif VAX
  72: #ifdef PORT
  73: DummyFcn(_coret)
  74: #endif PORT
  75: #ifdef PDP11
  76: / coret(coexpr,value) - suspend current co-expression and activate
  77: / activator with value, without changing activator's activator.
  78: 
  79: / NOTE:  this code is highly dependent on stack frame layout.
  80: 
  81: / Outline:
  82: /    create procedure frame
  83: /    save sp and boundary in current co-expression stack header
  84: /    change current stack to coexpr
  85: /    get sp and boundary from new co-expression stack header
  86: /    return value in new stack
  87: 
  88: / Register usage:
  89: /    r2:  pointer to current co-expression stack header
  90: /    r3:  pointer to new co-expression stack header
  91: /    r4:  pointer to arguments to activate
  92: /    r5:  procedure frame pointer
  93: Global(csv)             / save registers
  94: Global(cret)            / return as from C
  95: 
  96: _coret:
  97:         jsr     r5,csv          / create procedure frame
  98:         mov     _line,(sp)      / save current line number
  99:         mov     _file,-(sp)     /   and file name
 100:         mov     _current+2,r2   / r2 <- pointer to current stack header
 101:         mov     sp,8.(r2)       / save sp
 102:         mov     _boundary,12.(r2)  / save boundary
 103:         mov     r5,r4           / r4 <- pointer to top of stack
 104:         mov     4(r2),r3        / r3 <- pointer to activator
 105:         mov     r3,_current+2   / make new stack header current
 106:         mov     8.(r3),sp       / get new sp
 107:         mov     12.(r3),r5      / get new r5 and
 108:         mov     r5,_boundary    /   new boundary
 109:         mov     6(r4),10.(r5)   / copy value from old stack
 110:         mov     8.(r4),12.(r5)
 111:         mov     r5,r4           / r4 <- address of result on new stack
 112:         add     $10.,r4
 113:         mov     (r4), r1        / get type field of return value into r1
 114:         bit     $F_NQUAL,r1     / if return value points into the old
 115:         beq     1f              /   co-expression, then it needs
 116:         bit     $F_VAR,r1       /   dereferencing
 117:         beq     1f
 118:         bit     $F_TVAR,r1
 119:         bne     2f
 120:         mov     2(r4),r1        / get pointer field into r1
 121:         br      3f
 122: 2:
 123:         bic     $!TYPEMASK,r1   / check type code for substring t.v.
 124:         cmp     $T_TVSUBS,r1    /   if not, it doesn't need
 125:         bne     1f              /   dereferencing
 126:         mov     2(r4),r1        / get pointer field from b_tvsubs
 127:         mov     8.(r1),r1       /   block into r1
 128: 3:
 129:         cmp     r1,8.(r2)       / if pointer is between old
 130:         blo     1f              /   sp and sbase it needs
 131:         cmp     r1,6.(r2)       /   dereferencing
 132:         bhi     1f
 133:         mov     r4,-(sp)         / dereference result
 134:         jsr     pc,_deref
 135:         tst     (sp)+
 136: 1:
 137:         mov     -8.(r5),_line   / restore line number
 138:         mov     -10.(r5),_file  /   and file name
 139:         jmp     cret            / return in new stack
 140: #endif PDP11

Defined functions