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