added PDX constant

[unix-history] / usr / src / usr.bin / pascal / px / interp.c

diff --git a/usr/src/usr.bin/pascal/px/interp.c b/usr/src/usr.bin/pascal/px/interp.c
index 76932f0..8a24aba 100644 (file)
--- a/usr/src/usr.bin/pascal/px/interp.c
+++ b/usr/src/usr.bin/pascal/px/interp.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)interp.c 1.10 %G%";
+static char sccsid[] = "@(#)interp.c 1.17 %G%";

 
 #include <math.h>
 #include "whoami.h"
 
 #include <math.h>
 #include "whoami.h"


@@ -9,7 +9,6 @@ static char sccsid[] = "@(#)interp.c 1.10 %G%";
 #include "panics.h"
 #include "h02opcs.h"
 #include "machdep.h"
 #include "panics.h"
 #include "h02opcs.h"
 #include "machdep.h"

-#include "h01errs.h"

 #include "libpc.h"
 
 /*
 #include "libpc.h"
 
 /*


@@ -91,6 +90,13 @@ struct iorec *_actfile[MAXFILES] = {
        ERR
 };
 
        ERR
 };
 

+/*
+ * stuff for pdx
+ */
+
+union progcntr *pcaddrp;
+asm(".globl _loopaddr");
+

 /*
  * Px profile array
  */
 /*
  * Px profile array
  */


@@ -129,6 +135,8 @@ interpreter(base)
        union progcntr tpc;
        struct iorec **ip;
 
        union progcntr tpc;
        struct iorec **ip;
 

+       pcaddrp = &pc;
+

        /*
         * Setup sets up any hardware specific parameters before
         * starting the interpreter. Typically this is inline replaced
        /*
         * Setup sets up any hardware specific parameters before
         * starting the interpreter. Typically this is inline replaced


@@ -151,6 +159,8 @@ interpreter(base)
        stp = (struct stack *)pushsp((long)(sizeof(struct stack)));
        _dp = &_display.frame[0];
        pc.cp = base;
        stp = (struct stack *)pushsp((long)(sizeof(struct stack)));
        _dp = &_display.frame[0];
        pc.cp = base;

+
+       asm("_loopaddr:");

        for(;;) {
 #              ifdef DEBUG
                if (++opcptr == 10)
        for(;;) {
 #              ifdef DEBUG
                if (++opcptr == 10)


@@ -161,6 +171,10 @@ interpreter(base)
                _profcnts[*pc.ucp]++;
 #              endif PROFILE
                switch (*pc.ucp++) {
                _profcnts[*pc.ucp]++;
 #              endif PROFILE
                switch (*pc.ucp++) {

+               case O_BPT:                     /* breakpoint trap */
+                       asm(".byte 0");
+                       pc.ucp--;
+                       continue;

                case O_NODUMP:
                        _nodump = TRUE;
                        /* and fall through */
                case O_NODUMP:
                        _nodump = TRUE;
                        /* and fall through */


@@ -217,32 +231,20 @@ interpreter(base)
                        pc.cp = tcp;
                        continue;
                case O_FCALL:
                        pc.cp = tcp;
                        continue;
                case O_FCALL:

-                       tl = *pc.cp++;          /* tl = number of args */
-                       if (tl == 0)
-                               tl = *pc.lp++;
+                       pc.cp++;
+                       tcp = popaddr(); /* ptr to display save area */

                        tfp = (struct formalrtn *)popaddr();
                        stp = (struct stack *)
                                pushsp((long)(sizeof(struct stack)));
                        stp->lino = _lino;      /* save lino, pc, dp */
                        stp->pc.cp = pc.cp;
                        stp->dp = _dp;
                        tfp = (struct formalrtn *)popaddr();
                        stp = (struct stack *)
                                pushsp((long)(sizeof(struct stack)));
                        stp->lino = _lino;      /* save lino, pc, dp */
                        stp->pc.cp = pc.cp;
                        stp->dp = _dp;

