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

_psusp declared in line 227; defined in line 228; used 3 times
chkloc defined in line 59; used 1 times
  • in line 49
chktv defined in line 51; used 1 times
  • in line 47
cmpltfrm defined in line 80; used 5 times
f1 defined in line 115; used 1 times
f2 defined in line 124; used 1 times
tracedone defined in line 155; used 1 times
Last modified: 1984-11-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 782
Valid CSS Valid XHTML 1.0 Strict