Added some comment

diff --git a/lang/m2/libm2/ChkCards.e b/lang/m2/libm2/ChkCards.e
index 0369818..902e6b8 100644 (file)
--- a/lang/m2/libm2/ChkCards.e
+++ b/lang/m2/libm2/ChkCards.e
@@ -103,7 +103,7 @@
  lol 0
  cmu EM_WSIZE
  zge *1
- loc M2_UOVFL
+ loc M2_UUVFL
  trp
 1
  lol EM_WSIZE
@@ -119,7 +119,7 @@
  ldl 0
  cmu EM_LSIZE
  zge *1
- loc M2_UOVFL
+ loc M2_UUVFL
  trp
 1
  ldl EM_LSIZE

diff --git a/lang/m2/libm2/EM.e b/lang/m2/libm2/EM.e
index f5f1b36..ce348f2 100644 (file)
--- a/lang/m2/libm2/EM.e
+++ b/lang/m2/libm2/EM.e
@@ -73,13 +73,16 @@
 ; SIG is called with one parameter:
 ;       - procedure instance identifier (PROC)
 ; and returns the old traphandler.
-; only the procedure identifier inside the PROC is used.
 
+ exa _handler
  exp $SIG
  pro $SIG, 0
+ lae _handler
+ loi EM_PSIZE
  lal PROC
  loi EM_PSIZE
- sig
+ lae _handler
+ sti EM_PSIZE
  ret EM_PSIZE
  end ?
 

diff --git a/lang/m2/libm2/Storage.def b/lang/m2/libm2/Storage.def
index 234562b..8b835e3 100644 (file)
--- a/lang/m2/libm2/Storage.def
+++ b/lang/m2/libm2/Storage.def
@@ -5,6 +5,12 @@ DEFINITION MODULE Storage;
   Version:     $Header$
 *)
 
+(*
+  Wirth's 3rd edition certainly is confusing: mostly it uses Allocate, but
+  the module at the end of the book defines ALLOCATE. To avoid problems,
+  I included them both.
+*)
+
        FROM SYSTEM IMPORT ADDRESS;
 
        PROCEDURE ALLOCATE(VAR a : ADDRESS; size : CARDINAL);
@@ -13,11 +19,17 @@ DEFINITION MODULE Storage;
           killed.
        *)
 
+       PROCEDURE Allocate(VAR a : ADDRESS; size : CARDINAL);
+       (* Identical to ALLOCATE *)
+
        PROCEDURE DEALLOCATE(VAR a : ADDRESS; size : CARDINAL);
        (* Free the area at address "a" with the given size. The area
           must have been allocated by "ALLOCATE", with the same size.
        *)
 
+       PROCEDURE Deallocate(VAR a : ADDRESS; size : CARDINAL);
+       (* Identical to DEALLOCATE *)
+
        PROCEDURE Available(size : CARDINAL) : BOOLEAN;
        (* Return TRUE if an area with the given size could be allocated.
        *)

diff --git a/lang/m2/libm2/Storage.mod b/lang/m2/libm2/Storage.mod
index 19a7d3b..bb350ac 100644 (file)
--- a/lang/m2/libm2/Storage.mod
+++ b/lang/m2/libm2/Storage.mod
@@ -52,7 +52,7 @@ IMPLEMENTATION MODULE Storage;
        Compacted: BOOLEAN;             (* avoid recursive reorganization *)
        FirstBlock: BucketPtr;
 
-  PROCEDURE Allocate(size: CARDINAL) : ADDRESS;
+  PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS;
     VAR        nu : INTEGER;
        b : INTEGER;
        p, q: BucketPtr;
@@ -141,7 +141,7 @@ IMPLEMENTATION MODULE Storage;
        IF brk = ILLBREAK THEN
                ReOrganize();
                Compacted := TRUE;
-               brk := Allocate(size);
+               brk := MyAllocate(size);
                Compacted := FALSE;
                RETURN brk;
        END;
