usr/src/usr.bin/pascal/pc2/langpats.c

/* Copyright (c) 1979, 1984 Regents of the University of California */

#ifndef lint
static char sccsid[] = "@(#)langpats.c  2.1     (Berkeley)      %G%";
#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
 */
        { "_ACTFILE\n",
"       movl    sp@,a0\n\
        movl    a0@(12),d0\n" },

        { "_ADDT\n",
"       movl    a2,sp@-\n\
        movl    sp@(8),a2\n\
        movl    sp@(12),a1\n\
        movl    sp@(4),a0\n\
        movl    sp@(16),d1\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" },

        { "_SUBT\n",
"       movl    a2,sp@-\n\
        movl    sp@(8),a2\n\
        movl    sp@(12),a1\n\
        movl    sp@(4),a0\n\
        movl    sp@(16),d1\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" },

        { "_MULT\n",
"       movl    a2,sp@-\n\
        movl    sp@(8),a2\n\
        movl    sp@(12),a1\n\
        movl    sp@(4),a0\n\
        movl    sp@(16),d1\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" },

        { "_IN\n",
"       movl    sp@,d1\n\
        subl    sp@(4),d1\n\
        cmpl    sp@(8),d1\n\
        jhi     1f\n\
        movl    sp@(12),a0\n\
        movl    d1,d0\n\
        lsrl    #3,d0\n\
        btst    d1,a0@(0,d0:l)\n\
        jeq     1f\n\
        moveq   #1,d0\n\
        jra     2f\n\
1:\n\
        moveq   #0,d0\n\
2:\n" },
        { "_RANG4\n",
"       movl    sp@,d0\n\
        cmpl    sp@(4),d0\n\
        jlt     1f\n\
        cmpl    sp@(8),d0\n\
        jle     2f\n\
1:\n\
        pea     _ERANG\n\
        jbsr    _ERROR\n\
        addqw   #4,sp\n\
2:\n" },
        { "_RSNG4\n",
"       movl    sp@,d0\n\
        cmpl    sp@(4),d0\n\
        jls     1f\n\
        pea     _ERANG\n\
        jbsr    _ERROR\n\
        addqw   #4,sp\n\
1:\n" },
#endif mc68000

        { "", "" }
};