|
|
1.1 ! root 1: #include "../h/config.h" ! 2: ! 3: /* psusp - suspends a value from an Icon procedure. The procedure ! 4: * calling psusp is suspending and the value to suspend appears as ! 5: * an argument to psusp. The generator or expression frame ! 6: * immediately containing the frame of the suspending procedure is ! 7: * duplicated. ! 8: * ! 9: * psusp returns through the duplicated procedure frame and leaves the ! 10: * value being suspended on the top of the stack. When an alternative ! 11: * is needed, efail causes a return through the original procedure frame ! 12: * which was created by invoke. ! 13: */ ! 14: Global(_deref) /* Dereference a variable */ ! 15: Global(_strace) /* Trace procedure suspension */ ! 16: Global(_boundary) /* Icon/C boundary address */ ! 17: Global(_current) /* Current expression stack */ ! 18: Global(_line) /* Current line number */ ! 19: Global(_file) /* Current file name */ ! 20: Global(_k_level) /* Value of &level */ ! 21: Global(_k_trace) /* Value of &trace */ ! 22: ! 23: Global(_psusp) ! 24: #ifdef VAX ! 25: _psusp: ! 26: /* ! 27: * Construct the generator frame. ! 28: */ ! 29: Mask STDSV # Start new generator frame by saving ! 30: # registers upon entry to psusp. ! 31: movl fp,_boundary # Establish boundary value to be saved ! 32: # in frame. boundary is also needed ! 33: # because deref may be called. ! 34: pushl fp # Save the boundary in the frame. ! 35: /* ! 36: * Dereference the return value if it is a local variable or an ! 37: * argument. ! 38: */ ! 39: # The return value is on the stack as ! 40: # an argument, put type field of return ! 41: movl 8(ap),r1 # value in r1 for testing. ! 42: bitl $F_NQUAL,r1 # If return value is a string, ! 43: beql cmpltfrm # it doesn't need dereferencing. ! 44: bitl $F_VAR,r1 # If return value isn't a variable, ! 45: beql cmpltfrm # it doesn't need dereferencing. ! 46: bitl $F_TVAR,r1 # If return value is a trapped variable, ! 47: bneq chktv # it requires some work. ! 48: movl 12(ap),r1 # Otherwise, get the address of the ! 49: jmp chkloc # data block for more testing. ! 50: ! 51: chktv: # A trapped variable is being returned, ! 52: # only substring trapped variables need ! 53: # dereferencing. ! 54: bicl2 $~TYPEMASK,r1 # "and" off all but bits in type field ! 55: cmpl $T_TVSUBS,r1 # If the variable isn't a substring t.v., ! 56: bneq cmpltfrm # it doesn't need dereferencing. ! 57: movl 12(ap),r1 # Point r1 at data block for s.s.t.v. ! 58: movl 16(r1),r1 # Then at actual address of variable ! 59: chkloc: # ! 60: # See if the variable is on the stack. ! 61: # If it is, it will lie between the ! 62: # sp and the base of the current ! 63: # expression stack. r1 holds address ! 64: # of variable. ! 65: cmpl r1,sp # If address is below the sp, ! 66: blssu cmpltfrm # it's not a local or an argument ! 67: movl _current+4,r0 # Point r0 at data block for current ! 68: # expression. ! 69: cmpl r1,12(r0) # Fourth word is the base of the stack ! 70: # for the current expression. If the ! 71: # variable address is above the stack ! 72: bgtru cmpltfrm # base, it's not a local or an argument. ! 73: # Otherwise, it is a local or an argument ! 74: # and must be dereferenced. ! 75: pushal 8(ap) # Push address of return value ! 76: calls $1,_deref # and dereference it. ! 77: /* ! 78: * Complete the generator frame. ! 79: */ ! 80: cmpltfrm: ! 81: movl sp,gfp # Boundary value is on top of stack, ! 82: # make it word 0 of generator frame ! 83: pushl _k_level # Push &level, ! 84: pushl _line # line number, ! 85: pushl _file # and file name to complete the frame. ! 86: /* ! 87: * Determine region to be duplicated and copy it. ! 88: */ ! 89: # Note that because the call to psusp ! 90: # made a frame, the saved ap and fp ! 91: # values in that frame must be used. ! 92: movl 12(fp),r7 # Low word of region to be copied is the ! 93: # low word of procedure frame of suspending ! 94: # procedure. ! 95: ! 96: # If the saved gfp is non-zero, the ! 97: # generator frame marker serves as the ! 98: # upper bound of the expression frame. ! 99: # If it is zero, the expression frame ! 100: # marker pointed at by the saved ! 101: # efp is the upper bound of the frame ! 102: # to be copied. ! 103: # Note that the marker itself is not ! 104: # copied, the region only extends to ! 105: # the marker and not through it. ! 106: # This code counts on efp and gfp being ! 107: # saved in the frame of the suspender. ! 108: movl 8(fp),r2 # Get ap of suspending procedure in r2 ! 109: movl -8(r2),r4 # Get gfp from procedure frame of suspending ! 110: # procedure. ! 111: bneq f1 # If it is zero, ! 112: movl -4(r2),r4 # get saved efp and ! 113: subl2 $8,r4 # use efp - 8. ! 114: jmp f2 ! 115: f1: # gfp is not zero, ! 116: subl2 $12,r4 # use gfp - 12. ! 117: /* ! 118: * Copy region to be duplicated to top of stack. ! 119: */ ! 120: # r7 points at the low word of the region ! 121: # to be copied. r4 points at the high end ! 122: # of the region. (i.e. r4 is the first ! 123: # word not_ to copy.) ! 124: f2: ! 125: subl2 r7,r4 # r4 = r4 - r7, giving r4 number of bytes ! 126: # in region. ! 127: subl2 r4,sp # Move stack pointer down to make space ! 128: # for region. ! 129: movc3 r4,(r7),(sp) # Copy the region by moving r4 bytes starting ! 130: # at r7 to the top of the stack. ! 131: /* ! 132: * Produce trace message if tracing is on. ! 133: */ ! 134: decl _k_level # Decrement &level because a procedure ! 135: # is being "exited". ! 136: tstl _k_trace # If &trace is 0, ! 137: jeql tracedone # no tracing. ! 138: # Otherwise, call strace with address ! 139: # of suspending procedure block and ! 140: # value being suspended. ! 141: pushal 8(ap) # Push pointer to value being suspended. ! 142: # arg0 in the suspender's argument list ! 143: # is the descriptor for the suspending ! 144: # procedure. ! 145: movl 8(fp),r1 # Get suspender's ap into r1. ! 146: ashl $3,4(r1),r0 # &arg0 = nargs * 8 ! 147: addl2 $8,r0 # + 8 ! 148: addl2 r1,r0 # + ap ! 149: pushl 4(r0) # Push second word (the address) of ! 150: # the descriptor for the procedure block ! 151: calls $2,_strace # strace(&procblock,&suspending-value) ! 152: /* ! 153: * Return from suspending function; resumption will return from suspend. ! 154: */ ! 155: tracedone: ! 156: movl 12(fp),r1 # Get fp of suspending procedure into r1 and ! 157: movl -4(r1),_line # restore _line and ! 158: movl -8(r1),_file # _file from the frame. ! 159: # The duplicated frame must be fixed up. ! 160: # Specifically, the saved gfp is replaced ! 161: # by the new gfp, and the value being ! 162: # suspended replaces arg0, the descriptor ! 163: # of the suspending procedure. ! 164: subl3 r1,8(fp),r0 # Calculate distance between fp and ap ! 165: # in suspender's frame, specifically, ! 166: # r0 = ap - fp ! 167: addl2 sp,r0 # sp points at the first word of the ! 168: # duplicated procedure frame on the ! 169: # stack. By adding it to r0, r0 points ! 170: # at nwords word in argument list of ! 171: # duplicated frame. That is, r0 is ! 172: # serving as a pseudo ap. ! 173: subl3 $8,r0,r1 # Point r1 at location of saved gfp ! 174: # in duplicated frame. ! 175: movl gfp,(r1) # Replace saved gfp with new gfp value ! 176: # Calculate address of arg0 via ! 177: # &arg0 = ! 178: ashl $2,(r0),r1 # nwords * 4 ! 179: addl2 $4,r1 # + 4 (bytes for nwords word) ! 180: addl2 r1,r0 # + (pseudo) ap ! 181: movq 8(ap),(r0) # Replace arg0 with suspending value ! 182: # ! 183: movl sp,fp # Point fp at duplicated procedure frame ! 184: # in preparation for return through it. ! 185: clrl _boundary # Clear the boundary since control is ! 186: # going back into Icon code. ! 187: ret # Return through duplicated frame. This ! 188: # looks like the original invoke for the ! 189: # suspending procedure has returned. The ! 190: # suspended value is left on the top ! 191: # of the stack. ! 192: ! 193: #endif VAX ! 194: ! 195: #ifdef PORT ! 196: DummyFcn(_psusp) ! 197: #endif PORT ! 198: #ifdef PDP11 ! 199: / psusp - suspend from an Icon procedure. ! 200: / Duplicates the most recent generator frame outside the ! 201: / calling procedure frame. The procedure calling psusp is ! 202: / suspending, and the saved value of r3 in its frame marker ! 203: / points to the beginning of the generator frame to be ! 204: / duplicated. Psusp does not return directly. The caller ! 205: / is reactivated when an alternative is needed; the return ! 206: / actually comes from efail. ! 207: ! 208: / Register usage: ! 209: / r0: pointer to top of stack region to be copied, ! 210: / which is just above the procedure descriptor (arg0) of the ! 211: / suspending procedure ! 212: / r2: suspending procedure frame pointer ! 213: / r3: new generator frame pointer ! 214: / r4: old generator frame pointer, indexed down to r0 during copy ! 215: / r5: current procedure frame pointer ! 216: ! 217: .globl _deref / dereference a variable ! 218: .globl _strace / suspend trace routine ! 219: ! 220: .globl _boundary / Icon/C boundary address ! 221: .globl _current / current expression stack ! 222: .globl _file / current file name ! 223: .globl _k_level / value of &level ! 224: .globl _k_trace / value of &trace ! 225: .globl _line / current line number ! 226: ! 227: .globl _psusp ! 228: _psusp: ! 229: mov r5,-(sp) / create new procedure frame ! 230: mov sp,r5 ! 231: mov r4,-(sp) / save registers ! 232: mov r3,-(sp) ! 233: mov r2,-(sp) ! 234: mov r5,-(sp) / create Icon/C boundary ! 235: mov r5,_boundary ! 236: ! 237: / Dereference return value if necessary. ! 238: ! 239: mov 6(r5),r1 / get type field of return value into r1 ! 240: bit $F_NQUAL,r1 / if return value is the ! 241: beq 1f / name of a local variable ! 242: bit $F_VAR,r1 / or argument, then it ! 243: beq 1f / needs dereferencing ! 244: bit $F_TVAR,r1 ! 245: bne 2f ! 246: mov 8.(r5),r1 / get pointer field into r1 ! 247: br 3f ! 248: 2: ! 249: bic $!TYPEMASK,r1 / check type code for substring t.v. ! 250: cmp $T_TVSUBS,r1 / if not, it doesn't need ! 251: bne 1f / dereferencing ! 252: mov 8.(r5),r1 / get pointer field from b_tvsubs ! 253: mov 8.(r1),r1 / block into r1 ! 254: 3: ! 255: cmp r1,sp / if pointer is between ! 256: blo 1f / sp and sbase, it is a local ! 257: mov _current+2,r0 / or an argument ! 258: cmp r1,6(r0) ! 259: bhi 1f ! 260: mov r5,-(sp) / dereference it ! 261: add $6,(sp) ! 262: jsr pc,_deref ! 263: tst (sp)+ ! 264: 1: ! 265: ! 266: / Calculate addresses of new generator frame. ! 267: ! 268: mov sp,r3 / r3 <- pointer to new generator frame ! 269: mov _k_level,-(sp) / save &level ! 270: mov _line,-(sp) / save current line number ! 271: mov _file,-(sp) / and file name ! 272: mov (r5),r2 / r2 <- pointer to calling procedure frame ! 273: mov 4(r2),r0 / r0 <- pointer to top of region to be copied ! 274: asl r0 / (= r2 + 10 + 4*nargs) ! 275: asl r0 ! 276: add r2,r0 ! 277: add $10.,r0 ! 278: mov -4(r2),r4 / r4 <- generator frame pointer from caller ! 279: bne 1f / use saved r3 (gfp) - 6 if non-zero, ! 280: mov -2(r2),r4 / else use saved r4 (efp) - 4 ! 281: cmp -(r4),-(r4) ! 282: br 2f ! 283: 1: ! 284: sub $6,r4 ! 285: br 2f ! 286: ! 287: / Copy surrounding expression frame. ! 288: ! 289: 1: ! 290: mov -(r4),-(sp) / copy old generator frame ! 291: 2: ! 292: cmp r4,r0 / stop at end of frame ! 293: bhi 1b ! 294: ! 295: / Copy return value of suspending procedure. ! 296: ! 297: mov 8.(r5),-(sp) ! 298: mov 6(r5),-(sp) ! 299: ! 300: / Decrement &level; print trace message if &trace is set. ! 301: ! 302: dec _k_level ! 303: tst _k_trace / print trace if &trace != 0 ! 304: beq 1f ! 305: mov r5,-(sp) / push address of suspending value ! 306: add $6,(sp) ! 307: mov -(r0),-(sp) / push address of procedure block ! 308: jsr pc,_strace / call strace ! 309: cmp (sp)+,(sp)+ ! 310: ! 311: / Return from suspending procedure; reactivation will return from psusp. ! 312: ! 313: 1: ! 314: mov r2,r0 ! 315: mov 2(r0),r1 / r1 <- return pc ! 316: mov (r0),r5 / restore old registers ! 317: mov -(r0),r4 ! 318: tst -(r0) / except generator frame pointer ! 319: mov -(r0),r2 ! 320: mov -(r0),_line ! 321: mov -(r0),_file ! 322: clr _boundary / returning to Icon code ! 323: jmp (r1) / this really suspends ! 324: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.