![[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.