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