add IN operator for tahoe
[unix-history] / usr / src / usr.bin / pascal / pc2 / langpats.c
CommitLineData
252367af
DF
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 */
b3e05d18 6
08bd3641 7#ifndef lint
ade415e6 8static char sccsid[] = "@(#)langpats.c 5.4 (Berkeley) %G%";
08bd3641 9#endif not lint
b3e05d18 10
08bd3641 11#include "inline.h"
af054913 12
a83071b9 13/*
08bd3641 14 * Pattern table for Pascal library routines.
a83071b9 15 */
08bd3641 16struct pats language_ptab[] = {
b3e05d18 17
08bd3641 18#ifdef vax
a83071b9 19/*
08bd3641 20 * General Pascal library routines
a83071b9 21 */
1e4dba2b 22 { 2, "_ROUND\n",
08bd3641
KM
23" movd (sp)+,r0\n\
24 cvtrdl r0,r0\n" },
b3e05d18 25
1e4dba2b 26 { 2, "_TRUNC\n",
08bd3641
KM
27" movd (sp)+,r0\n\
28 cvtdl r0,r0\n" },
b3e05d18 29
1e4dba2b 30 { 1, "_ACTFILE\n",
a83071b9
KM
31" movl (sp)+,r1\n\
32 movl 12(r1),r0\n" },
33
1e4dba2b 34 { 2, "_FCALL\n",
08bd3641
KM
35" movl (sp)+,r5\n\
36 movl (sp),r0\n\
37 movc3 4(r0),__disply+8,(r5)\n\
6b4e6ddb 38 movl (sp)+,r0\n\
9d34bc3a 39 movc3 4(r0),8(r0),__disply+8\n" },
b3e05d18 40
1e4dba2b 41 { 2, "_FRTN\n",
6b4e6ddb 42" movl (sp)+,r0\n\
08bd3641
KM
43 movl (sp)+,r5\n\
44 movc3 4(r0),(r5),__disply+8\n" },
b3e05d18 45
1e4dba2b 46 { 3, "_FSAV\n",
08bd3641
KM
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\
9d34bc3a 53 movl (sp)+,r0\n" },
b3e05d18 54
a83071b9
KM
55/*
56 * Pascal relational comparisons
57 */
1e4dba2b 58 { 3, "_RELEQ\n",
08bd3641
KM
59" movl (sp)+,r0\n\
60 movl (sp)+,r1\n\
61 movl (sp)+,r3\n\
9d34bc3a 62 movl r0,r4\n\
b3e05d18 631:\n\
f703f747
KM
64 movzwl $65535,r0\n\
65 cmpl r4,r0\n\
945bf1d0 66 jleq 3f\n\
f703f747
KM
67 subl2 r0,r4\n\
68 cmpc3 r0,(r1),(r3)\n\
69 jeql 1b\n\
f703f747 702:\n\
945bf1d0 71 clrl r0\n\
f703f747
KM
72 jbr 4f\n\
733:\n\
945bf1d0
KM
74 cmpc3 r4,(r1),(r3)\n\
75 jneq 2b\n\
76 incl r0\n\
f703f747 774:\n" },
b3e05d18 78
1e4dba2b 79 { 3, "_RELNE\n",
08bd3641
KM
80" movl (sp)+,r0\n\
81 movl (sp)+,r1\n\
82 movl (sp)+,r3\n\
9d34bc3a 83 movl r0,r4\n\
b3e05d18 841:\n\
f703f747
KM
85 movzwl $65535,r0\n\
86 cmpl r4,r0\n\
945bf1d0 87 jleq 3f\n\
f703f747
KM
88 subl2 r0,r4\n\
89 cmpc3 r0,(r1),(r3)\n\
90 jeql 1b\n\
f703f747 912:\n\
b3e05d18 92 movl $1,r0\n\
945bf1d0
KM
93 jbr 4f\n\
943:\n\
95 cmpc3 r4,(r1),(r3)\n\
96 jneq 2b\n\
f703f747 974:\n" },
b3e05d18 98
1e4dba2b 99 { 3, "_RELSLT\n",
08bd3641
KM
100" movl (sp)+,r0\n\
101 movl (sp)+,r1\n\
102 movl (sp)+,r3\n\
9d34bc3a 103 movl r0,r4\n\
945bf1d0 104 jbr 2f\n\
b3e05d18 1051:\n\
f703f747
KM
106 subl2 r0,r4\n\
107 cmpc3 r0,(r1),(r3)\n\
945bf1d0 108 jneq 3f\n\
f703f747 1092:\n\
945bf1d0
KM
110 movzwl $65535,r0\n\
111 cmpl r4,r0\n\
112 jgtr 1b\n\
f703f747
KM
113 cmpc3 r4,(r1),(r3)\n\
1143:\n\
115 jlss 4f\n\
116 clrl r0\n\
117 jbr 5f\n\
1184:\n\
b3e05d18 119 movl $1,r0\n\
f703f747 1205:\n" },
b3e05d18 121
1e4dba2b 122 { 3, "_RELSLE\n",
08bd3641
KM
123" movl (sp)+,r0\n\
124 movl (sp)+,r1\n\
125 movl (sp)+,r3\n\
9d34bc3a 126 movl r0,r4\n\
945bf1d0 127 jbr 2f\n\
b3e05d18 1281:\n\
f703f747
KM
129 subl2 r0,r4\n\
130 cmpc3 r0,(r1),(r3)\n\
945bf1d0 131 jneq 3f\n\
f703f747 1322:\n\
945bf1d0
KM
133 movzwl $65535,r0\n\
134 cmpl r4,r0\n\
135 jgtr 1b\n\
f703f747
KM
136 cmpc3 r4,(r1),(r3)\n\
1373:\n\
138 jleq 4f\n\
139 clrl r0\n\
140 jbr 5f\n\
1414:\n\
b3e05d18 142 movl $1,r0\n\
f703f747 1435:\n" },
b3e05d18 144
1e4dba2b 145 { 3, "_RELSGT\n",
08bd3641
KM
146" movl (sp)+,r0\n\
147 movl (sp)+,r1\n\
148 movl (sp)+,r3\n\
9d34bc3a 149 movl r0,r4\n\
945bf1d0 150 jbr 2f\n\
b3e05d18 1511:\n\
f703f747
KM
152 subl2 r0,r4\n\
153 cmpc3 r0,(r1),(r3)\n\
945bf1d0 154 jneq 3f\n\
f703f747 1552:\n\
945bf1d0
KM
156 movzwl $65535,r0\n\
157 cmpl r4,r0\n\
158 jgtr 1b\n\
f703f747
KM
159 cmpc3 r4,(r1),(r3)\n\
1603:\n\
161 jgtr 4f\n\
162 clrl r0\n\
163 jbr 5f\n\
1644:\n\
b3e05d18 165 movl $1,r0\n\
f703f747 1665:\n" },
b3e05d18 167
1e4dba2b 168 { 3, "_RELSGE\n",
08bd3641
KM
169" movl (sp)+,r0\n\
170 movl (sp)+,r1\n\
171 movl (sp)+,r3\n\
9d34bc3a 172 movl r0,r4\n\
945bf1d0 173 jbr 2f\n\
b3e05d18 1741:\n\
f703f747
KM
175 subl2 r0,r4\n\
176 cmpc3 r0,(r1),(r3)\n\
945bf1d0 177 jneq 3f\n\
f703f747 1782:\n\
945bf1d0
KM
179 movzwl $65535,r0\n\
180 cmpl r4,r0\n\
181 jgtr 1b\n\
f703f747
KM
182 cmpc3 r4,(r1),(r3)\n\
1833:\n\
184 jgeq 4f\n\
185 clrl r0\n\
186 jbr 5f\n\
1874:\n\
b3e05d18 188 movl $1,r0\n\
f703f747 1895:\n" },
b3e05d18 190
a83071b9
KM
191/*
192 * Pascal set operations.
193 */
1e4dba2b 194 { 4, "_ADDT\n",
08bd3641
KM
195" movl (sp)+,r0\n\
196 movl (sp)+,r1\n\
197 movl (sp)+,r2\n\
198 movl (sp)+,r4\n\
b3e05d18 199 movl r0,r3\n\
b3e05d18
KM
2001:\n\
201 bisl3 (r1)+,(r2)+,(r3)+\n\
202 sobgtr r4,1b\n" },
203
1e4dba2b 204 { 4, "_SUBT\n",
08bd3641
KM
205" movl (sp)+,r0\n\
206 movl (sp)+,r1\n\
207 movl (sp)+,r2\n\
208 movl (sp)+,r4\n\
b3e05d18 209 movl r0,r3\n\
b3e05d18
KM
2101:\n\
211 bicl3 (r2)+,(r1)+,(r3)+\n\
212 sobgtr r4,1b\n" },
213
1e4dba2b 214 { 4, "_MULT\n",
08bd3641
KM
215" movl (sp)+,r0\n\
216 movl (sp)+,r1\n\
217 movl (sp)+,r2\n\
218 movl (sp)+,r4\n\
b3e05d18 219 movl r0,r3\n\
b3e05d18
KM
2201:\n\
221 mcoml (r1)+,r5\n\
222 bicl3 r5,(r2)+,(r3)+\n\
223 sobgtr r4,1b\n" },
224
1e4dba2b 225 { 4, "_IN\n",
08bd3641
KM
226" movl (sp)+,r1\n\
227 movl (sp)+,r2\n\
228 movl (sp)+,r3\n\
229 movl (sp)+,r4\n\
0d53952d 230 clrl r0\n\
945bf1d0
KM
231 subl2 r2,r1\n\
232 cmpl r1,r3\n\
f703f747 233 jgtru 1f\n\
945bf1d0
KM
234 jbc r1,(r4),1f\n\
235 incl r0\n\
a83071b9
KM
2361:\n" },
237
238/*
239 * Pascal runtime checks
240 */
1e4dba2b 241 { 1, "_ASRT\n",
08bd3641
KM
242" movl (sp)+,r0\n\
243 tstl r0\n\
a83071b9
KM
244 jneq 1f\n\
245 pushl $0\n\
246 pushl $_EASRT\n\
247 calls $2,_ERROR\n\
2481:\n" },
249
1e4dba2b 250 { 2, "_ASRTS\n",
08bd3641
KM
251" movl (sp)+,r0\n\
252 movl (sp)+,r1\n\
a83071b9
KM
253 tstl r0\n\
254 jneq 1f\n\
255 pushl r1\n\
256 pushl $_EASRTS\n\
257 calls $2,_ERROR\n\
2581:\n" },
259
1e4dba2b 260 { 1, "_CHR\n",
a83071b9
KM
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\
2671:\n" },
268
1e4dba2b 269 { 0, "_LINO\n",
a83071b9
KM
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\
2761:\n" },
277
1e4dba2b 278 { 1, "_NIL\n",
a83071b9
KM
279" movl (sp)+,r0\n\
280 cmpl r0,__maxptr\n\
281 jgtr 1f\n\
282 cmpl r0,__minptr\n\
283 jgeq 2f\n\
2841:\n\
285 pushl $0\n\
286 pushl $_ENIL\n\
287 calls $2,_ERROR\n\
2882:\n" },
289
1e4dba2b 290 { 2, "_RANDOM\n",
08bd3641 291" movd (sp)+,r0\n\
a83071b9
KM
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
1e4dba2b 298 { 3, "_RANG4\n",
08bd3641
KM
299" movl (sp)+,r0\n\
300 movl (sp)+,r1\n\
301 movl (sp)+,r2\n\
a83071b9
KM
302 cmpl r0,r1\n\
303 jlss 1f\n\
304 cmpl r0,r2\n\
305 jleq 2f\n\
3061:\n\
307 pushl r0\n\
308 pushl $_ERANG\n\
309 calls $2,_ERROR\n\
3102:\n" },
311
1e4dba2b 312 { 2, "_RSNG4\n",
08bd3641
KM
313" movl (sp)+,r0\n\
314 movl (sp)+,r1\n\
a83071b9
KM
315 cmpl r0,r1\n\
316 jlequ 1f\n\
317 pushl r0\n\
318 pushl $_ERANG\n\
319 calls $2,_ERROR\n\
3201:\n" },
321
1e4dba2b 322 { 1, "_SEED\n",
08bd3641
KM
323" movl (sp)+,r1\n\
324 movl __seed,r0\n\
325 movl r1,__seed\n" },
a83071b9 326
1e4dba2b 327 { 3, "_SUBSC\n",
08bd3641
KM
328" movl (sp)+,r0\n\
329 movl (sp)+,r1\n\
330 movl (sp)+,r2\n\
a83071b9
KM
331 cmpl r0,r1\n\
332 jlss 1f\n\
333 cmpl r0,r2\n\
334 jleq 2f\n\
3351:\n\
336 pushl r0\n\
337 pushl $_ESUBSC\n\
338 calls $2,_ERROR\n\
3392:\n" },
340
1e4dba2b 341 { 2, "_SUBSCZ\n",
08bd3641
KM
342" movl (sp)+,r0\n\
343 movl (sp)+,r1\n\
a83071b9
KM
344 cmpl r0,r1\n\
345 jlequ 1f\n\
346 pushl r0\n\
347 pushl $_ESUBSC\n\
348 calls $2,_ERROR\n\
3491:\n" },
af054913
KM
350#endif vax
351
352#ifdef mc68000
f83c4f18
KM
353/*
354 * General Pascal library routines
355 */
1e4dba2b 356 { 1, "_ACTFILE\n",
aa2758a3 357" movl sp@+,a0\n\
f83c4f18
KM
358 movl a0@(12),d0\n" },
359
1e4dba2b 360 { 4, "_ADDT\n",
aa2758a3
KM
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\
f83c4f18
KM
368 subql #1,d1\n\
3691:\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\
aa2758a3 375 movl sp@+,d0\n" },
f83c4f18 376
1e4dba2b 377 { 4, "_SUBT\n",
aa2758a3
KM
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\
f83c4f18
KM
385 subql #1,d1\n\
3861:\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\
aa2758a3 393 movl sp@+,d0\n" },
f83c4f18 394
1e4dba2b 395 { 4, "_MULT\n",
aa2758a3
KM
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\
f83c4f18
KM
403 subql #1,d1\n\
4041:\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\
aa2758a3 410 movl sp@+,d0\n" },
f83c4f18 411
1e4dba2b 412 { 4, "_IN\n",
aa2758a3
KM
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\
a2793457 419 jhi 1f\n\
aa2758a3
KM
420 movl d0,d1\n\
421 lsrl #3,d1\n\
422 btst d0,a1@(0,d1:l)\n\
a2793457 423 jeq 1f\n\
f83c4f18 424 moveq #1,d0\n\
a2793457 425 jra 2f\n\
f83c4f18
KM
4261:\n\
427 moveq #0,d0\n\
4282:\n" },
aa2758a3 429
1e4dba2b 430 { 3, "_RANG4\n",
aa2758a3
KM
431" movl sp@+,d0\n\
432 movl sp@+,a0\n\
433 movl sp@+,a1\n\
434 cmpl a0,d0\n\
6dc72518 435 jlt 1f\n\
aa2758a3 436 cmpl a1,d0\n\
6dc72518
PA
437 jle 2f\n\
4381:\n\
439 pea _ERANG\n\
440 jbsr _ERROR\n\
441 addqw #4,sp\n\
4422:\n" },
1e4dba2b 443 { 2, "_RSNG4\n",
aa2758a3
KM
444" movl sp@+,a0\n\
445 movl sp@+,a1\n\
446 cmpl a1,a0\n\
6dc72518
PA
447 jls 1f\n\
448 pea _ERANG\n\
449 jbsr _ERROR\n\
450 addqw #4,sp\n\
4511:\n" },
aa2758a3 452
1e4dba2b 453 { 3, "_SUBSC\n",
aa2758a3
KM
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\
4611:\n\
462 pea _ESUBSC\n\
463 jbsr _ERROR\n\
464 addqw #4,sp\n\
4652:\n" },
466
1e4dba2b 467 { 2, "_SUBSCZ\n",
aa2758a3
KM
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\
4751:\n" },
476
af054913 477#endif mc68000
a83071b9 478
911a6ebb
KM
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)+,r4\n\
498 movl r0,r3\n\
499 clrl r5\n\
5001:\n\
501 orl3 (r1),(r2),(r3)\n\
502 addl2 $4,r1\n\
503 addl2 $4,r2\n\
504 addl2 $4,r3\n\
505 aoblss r4,r5,1b\n" },
506
507 { 4, "_SUBT\n",
508" movl (sp)+,r0\n\
509 movl (sp)+,r1\n\
510 movl (sp)+,r2\n\
511 movl (sp)+,r4\n\
512 movl r0,r3\n\
5131:\n\
514 mcoml (r2),r5\n\
515 andl3 r5,(r1),(r3)\n\
516 addl2 $4,r1\n\
517 addl2 $4,r2\n\
518 addl2 $4,r3\n\
519 decl r4\n\
520 jgtr 1b\n" },
521
522 { 4, "_MULT\n",
523" movl (sp)+,r0\n\
524 movl (sp)+,r1\n\
525 movl (sp)+,r2\n\
526 movl (sp)+,r4\n\
527 movl r0,r3\n\
528 clrl r5\n\
5291:\n\
530 andl3 (r1),(r2),(r3)\n\
531 addl2 $4,r1\n\
532 addl2 $4,r2\n\
533 addl2 $4,r3\n\
534 aoblss r4,r5,1b\n" },
535
ade415e6
KM
536 { 4, "_IN\n",
537" movl (sp)+,r1\n\
538 movl (sp)+,r2\n\
539 movl (sp)+,r3\n\
540 movl (sp)+,r4\n\
541 clrl r0\n\
542 subl2 r2,r1\n\
543 cmpl r1,r3\n\
544 jgtru 1f\n\
545 shrl $3,r1,r2\n\
546 movzbl (r4)[r2],r3\n\
547 andl2 $7,r1\n\
548 jbc r1,r3,1f\n\
549 incl r0\n\
5501:\n" },
551
911a6ebb
KM
552/*
553 * Pascal runtime checks
554 */
555 { 1, "_ASRT\n",
556" movl (sp)+,r0\n\
557 tstl r0\n\
558 jneq 1f\n\
559 pushl $0\n\
560 pushl $_EASRT\n\
561 callf $12,_ERROR\n\
5621:\n" },
563
564 { 2, "_ASRTS\n",
565" movl (sp)+,r0\n\
566 movl (sp)+,r1\n\
567 tstl r0\n\
568 jneq 1f\n\
569 pushl r1\n\
570 pushl $_EASRTS\n\
571 callf $12,_ERROR\n\
5721:\n" },
573
574 { 1, "_CHR\n",
575" movl (sp)+,r0\n\
576 cmpl r0,$127\n\
577 jlequ 1f\n\
578 pushl r0\n\
579 pushl $_ECHR\n\
580 callf $12,_ERROR\n\
5811:\n" },
582
583 { 0, "_LINO\n",
584" incl __stcnt\n\
585 cmpl __stcnt,__stlim\n\
586 jlss 1f\n\
587 pushl __stcnt\n\
588 pushl $_ELINO\n\
589 callf $12,_ERROR\n\
5901:\n" },
591
592 { 1, "_NIL\n",
593" movl (sp)+,r0\n\
594 cmpl r0,__maxptr\n\
595 jgtr 1f\n\
596 cmpl r0,__minptr\n\
597 jgeq 2f\n\
5981:\n\
599 pushl $0\n\
600 pushl $_ENIL\n\
601 callf $12,_ERROR\n\
6022:\n" },
603
604 { 3, "_RANG4\n",
605" movl (sp)+,r0\n\
606 movl (sp)+,r1\n\
607 movl (sp)+,r2\n\
608 cmpl r0,r1\n\
609 jlss 1f\n\
610 cmpl r0,r2\n\
611 jleq 2f\n\
6121:\n\
613 pushl r0\n\
614 pushl $_ERANG\n\
615 callf $12,_ERROR\n\
6162:\n" },
617
618 { 2, "_RSNG4\n",
619" movl (sp)+,r0\n\
620 movl (sp)+,r1\n\
621 cmpl r0,r1\n\
622 jlequ 1f\n\
623 pushl r0\n\
624 pushl $_ERANG\n\
625 callf $12,_ERROR\n\
6261:\n" },
627
628 { 1, "_SEED\n",
629" movl (sp)+,r1\n\
630 movl __seed,r0\n\
631 movl r1,__seed\n" },
632
633 { 3, "_SUBSC\n",
634" movl (sp)+,r0\n\
635 movl (sp)+,r1\n\
636 movl (sp)+,r2\n\
637 cmpl r0,r1\n\
638 jlss 1f\n\
639 cmpl r0,r2\n\
640 jleq 2f\n\
6411:\n\
642 pushl r0\n\
643 pushl $_ESUBSC\n\
644 callf $12,_ERROR\n\
6452:\n" },
646
647 { 2, "_SUBSCZ\n",
648" movl (sp)+,r0\n\
649 movl (sp)+,r1\n\
650 cmpl r0,r1\n\
651 jlequ 1f\n\
652 pushl r0\n\
653 pushl $_ESUBSC\n\
654 callf $12,_ERROR\n\
6551:\n" },
656#endif tahoe
657
1e4dba2b 658 { 0, "", "" }
b3e05d18 659};