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
Defined functions
|
Last modified: 1984-11-18
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 883 |
|