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 0dfef1e..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.12 %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.12 %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 */


@@ -218,7 +232,7 @@ interpreter(base)
                        continue;
                case O_FCALL:
                        pc.cp++;
                        continue;
                case O_FCALL:
                        pc.cp++;

-                       tcp = popaddr(); /* ptr to display save area */
+                       tcp = popaddr(); /* ptr to display save area */

                        tfp = (struct formalrtn *)popaddr();
                        stp = (struct stack *)
                                pushsp((long)(sizeof(struct stack)));
                        tfp = (struct formalrtn *)popaddr();
                        stp = (struct stack *)
                                pushsp((long)(sizeof(struct stack)));


@@ -228,7 +242,7 @@ interpreter(base)
                        pc.cp = tfp->fentryaddr;/* calc new entry point */
                        _dp = &_display.frame[tfp->fbn];/* new display ptr */
                        blkcpy(tfp->fbn * sizeof(struct disp),
                        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);
+                               &_display.frame[1], tcp);

                        blkcpy(tfp->fbn * sizeof(struct disp),
                                &tfp->fdisp[0], &_display.frame[1]);
                        continue;
                        blkcpy(tfp->fbn * sizeof(struct disp),
                                &tfp->fdisp[0], &_display.frame[1]);
                        continue;


@@ -238,19 +252,21 @@ 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);

-                       tcp1 = *(char **)
-                           (tcp + tl + sizeof(struct formalrtn *));
-                       blkcpy(tl, tcp,
-                           tcp + sizeof(struct formalrtn *) + sizeof(char *));
-                       popsp((long)
-                           (sizeof(struct formalrtn *) + sizeof (char *)));
+                       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),
                        blkcpy(tfp->fbn * sizeof(struct disp),

-                           tcp1, &_display.frame[1]);
+                           tcp1, &_display.frame[1]);

                        continue;
                case O_FSAV:
                        tfp = (struct formalrtn *)popaddr();
                        tfp->fbn = *pc.cp++;    /* blk number of routine */
                        continue;
                case O_FSAV:
                        tfp = (struct formalrtn *)popaddr();
                        tfp->fbn = *pc.cp++;    /* blk number of routine */

-                       tcp = base + *pc.lp++;/* calc new entry point */
+                       tcp = base + *pc.lp++;  /* calc new entry point */

                        tcp += sizeof(short);
                        tfp->fentryaddr = base + *(long *)tcp;
                        blkcpy(tfp->fbn * sizeof(struct disp),
                        tcp += sizeof(short);
                        tfp->fentryaddr = base + *(long *)tcp;
                        blkcpy(tfp->fbn * sizeof(struct disp),


@@ -284,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 */


@@ -985,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++;


@@ -1009,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++;


@@ -1068,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:


@@ -1082,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:


@@ -1096,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:


@@ -1155,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));


@@ -1166,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);


@@ -1208,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);


@@ -1253,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++;