@@ -150,11 +150,16 @@ IMPLEMENTATION MODULE Storage;
        p^.BSIZE := nu;
        p^.BNEXT := USED;
        RETURN ADR(p^.BSTORE);
+  END MyAllocate;
+
+  PROCEDURE Allocate(VAR a: ADDRESS; size: CARDINAL);
+  BEGIN
+       ALLOCATE(a, size);
   END Allocate;
 
   PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL);
   BEGIN
-       a := Allocate(size);
+       a := MyAllocate(size);
        IF a = NIL THEN
                Message("out of core");
                HALT;
@@ -164,7 +169,7 @@ IMPLEMENTATION MODULE Storage;
   PROCEDURE Available(size: CARDINAL): BOOLEAN;
     VAR        a: ADDRESS;
   BEGIN
-       a:= Allocate(size);
+       a:= MyAllocate(size);
        IF a # NIL THEN
                DEALLOCATE(a, size);
                RETURN TRUE;
@@ -172,6 +177,11 @@ IMPLEMENTATION MODULE Storage;
        RETURN FALSE;
   END Available;
 
+  PROCEDURE Deallocate(VAR a: ADDRESS; size: CARDINAL);
+  BEGIN
+       DEALLOCATE(a, size);
+  END Deallocate;
+
   PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL);
     VAR        p: BucketPtr;
   BEGIN

diff --git a/lang/m2/libm2/Traps.def b/lang/m2/libm2/Traps.def
index fc6d174..0d97b53 100644 (file)
--- a/lang/m2/libm2/Traps.def
+++ b/lang/m2/libm2/Traps.def
@@ -15,6 +15,7 @@ DEFINITION MODULE Traps;
        ERRFORLOOP =    68;     (* value of FOR-loop control variable changed
                                   in loop
                                *)
+       ERRCARDUVFL =   69;     (* CARDINAL underflow *)
 
   TYPE TrapHandler = EM.TrapHandler;
 

diff --git a/lang/m2/libm2/catch.c b/lang/m2/libm2/catch.c
index ca6402c..13db422 100644 (file)
--- a/lang/m2/libm2/catch.c
+++ b/lang/m2/libm2/catch.c
@@ -45,6 +45,7 @@ static struct errm {
        { M2_NORESULT,  "no RETURN from procedure function"},
        { M2_UOVFL,     "cardinal overflow"},
        { M2_FORCH,     "Warning: FOR-loop control variable was changed in the body"},
+       { M2_UUVFL,     "cardinal underflow"},
        { -1,           0}
 };
 

diff --git a/lang/m2/libm2/head_m2.e b/lang/m2/libm2/head_m2.e
index c9bfc2a..568c7a8 100644 (file)
--- a/lang/m2/libm2/head_m2.e
+++ b/lang/m2/libm2/head_m2.e
@@ -13,6 +13,7 @@
 
 #define STACKSIZE      2048    /* maximum stack size for a coroutine */
 
+ exa _handler
  exa _environ
  exa _argv
  exa _argc
@@ -23,6 +24,8 @@
  exa _StackSize
  exp $_catch
 
+_handler
+ bss EM_PSIZE,0,0
 _environ
  bss EM_PSIZE,0,0
 _argv
@@ -42,6 +45,16 @@ _StackSize
 mainroutine
  bss 2*EM_PSIZE,0,0
 
+ inp $trap_handler
+ pro $trap_handler,0
+ lol 0 ; trap number
+ lae _handler
+ loi EM_PSIZE
+ cai
+ asp EM_WSIZE
+ rtt
+ end 0
+
  exp $m_a_i_n
  pro $m_a_i_n, STACKSIZE
 
@@ -78,7 +91,7 @@ mainroutine
  lol 0
  ste _argc             ; save argument count
 
- lpi $_catch
+ lpi $trap_handler
  sig
  asp EM_PSIZE
  cal $_M2M