|
|
1.1 root 1: #include "../h/config.h"
2: /*
3: * Icon interpreter.
4: */
5:
6: Global(_c_exit) /* Exit */
7: Global(_current) /* Descriptor for current coexpression block */
8: Global(_file) /* Source file name */
9: Global(_globals) /* Pointer to first global variable */
10: Global(_ident)
11: Global(_line) /* Source line number */
12: Global(_k_pos) /* &pos */
13: Global(_k_subject) /* &subject */
14: Global(_statics) /* Pointer to first static variable */
15: Global(_syserr) /* Internal system error */
16: Global(_interp) /* Main interpreter loop */
17: #ifdef VAX
18: /*
19: * Some defines for the interpreter.
20: */
21: #define Op r1
22: #define GetOp movl (ipc)+,Op
23: #define PushOp pushl Op
24: #define PushNull clrq -(sp)
25: #define Push_R(a) pushl a
26: #define Push_S(a) pushl a
27: #define Push_K(a) pushl $a
28: #define PushOpSum_R(a) addl3 Op,a,-(sp)
29: #define PushOpSum_S(a) addl3 Op,a,-(sp)
30: #define NextInst jmp _interp
31: #define CallN(n) pushl $n;\
32: calls $((n*2)+1),*optab(r0)
33: #define CallNameN(n,f) pushl $n;\
34: calls $((n*2)+1),f
35: #define BitClear(m) bicl2 $~m,Op
36: #define Jump(lab) jbr lab
37: #define LongJump(lab) jmp lab
38: #define Label(lab) lab:
39: /*
40: * Globals for various routines.
41: */
42: #define Glob4(a,b,c,d) Global(a); Global(b); Global(c); Global(d)
43: Glob4(_asgn, _bang, _bscan, _cat)
44: Glob4(_coact, _cofail, _compl, _coret)
45: Glob4(_create, _diff, _div, _eqv)
46: Glob4(_escan, _esusp, _field, _inter)
47: Glob4(_invoke, _keywd, _lconcat, _lexeq)
48: Glob4(_lexge, _lexgt, _lexle, _lexlt)
49: Glob4(_lexne, _limit, _llist, _lsusp)
50: Glob4(_minus, _mod, _mult, _neg)
51: Glob4(_neqv, _nonnull, _null, _number)
52: Glob4(_numeq, _numge, _numgt, _numle)
53: Glob4(_numlt, _numne, _pfail, _plus)
54: Glob4(_power, _pret, _psusp, _random)
55: Glob4(_rasgn, _refresh, _rswap, _sect)
56: Glob4(_size, _subsc, _swap, _tabmat)
57: Global(_toby); Global(_unioncs); Global(_value)
58:
59: Label(jumptab)
60: /*
61: * The jump table, the interpreter branches to the nth label
62: * to execute opcode n.
63: */
64: /* 0 */ .long quit, op_asgn, op_bang, op_cat
65: /* 4 */ .long op_compl, op_diff, op_div, op_eqv
66: /* 8 */ .long op_inter, op_lconcat, op_lexeq, op_lexge
67: /* 12 */ .long op_lexgt, op_lexle, op_lexlt, op_lexne
68: /* 16 */ .long op_minus, op_mod, op_mult, op_neg
69: /* 20 */ .long op_neqv, op_nonnull, op_null, op_number
70: /* 24 */ .long op_numeq, op_numge, op_numgt, op_numle
71: /* 28 */ .long op_numlt, op_numne, op_plus, op_power
72: /* 32 */ .long op_random, op_rasgn, op_refresh, op_rswap
73: /* 36 */ .long op_sect, op_size, op_subsc, op_swap
74: /* 40 */ .long op_tabmat, op_toby, op_unioncs, op_value
75: /* 44 */ .long op_bscan, op_ccase, op_chfail, op_coact
76: /* 48 */ .long op_cofail, op_coret, op_create, op_cset
77: /* 52 */ .long op_dup, op_efail, op_eret, op_escan
78: /* 56 */ .long op_esusp, op_field, op_file, op_goto
79: /* 60 */ .long op_incres, op_init, op_int, op_invoke
80: /* 64 */ .long op_keywd, err, op_limit, op_line
81: /* 68 */ .long op_llist, op_lsusp, op_mark, op_pfail
82: /* 72 */ .long op_pnull, op_pop, op_pret, op_psusp
83: /* 76 */ .long op_push1, op_pushn1, op_real, op_sdup
84: /* 80 */ .long op_str, op_unmark, err, err
85: /* 84 */ .long op_local, err, err, err
86: /* 88 */ .long err, err, err, err
87: /* 92 */ .long op_global, op_arg, op_static, op_mark0
88: /* 96 */ .long err, err, err, err
89: /* 100 */ .long err, err, err, err
90: /* 104 */ .long err, err, err, err
91: /* 108 */ .long err, err, err, err
92: /* 112 */ .long op_globx, op_globx, op_globx, op_globx
93: /* 116 */ .long op_globx, op_globx, op_globx, op_globx
94: /* 120 */ .long op_globx, op_globx, op_globx, op_globx
95: /* 124 */ .long op_globx, op_globx, op_globx, op_globx
96: /* 128 */ .long op_locx, op_locx, op_locx, op_locx
97: /* 132 */ .long op_locx, op_locx, op_locx, op_locx
98: /* 136 */ .long op_locx, op_locx, op_locx, op_locx
99: /* 140 */ .long op_locx, op_locx, op_locx, op_locx
100: /* 144 */ .long op_intx, op_intx, op_intx, op_intx
101: /* 148 */ .long op_intx, op_intx, op_intx, op_intx
102: /* 152 */ .long op_intx, op_intx, op_intx, op_intx
103: /* 156 */ .long op_intx, op_intx, op_intx, op_intx
104: /* 160 */ .long op_statx, op_statx, op_statx, op_statx
105: /* 164 */ .long op_statx, op_statx, op_statx, op_statx
106: /* 168 */ .long op_argx, op_argx, op_argx, op_argx
107: /* 172 */ .long op_argx, op_argx, op_argx, op_argx
108: /* 176 */ .long op_unmk0, op_unmk1, op_unmk2, op_unmk3
109: /* 180 */ .long op_unmk4, op_unmk5, op_unmk6, op_unmk7
110: /* 184 */ .long op_invkx, op_invkx, op_invkx, op_invkx
111: /* 188 */ .long op_invkx, op_invkx, op_invkx, op_invkx
112: /* 192 */ .long op_linex, op_linex, op_linex, op_linex
113: /* 196 */ .long op_linex, op_linex, op_linex, op_linex
114: /* 200 */ .long op_linex, op_linex, op_linex, op_linex
115: /* 204 */ .long op_linex, op_linex, op_linex, op_linex
116: /* 208 */ .long op_linex, op_linex, op_linex, op_linex
117: /* 212 */ .long op_linex, op_linex, op_linex, op_linex
118: /* 216 */ .long op_linex, op_linex, op_linex, op_linex
119: /* 220 */ .long op_linex, op_linex, op_linex, op_linex
120: /* 224 */ .long op_linex, op_linex, op_linex, op_linex
121: /* 228 */ .long op_linex, op_linex, op_linex, op_linex
122: /* 232 */ .long op_linex, op_linex, op_linex, op_linex
123: /* 236 */ .long op_linex, op_linex, op_linex, op_linex
124: /* 240 */ .long op_linex, op_linex, op_linex, op_linex
125: /* 244 */ .long op_linex, op_linex, op_linex, op_linex
126: /* 248 */ .long op_linex, op_linex, op_linex, op_linex
127: /* 252 */ .long op_linex, op_linex, op_linex, op_linex
128: Label(optab)
129: /*
130: * When an opcode n has a subroutine call associated with it, the
131: * nth word here is the routine to call.
132: */
133: /* 0 */ .long err, _asgn, _bang, _cat
134: /* 4 */ .long _compl, _diff, _div, _eqv
135: /* 8 */ .long _inter, _lconcat, _lexeq, _lexge
136: /* 12 */ .long _lexgt, _lexle, _lexlt, _lexne
137: /* 16 */ .long _minus, _mod, _mult, _neg
138: /* 20 */ .long _neqv, _nonnull, _null, _number
139: /* 24 */ .long _numeq, _numge, _numgt, _numle
140: /* 28 */ .long _numlt, _numne, _plus, _power
141: /* 32 */ .long _random, _rasgn, _refresh, _rswap
142: /* 36 */ .long _sect, _size, _subsc, _swap
143: /* 40 */ .long _tabmat, _toby, _unioncs, _value
144: /* 44 */ .long _bscan, err, err, _coact
145: /* 48 */ .long _cofail, _coret, _create, err
146: /* 52 */ .long err, err, err, _escan
147: /* 56 */ .long _esusp, _field, err, err
148: /* 60 */ .long err, err, err, _invoke
149: /* 64 */ .long _keywd, err, _limit, err
150: /* 68 */ .long _llist, _lsusp, err, _pfail
151: /* 72 */ .long err, err, _pret, _psusp
152:
153: .text
154:
155:
156: /*
157: * Interpreter main loop.
158: */
159: Label(_interp)
160: movzbl (ipc)+,r0
161: movl r0,Op
162: ashl $2,r0,r0
163: jmp *jumptab(r0)
164:
165: /*
166: * Ternary operators.
167: */
168:
169: Label(op_toby) /* e1 to e2 by e3 */
170: Label(op_escan) /* escan */
171: CallN(3)
172: NextInst
173: Label(op_sect) /* e1[e2:e3] */
174: PushNull
175: CallN(4)
176: NextInst
177:
178: /*
179: * Binary operators.
180: */
181: Label(op_asgn) /* e1 := e2 */
182: Label(op_cat) /* e1 || e2 */
183: Label(op_diff) /* e1 -- e2 */
184: Label(op_div) /* e1 / e2 */
185: Label(op_eqv) /* e1 === e2 */
186: Label(op_inter) /* e1 ** e2 */
187: Label(op_lconcat) /* e1 ||| e2 */
188: Label(op_lexeq) /* e1 == e2 */
189: Label(op_lexge) /* e1 >>= e2 */
190: Label(op_lexgt) /* e1 >> e2 */
191: Label(op_lexle) /* e1 <<= e2 */
192: Label(op_lexlt) /* e1 << e2 */
193: Label(op_lexne) /* e1 ~== e2 */
194: Label(op_minus) /* e1 - e2 */
195: Label(op_mod) /* e1 % e2 */
196: Label(op_mult) /* e1 * e2 */
197: Label(op_neqv) /* e1 ~==== e2 */
198: Label(op_numeq) /* e1 = e2 */
199: Label(op_numge) /* e1 >= e2 */
200: Label(op_numgt) /* e1 > e2 */
201: Label(op_numle) /* e1 <= e2 */
202: Label(op_numlt) /* e1 < e2 */
203: Label(op_numne) /* e1 ~= e2 */
204: Label(op_plus) /* e1 + e2 */
205: Label(op_power) /* e1 ^ e2 */
206: Label(op_rasgn) /* e1 <- e2 */
207: Label(op_unioncs) /* e1 ++ e2 */
208: CallN(2)
209: NextInst
210:
211: Label(op_rswap) /* e1 <-> e2 */
212: Label(op_subsc) /* e1[e2] */
213: Label(op_swap) /* e1 :=: e2 */
214: PushNull
215: CallN(3)
216: NextInst
217:
218: /*
219: * Unary operators.
220: */
221: Label(op_compl) /* ~e */
222: Label(op_neg) /* -e */
223: Label(op_nonnull) /* \e */
224: Label(op_null) /* /e */
225: Label(op_number) /* +e */
226: Label(op_refresh) /* ^e */
227: Label(op_size) /* *e */
228: Label(op_value) /* .e */
229: Label(op_coact) /* @e */
230: Label(op_esusp) /* esusp */
231: Label(op_pret) /* pret */
232: CallN(1)
233: NextInst
234:
235: Label(op_bang) /* !e */
236: Label(op_random) /* ?e */
237: Label(op_tabmat) /* =e */
238: PushNull
239: CallN(2)
240: NextInst
241: /*
242: * Instructions.
243: */
244: Label(op_bscan) /* bscan */
245: movq _k_subject,-(sp)
246: Push_S(_k_pos)
247: Push_K(D_INTEGER)
248: CallN(0)
249: NextInst
250:
251: Label(op_ccase) /* ccase */
252: PushNull
253: movq 4(efp),-(sp)
254: NextInst
255:
256: Label(op_chfail) /* chfail */
257: GetOp
258: addl3 ipc,Op,-8(efp)
259: NextInst
260:
261: Label(op_efail) /* efail */
262: LongJump(_efail)
263:
264: Label(op_pfail) /* pfail */
265: LongJump(_pfail)
266:
267: Label(op_cofail) /* cofail */
268: Label(op_coret) /* coret */
269: Label(op_limit) /* limit */
270: Label(op_lsusp) /* lsusp */
271: Label(op_psusp) /* psusp */
272: CallN(0)
273: NextInst
274:
275: Label(op_create) /* create */
276: GetOp
277: PushOpSum_R(ipc)
278: Push_K(D_INTEGER)
279: CallNameN(0,_create)
280: NextInst
281:
282: Label(op_cset) /* cset */
283: GetOp
284: PushOpSum_R(ipc)
285: Push_K(D_CSET)
286: NextInst
287:
288: Label(op_dup) /* dup */
289: PushNull
290: movq 8(sp),-(sp)
291: NextInst
292:
293: Label(op_field) /* field */
294: GetOp
295: PushOp
296: Push_K(D_INTEGER)
297: CallNameN(2,_field)
298: NextInst
299:
300: Label(op_eret) /* eret */
301: movq (sp)+,r0
302: movl -4(efp),gfp
303: movl efp,sp
304: movl (sp)+,efp
305: movq r0,-(sp)
306: NextInst
307:
308: Label(op_file) /* file */
309: GetOp
310: addl3 Op,_ident,_file
311: NextInst
312:
313: Label(op_goto) /* goto */
314: GetOp
315: addl2 Op,ipc
316: NextInst
317:
318: Label(op_incres) /* incres */
319: movl _current+4,r0
320: incl 28(r0)
321: NextInst
322:
323: Label(op_init) /* init */
324: movb $59,-(ipc)
325: addl2 $5,ipc /* Watch out here, that 5 comes from
326: # bytes in op + operand, not to
327: mention that the 59 is OP_GOTO */
328: NextInst
329:
330: Label(op_invoke) /* invoke */
331: GetOp
332: Jump(invkjmp)
333: Label(op_invkx)
334: BitClear(7)
335: Label(invkjmp)
336: PushOp
337: ashl $1,Op,Op
338: incl Op
339: calls Op,_invoke
340: NextInst
341:
342: Label(op_int) /* int */
343: movl (ipc)+,Op /* Special case here, integers come
344: out as a WORDSIZE value */
345: Jump(intjmp)
346: Label(op_intx)
347: BitClear(15)
348: Label(intjmp)
349: PushOp
350: Push_K(D_INTEGER)
351: NextInst
352:
353: Label(op_keywd) /* keywd */
354: GetOp
355: PushOp
356: Push_K(D_INTEGER)
357: CallNameN(0,_keywd)
358: NextInst
359:
360: Label(op_line) /* line */
361: GetOp
362: Jump(linejmp)
363: Label(op_linex)
364: BitClear(63)
365: Label(linejmp)
366: movl Op,_line
367: NextInst
368:
369: Label(op_llist) /* llist */
370: GetOp
371: PushOp
372: movl Op,r8 /* Do a workaround to allow for more */
373: calls $0,_llist /* than 256 words of arg list. */
374: ashl $1,r8,r8 /* This assumes that we don't "reenter" */
375: incl r8 /* this piece of code. */
376: ashl $2,r8,r8
377: addl2 r8,sp
378: NextInst
379:
380: Label(op_mark) /* mark */
381: GetOp
382: addl2 ipc,Op
383: Push_R(efp)
384: movl sp,efp
385: Push_R(gfp)
386: clrl gfp
387: PushOp
388: NextInst
389:
390: Label(op_mark0) /* mark0 */
391: Push_R(efp)
392: movl sp,efp
393: Push_R(gfp)
394: clrl gfp
395: Push_K(0)
396: NextInst
397:
398: Label(op_pnull) /* pnull */
399: PushNull
400: NextInst
401:
402: Label(op_pop) /* pop */
403: tstl (sp)+
404: tstl (sp)+
405: NextInst
406:
407: Label(op_push1) /* push1 */
408: Push_K(1)
409: Push_K(D_INTEGER)
410: NextInst
411:
412: Label(op_pushn1) /* pushn1 */
413: Push_K(-1)
414: Push_K(D_INTEGER)
415: NextInst
416:
417: Label(op_real) /* real */
418: GetOp
419: PushOpSum_R(ipc)
420: Push_K(D_REAL)
421: NextInst
422:
423: Label(op_sdup) /* sdup */
424: movq (sp),-(sp)
425: NextInst
426:
427: Label(op_str) /* str */
428: GetOp
429: PushOpSum_S(_ident)
430: GetOp
431: PushOp
432: NextInst
433:
434: Label(op_unmark) /* unmark */
435: GetOp
436: Label(unmkjmp)
437: movl (efp),efp
438: sobgtr Op,unmkjmp
439: movl -4(efp),gfp
440: movl efp,sp
441: movl (sp)+,efp
442: NextInst
443: Label(op_unmk7)
444: movl (efp),efp
445: Label(op_unmk6)
446: movl (efp),efp
447: Label(op_unmk5)
448: movl (efp),efp
449: Label(op_unmk4)
450: movl (efp),efp
451: Label(op_unmk3)
452: movl (efp),efp
453: Label(op_unmk2)
454: movl (efp),efp
455: Label(op_unmk1)
456: movl -4(efp),gfp
457: movl efp,sp
458: movl (sp)+,efp
459: Label(op_unmk0)
460: NextInst
461:
462: Label(op_global) /* global */
463: GetOp
464: Jump(globjmp)
465: Label(op_globx)
466: BitClear(15)
467: Label(globjmp)
468: ashl $3,Op,Op
469: PushOpSum_S(_globals)
470: Push_K(D_VAR)
471: NextInst
472:
473: Label(op_static) /* static */
474: GetOp
475: Jump(statjmp)
476: Label(op_statx)
477: BitClear(7)
478: Label(statjmp)
479: ashl $3,Op,Op
480: PushOpSum_S(_statics)
481: Push_K(D_VAR)
482: NextInst
483:
484: Label(op_local) /* local */
485: GetOp
486: Jump(locjmp)
487: Label(op_locx)
488: BitClear(15)
489: Label(locjmp)
490: mnegl Op,Op
491: movaq -16(fp)[Op],-(sp)
492: Push_K(D_VAR)
493: NextInst
494:
495: Label(op_arg) /* arg */
496: GetOp
497: Jump(argjmp)
498: Label(op_argx)
499: BitClear(7)
500: Label(argjmp)
501: pushaq 8(ap)[Op]
502: Push_K(D_VAR)
503: NextInst
504:
505: Label(quit) /* quit */
506: Push_K(0)
507: calls $1,_c_exit
508:
509: Label(err) /* err */
510: subl3 _code,ipc,-(sp)
511: ashl $-2,r0,-(sp)
512: Push_K(unrecog)
513: Push_K(message)
514: calls $3,_sprintf
515: Push_K(message)
516: calls $0,_syserr
517: .data
518: Label(message)
519: .space 30
520: Label(unrecog)
521: .asciz "Unknown opcode %d, pc = %d\n"
522: halt
523: #endif VAX
524: #ifdef PORT
525: /* Copy the code for the VAX in here and work on it */
526: DummyFcn(_interp)
527: #endif PORT
528:
529: #ifdef PDP11
530: / Icon interpreter
531:
532: .globl _c_exit
533: .globl _current
534: .globl _file
535: .globl _globals
536: .globl _ident
537: .globl _line
538: .globl _k_pos
539: .globl _k_subject
540: .globl _statics
541: .globl _syserr
542:
543: .globl _interp
544:
545: _interp:
546: movb (r2)+,r0
547: bic $!377,r0
548: mov r0,r1
549: asl r0
550: jmp *jumptab(r0)
551:
552: .data
553: jumptab:
554: quit; op_asgn; op_bang; op_cat
555: op_compl; op_diff; op_div; op_eqv
556: op_inter; op_lconcat; op_lexeq; op_lexge
557: op_lexgt; op_lexle; op_lexlt; op_lexne
558: op_minus; op_mod; op_mult; op_neg
559: op_neqv; op_nonnull; op_null; op_number
560: op_numeq; op_numge; op_numgt; op_numle
561: op_numlt; op_numne; op_plus; op_power
562: op_random; op_rasgn; op_refresh; op_rswap
563: op_sect; op_size; op_subsc; op_swap
564: op_tabmat; op_toby; op_unioncs; op_value
565: op_bscan; op_ccase; op_chfail; op_coact
566: op_cofail; op_coret; op_create; op_cset
567: op_dup; op_efail; op_eret; op_escan
568: op_esusp; op_field; op_file; op_goto
569: op_incres; op_init; op_int; op_invoke
570: op_keywd; err; op_limit; op_line
571: op_llist; op_lsusp; op_mark; op_pfail
572: op_pnull; op_pop; op_pret; op_psusp
573: op_push1; op_pushn1; op_real; op_sdup
574: op_str; op_unmark; err; err
575: op_local; op_long; err; err
576: err; err; err; err
577: op_global; op_arg; op_static; op_mark0
578: err; err; err; err
579: err; err; err; err
580: err; err; err; err
581: err; err; err; err
582: op_globx; op_globx; op_globx; op_globx
583: op_globx; op_globx; op_globx; op_globx
584: op_globx; op_globx; op_globx; op_globx
585: op_globx; op_globx; op_globx; op_globx
586: op_locx; op_locx; op_locx; op_locx
587: op_locx; op_locx; op_locx; op_locx
588: op_locx; op_locx; op_locx; op_locx
589: op_locx; op_locx; op_locx; op_locx
590: op_intx; op_intx; op_intx; op_intx
591: op_intx; op_intx; op_intx; op_intx
592: op_intx; op_intx; op_intx; op_intx
593: op_intx; op_intx; op_intx; op_intx
594: op_statx; op_statx; op_statx; op_statx
595: op_statx; op_statx; op_statx; op_statx
596: op_argx; op_argx; op_argx; op_argx
597: op_argx; op_argx; op_argx; op_argx
598: op_unmk0; op_unmk1; op_unmk2; op_unmk3
599: op_unmk4; op_unmk5; op_unmk6; op_unmk7
600: op_invkx; op_invkx; op_invkx; op_invkx
601: op_invkx; op_invkx; op_invkx; op_invkx
602: op_linex; op_linex; op_linex; op_linex
603: op_linex; op_linex; op_linex; op_linex
604: op_linex; op_linex; op_linex; op_linex
605: op_linex; op_linex; op_linex; op_linex
606: op_linex; op_linex; op_linex; op_linex
607: op_linex; op_linex; op_linex; op_linex
608: op_linex; op_linex; op_linex; op_linex
609: op_linex; op_linex; op_linex; op_linex
610: op_linex; op_linex; op_linex; op_linex
611: op_linex; op_linex; op_linex; op_linex
612: op_linex; op_linex; op_linex; op_linex
613: op_linex; op_linex; op_linex; op_linex
614: op_linex; op_linex; op_linex; op_linex
615: op_linex; op_linex; op_linex; op_linex
616: op_linex; op_linex; op_linex; op_linex
617: op_linex; op_linex; op_linex; op_linex
618:
619: .globl _asgn, _bang, _cat
620: .globl _compl, _diff, _div, _eqv
621: .globl _inter, _lconcat, _lexeq, _lexge
622: .globl _lexgt, _lexle, _lexlt, _lexne
623: .globl _minus, _mod, _mult, _neg
624: .globl _neqv, _nonnull, _null, _number
625: .globl _numeq, _numge, _numgt, _numle
626: .globl _numlt, _numne, _plus, _power
627: .globl _random, _rasgn, _refresh, _rswap
628: .globl _sect, _size, _subsc, _swap
629: .globl _tabmat, _toby, _unioncs, _value
630: .globl _bscan
631: .globl _coact, _cofail, _coret, _create
632: .globl _efail
633: .globl _escan, _esusp, _field
634: .globl _invoke, _keywd
635: .globl _limit, _llist, _lsusp
636: .globl _pfail
637: .globl _pret, _psusp
638:
639: optab:
640: err; _asgn; _bang; _cat
641: _compl; _diff; _div; _eqv
642: _inter; _lconcat; _lexeq; _lexge
643: _lexgt; _lexle; _lexlt; _lexne
644: _minus; _mod; _mult; _neg
645: _neqv; _nonnull; _null; _number
646: _numeq; _numge; _numgt; _numle
647: _numlt; _numne; _plus; _power
648: _random; _rasgn; _refresh; _rswap
649: _sect; _size; _subsc; _swap
650: _tabmat; _toby; _unioncs; _value
651: _bscan; err; err; _coact
652: _cofail; _coret; _create; err
653: err; _efail; err; _escan
654: _esusp; _field; err; err
655: err; err; err; _invoke
656: _keywd; err; _limit; err
657: _llist; _lsusp; err; _pfail
658: err; err; _pret; _psusp
659: .text
660:
661: / ternary operators
662:
663: op_toby:
664: op_escan:
665: mov $3,-(sp)
666: jsr pc,*optab(r0)
667: jbr _interp
668: op_sect:
669: clr -(sp)
670: clr -(sp)
671: mov $4,-(sp)
672: jsr pc,*optab(r0)
673: jbr _interp
674:
675: / binary operators
676:
677: op_asgn:
678: op_cat:
679: op_diff:
680: op_div:
681: op_eqv:
682: op_inter:
683: op_lconcat:
684: op_lexeq:
685: op_lexge:
686: op_lexgt:
687: op_lexle:
688: op_lexlt:
689: op_lexne:
690: op_minus:
691: op_mod:
692: op_mult:
693: op_neqv:
694: op_numeq:
695: op_numge:
696: op_numgt:
697: op_numle:
698: op_numlt:
699: op_numne:
700: op_plus:
701: op_power:
702: op_rasgn:
703: op_unioncs:
704: mov $2,-(sp)
705: jsr pc,*optab(r0)
706: jbr _interp
707: op_rswap:
708: op_subsc:
709: op_swap:
710: clr -(sp)
711: clr -(sp)
712: mov $3,-(sp)
713: jsr pc,*optab(r0)
714: jbr _interp
715:
716: / unary operators
717:
718: op_compl:
719: op_neg:
720: op_nonnull:
721: op_null:
722: op_number:
723: op_refresh:
724: op_size:
725: op_value:
726: op_coact:
727: op_esusp:
728: op_pret:
729: mov $1,-(sp)
730: jsr pc,*optab(r0)
731: jbr _interp
732: op_bang:
733: op_random:
734: op_tabmat:
735: clr -(sp)
736: clr -(sp)
737: mov $2,-(sp)
738: jsr pc,*optab(r0)
739: jbr _interp
740:
741: / instructions
742:
743: op_bscan:
744: mov _k_subject+2,-(sp)
745: mov _k_subject,-(sp)
746: mov _k_pos,-(sp)
747: mov $D_INTEGER,-(sp)
748: clr -(sp)
749: jsr pc,*optab(r0)
750: jbr _interp
751: op_ccase:
752: clr -(sp)
753: clr -(sp)
754: mov 4(r4),-(sp)
755: mov 2(r4),-(sp)
756: jbr _interp
757: op_chfail:
758: movb (r2)+,r0
759: movb (r2)+,r1
760: bic $!0377,r0
761: ash $8.,r1
762: bis r0,r1
763: add r2,r1
764: mov r1,-4(r4)
765: jbr _interp
766: op_cofail:
767: op_coret:
768: op_efail:
769: op_limit:
770: op_lsusp:
771: op_pfail:
772: op_psusp:
773: clr -(sp)
774: jsr pc,*optab(r0)
775: jbr _interp
776: op_create:
777: movb (r2)+,r0
778: movb (r2)+,r1
779: bic $!0377,r0
780: ash $8.,r1
781: bis r0,r1
782: add r2,r1
783: mov r1,-(sp)
784: mov $D_INTEGER,-(sp)
785: clr -(sp)
786: jsr pc,_create
787: jbr _interp
788: op_cset:
789: movb (r2)+,r0
790: movb (r2)+,r1
791: bic $!0377,r0
792: ash $8.,r1
793: bis r0,r1
794: add r2,r1
795: mov r1,-(sp)
796: mov $D_CSET,-(sp)
797: jbr _interp
798: op_dup:
799: clr -(sp)
800: clr -(sp)
801: mov 6(sp),-(sp)
802: mov 6(sp),-(sp)
803: jbr _interp
804: op_eret:
805: mov (sp)+,r0
806: mov (sp)+,r1
807: mov -2(r4),r3
808: mov r4,sp
809: mov (sp)+,r4
810: mov r1,-(sp)
811: mov r0,-(sp)
812: jbr _interp
813: op_field:
814: movb (r2)+,r0
815: movb (r2)+,r1
816: bic $!0377,r0
817: ash $8.,r1
818: bis r0,r1
819: mov r1,-(sp)
820: mov $D_INTEGER,-(sp)
821: mov $2,-(sp)
822: jsr pc,_field
823: jbr _interp
824: op_file:
825: movb (r2)+,r0
826: movb (r2)+,r1
827: bic $!0377,r0
828: ash $8.,r1
829: bis r0,r1
830: add _ident,r1
831: mov r1,_file
832: jbr _interp
833: op_goto:
834: movb (r2)+,r0
835: movb (r2)+,r1
836: bic $!0377,r0
837: ash $8.,r1
838: bis r0,r1
839: add r1,r2
840: jbr _interp
841: op_incres:
842: mov _current+2,r0
843: inc 14.(r0)
844: jbr _interp
845: op_init:
846: movb $59.,-(r2) / change the INIT to a GOTO for next time
847: add $3,r2
848: jbr _interp
849: op_int:
850: movb (r2)+,r0
851: movb (r2)+,r1
852: bic $!0377,r0
853: ash $8.,r1
854: bis r0,r1
855: br 1f
856: op_intx:
857: bic $!017,r1
858: 1: mov r1,-(sp)
859: mov $D_INTEGER,-(sp)
860: jbr _interp
861: op_invoke:
862: movb (r2)+,r0
863: movb (r2)+,r1
864: bic $!0377,r0
865: ash $8.,r1
866: bis r0,r1
867: br 1f
868: op_invkx:
869: bic $!07,r1
870: 1: mov r1,-(sp)
871: jsr pc,_invoke
872: jbr _interp
873: op_keywd:
874: movb (r2)+,r0
875: movb (r2)+,r1
876: bic $!0377,r0
877: ash $8.,r1
878: bis r0,r1
879: mov r1,-(sp)
880: mov $D_INTEGER,-(sp)
881: clr -(sp)
882: jsr pc,_keywd
883: jbr _interp
884: op_line:
885: movb (r2)+,r0
886: movb (r2)+,r1
887: bic $!0377,r0
888: ash $8.,r1
889: bis r0,r1
890: br 1f
891: op_linex:
892: bic $!077,r1
893: 1: mov r1,_line
894: jbr _interp
895: op_llist:
896: movb (r2)+,r0
897: movb (r2)+,r1
898: bic $!0377,r0
899: ash $8.,r1
900: bis r0,r1
901: mov r1,-(sp)
902: jsr pc,_llist
903: jbr _interp
904: op_long:
905: movb (r2)+,r0
906: movb (r2)+,r1
907: bic $!0377,r0
908: ash $8.,r1
909: bis r0,r1
910: add r2,r1
911: mov r1,-(sp)
912: mov $D_LONGINT,-(sp)
913: jbr _interp
914: op_mark:
915: movb (r2)+,r0
916: movb (r2)+,r1
917: bic $!0377,r0
918: ash $8.,r1
919: bis r0,r1
920: add r2,r1
921: mov r4,-(sp)
922: mov sp,r4
923: mov r3,-(sp)
924: clr r3
925: mov r1,-(sp)
926: jbr _interp
927: op_mark0:
928: mov r4,-(sp)
929: mov sp,r4
930: mov r3,-(sp)
931: clr r3
932: clr -(sp)
933: jbr _interp
934: op_pnull:
935: clr -(sp)
936: clr -(sp)
937: jbr _interp
938: op_pop:
939: cmp (sp)+,(sp)+
940: jbr _interp
941: op_push1:
942: mov $1,-(sp)
943: mov $D_INTEGER,-(sp)
944: jbr _interp
945: op_pushn1:
946: mov $-1,-(sp)
947: mov $D_INTEGER,-(sp)
948: jbr _interp
949: op_real:
950: movb (r2)+,r0
951: movb (r2)+,r1
952: bic $!0377,r0
953: ash $8.,r1
954: bis r0,r1
955: add r2,r1
956: mov r1,-(sp)
957: mov $D_REAL,-(sp)
958: jbr _interp
959: op_sdup:
960: mov 2(sp),-(sp)
961: mov 2(sp),-(sp)
962: jbr _interp
963: op_str:
964: movb (r2)+,r0
965: movb (r2)+,r1
966: bic $!0377,r0
967: ash $8.,r1
968: bis r0,r1
969: add _ident,r1
970: mov r1,-(sp)
971: movb (r2)+,r0
972: movb (r2)+,r1
973: bic $!0377,r0
974: ash $8.,r1
975: bis r0,r1
976: mov r1,-(sp)
977: jbr _interp
978: op_unmark:
979: movb (r2)+,r0
980: movb (r2)+,r1
981: bic $!0377,r0
982: ash $8.,r1
983: bis r0,r1
984: dec r1
985: 1: mov (r4),r4
986: sob r1,1b
987: mov -2(r4),r3
988: mov r4,sp
989: mov (sp)+,r4
990: jbr _interp
991: op_unmk7:
992: mov (r4),r4
993: op_unmk6:
994: mov (r4),r4
995: op_unmk5:
996: mov (r4),r4
997: op_unmk4:
998: mov (r4),r4
999: op_unmk3:
1000: mov (r4),r4
1001: op_unmk2:
1002: mov (r4),r4
1003: op_unmk1:
1004: mov -2(r4),r3
1005: mov r4,sp
1006: mov (sp)+,r4
1007: op_unmk0:
1008: jbr _interp
1009: op_global:
1010: movb (r2)+,r0
1011: movb (r2)+,r1
1012: bic $!0377,r0
1013: ash $8.,r1
1014: bis r0,r1
1015: br 1f
1016: op_globx:
1017: bic $!017,r1
1018: 1: asl r1
1019: asl r1
1020: add _globals,r1
1021: mov r1,-(sp)
1022: mov $D_VAR,-(sp)
1023: jbr _interp
1024: op_static:
1025: movb (r2)+,r0
1026: movb (r2)+,r1
1027: bic $!0377,r0
1028: ash $8.,r1
1029: bis r0,r1
1030: br 1f
1031: op_statx:
1032: bic $!07,r1
1033: 1: asl r1
1034: asl r1
1035: add _statics,r1
1036: mov r1,-(sp)
1037: mov $D_VAR,-(sp)
1038: jbr _interp
1039: op_local:
1040: movb (r2)+,r0
1041: movb (r2)+,r1
1042: bic $!0377,r0
1043: ash $8.,r1
1044: bis r0,r1
1045: br 1f
1046: op_locx:
1047: bic $!017,r1
1048: 1: asl r1
1049: asl r1
1050: add $14.,r1
1051: neg r1
1052: add r5,r1
1053: mov r1,-(sp)
1054: mov $D_VAR,-(sp)
1055: jbr _interp
1056: op_arg:
1057: movb (r2)+,r0
1058: movb (r2)+,r1
1059: bic $!0377,r0
1060: ash $8.,r1
1061: bis r0,r1
1062: br 1f
1063: op_argx:
1064: bic $!07,r1
1065: 1: asl r1
1066: asl r1
1067: add $6,r1
1068: add r5,r1
1069: mov r1,-(sp)
1070: mov $D_VAR,-(sp)
1071: jbr _interp
1072: quit:
1073: clr -(sp)
1074: jsr pc,*$_c_exit
1075: err:
1076: mov $9f,-(sp)
1077: jsr pc,_syserr
1078: .data
1079: 9: <unrecognized ucode instruction\0>
1080: .even
1081: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.