|
|
1.1 root 1: /*
2: * Copyright (c) 1979, 1984 Regents of the University of California
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char sccsid[] = "@(#)langpats.c 5.5 (Berkeley) 4/7/87";
9: #endif not lint
10:
11: #include "inline.h"
12:
13: /*
14: * Pattern table for Pascal library routines.
15: */
16: struct pats language_ptab[] = {
17:
18: #ifdef vax
19: /*
20: * General Pascal library routines
21: */
22: { 2, "_ROUND\n",
23: " movd (sp)+,r0\n\
24: cvtrdl r0,r0\n" },
25:
26: { 2, "_TRUNC\n",
27: " movd (sp)+,r0\n\
28: cvtdl r0,r0\n" },
29:
30: { 1, "_ACTFILE\n",
31: " movl (sp)+,r1\n\
32: movl 12(r1),r0\n" },
33:
34: { 2, "_FCALL\n",
35: " movl (sp)+,r5\n\
36: movl (sp),r0\n\
37: movc3 4(r0),__disply+8,(r5)\n\
38: movl (sp)+,r0\n\
39: movc3 4(r0),8(r0),__disply+8\n" },
40:
41: { 2, "_FRTN\n",
42: " movl (sp)+,r0\n\
43: movl (sp)+,r5\n\
44: movc3 4(r0),(r5),__disply+8\n" },
45:
46: { 3, "_FSAV\n",
47: " movl (sp)+,r3\n\
48: movl (sp)+,r4\n\
49: movl (sp),r5\n\
50: movl r3,(r5)\n\
51: ashl $3,r4,4(r5)\n\
52: movc3 4(r5),__disply+8,8(r5)\n\
53: movl (sp)+,r0\n" },
54:
55: /*
56: * Pascal relational comparisons
57: */
58: { 3, "_RELEQ\n",
59: " movl (sp)+,r0\n\
60: movl (sp)+,r1\n\
61: movl (sp)+,r3\n\
62: movl r0,r4\n\
63: 1:\n\
64: movzwl $65535,r0\n\
65: cmpl r4,r0\n\
66: jleq 3f\n\
67: subl2 r0,r4\n\
68: cmpc3 r0,(r1),(r3)\n\
69: jeql 1b\n\
70: 2:\n\
71: clrl r0\n\
72: jbr 4f\n\
73: 3:\n\
74: cmpc3 r4,(r1),(r3)\n\
75: jneq 2b\n\
76: incl r0\n\
77: 4:\n" },
78:
79: { 3, "_RELNE\n",
80: " movl (sp)+,r0\n\
81: movl (sp)+,r1\n\
82: movl (sp)+,r3\n\
83: movl r0,r4\n\
84: 1:\n\
85: movzwl $65535,r0\n\
86: cmpl r4,r0\n\
87: jleq 3f\n\
88: subl2 r0,r4\n\
89: cmpc3 r0,(r1),(r3)\n\
90: jeql 1b\n\
91: 2:\n\
92: movl $1,r0\n\
93: jbr 4f\n\
94: 3:\n\
95: cmpc3 r4,(r1),(r3)\n\
96: jneq 2b\n\
97: 4:\n" },
98:
99: { 3, "_RELSLT\n",
100: " movl (sp)+,r0\n\
101: movl (sp)+,r1\n\
102: movl (sp)+,r3\n\
103: movl r0,r4\n\
104: jbr 2f\n\
105: 1:\n\
106: subl2 r0,r4\n\
107: cmpc3 r0,(r1),(r3)\n\
108: jneq 3f\n\
109: 2:\n\
110: movzwl $65535,r0\n\
111: cmpl r4,r0\n\
112: jgtr 1b\n\
113: cmpc3 r4,(r1),(r3)\n\
114: 3:\n\
115: jlss 4f\n\
116: clrl r0\n\
117: jbr 5f\n\
118: 4:\n\
119: movl $1,r0\n\
120: 5:\n" },
121:
122: { 3, "_RELSLE\n",
123: " movl (sp)+,r0\n\
124: movl (sp)+,r1\n\
125: movl (sp)+,r3\n\
126: movl r0,r4\n\
127: jbr 2f\n\
128: 1:\n\
129: subl2 r0,r4\n\
130: cmpc3 r0,(r1),(r3)\n\
131: jneq 3f\n\
132: 2:\n\
133: movzwl $65535,r0\n\
134: cmpl r4,r0\n\
135: jgtr 1b\n\
136: cmpc3 r4,(r1),(r3)\n\
137: 3:\n\
138: jleq 4f\n\
139: clrl r0\n\
140: jbr 5f\n\
141: 4:\n\
142: movl $1,r0\n\
143: 5:\n" },
144:
145: { 3, "_RELSGT\n",
146: " movl (sp)+,r0\n\
147: movl (sp)+,r1\n\
148: movl (sp)+,r3\n\
149: movl r0,r4\n\
150: jbr 2f\n\
151: 1:\n\
152: subl2 r0,r4\n\
153: cmpc3 r0,(r1),(r3)\n\
154: jneq 3f\n\
155: 2:\n\
156: movzwl $65535,r0\n\
157: cmpl r4,r0\n\
158: jgtr 1b\n\
159: cmpc3 r4,(r1),(r3)\n\
160: 3:\n\
161: jgtr 4f\n\
162: clrl r0\n\
163: jbr 5f\n\
164: 4:\n\
165: movl $1,r0\n\
166: 5:\n" },
167:
168: { 3, "_RELSGE\n",
169: " movl (sp)+,r0\n\
170: movl (sp)+,r1\n\
171: movl (sp)+,r3\n\
172: movl r0,r4\n\
173: jbr 2f\n\
174: 1:\n\
175: subl2 r0,r4\n\
176: cmpc3 r0,(r1),(r3)\n\
177: jneq 3f\n\
178: 2:\n\
179: movzwl $65535,r0\n\
180: cmpl r4,r0\n\
181: jgtr 1b\n\
182: cmpc3 r4,(r1),(r3)\n\
183: 3:\n\
184: jgeq 4f\n\
185: clrl r0\n\
186: jbr 5f\n\
187: 4:\n\
188: movl $1,r0\n\
189: 5:\n" },
190:
191: /*
192: * Pascal set operations.
193: */
194: { 4, "_ADDT\n",
195: " movl (sp)+,r0\n\
196: movl (sp)+,r1\n\
197: movl (sp)+,r2\n\
198: movl (sp)+,r4\n\
199: movl r0,r3\n\
200: 1:\n\
201: bisl3 (r1)+,(r2)+,(r3)+\n\
202: sobgtr r4,1b\n" },
203:
204: { 4, "_SUBT\n",
205: " movl (sp)+,r0\n\
206: movl (sp)+,r1\n\
207: movl (sp)+,r2\n\
208: movl (sp)+,r4\n\
209: movl r0,r3\n\
210: 1:\n\
211: bicl3 (r2)+,(r1)+,(r3)+\n\
212: sobgtr r4,1b\n" },
213:
214: { 4, "_MULT\n",
215: " movl (sp)+,r0\n\
216: movl (sp)+,r1\n\
217: movl (sp)+,r2\n\
218: movl (sp)+,r4\n\
219: movl r0,r3\n\
220: 1:\n\
221: mcoml (r1)+,r5\n\
222: bicl3 r5,(r2)+,(r3)+\n\
223: sobgtr r4,1b\n" },
224:
225: { 4, "_IN\n",
226: " movl (sp)+,r1\n\
227: movl (sp)+,r2\n\
228: movl (sp)+,r3\n\
229: movl (sp)+,r4\n\
230: clrl r0\n\
231: subl2 r2,r1\n\
232: cmpl r1,r3\n\
233: jgtru 1f\n\
234: jbc r1,(r4),1f\n\
235: incl r0\n\
236: 1:\n" },
237:
238: /*
239: * Pascal runtime checks
240: */
241: { 1, "_ASRT\n",
242: " movl (sp)+,r0\n\
243: tstl r0\n\
244: jneq 1f\n\
245: pushl $0\n\
246: pushl $_EASRT\n\
247: calls $2,_ERROR\n\
248: 1:\n" },
249:
250: { 2, "_ASRTS\n",
251: " movl (sp)+,r0\n\
252: movl (sp)+,r1\n\
253: tstl r0\n\
254: jneq 1f\n\
255: pushl r1\n\
256: pushl $_EASRTS\n\
257: calls $2,_ERROR\n\
258: 1:\n" },
259:
260: { 1, "_CHR\n",
261: " movl (sp)+,r0\n\
262: cmpl r0,$127\n\
263: jlequ 1f\n\
264: pushl r0\n\
265: pushl $_ECHR\n\
266: calls $2,_ERROR\n\
267: 1:\n" },
268:
269: { 0, "_LINO\n",
270: " incl __stcnt\n\
271: cmpl __stcnt,__stlim\n\
272: jlss 1f\n\
273: pushl __stcnt\n\
274: pushl $_ELINO\n\
275: calls $2,_ERROR\n\
276: 1:\n" },
277:
278: { 1, "_NIL\n",
279: " movl (sp)+,r0\n\
280: cmpl r0,__maxptr\n\
281: jgtr 1f\n\
282: cmpl r0,__minptr\n\
283: jgeq 2f\n\
284: 1:\n\
285: pushl $0\n\
286: pushl $_ENIL\n\
287: calls $2,_ERROR\n\
288: 2:\n" },
289:
290: { 2, "_RANDOM\n",
291: " movd (sp)+,r0\n\
292: emul __seed,$1103515245,$0,r0\n\
293: ediv $0x7fffffff,r0,r1,r0\n\
294: movl r0,__seed\n\
295: cvtld r0,r0\n\
296: divd2 $0d2.147483647e+09,r0\n" },
297:
298: { 3, "_RANG4\n",
299: " movl (sp)+,r0\n\
300: movl (sp)+,r1\n\
301: movl (sp)+,r2\n\
302: cmpl r0,r1\n\
303: jlss 1f\n\
304: cmpl r0,r2\n\
305: jleq 2f\n\
306: 1:\n\
307: pushl r0\n\
308: pushl $_ERANG\n\
309: calls $2,_ERROR\n\
310: 2:\n" },
311:
312: { 2, "_RSNG4\n",
313: " movl (sp)+,r0\n\
314: movl (sp)+,r1\n\
315: cmpl r0,r1\n\
316: jlequ 1f\n\
317: pushl r0\n\
318: pushl $_ERANG\n\
319: calls $2,_ERROR\n\
320: 1:\n" },
321:
322: { 1, "_SEED\n",
323: " movl (sp)+,r1\n\
324: movl __seed,r0\n\
325: movl r1,__seed\n" },
326:
327: { 3, "_SUBSC\n",
328: " movl (sp)+,r0\n\
329: movl (sp)+,r1\n\
330: movl (sp)+,r2\n\
331: cmpl r0,r1\n\
332: jlss 1f\n\
333: cmpl r0,r2\n\
334: jleq 2f\n\
335: 1:\n\
336: pushl r0\n\
337: pushl $_ESUBSC\n\
338: calls $2,_ERROR\n\
339: 2:\n" },
340:
341: { 2, "_SUBSCZ\n",
342: " movl (sp)+,r0\n\
343: movl (sp)+,r1\n\
344: cmpl r0,r1\n\
345: jlequ 1f\n\
346: pushl r0\n\
347: pushl $_ESUBSC\n\
348: calls $2,_ERROR\n\
349: 1:\n" },
350: #endif vax
351:
352: #ifdef mc68000
353: /*
354: * General Pascal library routines
355: */
356: { 1, "_ACTFILE\n",
357: " movl sp@+,a0\n\
358: movl a0@(12),d0\n" },
359:
360: { 4, "_ADDT\n",
361: " movl sp@+,a0\n\
362: movl sp@+,d0\n\
363: movl sp@+,a1\n\
364: movl sp@+,d1\n\
365: movl a0,sp@-\n\
366: movl a2,sp@-\n\
367: movl d0,a2\n\
368: subql #1,d1\n\
369: 1:\n\
370: movl a2@+,d0\n\
371: orl a1@+,d0\n\
372: movl d0,a0@+\n\
373: dbra d1,1b\n\
374: movl sp@+,a2\n\
375: movl sp@+,d0\n" },
376:
377: { 4, "_SUBT\n",
378: " movl sp@+,a0\n\
379: movl sp@+,d0\n\
380: movl sp@+,a1\n\
381: movl sp@+,d1\n\
382: movl a0,sp@-\n\
383: movl a2,sp@-\n\
384: movl d0,a2\n\
385: subql #1,d1\n\
386: 1:\n\
387: movl a1@+,d0\n\
388: notl d0\n\
389: andl a2@+,d0\n\
390: movl d0,a0@+\n\
391: dbra d1,1b\n\
392: movl sp@+,a2\n\
393: movl sp@+,d0\n" },
394:
395: { 4, "_MULT\n",
396: " movl sp@+,a0\n\
397: movl sp@+,d0\n\
398: movl sp@+,a1\n\
399: movl sp@+,d1\n\
400: movl a0,sp@-\n\
401: movl a2,sp@-\n\
402: movl d0,a2\n\
403: subql #1,d1\n\
404: 1:\n\
405: movl a2@+,d0\n\
406: andl a1@+,d0\n\
407: movl d0,a0@+\n\
408: dbra d1,1b\n\
409: movl sp@+,a2\n\
410: movl sp@+,d0\n" },
411:
412: { 4, "_IN\n",
413: " movl sp@+,d0\n\
414: movl sp@+,a0\n\
415: movl sp@+,d1\n\
416: movl sp@+,a1\n\
417: subl a0,d0\n\
418: cmpl d1,d0\n\
419: jhi 1f\n\
420: movl d0,d1\n\
421: lsrl #3,d1\n\
422: btst d0,a1@(0,d1:l)\n\
423: jeq 1f\n\
424: moveq #1,d0\n\
425: jra 2f\n\
426: 1:\n\
427: moveq #0,d0\n\
428: 2:\n" },
429:
430: { 3, "_RANG4\n",
431: " movl sp@+,d0\n\
432: movl sp@+,a0\n\
433: movl sp@+,a1\n\
434: cmpl a0,d0\n\
435: jlt 1f\n\
436: cmpl a1,d0\n\
437: jle 2f\n\
438: 1:\n\
439: pea _ERANG\n\
440: jbsr _ERROR\n\
441: addqw #4,sp\n\
442: 2:\n" },
443: { 2, "_RSNG4\n",
444: " movl sp@+,a0\n\
445: movl sp@+,a1\n\
446: cmpl a1,a0\n\
447: jls 1f\n\
448: pea _ERANG\n\
449: jbsr _ERROR\n\
450: addqw #4,sp\n\
451: 1:\n" },
452:
453: { 3, "_SUBSC\n",
454: " movl sp@+,d0\n\
455: movl sp@+,a0\n\
456: movl sp@+,a1\n\
457: cmpl a0,d0\n\
458: jlt 1f\n\
459: cmpl a1,d0\n\
460: jle 2f\n\
461: 1:\n\
462: pea _ESUBSC\n\
463: jbsr _ERROR\n\
464: addqw #4,sp\n\
465: 2:\n" },
466:
467: { 2, "_SUBSCZ\n",
468: " movl sp@+,a0\n\
469: movl sp@+,a1\n\
470: cmpl a1,a0\n\
471: jls 1f\n\
472: pea _ESUBSC\n\
473: jbsr _ERROR\n\
474: addqw #4,sp\n\
475: 1:\n" },
476:
477: #endif mc68000
478:
479: #ifdef tahoe
480: { 2, "_TRUNC\n",
481: " ldd (sp)\n\
482: movab 8(sp),sp\n\
483: cvdl r0\n" },
484:
485: { 1, "_ACTFILE\n",
486: " movl (sp)+,r1\n\
487: movl 12(r1),r0\n" },
488:
489: /*
490: * Pascal set operations.
491: */
492:
493: { 4, "_ADDT\n",
494: " movl (sp)+,r0\n\
495: movl (sp)+,r1\n\
496: movl (sp)+,r2\n\
497: movl (sp)+,r3\n\
498: clrl r4\n\
499: 1:\n\
500: orl3 (r1)[r4],(r2)[r4],(r0)[r4]\n\
501: aoblss r3,r4,1b\n" },
502:
503: { 4, "_SUBT\n",
504: " movl (sp)+,r0\n\
505: movl (sp)+,r1\n\
506: movl (sp)+,r2\n\
507: movl (sp)+,r3\n\
508: decl r3\n\
509: 1:\n\
510: mcoml (r2)[r3],r4\n\
511: andl3 r4,(r1)[r3],(r0)[r3]\n\
512: decl r3\n\
513: jgeq 1b\n" },
514:
515: { 4, "_MULT\n",
516: " movl (sp)+,r0\n\
517: movl (sp)+,r1\n\
518: movl (sp)+,r2\n\
519: movl (sp)+,r3\n\
520: clrl r4\n\
521: 1:\n\
522: andl3 (r1)[r4],(r2)[r4],(r0)[r4]\n\
523: aoblss r3,r4,1b\n" },
524:
525: { 4, "_IN\n",
526: " movl (sp)+,r1\n\
527: movl (sp)+,r2\n\
528: movl (sp)+,r3\n\
529: movl (sp)+,r4\n\
530: clrl r0\n\
531: subl2 r2,r1\n\
532: cmpl r1,r3\n\
533: jgtru 1f\n\
534: shrl $3,r1,r2\n\
535: movzbl (r4)[r2],r3\n\
536: andl2 $7,r1\n\
537: jbc r1,r3,1f\n\
538: incl r0\n\
539: 1:\n" },
540:
541: /*
542: * Pascal runtime checks
543: */
544: { 1, "_ASRT\n",
545: " movl (sp)+,r0\n\
546: tstl r0\n\
547: jneq 1f\n\
548: pushl $0\n\
549: pushl $_EASRT\n\
550: callf $12,_ERROR\n\
551: 1:\n" },
552:
553: { 2, "_ASRTS\n",
554: " movl (sp)+,r0\n\
555: movl (sp)+,r1\n\
556: tstl r0\n\
557: jneq 1f\n\
558: pushl r1\n\
559: pushl $_EASRTS\n\
560: callf $12,_ERROR\n\
561: 1:\n" },
562:
563: { 1, "_CHR\n",
564: " movl (sp)+,r0\n\
565: cmpl r0,$127\n\
566: jlequ 1f\n\
567: pushl r0\n\
568: pushl $_ECHR\n\
569: callf $12,_ERROR\n\
570: 1:\n" },
571:
572: { 0, "_LINO\n",
573: " incl __stcnt\n\
574: cmpl __stcnt,__stlim\n\
575: jlss 1f\n\
576: pushl __stcnt\n\
577: pushl $_ELINO\n\
578: callf $12,_ERROR\n\
579: 1:\n" },
580:
581: { 1, "_NIL\n",
582: " movl (sp)+,r0\n\
583: cmpl r0,__maxptr\n\
584: jgtr 1f\n\
585: cmpl r0,__minptr\n\
586: jgeq 2f\n\
587: 1:\n\
588: pushl $0\n\
589: pushl $_ENIL\n\
590: callf $12,_ERROR\n\
591: 2:\n" },
592:
593: { 3, "_RANG4\n",
594: " movl (sp)+,r0\n\
595: movl (sp)+,r1\n\
596: movl (sp)+,r2\n\
597: cmpl r0,r1\n\
598: jlss 1f\n\
599: cmpl r0,r2\n\
600: jleq 2f\n\
601: 1:\n\
602: pushl r0\n\
603: pushl $_ERANG\n\
604: callf $12,_ERROR\n\
605: 2:\n" },
606:
607: { 2, "_RSNG4\n",
608: " movl (sp)+,r0\n\
609: movl (sp)+,r1\n\
610: cmpl r0,r1\n\
611: jlequ 1f\n\
612: pushl r0\n\
613: pushl $_ERANG\n\
614: callf $12,_ERROR\n\
615: 1:\n" },
616:
617: { 1, "_SEED\n",
618: " movl (sp)+,r1\n\
619: movl __seed,r0\n\
620: movl r1,__seed\n" },
621:
622: { 3, "_SUBSC\n",
623: " movl (sp)+,r0\n\
624: movl (sp)+,r1\n\
625: movl (sp)+,r2\n\
626: cmpl r0,r1\n\
627: jlss 1f\n\
628: cmpl r0,r2\n\
629: jleq 2f\n\
630: 1:\n\
631: pushl r0\n\
632: pushl $_ESUBSC\n\
633: callf $12,_ERROR\n\
634: 2:\n" },
635:
636: { 2, "_SUBSCZ\n",
637: " movl (sp)+,r0\n\
638: movl (sp)+,r1\n\
639: cmpl r0,r1\n\
640: jlequ 1f\n\
641: pushl r0\n\
642: pushl $_ESUBSC\n\
643: callf $12,_ERROR\n\
644: 1:\n" },
645: #endif tahoe
646:
647: { 0, "", "" }
648: };
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.