-                       pc.cp = tfp->entryaddr; /* calc new entry point */
-                       if (_runtst) {
-                               tpc.sp = pc.sp + 1;
-                               tl -= tpc.hdrp->nargs;
-                               if (tl != 0) {
-                                       if (tl > 0)
-                                               tl += sizeof(int) - 1;
-                                       else
-                                               tl -= sizeof(int) - 1;
-                                       ERROR(ENARGS, tl / sizeof(int));
-                               }
-                       }
-                       _dp = &_display.frame[tfp->cbn];/* new display ptr */
-                       blkcpy(tfp->cbn * sizeof(struct disp),
-                               &_display.frame[1], &tfp->disp[tfp->cbn]);
-                       blkcpy(tfp->cbn * sizeof(struct disp),
-                               &tfp->disp[0], &_display.frame[1]);
+                       pc.cp = tfp->fentryaddr;/* calc new entry point */
+                       _dp = &_display.frame[tfp->fbn];/* new display ptr */
+                       blkcpy(tfp->fbn * sizeof(struct disp),
+                               &_display.frame[1], tcp);
+                       blkcpy(tfp->fbn * sizeof(struct disp),
+                               &tfp->fdisp[0], &_display.frame[1]);

                        continue;
                case O_FRTN:
                        tl = *pc.cp++;          /* tl = size of return obj */
                        continue;
                case O_FRTN:
                        tl = *pc.cp++;          /* tl = size of return obj */


@@ -250,19 +252,25 @@ interpreter(base)
                                tl = *pc.usp++;
                        tcp = pushsp((long)(0));
                        tfp = *(struct formalrtn **)(tcp + tl);
                                tl = *pc.usp++;
                        tcp = pushsp((long)(0));
                        tfp = *(struct formalrtn **)(tcp + tl);

-                       blkcpy(tl, tcp, tcp + sizeof(struct formalrtn *));
-                       popsp((long)(sizeof(struct formalrtn *)));
-                       blkcpy(tfp->cbn * sizeof(struct disp),
-                               &tfp->disp[tfp->cbn], &_display.frame[1]);
+                       tcp1 = *(char **)
+                           (tcp + tl + sizeof(struct formalrtn *));
+                       if (tl != 0) {
+                               blkcpy(tl, tcp, tcp + sizeof(struct formalrtn *)
+                                   + sizeof(char *));
+                       }
+                       popsp((long)
+                           (sizeof(struct formalrtn *) + sizeof (char *)));
+                       blkcpy(tfp->fbn * sizeof(struct disp),
+                           tcp1, &_display.frame[1]);

                        continue;
                case O_FSAV:
                        tfp = (struct formalrtn *)popaddr();
                        continue;
                case O_FSAV:
                        tfp = (struct formalrtn *)popaddr();

-                       tfp->cbn = *pc.cp++;    /* blk number of routine */
-                       tcp = base + *pc.lp++;/* calc new entry point */
+                       tfp->fbn = *pc.cp++;    /* blk number of routine */
+                       tcp = base + *pc.lp++;  /* calc new entry point */

                        tcp += sizeof(short);
                        tcp += sizeof(short);

-                       tfp->entryaddr = base + *(long *)tcp;
-                       blkcpy(tfp->cbn * sizeof(struct disp),
-                               &_display.frame[1], &tfp->disp[0]);
+                       tfp->fentryaddr = base + *(long *)tcp;
+                       blkcpy(tfp->fbn * sizeof(struct disp),
+                               &_display.frame[1], &tfp->fdisp[0]);

                        pushaddr(tfp);
                        continue;
                case O_SDUP2:
                        pushaddr(tfp);
                        continue;
                case O_SDUP2:


