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