![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to coact.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib|
Return to coact.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.