@@ -292,7 +300,7 @@ interpreter(base)
                        stp = _dp->stp;
                        while (tstp != stp) {
                                if (_dp == &_display.frame[1])
                        stp = _dp->stp;
                        while (tstp != stp) {
                                if (_dp == &_display.frame[1])

-                                       ERROR(EGOTO); /* exiting prog ??? */
+                                       ERROR("Active frame not found in non-local goto\n", 0); /* exiting prog ??? */

                                PCLOSE(_dp->locvars); /* close local files */
                                curfile = stp->file;  /* restore active file */
                                *_dp = stp->odisp;    /* old display entry */
                                PCLOSE(_dp->locvars); /* close local files */
                                curfile = stp->file;  /* restore active file */
                                *_dp = stp->odisp;    /* old display entry */


@@ -993,14 +1001,14 @@ interpreter(base)
                        if (tl == 0)
                                tl = *pc.sp++;
                        tl1 = pop2();
                        if (tl == 0)
                                tl = *pc.sp++;
                        tl1 = pop2();

-                       push2((short)(RANG4(tl1, tl, *pc.sp++)));
+                       push2((short)(RANG4(tl1, tl, (long)(*pc.sp++))));

                        continue;
                case O_RANG42:
                        tl = *pc.cp++;
                        if (tl == 0)
                                tl = *pc.sp++;
                        tl1 = pop4();
                        continue;
                case O_RANG42:
                        tl = *pc.cp++;
                        if (tl == 0)
                                tl = *pc.sp++;
                        tl1 = pop4();

-                       push4(RANG4(tl1, tl, *pc.sp++));
+                       push4(RANG4(tl1, tl, (long)(*pc.sp++)));

                        continue;
                case O_RSNG2:
                        tl = *pc.cp++;
                        continue;
                case O_RSNG2:
                        tl = *pc.cp++;


@@ -1017,26 +1025,32 @@ interpreter(base)
                        push4(RSNG4(tl1, tl));
                        continue;
                case O_RANG4:
                        push4(RSNG4(tl1, tl));
                        continue;
                case O_RANG4:

-                       pc.cp++;
-                       tl = *pc.lp++;
+                       tl = *pc.cp++;
+                       if (tl == 0)
+                               tl = *pc.lp++;

                        tl1 = pop4();
                        push4(RANG4(tl1, tl, *pc.lp++));
                        continue;
                case O_RANG24:
                        tl1 = pop4();
                        push4(RANG4(tl1, tl, *pc.lp++));
                        continue;
                case O_RANG24:

-                       pc.cp++;
-                       tl = *pc.lp++;
+                       tl = *pc.cp++;
+                       if (tl == 0)
+                               tl = *pc.lp++;

                        tl1 = pop2();
                        push2((short)(RANG4(tl1, tl, *pc.lp++)));
                        continue;
                case O_RSNG4:
                        tl1 = pop2();
                        push2((short)(RANG4(tl1, tl, *pc.lp++)));
                        continue;
                case O_RSNG4:

-                       pc.cp++;
-                       tl = pop4();
-                       push4(RSNG4(tl, *pc.lp++));
+                       tl = *pc.cp++;
+                       if (tl == 0)
+                               tl = *pc.lp++;
+                       tl1 = pop4();
+                       push4(RSNG4(tl1, tl));

                        continue;
                case O_RSNG24:
                        continue;
                case O_RSNG24:

-                       pc.cp++;
-                       tl = pop2();
-                       push2((short)(RSNG4(tl, *pc.lp++)));
+                       tl = *pc.cp++;
+                       if (tl == 0)
+                               tl = *pc.lp++;
+                       tl1 = pop2();
+                       push2((short)(RSNG4(tl1, tl)));

                        continue;
                case O_STLIM:
                        pc.cp++;
                        continue;
                case O_STLIM:
                        pc.cp++;


@@ -1076,7 +1090,7 @@ interpreter(base)
                                if (tl1 == *tcp++)
                                        break;
                        if (tl == 0)            /* default case => error */
                                if (tl1 == *tcp++)
                                        break;
                        if (tl == 0)            /* default case => error */

-                               ERROR(ECASE, tl1);
+                               ERROR("Label of %D not found in case\n", tl1);

                        pc.cp += *(tsp - tl);
                        continue;
                case O_CASE2OP:
                        pc.cp += *(tsp - tl);
                        continue;
                case O_CASE2OP:


@@ -1090,7 +1104,7 @@ interpreter(base)
                                if (tl1 == *tsp1++)
                                        break;
                        if (tl == 0)            /* default case => error */
                                if (tl1 == *tsp1++)
                                        break;
                        if (tl == 0)            /* default case => error */

-                               ERROR(ECASE, tl1);
+                               ERROR("Label of %D not found in case\n", tl1);

                        pc.cp += *(tsp - tl);
                        continue;
                case O_CASE4OP:
                        pc.cp += *(tsp - tl);
                        continue;
                case O_CASE4OP:


@@ -1104,7 +1118,7 @@ interpreter(base)
                                if (tl1 == *tlp++)
                                        break;
                        if (tl == 0)            /* default case => error */
                                if (tl1 == *tlp++)
                                        break;
                        if (tl == 0)            /* default case => error */

-                               ERROR(ECASE, tl1);
+                               ERROR("Label of %D not found in case\n", tl1);

                        pc.cp += *(tsp - tl);
                        continue;
                case O_ADDT:
                        pc.cp += *(tsp - tl);
                        continue;
                case O_ADDT:


@@ -1163,7 +1177,7 @@ interpreter(base)
                                tl = *pc.usp++;
                        tl1 = pop4();           /* tl1 is the element */
                        tcp = pushsp((long)(0));/* tcp pts to set */
                                tl = *pc.usp++;
                        tl1 = pop4();           /* tl1 is the element */
                        tcp = pushsp((long)(0));/* tcp pts to set */

-                       tl2 = *pc.usp++;        /* lower bound */
+                       tl2 = *pc.sp++; /* lower bound */

                        tb = IN(tl1, tl2, (long)(*pc.usp++), tcp);
                        popsp(tl);
                        push2((short)(tb));
                        tb = IN(tl1, tl2, (long)(*pc.usp++), tcp);
                        popsp(tl);
                        push2((short)(tb));


@@ -1174,41 +1188,35 @@ interpreter(base)
                        ASRT(ts, "");
                        continue;
                case O_FOR1U:
                        ASRT(ts, "");
                        continue;
                case O_FOR1U:

-                       pc.cp++;
-                       tcp = popaddr();        /* tcp = ptr to index var */
-                       if (*tcp < pop4()) {    /* still going up */
-                               tl = *tcp + 1;  /* inc index var */
-                               tl1 = *pc.sp++; /* index lower bound */
-                               tl2 = *pc.sp++; /* index upper bound */
-                               if (_runtst)
-                                       RANG4(tl, tl1, tl2);
-                               *tcp = tl;      /* update index var */
-                               pc.cp += *pc.sp;/* return to top of loop */
-                               continue;
-                       }
-                       pc.sp += 3;             /* else fall through */
-                       continue;
+                       /*
+                        * with the shadowing of for loop variables
+                        * the variable is always sizeof(long) hence
+                        * nullifying the need for shorter length
+                        * assignments
+                        */

                case O_FOR2U:
                case O_FOR2U:

-                       pc.cp++;
-                       tsp = (short *)popaddr(); /* tsp = ptr to index var */
-                       if (*tsp < pop4()) {    /* still going up */
-                               tl = *tsp + 1;  /* inc index var */
-                               tl1 = *pc.sp++; /* index lower bound */
+                       tl1 = *pc.cp++;         /* tl1 index lower bound */
+                       if (tl1 == 0)
+                               tl1 = *pc.sp++;
+                       tlp = (long *)popaddr(); /* tlp = ptr to index var */
+                       if (*tlp < pop4()) {    /* still going up */
+                               tl = *tlp + 1;  /* inc index var */

                                tl2 = *pc.sp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);
                                tl2 = *pc.sp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);

-                               *tsp = tl;      /* update index var */
+                               *tlp = tl;      /* update index var */

                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }

-                       pc.sp += 3;             /* else fall through */
+                       pc.sp += 2;             /* else fall through */

                        continue;
                case O_FOR4U:
                        continue;
                case O_FOR4U:

-                       pc.cp++;
+                       tl1 = *pc.cp++;         /* tl1 index lower bound */
+                       if (tl1 == 0)
+                               tl1 = *pc.lp++;

                        tlp = (long *)popaddr(); /* tlp = ptr to index var */
                        if (*tlp < pop4()) {    /* still going up */
                                tl = *tlp + 1;  /* inc index var */
                        tlp = (long *)popaddr(); /* tlp = ptr to index var */
                        if (*tlp < pop4()) {    /* still going up */
                                tl = *tlp + 1;  /* inc index var */

-                               tl1 = *pc.lp++; /* index lower bound */

                                tl2 = *pc.lp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);
                                tl2 = *pc.lp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);


@@ -1216,44 +1224,38 @@ interpreter(base)
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }

-                       pc.sp += 5;             /* else fall through */
-                       continue;
-               case O_FOR1D:
-                       pc.cp++;
-                       tcp = popaddr();        /* tcp = ptr to index var */
-                       if (*tcp > pop4()) {    /* still going down */
-                               tl = *tcp - 1;  /* inc index var */
-                               tl1 = *pc.sp++; /* index lower bound */
-                               tl2 = *pc.sp++; /* index upper bound */
-                               if (_runtst)
-                                       RANG4(tl, tl1, tl2);
-                               *tcp = tl;      /* update index var */
-                               pc.cp += *pc.sp;/* return to top of loop */
-                               continue;
-                       }

                        pc.sp += 3;             /* else fall through */
                        continue;
                        pc.sp += 3;             /* else fall through */
                        continue;

+               case O_FOR1D:
+                       /*
+                        * with the shadowing of for loop variables
+                        * the variable is always sizeof(long) hence
+                        * nullifying the need for shorter length
+                        * assignments
+                        */

                case O_FOR2D:
                case O_FOR2D:

-                       pc.cp++;
-                       tsp = (short *)popaddr(); /* tsp = ptr to index var */
-                       if (*tsp > pop4()) {    /* still going down */
-                               tl = *tsp - 1;  /* inc index var */
-                               tl1 = *pc.sp++; /* index lower bound */
+                       tl1 = *pc.cp++;         /* tl1 index lower bound */
+                       if (tl1 == 0)
+                               tl1 = *pc.sp++;
+                       tlp = (long *)popaddr(); /* tlp = ptr to index var */
+                       if (*tlp > pop4()) {    /* still going down */
+                               tl = *tlp - 1;  /* inc index var */

                                tl2 = *pc.sp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);
                                tl2 = *pc.sp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);

