BSD 4_3 release

[unix-history] / usr / src / ucb / pascal / utilities / pc2 / langpats.c

/*
* Copyright (c) 1979, 1984 Regents of the University of California 
* All rights reserved.  The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
*/

#ifndef lint
static char sccsid[] = "@(#)langpats.c  5.2 (Berkeley) 8/22/85";
#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

       { 0, "", "" }
};