langpats.c

早期freebsd实现

/*-
 * Copyright (c) 1979, 1984, 1993
 *	The Regents of the University of California.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgement:
 *	This product includes software developed by the University of
 *	California, Berkeley and its contributors.
 * 4. Neither the name of the University nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

#ifndef lint
static char sccsid[] = "@(#)langpats.c	8.1 (Berkeley) 6/6/93";
#endif /* not lint */

#include "inline.h"

/*
 * Pattern table for Pascal library routines.
 */
struct pats language_ptab[] = {

#ifdef vax
/*
 * General Pascal library routines
 */
	{ 2, "_ROUND\n",
"	movd	(sp)+,r0\n\
	cvtrdl	r0,r0\n" },

	{ 2, "_TRUNC\n",
"	movd	(sp)+,r0\n\
	cvtdl	r0,r0\n" },

	{ 1, "_ACTFILE\n",
"	movl	(sp)+,r1\n\
	movl	12(r1),r0\n" },

	{ 2, "_FCALL\n",
"	movl	(sp)+,r5\n\
	movl	(sp),r0\n\
	movc3	4(r0),__disply+8,(r5)\n\
	movl	(sp)+,r0\n\
	movc3	4(r0),8(r0),__disply+8\n" },

	{ 2, "_FRTN\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r5\n\
	movc3	4(r0),(r5),__disply+8\n" },

