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