Added handling of cardinal overflow

diff --git a/lang/m2/libm2/ChkCards.e b/lang/m2/libm2/ChkCards.e
new file mode 100644 (file)
index 0000000..906efac
--- /dev/null
+++ b/lang/m2/libm2/ChkCards.e
@@ -0,0 +1,39 @@
+#include <m2_traps.h>
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+ pro $addu,0
+ loc -1
+ lol 0
+ sbu EM_WSIZE
+ lol EM_WSIZE
+ cmu EM_WSIZE
+ zle *1
+ loc M2_UOVFL
+ trp
+1
+ lol 0
+ lol EM_WSIZE
+ adu EM_WSIZE
+ stl EM_WSIZE
+ ret 0
+ end 0
+
+ pro $mulu,0
+ lol 0
+ zeq *1
+ loc -1
+ lol 0
+ dvu EM_WSIZE
+ lol EM_WSIZE
+ cmu EM_WSIZE
+ zle *1
+ loc M2_UOVFL
+ trp
+1
+ lol 0
+ lol EM_WSIZE
+ mlu EM_WSIZE
+ stl EM_WSIZE
+ ret 0
+ end 0

diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST
index a0077c8..bb10d60 100644 (file)
--- a/lang/m2/libm2/LIST
+++ b/lang/m2/libm2/LIST
@@ -31,6 +31,7 @@ store.c
 confarray.c
 load.c
 stackprio.c
+ChkCards.e
 EM.e
 rcku.e
 rcki.e

diff --git a/lang/m2/libm2/Traps.def b/lang/m2/libm2/Traps.def
index ca38b11..6854bb1 100644 (file)
--- a/lang/m2/libm2/Traps.def
+++ b/lang/m2/libm2/Traps.def
@@ -2,6 +2,12 @@ DEFINITION MODULE Traps;
 
   IMPORT EM;
 
+  CONST
+       ERRTOOLARGE =   64;     (* stack size of process too large *)
+       ERRTOOMANY =    65;     (* too many nested traps + handlers *)
+       ERRNORESULT =   66;     (* no RETURN from function procedure *)
+       ERRCARDOVFL =   67;     (* CARDINAL overflow *)
+
   TYPE TrapHandler = EM.TrapHandler;
 
   PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler;

diff --git a/lang/m2/libm2/catch.c b/lang/m2/libm2/catch.c
index 3ee3d1d..74232d2 100644 (file)
--- a/lang/m2/libm2/catch.c
+++ b/lang/m2/libm2/catch.c
@@ -33,6 +33,7 @@ static struct errm {
        { M2_TOOLARGE,  "stack size of process too large"},
        { M2_TOOMANY,   "too many nested traps + handlers"},
        { M2_NORESULT,  "no RETURN from procedure function"},
+       { M2_UOVFL,     "cardinal overflow"},
        { -1,           0}
 };
 

diff --git a/lang/m2/libm2/confarray.c b/lang/m2/libm2/confarray.c
index 0226a32..c85a50d 100644 (file)
--- a/lang/m2/libm2/confarray.c
+++ b/lang/m2/libm2/confarray.c
@@ -1,5 +1,13 @@
 #include <m2_traps.h>
 
+/*     Runtime handling of "value" conformant arrays.
+       The routine that accepts the conformant array parameter first calls
+       the routine new_stackptr. This routine computes a new stack pointer
+       for the calling routine and returns it. The new space on the stack is
+       large enough to store the array.
+       Then, it calls copy_array to do the copying.
+*/
+
 struct descr {
        char *addr;
        int low;
@@ -14,6 +22,9 @@ char *
 _new_stackptr(pdescr, a)
        register struct descr *pdescr;
 {
+       /*      The parameter "a" is not used and not supplied.
+               It's address is the old stack-pointer.
+       */
        unsigned int size = (((pdescr->highminlow + 1) * pdescr->size +
                                (EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
 
@@ -30,20 +41,19 @@ _new_stackptr(pdescr, a)
 }
 
 _copy_array(p, a)
-       register char *p;
+       register int *p;
 {
-       register char *q;
+       register int *q;
        register unsigned int sz;
        char dummy;
 
        ppdescr--;
-       sz = (((*ppdescr)->highminlow + 1) * (*ppdescr)->size +
-               (EM_WSIZE -1)) & ~ (EM_WSIZE - 1);
+       sz = (((*ppdescr)->highminlow + 1) * (*ppdescr)->size) / EM_WSIZE;
        
        if ((char *) &a - (char *) &dummy > 0) {
-               (*ppdescr)->addr = q = (char *) &a;
+               (*ppdescr)->addr = (char *) (q = &a);
        }
-       else    (*ppdescr)->addr = q = (char *) &a - sz;
+       else    (*ppdescr)->addr = (char *) (q = &a - sz);
 
        while (sz--) *q++ = *p++;
 }