1: #include "../h/config.h" 2: /* 3: * invoke is used to invoke something. Among the candidates are: 4: * Call a built-in function 5: * Call an Icon procedure 6: * Create a record 7: * Perform mutual evaluation 8: * 9: * Note that all calls rise from a source code construct like 10: * expr0(expr1,...,exprn) 11: */ 12: Global(_interp) /* interpreter loop */ 13: Global(_cvstr) /* convert to string */ 14: #ifdef XPX 15: Global(_strprc) /* convert string to procedure block address */ 16: #endif XPX 17: Global(_ctrace) /* call trace routine */ 18: Global(_cvint) /* convert to integer */ 19: Global(_cvpos) /* convert to position */ 20: Global(_deref) /* dereference a variable */ 21: Global(_fail) /* failure processing */ 22: Global(_runerr) /* issue a runtime error */ 23: 24: Global(_boundary) /* Icon/C boundary address */ 25: Global(_line) /* current line number */ 26: Global(_file) /* current file name */ 27: Global(_k_level) /* value of &level */ 28: Global(_k_trace) /* value of &trace */ 29: 30: Global(_invoke) 31: 32: #ifdef VAX 33: .text 34: _invoke: 35: Mask 0x0e02 # Save r1, r9, r10, and r11. The return pc 36: # is stashed where r1 is saved. 37: #define INVREGS 4 /* number of registers saved */ 38: 39: movl fp,_boundary # Set Icon/C boundary 40: movl 4(ap),r8 # r8 holds number of arguments 41: movaq 8(ap)[r8],r11 # r11 points to expr0 42: pushl r11 # Push address of expr0 for deref 43: calls $1,_deref # deref(&expr0) 44: movl (r11),r0 # r11 now points to a descriptor for 45: # expr0. The type word of the descriptor 46: # is put in r0 for examination 47: cmpl $D_PROC,r0 # See if expr0 is a procedure 48: jeql doinvk # if procedure, branch 49: /* 50: * See if mutual evaluation is to be performed. 51: */ 52: # If not a procedure, maybe an integer 53: pushl $longint # Set up for cvint, longint is buffer to 54: pushl r11 # receive result 55: calls $2,_cvint # cvint(&expr0,&longint) 56: cmpl $T_INTEGER,r0 # Type comes back in r0, if not integer, 57: jneq trystr # branch. Otherwise, longint holds 58: # integer value of expr0. 59: 60: pushl 4(ap) # Got an integer, 61: movl longint,-(sp) # convert it to a canonical position 62: calls $2,_cvpos # cvpos(longint), position 63: # comes back in r0 64: cmpl r0,4(ap) # See if position is less than or equal 65: # to the number of arguments. 66: bleq f1 # if so, branch 67: calls $0,_fail # otherwise, fail 68: /* 69: * Do mutual evaluation by returning expr[expr0] 70: */ 71: f1: ashl $3,r0,r0 # Each expri is 8 bytes, so r0 is turned 72: # into a byte offset by multiplying it by 3. 73: subl3 r0,r11,r1 # Point r1 at desired expri 74: movq (r1),(r11) # r11 points at expr0, which is to replaced 75: # by result of mutual evaluation (the result of invoke), 76: # so move result of descriptor into expr0's 77: # place. 78: 79: clrl _boundary # mutual evaluation is done, clear the boundary and return 80: ret 81: 82: trystr: 83: #ifdef XPX 84: /* 85: * If expr0 is a string and the name of an operation, expr0 is turned 86: * into a procedure and execution proceeds as if expr0 had been 87: * a procedure all along. 88: */ 89: pushl $strbuf # Try to convert expr0 to a string 90: pushl r11 91: calls $2,_cvstr # cvstr(&expr0,&strbuf), r0 is 92: tstl r0 # non-zero if expr0 is a string, and 93: # strbuf will contain the string. 94: beql f4 # If expr0 couldn't not be converted 95: # to a string, branch. 96: 97: pushl r8 # Otherwise, see if the string names 98: pushl r11 # a procedure or a function 99: calls $2,_strprc # strprc(&expr0,r8), note that r8 contains 100: # the number of expri (number of arguments) 101: tstl r0 # If non-zero rc, r11 now points to a 102: bneq doinvk # descriptor that references the procedure 103: # to be invoked. 104: #endif XPX 105: f4: pushl r11 # if not procedure or integer, then error 106: pushl $106 107: calls $2,_runerr # runerr(106,&expr0) 108: 109: /* 110: * If the procedure being invoked has a fixed number of arguments, 111: * the arguments supplied are adjusted to conform in number to 112: * the number expected. 113: */ 114: doinvk: movl 4(r11),r9 # r11 is a procedure descriptor, r9 115: # gets the address of the procedure block. 116: movl 12(r9),r10 # The fourth word of the procedure block 117: # is the number of arguments the procedure 118: # wants. 119: jlss builtin # If < 0, the number of arguments is variable; 120: # branch to builtin. 121: 122: subl2 r10,r8 # r8 = # args expected - # args given 123: beql doderef # If # given is the # expected, no 124: # adjustment is required. 125: # Otherwise, nargs and nwords must 126: # be adjusted. 127: movl r10,4(ap) # Change nargs on stack 128: movb r10,(ap) # Set nwords to nargs 129: addb2 (ap),(ap) # Double nwords because each argument 130: # is two words long. 131: addb2 $1,(ap) # Add 1 to nwords to allow for the 132: # nargs word. 133: /* 134: * The arguments now need to be adjusted to conform with the 135: * number expected. 136: */ 137: ashl $3,r8,r8 # Convert r8 to byte count 138: addl2 r8,sp # Move the stack pointer up or down 139: # as required 140: # 141: # Now the portion of the stack from 142: # nargs to the condition handler (inclusive) 143: # must be moved up or down. This 144: # region is 145: # 5 (handler, psw, ap, fp, pc) 146: # + 147: # INVREGS (11 registers saved) 148: # + 149: # 2 (nwords, nargs) words long 150: movc3 $(INVREGS+7)*4,(fp),(sp) # do the move, note that the 151: # the VAX microcode is smart enough to 152: # allow the regions to overlap. 153: movl sp,fp # Point fp at new top of stack 154: movl fp,_boundary # The boundary follows the fp 155: addl2 r8,ap # Also adjust argument pointer 156: tstl r8 # If r8 is positive, there were too 157: # many arguments, and the stack move 158: # overwrote excess ones. If r8 is 159: bgeq doderef # negative, the stack moved down 160: # leaving a "hole" where additional 161: # arguments are to be. Branch 162: # if r8 is positive. 163: # 164: # 165: mnegl r8,r8 # Otherwise, make r8 positive and 166: # insert null bytes to form null 167: # descriptors for the missing 168: # arguments. 169: movc5 $0,(r0),$0,r8,(INVREGS+7)*4(sp) # Do it. Note that 170: # this is a VAX idiom to move a bunch 171: # of null bytes to a location, r0 172: # is not used at all. 173: /* 174: * Arguments to Icon procedures must be dereferenced 175: */ 176: doderef: 177: tstl 16(r9) # r9 still points at the procedure 178: # block of the procedure being invoked 179: # and the fifth word of the block is 180: # the number of dynamic locals. If 181: jlss builtin # it's less than 0, the procedure is 182: # a builtin. 183: tstl r10 # r10 is the number of arguments, if 184: jeql cktrace # it's 0 (no arguments) no dereferencing 185: # is needed. 186: 187: moval -8(r11),r6 # Point r6 at expr1 for later use 188: movl r10,r5 # Make copy of r10 for a counter 189: nxtarg: 190: pushaq -(r11) # r11 points at expr0 initially, it 191: # is decremented by 8, and the resulting 192: # value is pushed on the stack. This 193: # value is the address of the descriptor 194: # for a particular expri and the expri 195: calls $1,_deref # is dereferenced 196: sobgeq r5,nxtarg # Loop around, dereferencing each expri 197: /* 198: * If tracing is on, indicated by _k_trace (&trace) being non-zero, 199: * ctrace is called to produce the appropriate trace message. 200: */ 201: cktrace: 202: tstl _k_trace # If not tracing, 203: beql tracedone # then branch 204: # Otherwise, must set up for the 205: # call to ctrace. 206: pushl r6 # Push &expr1 207: pushl r10 # Push nargs 208: pushl r9 # Push r9, procedure block address 209: calls $3,_ctrace # ctrace(&procedure-block,nargs,&expr1) 210: /* 211: * A procedure frame was partially built by the call to invoke, 212: * it is completed by adding _line, _file, and &null for each 213: * local variable. 214: */ 215: tracedone: 216: pushl _line # Put _line 217: pushl _file # and _file on the stack 218: 219: ashl $3,16(r9),r0 # r0 = #locals * 3 220: subl2 r0,sp # Make space on stack for locals 221: movc5 $0,(r0),$0,r0,(sp) # Move the required number of null 222: # bytes onto the stack 223: /* 224: * Enter the procedure or function. 225: */ 226: clrl _boundary # Clear the boundary since an Icon 227: # procedure is to be invoked. 228: incl _k_level # Increment &level to indicate one more 229: # level of depth. 230: movl 8(r9),ipc # Get the procedure entry point which 231: # is the third word of the procedure block 232: # and load the interpreter pc with it. 233: clrq gfp # clear gfp and efp (r10 and r11) 234: jmp _interp # Jump back to the interpreter, note 235: # that at this point, the procedure 236: # is "in execution". 237: /* 238: * Handle invocation of a builtin procedure. Because of the extra 239: * "help" the VAX provides, this is inordinately complicated. 240: */ 241: builtin: 242: movl 16(fp),20(fp) # Save real return address where r1 243: # "should be". 244: movab bprtn,16(fp) # Use a fake return address so that 245: # control comes to "bprtn:" below when 246: # the built-in procedure returns. 247: movl fp,_boundary # Going into C code, so the boundary 248: # must be set. 249: jmp *8(r9) # Jump into the procedure. 250: 251: bprtn: # When the procedure returns, it comes 252: # right here. 253: clrl _boundary # Clear Icon/C boundary since we're going 254: # back to Icon. (Builtin's are C fcns.) 255: jmp (r1) # Jump back to caller of invoke. Recall 256: # that the pc was stashed where r1 should 257: # have been saved. 258: 259: .data 260: longint: .long 0 261: strbuf: .space MAXSTRING 262: #endif VAX 263: 264: #ifdef PORT 265: DummyFcn(_invoke) 266: #endif PORT 267: 268: #ifdef PDP11 269: / invoke - call a procedure or function or create a record or 270: / perform mutual goal-directed evaluation. 271: / Supplies missing arguments, deletes extras for Icon 272: / procedures. 273: 274: / Register usage: 275: / r0-r2: utility registers 276: / r3: pointer to procedure block 277: / r4: pointer to icon arguments on the stack 278: / r5: current procedure frame pointer 279: 280: .text 281: _invoke: 282: mov r5,-(sp) / create new procedure frame 283: mov sp,r5 284: mov r5,_boundary / set Icon/C boundary 285: mov r4,-(sp) / save registers 286: mov r3,-(sp) 287: mov r2,-(sp) 288: 289: / Find descriptor for procedure or function and dereference it. 290: 291: mov 4(r5),r4 / get # arguments supplied 292: asl r4 / compute address 293: asl r4 / of procedure name 294: add $6,r4 / in r4 295: add r5,r4 296: mov r4,-(sp) / dereference it 297: jsr pc,_deref 298: tst (sp)+ 299: mov (r4),r0 / get type field of descriptor 300: cmp $D_PROC,r0 / check for procedure type 301: beq 3f 302: mov $longint,-(sp) / see if its an integer for MGDE 303: mov r4,-(sp) 304: jsr pc,_cvint 305: cmp (sp)+,(sp)+ 306: cmp $T_INTEGER,r0 307: bne 2f 308: mov 4(r5),-(sp) / push number of expressions 309: mov $longint,r0 / convert integer to position 310: mov 2(r0),-(sp) 311: mov (r0),-(sp) 312: jsr pc,_cvpos / r0 <- position 313: cmp (sp)+,(sp)+ 314: tst (sp)+ 315: cmp r0,4(r5) / see if in range 316: ble 1f 317: jsr pc,_fail / if not then fail 318: 1: asl r0 / convert position to offset from arg0 319: asl r0 320: mov r4,r1 321: sub r0,r1 322: mov (r1)+,(r4)+ / copy result to arg0 323: mov (r1),(r4) 324: tst -(r4) / restore r4 325: mov r4,sp / set sp to end of returned result 326: mov r5,r0 327: mov (r5),r1 328: mov -(r0),r4 / restore registers 329: mov -(r0),r3 330: mov -(r0),r2 331: clr _boundary 332: mov (r5)+,r0 / r0 <- return pc. 333: mov (r5)+,r0 334: mov r1,r5 335: jmp (r0) / return to code 336: 2: 337: #ifdef XPX 338: /* 339: * If the invokee is a string and the name of an operation, 340: * we invoke the corresponding procedure. 341: */ 342: mov $strbuf,-(sp) 343: mov r4,-(sp) 344: jsr pc,_cvstr / see if string for string invocation 345: cmp (sp)+,(sp)+ 346: tst r0 347: beq 4f / if ok, we see if the string is the 348: / name of something 349: mov 4(r5),-(sp) / push number of arguments 350: mov r4,-(sp) / address of string descriptor 351: jsr pc,_strprc 352: cmp (sp)+,(sp)+ 353: tst r0 354: bne 3f / if non-zero rc, r4 now points to a 355: / descriptor that references the 356: / procedure we want 357: #endif XPX 358: 4: mov r4,-(sp) / if not procedure or integer, error 359: mov $106.,-(sp) 360: jsr pc,_runerr 361: 362: / Check number of arguments supplied vs. number expected. 363: 364: 3: 365: mov 2(r4),r3 / get pointer field of descriptor 366: mov 6(r3),r0 / get # arguments expected 367: blt builtin / if < 0, # arguments is variable 368: mov r0,nargs / save # expected for later dereferencing 369: sub 4(r5),r0 / subtract # supplied from # expected 370: beq 1f / if zero difference, no adjustment 371: mov nargs,4(r5) / change nargs on stack 372: neg r0 / negate the difference 373: blt 2f / if too few supplied, branch 374: 375: / Too many arguments supplied: delete extras, compressing the stack. 376: 377: mov r5,r1 / compute adjustment addresses 378: add $6,r1 / r1 <- source 379: asl r0 / r0 <- dest 380: asl r0 381: add r0,r5 / adjust r5 382: add r0,_boundary / and boundary 383: add r1,r0 384: 3: / move top 6 words up 385: mov -(r1),-(r0) 386: cmp r1,sp 387: bgt 3b 388: 389: mov r0,sp / adjust stack pointer 390: br 1f 391: 392: / Too few arguments supplied: push null values, expanding the stack. 393: 394: 2: 395: mov 4(r5),nargs / save # supplied for later dereferencing 396: asl r0 / compute new top of stack 397: asl r0 398: add r0,r5 / adjust r5 399: add r0,_boundary / and boundary 400: add sp,r0 401: mov r0,r2 / save new stack pointer 402: mov $6,r1 403: 3: / move top 6 words down 404: mov (sp)+,(r0)+ 405: sob r1,3b 406: 3: / supply &null for omitted arguments 407: clr (r0)+ 408: clr (r0)+ 409: cmp r0,sp 410: blt 3b 411: 412: mov r2,sp / restore new top of stack pointer 413: 414: / Dereference arguments to Icon procedures. 415: 416: 1: 417: tst 8.(r3) / test # dynamic locals 418: blt builtin / if < 0, then builtin function 419: mov nargs,r2 / dereference the arguments 420: beq 1f 421: 2: 422: cmp -(r4),-(r4) / point r4 to next argument 423: mov r4,-(sp) / dereference it 424: jsr pc,_deref 425: tst (sp)+ 426: sob r2,2b 427: 428: / Print trace message if &trace is set. 429: 430: 1: 431: tst _k_trace 432: beq 1f 433: mov nargs,r0 / calc address of arg1 via: 434: dec r0 / sp + 12. + (nargs-1)*4 435: asl r0 436: asl r0 437: add $12.,r0 438: add sp,r0 439: mov r0,-(sp) / push &arg1 440: mov nargs,-(sp) / push nargs 441: mov r3,-(sp) / push proc address 442: jsr pc,_ctrace / ctrace(proc_address,nargs,&arg1) 443: cmp (sp)+,(sp)+ 444: tst (sp)+ / zap ctrace args 445: 446: / Save line number and file name 447: 448: 1: 449: mov _line,-(sp) 450: mov _file,-(sp) 451: 452: / Push null values onto stack for each dynamic local 453: 454: mov 8.(r3),r0 / get # dynamic locals 455: beq 1f 456: 2: 457: clr -(sp) / push null value on stack for each 458: clr -(sp) / dynamic local 459: sob r0,2b 460: 461: / Enter the procedure or function. 462: 463: 1: 464: clr _boundary / clear boundary when going to Icon procedure 465: inc _k_level / increment &level 466: mov 4(r3),r2 / r2 <- procedure entry point 467: clr r3 / clear generator frame pointer 468: clr r4 / and expression frame pointer 469: jmp _interp / jump back to interpreter 470: builtin: / special-case builtin functions 471: jsr pc,*4(r3) / jump to procedure entry point 472: 473: .bss 474: nargs: .=.+2 475: longint: .=.+4 476: strbuf: .=.+MAXSTRING 477: #endif PDP11
Defined functions
Defined variables
Defined macros
|
Last modified: 1984-11-18
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 862 |
|