1: /*
   2:  * coact(coexpr,value) - suspend current co-expression and activate
   3:  *  coexpr with value.
   4:  *
   5:  * Outline:
   6:  *    create procedure frame
   7:  *    save sp and boundary in current co-expression stack header
   8:  *    dereference result if it is local to co-expression
   9:  *    change current stack to coexpr
  10:  *    set activator in new co-expression stack header
  11:  *    get sp and boundary from new co-expression stack header
  12:  *    return value in new stack
  13:  */
  14: Global(_boundary)       /* Icon/C boundary */
  15: Global(_current)        /* current co-expression */
  16: Global(_file)           /* current file name */
  17: Global(_line)           /* current line number */
  18: Global(_deref)          /* dereference */
  19: Global(_runerr)         /* runtime error */
  20: Global(_coact)
  21: 
  22: #ifdef VAX
  23: _coact:
  24:         Mask    STDSV
  25:         calls   $0,_setbound
  26:         subl2   $8,sp           # Make room on stack for line and file
  27:         movl    _line,-4(fp)    # and put them in the frame
  28:         movl    _file,-8(fp)
  29:         movl    _current+4,r2   # r2  <- pointer to current stack header
  30:         movl    sp,16(r2)       # save the stack pointer,
  31:         movl    ap,20(r2)       #  address pointer,
  32:         movl    _boundary,24(r2)#  and boundary for the current co-expression
  33:                                 #  in its stack header
  34:         moval   8(ap),r4        # point r4 at coexp argument on stack
  35:         pushl   r4              #  and
  36:         calls   $1,_deref       # dereference the co-expression
  37:         cmpl    $D_ESTACK,(r4)+ # see if we indeed have a co-expression
  38:                                 #  and if we don't, it's runnerr 118,
  39:                                 #  "co-expression expected"
  40:         jeql    f1
  41:         tstl    -(r4)           # back up to point at bogus co-expression
  42:         pushl   r4              #  and call runerr with the bogon as
  43:         pushl   $118            #  its argument
  44:         calls   $2,_runerr
  45: 
  46: f1:
  47:         movl    (r4)+,r3        # point r3 at the co-expression stack header
  48:         movl    $D_ESTACK,4(r3) # create the descriptor for the activator
  49:         movl    r2,8(r3)        #  (r2 has pointer to previously current
  50:                                 #   co-expression, which is the activator)
  51:         movl    r3,_current+4   # make the new co-expression current
  52:         movl    16(r3),sp       # get stack pointer,
  53:         movl    20(r3),ap       #  address pointer,
  54:         movl    24(r3),fp       #  and frame pointer/boundary from header
  55:         movl    fp,_boundary
  56:         movl    4(ap),r1        # get nargs in r1
  57:         movaq   8(ap)[r1],r0    # point r0 at target for result on stack,
  58:         movl    r0,r1           #  and save the pointer
  59:         movq    (r4),(r1)       # copy value from old stack to new
  60:         movl    r1,r4           # point r4 at address of result on new stack
  61:         movl    (r4),r1         # get type field of new result
  62:         bitl    $F_NQUAL,r1     # if return value points into the old
  63:         jeql    f11             #   co-expression, then it needs
  64:         bitl    $F_VAR,r1       #   dereferencing
  65:         jeql    f11
  66:         bitl    $F_TVAR,r1
  67:         jneq    f2
  68:         movl    4(r4),r1        # get pointer field of result into r1
  69:         jbr     f3
  70: f2:
  71:         bicl2   $~TYPEMASK,r1   # isolate type bits by turning off others
  72:         cmpl    $T_TVSUBS,r1    # if we have a substring t.v., we have
  73:         jneq    f11             #  to dereference it.
  74:         movl    4(r4),r1        # point r1 at the string of the
  75:         movl    16(r1),r1       #  trapped variable (cmt??)
  76: f3:
  77:         cmpl    r1,16(r2)       # if pointer is between old sp and sbase,
  78:         jlss    f11             #  it needs dereferencing
  79:         cmpl    r1,12(r2)
  80:         jgtr    f11
  81:         pushl   r4
  82:         calls   $1,_deref       # so, dereference it
  83: f11:
  84:         movl    -4(fp),_line    # restore line number
  85:         movl    -8(fp),_file    #  and file name
  86:         calls   $0,_clrbound
  87:         ret                     # return.  This return will use the dummy
  88:                                 #  frame built above and we should land in
  89:                                 #  first frame built above
  90: #endif VAX
  91: #ifdef PORT
  92: DummyFcn(_coact)
  93: #endif PORT
  94: #ifdef PDP11
  95: / coact(coexpr,value) - suspend current co-expression and activate
  96: / coexpr with value.
  97: 
  98: / NOTE:  this code is highly dependent on stack frame layout.
  99: 
 100: / Outline:
 101: /    create procedure frame
 102: /    save sp and boundary in current co-expression stack header
 103: /    dereference result if it is local to co-expression
 104: /    change current stack to coexpr
 105: /    set activator in new co-expression stack header
 106: /    get sp and boundary from new co-expression stack header
 107: /    return value in new stack
 108: 
 109: / Register usage:
 110: /    r2:  pointer to current co-expression stack header
 111: /    r3:  pointer to new co-expression stack header
 112: /    r4:  pointer to arguments to activate
 113: /    r5:  procedure frame pointer
 114: Global(csv)             / save registers
 115: Global(cret)            / return as from C
 116: _coact:
 117:         jsr     r5,csv          / create procedure frame
 118:         mov     _line,(sp)      / save current line number
 119:         mov     _file,-(sp)     /   and file name
 120:         mov     _current+2,r2   / r2 <- pointer to current stack header
 121:         mov     sp,8.(r2)       / save sp
 122:         mov     _boundary,12.(r2)  / save boundary
 123:         mov     r5,r4           / r4 <- pointer to coexpr
 124:         add     $6,r4
 125:         mov     r4,-(sp)        / dereference coexpr
 126:         jsr     pc,_deref
 127:         tst     (sp)+
 128:         cmp     $D_ESTACK,(r4)+ / check type field of coexpr
 129:         beq     1f
 130:         tst     -(r4)
 131:         mov     r4,-(sp)
 132:         mov     $118.,-(sp)     / runerr 118 - co-expression expected
 133:         jsr     pc,_runerr
 134: 1:
 135:         mov     (r4)+,r3        / r3 <- pointer to new stack header
 136:         mov     $D_ESTACK,2(r3) / set activator field of new stack header
 137:         mov     r2,4(r3)
 138:         mov     r3,_current+2   / make new stack header current
 139:         mov     8.(r3),sp       / get new sp
 140:         mov     12.(r3),r5      / get new r5 and
 141:         mov     r5,_boundary    /   new boundary
 142:         mov     4(r5),r0        / r0 <- location of result on new stack
 143:         asl     r0              /    (r0 <- 6 + 4*nargs)
 144:         asl     r0
 145:         add     r5,r0
 146:         add     $6,r0
 147:         mov     r0,r1           / remember address of result on new stack
 148:         mov     (r4)+,(r0)+     / copy value from old stack
 149:         mov     (r4)+,(r0)
 150:         mov     r1,r4           / r4 <- address of result on new stack
 151:         mov     (r4), r1        / get type field of return value into r1
 152:         bit     $F_NQUAL,r1     / if return value points into the old
 153:         beq     1f              /   co-expression, then it needs
 154:         bit     $F_VAR,r1       /   dereferencing
 155:         beq     1f
 156:         bit     $F_TVAR,r1
 157:         bne     2f
 158:         mov     2(r4),r1        / get pointer field into r1
 159:         br      3f
 160: 2:
 161:         bic     $!TYPEMASK,r1   / check type code for substring t.v.
 162:         cmp     $T_TVSUBS,r1    /   if not, it doesn't need
 163:         bne     1f              /   dereferencing
 164:         mov     2(r4),r1        / get pointer field from b_tvsubs
 165:         mov     8.(r1),r1       /   block into r1
 166: 3:
 167:         cmp     r1,8.(r2)       / if pointer is between old
 168:         blo     1f              /   sp and sbase it needs
 169:         cmp     r1,6.(r2)       /   dereferencing
 170:         bhi     1f
 171:         mov     r4,(sp)         / dereference it
 172:         jsr     pc,_deref
 173:         tst     (sp)+
 174: 1:
 175:         mov     -8.(r5),_line   / restore line number
 176:         mov     -10.(r5),_file  /   and file name
 177:         jmp     cret            / return in new stack
 178: #endif PDP11

Defined functions

_coact defined in line 116; used 2 times
f1 defined in line 46; used 1 times
  • in line 40
f11 defined in line 83; used 5 times
f2 defined in line 70; used 1 times
  • in line 67
f3 defined in line 76; used 1 times
  • in line 69
Last modified: 1984-11-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1100
Valid CSS Valid XHTML 1.0 Strict