	{ 3, "_FSAV\n",
"	movl	(sp)+,r3\n\
	movl	(sp)+,r4\n\
	movl	(sp),r5\n\
	movl	r3,(r5)\n\
	ashl	$3,r4,4(r5)\n\
	movc3	4(r5),__disply+8,8(r5)\n\
	movl	(sp)+,r0\n" },

/*
 * Pascal relational comparisons
 */
	{ 3, "_RELEQ\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
1:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jleq	3f\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jeql	1b\n\
2:\n\
	clrl	r0\n\
	jbr	4f\n\
3:\n\
	cmpc3	r4,(r1),(r3)\n\
	jneq	2b\n\
	incl	r0\n\
4:\n" },

	{ 3, "_RELNE\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
1:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jleq	3f\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jeql	1b\n\
2:\n\
	movl	$1,r0\n\
	jbr	4f\n\
3:\n\
	cmpc3	r4,(r1),(r3)\n\
	jneq	2b\n\
4:\n" },

	{ 3, "_RELSLT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
	jbr	2f\n\
1:\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jneq	3f\n\
2:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jgtr	1b\n\
	cmpc3	r4,(r1),(r3)\n\
3:\n\
	jlss	4f\n\
	clrl	r0\n\
	jbr	5f\n\
4:\n\
	movl	$1,r0\n\
5:\n" },

	{ 3, "_RELSLE\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
	jbr	2f\n\
1:\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jneq	3f\n\
2:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jgtr	1b\n\
	cmpc3	r4,(r1),(r3)\n\
3:\n\
	jleq	4f\n\
	clrl	r0\n\
	jbr	5f\n\
4:\n\
	movl	$1,r0\n\
5:\n" },

	{ 3, "_RELSGT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
	jbr	2f\n\
1:\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jneq	3f\n\
2:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jgtr	1b\n\
	cmpc3	r4,(r1),(r3)\n\
3:\n\
	jgtr	4f\n\
	clrl	r0\n\
	jbr	5f\n\
4:\n\
	movl	$1,r0\n\
5:\n" },

	{ 3, "_RELSGE\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r3\n\
	movl	r0,r4\n\
	jbr	2f\n\
1:\n\
	subl2	r0,r4\n\
	cmpc3	r0,(r1),(r3)\n\
	jneq	3f\n\
2:\n\
	movzwl	$65535,r0\n\
	cmpl	r4,r0\n\
	jgtr	1b\n\
	cmpc3	r4,(r1),(r3)\n\
3:\n\
	jgeq	4f\n\
	clrl	r0\n\
	jbr	5f\n\
4:\n\
	movl	$1,r0\n\
5:\n" },

/*
 * Pascal set operations.
 */
	{ 4, "_ADDT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r4\n\
	movl	r0,r3\n\
1:\n\
	bisl3	(r1)+,(r2)+,(r3)+\n\
	sobgtr	r4,1b\n" },

	{ 4, "_SUBT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r4\n\
	movl	r0,r3\n\
1:\n\
	bicl3	(r2)+,(r1)+,(r3)+\n\
	sobgtr	r4,1b\n" },

	{ 4, "_MULT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r4\n\
	movl	r0,r3\n\
1:\n\
	mcoml	(r1)+,r5\n\
	bicl3	r5,(r2)+,(r3)+\n\
	sobgtr	r4,1b\n" },

	{ 4, "_IN\n",
"	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r3\n\
	movl	(sp)+,r4\n\
	clrl	r0\n\
	subl2	r2,r1\n\
	cmpl	r1,r3\n\
	jgtru	1f\n\
	jbc	r1,(r4),1f\n\
	incl	r0\n\
1:\n" },

/*
 * Pascal runtime checks
 */
	{ 1, "_ASRT\n",
"	movl	(sp)+,r0\n\
	tstl	r0\n\
	jneq	1f\n\
	pushl	$0\n\
	pushl	$_EASRT\n\
	calls	$2,_ERROR\n\
1:\n" },

	{ 2, "_ASRTS\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	tstl	r0\n\
	jneq	1f\n\
	pushl	r1\n\
	pushl	$_EASRTS\n\
	calls	$2,_ERROR\n\
1:\n" },

	{ 1, "_CHR\n",
"	movl	(sp)+,r0\n\
	cmpl	r0,$127\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ECHR\n\
	calls	$2,_ERROR\n\
1:\n" },

	{ 0, "_LINO\n",
"	incl	__stcnt\n\
	cmpl	__stcnt,__stlim\n\
	jlss	1f\n\
	pushl	__stcnt\n\
	pushl	$_ELINO\n\
	calls	$2,_ERROR\n\
1:\n" },

	{ 1, "_NIL\n",
"	movl	(sp)+,r0\n\
	cmpl	r0,__maxptr\n\
	jgtr	1f\n\
	cmpl	r0,__minptr\n\
	jgeq	2f\n\
1:\n\
	pushl	$0\n\
	pushl	$_ENIL\n\
	calls	$2,_ERROR\n\
2:\n" },

	{ 2, "_RANDOM\n",
"	movd	(sp)+,r0\n\
	emul	__seed,$1103515245,$0,r0\n\
	ediv	$0x7fffffff,r0,r1,r0\n\
	movl	r0,__seed\n\
	cvtld	r0,r0\n\
	divd2	$0d2.147483647e+09,r0\n" },

	{ 3, "_RANG4\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	cmpl	r0,r1\n\
	jlss	1f\n\
	cmpl	r0,r2\n\
	jleq	2f\n\
1:\n\
	pushl	r0\n\
	pushl	$_ERANG\n\
	calls	$2,_ERROR\n\
2:\n" },

	{ 2, "_RSNG4\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	cmpl	r0,r1\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ERANG\n\
	calls	$2,_ERROR\n\
1:\n" },

	{ 1, "_SEED\n",
"	movl	(sp)+,r1\n\
	movl	__seed,r0\n\
	movl	r1,__seed\n" },

	{ 3, "_SUBSC\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	cmpl	r0,r1\n\
	jlss	1f\n\
	cmpl	r0,r2\n\
	jleq	2f\n\
1:\n\
	pushl	r0\n\
	pushl	$_ESUBSC\n\
	calls	$2,_ERROR\n\
2:\n" },

	{ 2, "_SUBSCZ\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	cmpl	r0,r1\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ESUBSC\n\
	calls	$2,_ERROR\n\
1:\n" },
#endif vax

#ifdef mc68000
/*
 * General Pascal library routines
 */
	{ 1, "_ACTFILE\n",
"	movl	sp@+,a0\n\
	movl	a0@(12),d0\n" },

	{ 4, "_ADDT\n",
"	movl	sp@+,a0\n\
	movl	sp@+,d0\n\
	movl	sp@+,a1\n\
	movl	sp@+,d1\n\
	movl	a0,sp@-\n\
	movl	a2,sp@-\n\
	movl	d0,a2\n\
	subql	#1,d1\n\
1:\n\
	movl	a2@+,d0\n\
	orl	a1@+,d0\n\
	movl	d0,a0@+\n\
	dbra	d1,1b\n\
	movl	sp@+,a2\n\
	movl	sp@+,d0\n" },

	{ 4, "_SUBT\n",
"	movl	sp@+,a0\n\
	movl	sp@+,d0\n\
	movl	sp@+,a1\n\
	movl	sp@+,d1\n\
	movl	a0,sp@-\n\
	movl	a2,sp@-\n\
	movl	d0,a2\n\
	subql	#1,d1\n\
1:\n\
	movl	a1@+,d0\n\
	notl	d0\n\
	andl	a2@+,d0\n\
	movl	d0,a0@+\n\
	dbra	d1,1b\n\
	movl	sp@+,a2\n\
	movl	sp@+,d0\n" },

	{ 4, "_MULT\n",
"	movl	sp@+,a0\n\
	movl	sp@+,d0\n\
	movl	sp@+,a1\n\
	movl	sp@+,d1\n\
	movl	a0,sp@-\n\
	movl	a2,sp@-\n\
	movl	d0,a2\n\
	subql	#1,d1\n\
1:\n\
	movl	a2@+,d0\n\
	andl	a1@+,d0\n\
	movl	d0,a0@+\n\
	dbra	d1,1b\n\
	movl	sp@+,a2\n\
	movl	sp@+,d0\n" },

	{ 4, "_IN\n",
"	movl	sp@+,d0\n\
	movl	sp@+,a0\n\
	movl	sp@+,d1\n\
	movl	sp@+,a1\n\
	subl	a0,d0\n\
	cmpl	d1,d0\n\
	jhi	1f\n\
	movl	d0,d1\n\
	lsrl	#3,d1\n\
	btst	d0,a1@(0,d1:l)\n\
	jeq	1f\n\
	moveq	#1,d0\n\
	jra	2f\n\
1:\n\
	moveq	#0,d0\n\
2:\n" },

	{ 3, "_RANG4\n",
"	movl	sp@+,d0\n\
	movl	sp@+,a0\n\
	movl	sp@+,a1\n\
	cmpl	a0,d0\n\
	jlt	1f\n\
	cmpl	a1,d0\n\
	jle	2f\n\
1:\n\
	pea	_ERANG\n\
	jbsr	_ERROR\n\
	addqw	#4,sp\n\
2:\n" },
	{ 2, "_RSNG4\n",
"	movl	sp@+,a0\n\
	movl	sp@+,a1\n\
	cmpl	a1,a0\n\
	jls	1f\n\
	pea	_ERANG\n\
	jbsr	_ERROR\n\
	addqw	#4,sp\n\
1:\n" },

	{ 3, "_SUBSC\n",
"	movl	sp@+,d0\n\
	movl	sp@+,a0\n\
	movl	sp@+,a1\n\
	cmpl	a0,d0\n\
	jlt	1f\n\
	cmpl	a1,d0\n\
	jle	2f\n\
1:\n\
	pea	_ESUBSC\n\
	jbsr	_ERROR\n\
	addqw	#4,sp\n\
2:\n" },

	{ 2, "_SUBSCZ\n",
"	movl	sp@+,a0\n\
	movl	sp@+,a1\n\
	cmpl	a1,a0\n\
	jls	1f\n\
	pea	_ESUBSC\n\
	jbsr	_ERROR\n\
	addqw	#4,sp\n\
1:\n" },

#endif mc68000

#ifdef tahoe
	{ 2, "_TRUNC\n",
"	ldd	(sp)\n\
	movab	8(sp),sp\n\
	cvdl	r0\n" },

	{ 1, "_ACTFILE\n",
"	movl	(sp)+,r1\n\
	movl	12(r1),r0\n" },

/*
 * Pascal set operations.
 */

	{ 4, "_ADDT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r3\n\
	clrl	r4\n\
1:\n\
	orl3	(r1)[r4],(r2)[r4],(r0)[r4]\n\
	aoblss	r3,r4,1b\n" },

	{ 4, "_SUBT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r3\n\
	decl	r3\n\
1:\n\
	mcoml	(r2)[r3],r4\n\
	andl3	r4,(r1)[r3],(r0)[r3]\n\
	decl	r3\n\
	jgeq	1b\n" },

	{ 4, "_MULT\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r3\n\
	clrl	r4\n\
1:\n\
	andl3	(r1)[r4],(r2)[r4],(r0)[r4]\n\
	aoblss	r3,r4,1b\n" },

	{ 4, "_IN\n",
"	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	movl	(sp)+,r3\n\
	movl	(sp)+,r4\n\
	clrl	r0\n\
	subl2	r2,r1\n\
	cmpl	r1,r3\n\
	jgtru	1f\n\
	shrl	$3,r1,r2\n\
	movzbl	(r4)[r2],r3\n\
	andl2	$7,r1\n\
	jbc	r1,r3,1f\n\
	incl	r0\n\
1:\n" },

/*
 * Pascal runtime checks
 */
	{ 1, "_ASRT\n",
"	movl	(sp)+,r0\n\
	tstl	r0\n\
	jneq	1f\n\
	pushl	$0\n\
	pushl	$_EASRT\n\
	callf	$12,_ERROR\n\
1:\n" },

	{ 2, "_ASRTS\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	tstl	r0\n\
	jneq	1f\n\
	pushl	r1\n\
	pushl	$_EASRTS\n\
	callf	$12,_ERROR\n\
1:\n" },

	{ 1, "_CHR\n",
"	movl	(sp)+,r0\n\
	cmpl	r0,$127\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ECHR\n\
	callf	$12,_ERROR\n\
1:\n" },

	{ 0, "_LINO\n",
"	incl	__stcnt\n\
	cmpl	__stcnt,__stlim\n\
	jlss	1f\n\
	pushl	__stcnt\n\
	pushl	$_ELINO\n\
	callf	$12,_ERROR\n\
1:\n" },

	{ 1, "_NIL\n",
"	movl	(sp)+,r0\n\
	cmpl	r0,__maxptr\n\
	jgtr	1f\n\
	cmpl	r0,__minptr\n\
	jgeq	2f\n\
1:\n\
	pushl	$0\n\
	pushl	$_ENIL\n\
	callf	$12,_ERROR\n\
2:\n" },

	{ 3, "_RANG4\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	cmpl	r0,r1\n\
	jlss	1f\n\
	cmpl	r0,r2\n\
	jleq	2f\n\
1:\n\
	pushl	r0\n\
	pushl	$_ERANG\n\
	callf	$12,_ERROR\n\
2:\n" },

	{ 2, "_RSNG4\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	cmpl	r0,r1\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ERANG\n\
	callf	$12,_ERROR\n\
1:\n" },

	{ 1, "_SEED\n",
"	movl	(sp)+,r1\n\
	movl	__seed,r0\n\
	movl	r1,__seed\n" },

	{ 3, "_SUBSC\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	movl	(sp)+,r2\n\
	cmpl	r0,r1\n\
	jlss	1f\n\
	cmpl	r0,r2\n\
	jleq	2f\n\
1:\n\
	pushl	r0\n\
	pushl	$_ESUBSC\n\
	callf	$12,_ERROR\n\
2:\n" },

	{ 2, "_SUBSCZ\n",
"	movl	(sp)+,r0\n\
	movl	(sp)+,r1\n\
	cmpl	r0,r1\n\
	jlequ	1f\n\
	pushl	r0\n\
	pushl	$_ESUBSC\n\
	callf	$12,_ERROR\n\
1:\n" },
#endif tahoe

	{ 0, "", "" }
};