-                               *tsp = tl;      /* update index var */
+                               *tlp = tl;      /* update index var */

                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }

-                       pc.sp += 3;             /* else fall through */
+                       pc.sp += 2;             /* else fall through */

                        continue;
                case O_FOR4D:
                        continue;
                case O_FOR4D:

-                       pc.cp++;
+                       tl1 = *pc.cp++;         /* tl1 index lower bound */
+                       if (tl1 == 0)
+                               tl1 = *pc.lp++;

                        tlp = (long *)popaddr(); /* tlp = ptr to index var */
                        if (*tlp > pop4()) {    /* still going down */
                                tl = *tlp - 1;  /* inc index var */
                        tlp = (long *)popaddr(); /* tlp = ptr to index var */
                        if (*tlp > pop4()) {    /* still going down */
                                tl = *tlp - 1;  /* inc index var */

-                               tl1 = *pc.lp++; /* index lower bound */

                                tl2 = *pc.lp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);
                                tl2 = *pc.lp++; /* index upper bound */
                                if (_runtst)
                                        RANG4(tl, tl1, tl2);


@@ -1261,7 +1263,7 @@ interpreter(base)
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }
                                pc.cp += *pc.sp;/* return to top of loop */
                                continue;
                        }

-                       pc.sp += 5;             /* else fall through */
+                       pc.sp += 3;             /* else fall through */

                        continue;
                case O_READE:
                        pc.cp++;
                        continue;
                case O_READE:
                        pc.cp++;