xref: /original-bsd/usr.bin/pascal/pc2/langpats.c (revision c577960b)
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) 04/07/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 };
649