Update library source to V2.

src/library/misc/MultiArrayRiders.Mod

@@ -20,7 +20,7 @@ email Patrick.Hunziker@unibas.ch
 MODULE MultiArrayRiders;  (** Patrick Hunziker, Basel,  **)
 (** Implements an array rider access mechanism for multidimensional arrays of arbitrary
     dimensions defined in MultiArrays*)
-IMPORT MultiArrays, Out:= Console, Input := Kernel;
+IMPORT MultiArrays, Out := Console, Input := Platform;
 CONST (** behaviour of array rider at end of array line;
         not yet completely implemented.
         The seemingly more exotic variants are especially useful in image processing *)

src/library/misc/MultiArrays.Mod

@@ -40,7 +40,7 @@ Patrick Hunziker,Basel.
 email Patrick.Hunziker@unibas.ch
 *)
 (** Version 0.9, 19.1.2001 *)
-IMPORT Out:= Console, Input:= Kernel; (* Import only needed for Demo purposes *)
+IMPORT Out := Console, Input := Platform; (* Import only needed for Demo purposes *)
 
 TYPE
     SIntPtr* = POINTER TO ARRAY OF SHORTINT;

src/library/misc/crt.Mod

@@ -1,6 +1,6 @@
 MODULE crt;
 
-IMPORT vt100, Unix, Console,
+IMPORT vt100, Platform, Console,
    Strings; (* strings to remove later ? *)
 
 CONST
@@ -28,11 +28,6 @@ CONST
 (* Add-in for blinking *)
    Blink*         = 128;
 
-TYPE
-   PFdSet = POINTER TO Unix.FdSet;
-
-VAR tmpstr : ARRAY 23 OF CHAR;
-
    PROCEDURE EraseDisplay*;
    BEGIN
       vt100.ED(2);
@@ -58,16 +53,8 @@ VAR tmpstr : ARRAY 23 OF CHAR;
       vt100.DECTCEMh;
    END cursoron;
 
-   PROCEDURE Delay*( ms : INTEGER);
+   PROCEDURE Delay*(ms: INTEGER);
-   VAR i : LONGINT;
+   BEGIN Platform.Delay(ms) END Delay;
-       tv : Unix.Timeval;
-       pfd : PFdSet;
-   BEGIN
-      tv.sec := 0;
-      tv.usec := ms * 1000;
-      pfd := NIL;
-      i := Unix.Select(0, pfd^, pfd^, pfd^, tv);
-   END Delay;
 
    PROCEDURE GotoXY* (x, y: INTEGER);
    BEGIN

src/library/ooc/oocCILP32.Mod

@@ -1,5 +1,8 @@
 (* 	$Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $	 *)
 MODULE oocC;
+
+(* ILP32 model *)
+
 (*  Basic data types for interfacing to C code.
     Copyright (C) 1997-1998  Michael van Acken
 
@@ -18,8 +21,7 @@ MODULE oocC;
     59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
  
-IMPORT
+IMPORT SYSTEM;
-  SYSTEM;
   
 (*
 These types are intended to be equivalent to their C counterparts.
@@ -28,31 +30,25 @@ Unix they should be fairly safe.
 *)  
 
 TYPE
-  char* = CHAR;
+  char*       = CHAR;                        (*  8 bits *)
-  signedchar* = SHORTINT;                (* signed char *)
+  signedchar* = SHORTINT;                    (*  8 bits *)
-  shortint* = INTEGER;                   (* short int *)
+  shortint*   = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
-  int* = LONGINT;
+  int*        = LONGINT;                     (* 32 bits *)   
-  set* = SET;                            (* unsigned int, used as set *)
+  set*        = LONGINT;                     (* 32 bits *)
-  longint* = LONGINT;                    (* long int *)
+  longint*    = LONGINT;                     (* 32 bits on ILP32 (64 bits is 'long long') *)
-  (*longset* = SYSTEM.SET64;  *)                      (* unsigned long, used as set *)
+(*longset*    = SET;  n/a *)                 (* 64 bit SET *)
-  longset* = SET;
+  address*    = LONGINT;                     (* 32 bits *)
-  address* = LONGINT;
+  float*      = REAL;                        (* 32 bits *)
-  float* = REAL;
+  double*     = LONGREAL;                    (* 64 bits *)
-  double* = LONGREAL;
 
   enum1* = int;
+  (*
     enum2* = int;
     enum4* = int;
-  
-  (* if your C compiler uses short enumerations, you'll have to replace the
-     declarations above with
-  enum1* = SHORTINT;
-  enum2* = INTEGER;
-  enum4* = LONGINT;
   *)
   
   FILE*  = address;  (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
-  sizet* = longint;
+  sizet* = longint;  (* 32 bits in i686 *)
   uidt*  = int;
   gidt*  = int;
 

src/library/ooc/oocCLLP64.Mod

@@ -1,5 +1,8 @@
 (* 	$Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $	 *)
 MODULE oocC;
+
+(* LP64 model *)
+
 (*  Basic data types for interfacing to C code.
     Copyright (C) 1997-1998  Michael van Acken
 
@@ -18,8 +21,7 @@ MODULE oocC;
     59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
  
-IMPORT
+IMPORT SYSTEM;
-  SYSTEM;
   
 (*
 These types are intended to be equivalent to their C counterparts.
@@ -28,26 +30,21 @@ Unix they should be fairly safe.
 *)  
 
 TYPE
-  char* = CHAR;
+  char*       = CHAR;                        (*  8 bits *)             
-  signedchar* = SHORTINT;                (* signed char *)
+  signedchar* = SHORTINT;                    (*  8 bits *)
-  shortint* = RECORD a,b : SYSTEM.BYTE END; (* 2 bytes on x64_64 *)  (* short int *)
+  shortint*   = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
-  int* = INTEGER;
+  int*        = INTEGER;                     (* 32 bits *)     
-  set* = INTEGER;(*SET;*) (* unsigned int, used as set *)
+  set*        = INTEGER;                     (* 32 bits *) 
-  longint* = LONGINT;                    (* long int *)
+  longint*    = INTEGER;                     (* 32 bits *)
-  longset* = SET; (*SYSTEM.SET64; *) (* unsigned long, used as set *)
+  longset*    = SET;                         (* 64 bits *)
-  address* = LONGINT; (*SYSTEM.ADDRESS;*)
+  address*    = LONGINT;                     (* 64 bits *)
-  float* = REAL;
+  float*      = REAL;                        (* 32 bits *)
-  double* = LONGREAL;
+  double*     = LONGREAL;                    (* 64 bits *)
 
   enum1* = int;
+  (*
     enum2* = int;
     enum4* = int;
-  
-  (* if your C compiler uses short enumerations, you'll have to replace the
-     declarations above with
-  enum1* = SHORTINT;
-  enum2* = INTEGER;
-  enum4* = LONGINT;
   *)
   
   FILE*  = address;  (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
@@ -63,7 +60,7 @@ TYPE  (* some commonly used C array types *)
 
 TYPE  (* C string type, assignment compatible with character arrays and
          string constants *)
-  string* = POINTER (*[CSTRING]*) TO ARRAY OF char;
+  string* = POINTER TO ARRAY OF char;
   
 TYPE
   Proc* = PROCEDURE;

src/library/ooc/oocCLP64.Mod

@@ -1,5 +1,8 @@
 (* 	$Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $	 *)
 MODULE oocC;
+
+(* LP64 model *)
+
 (*  Basic data types for interfacing to C code.
     Copyright (C) 1997-1998  Michael van Acken
 
@@ -18,8 +21,7 @@ MODULE oocC;
     59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
  
-IMPORT
+IMPORT SYSTEM;
-  SYSTEM;
   
 (*
 These types are intended to be equivalent to their C counterparts.
@@ -28,26 +30,21 @@ Unix they should be fairly safe.
 *)  
 
 TYPE
-  char* = CHAR;
+  char*       = CHAR;                        (*  8 bits *)             
-  signedchar* = SHORTINT;                (* signed char *)
+  signedchar* = SHORTINT;                    (*  8 bits *)
-  shortint* = RECORD a,b : SYSTEM.BYTE END; (* 2 bytes on x64_64 *)  (* short int *)
+  shortint*   = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
-  int* = INTEGER;
+  int*        = INTEGER;                     (* 32 bits *)     
-  set* = INTEGER;(*SET;*) (* unsigned int, used as set *)
+  set*        = INTEGER;                     (* 32 bits *) 
-  longint* = LONGINT;                    (* long int *)
+  longint*    = LONGINT;                     (* 64 bits *)
-  longset* = SET; (*SYSTEM.SET64; *) (* unsigned long, used as set *)
+  longset*    = SET;                         (* 64 bits *)
-  address* = LONGINT; (*SYSTEM.ADDRESS;*)
+  address*    = LONGINT;                     (* 64 bits *)
-  float* = REAL;
+  float*      = REAL;                        (* 32 bits *)
-  double* = LONGREAL;
+  double*     = LONGREAL;                    (* 64 bits *)
 
   enum1* = int;
+  (*
     enum2* = int;
     enum4* = int;
-  
-  (* if your C compiler uses short enumerations, you'll have to replace the
-     declarations above with
-  enum1* = SHORTINT;
-  enum2* = INTEGER;
-  enum4* = LONGINT;
   *)
   
   FILE*  = address;  (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
@@ -63,7 +60,7 @@ TYPE  (* some commonly used C array types *)
 
 TYPE  (* C string type, assignment compatible with character arrays and
          string constants *)
-  string* = POINTER (*[CSTRING]*) TO ARRAY OF char;
+  string* = POINTER TO ARRAY OF char;
   
 TYPE
   Proc* = PROCEDURE;

src/library/ooc/oocIntConv.Mod

@@ -162,6 +162,7 @@ BEGIN
       ELSE
         RETURN strWrongFormat;
       END;
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;

src/library/ooc/oocLRealConv.Mod

@@ -231,6 +231,7 @@ BEGIN
           IF decExp THEN DEC(nexp) END;
         END
     | Conv.invalid, Conv.terminator: EXIT
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;
@@ -285,6 +286,7 @@ BEGIN
           IF decExp THEN DEC(nexp) END;
         END
     | Conv.invalid, Conv.terminator: EXIT
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;

src/library/ooc/oocRealConv.Mod

@@ -182,6 +182,7 @@ BEGIN
           IF decExp THEN DEC(nexp) END;
         END
     | Conv.invalid, Conv.terminator: EXIT
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;
@@ -254,6 +255,7 @@ BEGIN
           IF decExp THEN DEC(nexp) END;
         END
     | Conv.invalid, Conv.terminator: EXIT
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;

src/library/ooc/oocRts.Mod

@@ -1,51 +1,43 @@
 MODULE oocRts;  (* module is written from scratch by noch to wrap around Unix.Mod and Args.Mod and provide compatibility for some ooc libraries *)
-IMPORT Args, Unix, Files, Strings := oocStrings(*, Console*);
+IMPORT Args, Platform, Files, Strings := oocStrings(*, Console*);
 CONST
   pathSeperator* = "/";
 
-VAR i : INTEGER;
+VAR 
-b : BOOLEAN;
+  i:    INTEGER;
-str0 : ARRAY 128 OF CHAR;
+  b:    BOOLEAN;
+  str0: ARRAY 128 OF CHAR;
 
 PROCEDURE System* (command : ARRAY OF CHAR) : INTEGER;
 (* Executes `command' as a shell command.  Result is the value returned by 
    the libc `system' function. *)
-BEGIN
+BEGIN RETURN Platform.System(command) END System;
-RETURN Unix.System(command)
-
-END System;
 
 PROCEDURE GetEnv* (VAR var: ARRAY OF CHAR; name: ARRAY OF CHAR): BOOLEAN;
 (* If an environment variable `name' exists, copy its value into `var' and
    return TRUE.  Otherwise return FALSE.  *)
-BEGIN
+BEGIN RETURN Platform.getEnv(name, var) END GetEnv;
-RETURN Args.getEnv(name, var);
-END GetEnv;
 
 
 PROCEDURE GetUserHome* (VAR home: ARRAY OF CHAR; user: ARRAY OF CHAR);
 (* Get the user's home directory path (stored in /etc/passwd)
    or the current user's home directory if user="". *)
 VAR 
-f : Files.File;
+  f : Files.File;
-r : Files.Rider;
+  r : Files.Rider;
-str, str1 : ARRAY 1024 OF CHAR;
+  str, str1 : ARRAY 1024 OF CHAR;
-found, found1 : BOOLEAN;
+  found, found1 : BOOLEAN;
-p, p1, p2 : INTEGER;
+  p, p1, p2 : INTEGER;
 BEGIN
-f := Files.Old("/etc/passwd");
+  f := Files.Old("/etc/passwd");
-Files.Set(r, f, 0);
+  Files.Set(r, f, 0);
 
-REPEAT
+  REPEAT
     Files.ReadLine(r, str);
-
+    (* Console.String(str); Console.Ln;*)
-(*   Console.String(str); Console.Ln;*)
-
     Strings.Extract(str, 0, SHORT(LEN(user)-1), str1);
-(*   Console.String(str1); Console.Ln;*)
+    (* Console.String(str1); Console.Ln;*)
-
+    found := Strings.Equal(user, str1)
-   IF Strings.Equal(user, str1) THEN found := TRUE END;
-
   UNTIL found OR r.eof;
 
   IF found THEN
@@ -62,17 +54,14 @@ REPEAT
     found1 := GetEnv(home, "HOME");
     (*Console.String("not found"); Console.Ln; Console.String (home); Console.Ln;*)
   END
-
-
 END GetUserHome;
 
 BEGIN
-(* test *)
+  (* test *)
-(* 
+  (* 
-i := System("ls");
+    i := System("ls");
-b := GetEnv(str0, "HOME");
+    b := GetEnv(str0, "HOME");
-IF b THEN Console.String(str0); Console.Ln END;
+    IF b THEN Console.String(str0); Console.Ln END;
-
+    GetUserHome(str0, "noch");
-GetUserHome(str0, "noch");
+  *)
-*)
 END oocRts.

src/library/ooc/oocSysClock.Mod

@@ -1,110 +1,15 @@
 MODULE oocSysClock; 
-IMPORT Unix;
+IMPORT SYSTEM, Platform;
   
-CONST
+PROCEDURE CanGetClock*(): BOOLEAN; BEGIN RETURN TRUE END CanGetClock;
-  maxSecondParts* = 999; (* Most systems have just millisecond accuracy *) 
-  
-  zoneMin* = -780;       (* time zone minimum minutes *)
-  zoneMax* =  720;       (* time zone maximum minutes *)
-
-  localTime* = MIN(INTEGER);  (* time zone is inactive & time is local *)
-  unknownZone* = localTime+1; (* time zone is unknown *)
- 
-  (* daylight savings mode values *)
-  unknown* = -1;   (* current daylight savings status is unknown *)
-  inactive* = 0;   (* daylight savings adjustments are not in effect *)
-  active* = 1;     (* daylight savings adjustments are being used *)
-    
-TYPE
-  (* The DateTime type is a system-independent time format whose fields
-     are defined as follows:
-     
-          year      > 0
-          month     = 1 .. 12
-          day       = 1 .. 31
-          hour      = 0 .. 23
-          minute    = 0 .. 59
-          second    = 0 .. 59
-          fractions = 0 .. maxSecondParts
-          zone      = -780 .. 720
-  *)     
-  DateTime* =
-    RECORD
-      year*:           INTEGER;
-      month*:          SHORTINT;
-      day*:            SHORTINT;
-      hour*:           SHORTINT;
-      minute*:         SHORTINT;
-      second*:         SHORTINT;
-      summerTimeFlag*: SHORTINT; (* daylight savings mode (see above) *)      
-      fractions*:      INTEGER;  (* parts of a second in milliseconds *)
-      zone*:           INTEGER;  (* Time zone differential factor which 
-                                    is the number of minutes to add to 
-                                    local time to obtain UTC or is set
-                                    to localTime when time zones are
-                                    inactive. *)
-    END;
-
-
-PROCEDURE CanGetClock*(): BOOLEAN;
-(* Returns TRUE if a system clock can be read; FALSE otherwise.  *)
-VAR timeval: Unix.Timeval; timezone: Unix.Timezone;
-l : LONGINT;
-BEGIN
-   l := Unix.Gettimeofday(timeval, timezone);
-   IF l = 0 THEN RETURN TRUE ELSE RETURN FALSE END 
-END CanGetClock;
-(*
-PROCEDURE CanSetClock*(): BOOLEAN;
-(* Returns TRUE if a system clock can be set; FALSE otherwise.  *)
-*)
-(*
-PROCEDURE IsValidDateTime* (d: DateTime): BOOLEAN;
-(* Returns TRUE if the value of `d' represents a valid date and time; 
-   FALSE otherwise.  *)
-*)
-
-
-  (*
-PROCEDURE SetClock* (userData: DateTime);
-(* If possible, sets the system clock to the values of `userData'.  *)
-*)
-(*
-PROCEDURE MakeLocalTime * (VAR c: DateTime);
-(* Fill in the daylight savings mode and time zone for calendar date `c'.
-   The fields `zone' and `summerTimeFlag' given in `c' are ignored, assuming
-   that the rest of the record describes a local time.
-   Note 1: On most Unix systems the time zone information is only available for
-    dates falling within approx. 1 Jan 1902 to 31 Dec 2037.  Outside this range
-    the field `zone' will be set to the unspecified `localTime' value (see 
-    above), and `summerTimeFlag' will be set to `unknown'.
-   Note 2: The time zone information might not be fully accurate for past (and
-    future) years that apply different DST rules than the current year.
-    Usually the current set of rules is used for _all_ years between 1902 and 
-    2037.
-   Note 3: With DST there is one hour in the year that happens twice: the
-    hour after which the clock is turned back for a full hour.  It is undefined
-    which time zone will be selected for dates refering to this hour, i.e.
-    whether DST or normal time zone will be chosen.  *)
-*)
 
 PROCEDURE GetTimeOfDay* (VAR sec, usec: LONGINT): LONGINT;
 (* PRIVAT.  Don't use this.  Take Time.GetTime instead.  
    Equivalent to the C function `gettimeofday'.  The return value is `0' on 
    success and `-1' on failure; in the latter case `sec' and `usec' are set to
    zero.  *)
-   VAR timeval: Unix.Timeval; timezone: Unix.Timezone;
-   l : LONGINT;
 BEGIN
-   l := Unix.Gettimeofday (timeval, timezone);
+  Platform.GetTimeOfDay(sec, usec); RETURN 0;
-   IF l = 0 THEN
-      sec := timeval.sec;
-      usec := timeval.usec;
-   ELSE
-      sec := 0;
-     usec := 0;
-   END;
-   RETURN l;
 END GetTimeOfDay;
 
 END oocSysClock.

src/library/ooc/oocwrapperlibc.Mod

@@ -0,0 +1,23 @@
+MODULE oocwrapperlibc;
+IMPORT SYSTEM, Platform;
+
+
+PROCEDURE -includeStdio()  "#include <stdio.h>";
+
+PROCEDURE system*(cmd : ARRAY OF CHAR); 
+VAR r: INTEGER;
+BEGIN 
+  r := Platform.System(cmd) 
+END system;
+
+
+PROCEDURE -sprntf(s, t0, t1, t2: ARRAY OF CHAR): INTEGER
+   "sprintf((char*)s, (char*)t0, (char*)t1, (char*)t2)";
+
+PROCEDURE sprintf*(VAR s: ARRAY OF CHAR; template0: ARRAY OF CHAR; template1: ARRAY OF CHAR; template2: ARRAY OF CHAR);
+VAR r : INTEGER;
+BEGIN
+  r := sprntf(s, template0, template1, template2);
+END sprintf;
+
+END oocwrapperlibc.

src/library/ooc2/ooc2IntConv.Mod

@@ -124,7 +124,7 @@ VAR
   positive: BOOLEAN;
   prev, class: Conv.ScanClass;
 
-PROCEDURE LessOrEqual (VAR high: ARRAY OF CHAR; start, end: INTEGER): BOOLEAN;
+  PROCEDURE LessOrEqual (VAR high: ARRAY OF CHAR; start, end: INTEGER): BOOLEAN;
   VAR
     i: INTEGER;
   BEGIN  (* pre: index-start = maxDigits *)
@@ -176,6 +176,7 @@ BEGIN
       ELSE
         RETURN strWrongFormat;
       END;
+    ELSE (* Ignore unrecognised class *)
     END;
     prev:=class; INC(index)
   END;

src/library/oocX11/oocX11.Mod

@@ -8,6 +8,7 @@ CONST
   XPROTOCOL* = 11;             (* current protocol version *)
   XPROTOCOLREVISION* = 0;     (* current minor version *)
 
+
 TYPE
   ulongmask* = C.longset;
   (*uintmask* = C.set;*)
@@ -1950,6 +1951,13 @@ TYPE
   XErrorHandler* = PROCEDURE (display: DisplayPtr; errorevent: XErrorEventPtr): C.int;
   XIOErrorHandler* = PROCEDURE (display: DisplayPtr);
   XConnectionWatchProc* = PROCEDURE (dpy: DisplayPtr; clientdate: XPointer; fd: C.int; opening: Bool; watchdata: XPointerPtr1d);
+
+
+PROCEDURE -aincludexlib      "#include <X11/Xlib.h>";
+PROCEDURE -aincludexutil     "#include <X11/Xutil.h>";
+PROCEDURE -aincludexresource "#include <X11/Xresource.h>";
+
+
 (*
 PROCEDURE XLoadQueryFont* (
     display: DisplayPtr;
@@ -1987,7 +1995,7 @@ PROCEDURE -XCreateImage* (
     height: C.int;
     bitmapPad: C.int;
     bytesPerLine: C.int): XImagePtr
-    "(long)XCreateImage(display, visual, depth, format, offset, data, width, height, bitmapPad, bytesPerLine)";
+    "(oocX11_XImagePtr)XCreateImage((struct _XDisplay*)display, (Visual*)visual, depth, format, offset, (char*)data, width, height, bitmapPad, bytesPerLine)";
 (*
 PROCEDURE XInitImage* (
     image: XImagePtr): Status;
@@ -2017,8 +2025,7 @@ PROCEDURE XGetSubImage* (
  * X function declarations.
  *)
  *)
-PROCEDURE -XOpenDisplay* (name: ARRAY OF C.char): DisplayPtr
+PROCEDURE -XOpenDisplay* (name: ARRAY OF C.char): DisplayPtr "(oocX11_DisplayPtr)XOpenDisplay((char*)name)";
- "(long)XOpenDisplay(name)";
 
 PROCEDURE OpenDisplay* (name: ARRAY OF C.char): DisplayPtr;
 BEGIN
@@ -2101,7 +2108,7 @@ PROCEDURE -XCreateGC* (
     d: Drawable;
     valueMask: ulongmask;
     VAR values: XGCValues): GC
-    "(long)XCreateGC(display, d, valueMask, values)";
+    "(oocX11_GC)XCreateGC((struct _XDisplay*)display, d, valueMask, (XGCValues *)values)";
 (*
 PROCEDURE XGContextFromGC* (
     gc: GC): GContext;
@@ -2140,7 +2147,7 @@ PROCEDURE -XCreateSimpleWindow* (
     borderWidth: C.int;
     border: C.longint;
     background: C.longint): Window
-    "(long)XCreateSimpleWindow(display, parent, x, y, width, height, borderWidth, border, background)";
+    "(long)XCreateSimpleWindow((struct _XDisplay*)display, parent, x, y, width, height, borderWidth, border, background)";
 (*
 PROCEDURE XGetSelectionOwner* (
     display: DisplayPtr;
@@ -2240,7 +2247,7 @@ PROCEDURE XEHeadOfExtensionList* (
 PROCEDURE -XRootWindow* (
     display: DisplayPtr;
     screen: C.int): Window
-    "(long)XRootWindow(display, screen)";
+    "(long)XRootWindow((struct _XDisplay*)display, screen)";
 (*
 PROCEDURE XDefaultRootWindow* (
     display: DisplayPtr): Window;
@@ -2250,7 +2257,7 @@ PROCEDURE XRootWindowOfScreen* (
 PROCEDURE -XDefaultVisual* (
     display: DisplayPtr;
     screen: C.int): VisualPtr
-    "(long)XDefaultVisual(display, screen)";
+    "(oocX11_VisualPtr)XDefaultVisual((struct _XDisplay*)display, screen)";
 (*
 PROCEDURE XDefaultVisualOfScreen* (
     screen: ScreenPtr): VisualPtr;
@@ -2263,12 +2270,12 @@ PROCEDURE XDefaultGCOfScreen* (
 PROCEDURE -XBlackPixel* (
     display: DisplayPtr;
     screen: C.int): C.longint
-    "(long)XBlackPixel(display, screen)";
+    "(long)XBlackPixel((struct _XDisplay*)display, screen)";
 
 PROCEDURE -XWhitePixel* (
     display: DisplayPtr;
     screen: C.int): C.longint
-    "(long)XWhitePixel(display, screen)";
+    "(long)XWhitePixel((struct _XDisplay*)display, screen)";
 (*
 PROCEDURE XAllPlanes* (): C.longint;
 PROCEDURE XBlackPixelOfScreen* (
@@ -2296,7 +2303,7 @@ PROCEDURE XScreenOfDisplay* (
 *)
 PROCEDURE -XDefaultScreenOfDisplay* (
     display: DisplayPtr): ScreenPtr
-     "(long)XDefaultScreen(display)";
+     "(long)XDefaultScreen((struct _XDisplay*)display)";
 (*
 PROCEDURE XEventMaskOfScreen* (
     screen: ScreenPtr): C.longint;
@@ -2523,7 +2530,7 @@ PROCEDURE XClearWindow* (
 
 PROCEDURE -XCloseDisplay* (
     display: DisplayPtr)
-    "XCloseDisplay(display)";
+    "XCloseDisplay((struct _XDisplay*)display)";
 
 
 (*
@@ -2577,7 +2584,7 @@ PROCEDURE XDefaultDepthOfScreen* (
 *)
 PROCEDURE -XDefaultScreen* (
     display: DisplayPtr): C.int
-    "(int)XDefaultScreen(display)";
+    "(int)XDefaultScreen((struct _XDisplay*)display)";
 (*
 PROCEDURE XDefineCursor* (
     display: DisplayPtr;
@@ -2591,11 +2598,11 @@ PROCEDURE XDeleteProperty* (
 PROCEDURE -XDestroyWindow* (
     display: DisplayPtr;
     w: Window)
-    "XDestroyWindow(display, w)";
+    "XDestroyWindow((struct _XDisplay*)display, w)";
 
 
 PROCEDURE -XDestroyImage* (image : XImagePtr)
-   "XDestroyImage(image)";
+   "XDestroyImage((struct _XDisplay*)image)";
 
 (*
 PROCEDURE XDestroySubwindows* (
@@ -2614,7 +2621,7 @@ PROCEDURE XDisplayCells* (
 PROCEDURE -XDisplayHeight* (
     display: DisplayPtr;
     screen: C.int): C.int
-    "(int)XDisplayHeight(display, screen)";
+    "(int)XDisplayHeight((struct _XDisplay*)display, screen)";
 (*
 PROCEDURE XDisplayHeightMM* (
     display: DisplayPtr;
@@ -2630,7 +2637,7 @@ PROCEDURE XDisplayPlanes* (
 PROCEDURE -XDisplayWidth* (
     display: DisplayPtr;
     screennumber: C.int): C.int
-    "(int)XDisplayWidth(display, screen)";
+    "(int)XDisplayWidth((struct _XDisplay*)display, screen)";
 (*
 PROCEDURE XDisplayWidthMM* (
     display: DisplayPtr;
@@ -2690,7 +2697,7 @@ PROCEDURE -XDrawPoint* (
     gc: GC;
     x: C.int;
     y: C.int)
-    "XDrawPoint(display, d, gc, x, y)";
+    "XDrawPoint((struct _XDisplay*)display, d, (struct _XGC*)gc, x, y)";
 (*
 PROCEDURE XDrawPoints* (
     display: DisplayPtr;
@@ -2758,7 +2765,7 @@ PROCEDURE XEnableAccessControl* (
 PROCEDURE -XEventsQueued* (
     display: DisplayPtr;
     mode: C.int): C.int
-    "(int)XEventsQueued(display, mode)";
+    "(int)XEventsQueued((struct _XDisplay*)display, mode)";
 (*
 PROCEDURE XFetchName* (
     display: DisplayPtr;
@@ -2797,7 +2804,7 @@ PROCEDURE -XFillRectangle* (
     y: C.int;
     width: C.int;
     height: C.int)
-    "XFillRectangle(display, d, gc, x, y, width, height)";
+    "XFillRectangle((struct _XDisplay*)display, d, (struct _XGC*)gc, x, y, width, height)";
 (*
 PROCEDURE XFillRectangles* (
     display: DisplayPtr;
@@ -2808,7 +2815,7 @@ PROCEDURE XFillRectangles* (
 *)
 PROCEDURE -XFlush* (
     display: DisplayPtr)
-    "XFlush(display)";
+    "XFlush((struct _XDisplay*)display)";
 (*
 PROCEDURE XForceScreenSaver* (
     display: DisplayPtr;
@@ -3016,13 +3023,13 @@ PROCEDURE XMapSubwindows* (
 PROCEDURE -XMapWindow* (
     display: DisplayPtr;
     w: Window)
-    "XMapWindow(display, w)";
+    "XMapWindow((struct _XDisplay*)display, w)";
 
 PROCEDURE -XMaskEvent* (
     display: DisplayPtr;
     mask: ulongmask;
     VAR event: XEvent)
-    "XMaskEvent(display, mask, event)";
+    "XMaskEvent((struct _XDisplay*)display, mask, (union _XEvent*)event)";
 
 (*
 PROCEDURE XMaxCmapsOfScreen* (
@@ -3045,7 +3052,7 @@ PROCEDURE XMoveWindow* (
 PROCEDURE -XNextEvent* (
     display: DisplayPtr;
     VAR event: XEvent)
-    "XNextEvent(display, event)";
+    "XNextEvent((struct _XDisplay*)display, (union _XEvent*)event)";
 (*
 PROCEDURE XNoOp* (
     display: DisplayPtr);
@@ -3091,7 +3098,7 @@ PROCEDURE -XPutImage* (
     dstY: C.int;
     width: C.int;
     height: C.int)
-    "XPutImage(display, d, gc, image, srcX, srcY, dstX, dstY, width, height)";
+    "XPutImage((struct _XDisplay*)display, d, (struct _XGC*)gc, (struct _XImage*)image, srcX, srcY, dstX, dstY, width, height)";
 (*
 PROCEDURE XQLength* (
     display: DisplayPtr): C.int;
@@ -3254,7 +3261,7 @@ PROCEDURE -XSelectInput* (
     display: DisplayPtr;
     window: Window;
     eventMask: ulongmask)
-   "XSelectInput(display, window, eventMask)";    
+   "XSelectInput((struct _XDisplay*)display, window, (long)eventMask)";    
 (*
 PROCEDURE XSendEvent* (
     display: DisplayPtr;
@@ -3441,7 +3448,7 @@ PROCEDURE -XStoreName* (
     display: DisplayPtr;
     window: Window;
     name: ARRAY OF C.char)
-    "XStoreName(display, window, name)";
+    "XStoreName((struct _XDisplay*)display, window, (char*)name)";
 (*
 PROCEDURE XStoreNamedColor* (
     display: DisplayPtr;

src/library/oocX11/oocXYplane.Mod

@@ -34,6 +34,12 @@ VAR
   map: POINTER TO ARRAY OF ARRAY OF SET;
 
   
+
+PROCEDURE -aincludexlib      "#include <X11/Xlib.h>";
+PROCEDURE -aincludexutil     "#include <X11/Xutil.h>";
+PROCEDURE -aincludexresource "#include <X11/Xresource.h>";
+
+
 PROCEDURE Error (msg: ARRAY OF CHAR);
   BEGIN
     Out.String ("Error: ");
@@ -70,6 +76,7 @@ PROCEDURE Dot* (x, y, mode: INTEGER);
         X11.XDrawPoint (display, window, fg, x, H-1-y)
       | erase:
         X11.XDrawPoint (display, window, bg, x, H-1-y)
+      ELSE
       END;
       X11.XFlush (display); 
     END
@@ -137,42 +144,41 @@ PROCEDURE Open*;
   VAR
     screen:  C.int;
     parent:  X11.Window;  
-    bgColor, fgColor: C.longint;
+    bgColor: C.longint;
+    fgColor: C.longint;
     gcValue: X11.XGCValues;
     event:   X11.XEvent;
     x, y:    INTEGER;
-    tmpstr : string;
+    tmpstr:  string;
-    (*tmpint : INTEGER;*)
     scrn :   C.int;
     vis :    X11.VisualPtr;
   BEGIN
-    
     IF ~initialized THEN
       initialized := TRUE;
 
       tmpstr[0] := 0X;
       (*display := X11.XOpenDisplay (NIL);*)
-      display := X11.XOpenDisplay (tmpstr);
+      display := X11.XOpenDisplay(tmpstr);
       (*display := X11.OpenDisplay (NIL);*)
       IF (display = NIL) THEN
-        Error ("Couldn't open display")
+        Error("Couldn't open display")
       ELSE
-        screen := X11.XDefaultScreen (display);
+        screen := X11.XDefaultScreen(display);
         X := 0; Y := 0;
         W := SHORT (X11.XDisplayWidth (display, screen));
-        H := SHORT (X11.XDisplayHeight (display, screen));
+        H := SHORT (X11.XDisplayHeight(display, screen));
         (* adjust ratio W:H to 3:4 [for no paritcular reason] *)
         IF (W > 3*H DIV 4) THEN
           W := 3*H DIV 4
         END;
-        parent := X11.XRootWindow (display, screen);
+        parent  := X11.XRootWindow(display, screen);
-        fgColor := X11.XBlackPixel (display, screen);
+        fgColor := X11.XBlackPixel(display, screen);
-        bgColor := X11.XWhitePixel (display, screen);
+        bgColor := X11.XWhitePixel(display, screen);
-        window := X11.XCreateSimpleWindow (display, parent, 0, 0, 
+        window  := X11.XCreateSimpleWindow(display, parent, 0, 0, 
                                            W, H, 0, 0, bgColor);  
-        X11.XStoreName (display, window, "XYplane");
+        X11.XStoreName(display, window, "XYplane");
-        X11.XSelectInput (display, window, X11.KeyPressMask+X11.ExposureMask);
+        X11.XSelectInput(display, window, X11.KeyPressMask+X11.ExposureMask);
-        X11.XMapWindow (display, window);
+        X11.XMapWindow(display, window);
         X11.XFlush (display);
         (*tmpint := W + ((*sizeSet*)32-1);
 	tmpint := tmpint DIV 32(*sizeSet*);*)
@@ -184,16 +190,16 @@ PROCEDURE Open*;
           END
         END;
         
-	scrn := X11.XDefaultScreen (display);
+	      scrn  := X11.XDefaultScreen(display);
-        vis := X11.XDefaultVisual (display, scrn);
+        vis   := X11.XDefaultVisual(display, scrn);
 	      image := X11.XCreateImage (display, 
                   (*X11.XDefaultVisual (display, X11.XDefaultScreen (display)),*)
                   vis,
                   (*1, X11.XYBitmap, 0, SYSTEM.ADR (map^), W, H, sizeSet, 0);*)
-                  1, X11.ZPixmap, 0, SYSTEM.ADR (map^), W, H, (*sizeSet*)32, 0);
+                  1, X11.ZPixmap, 0, SYSTEM.VAL(C.address,SYSTEM.ADR(map^)), W, H, (*sizeSet*)32, 0);
 
         (* wait until the window manager gives its ok to draw things *)
-        X11.XMaskEvent (display, X11.ExposureMask, event);
+        X11.XMaskEvent(display, X11.ExposureMask, event);
 
         (* create graphic context to draw resp. erase a point *)
         gcValue. foreground := fgColor;
@@ -208,7 +214,7 @@ PROCEDURE Open*;
     END
   END Open;
 
-   PROCEDURE Close*;
+PROCEDURE Close*;
 
    BEGIN
   (*    X11.XDestroyImage(image);

src/library/oocX11/oocXutil.Mod

@@ -359,7 +359,7 @@ PROCEDURE -XLookupString* (
     VAR keysymReturn: X.KeySym;
     (*VAR statusInOut(*[NILCOMPAT]*): XComposeStatus): C.int*)
     VAR statusInOut(*[NILCOMPAT]*): C.longint): C.int
-    "(int)XLookupString(eventStruct, bufferReturn, bytesBuffer, keysymReturn, statusInOut)";
+    "(int)XLookupString((XKeyEvent*)eventStruct, bufferReturn, bytesBuffer, (KeySym*)keysymReturn, (XComposeStatus*)statusInOut)";
 (*
 PROCEDURE XMatchVisualInfo* (
     display: X.DisplayPtr;

src/library/s3/ethBTrees.Mod

@@ -1105,6 +1105,7 @@ MODULE ethBTrees;  (** portable *) (* ejz,  *)
         CASE T.class OF
           LInt: WriteLIntPage(T, p(LIntPage))
           |Str: WriteStrPage(T, p(StrPage))
+          ELSE
         END
       END;
       p := p.next

src/library/s3/ethRandomNumbers.Mod

@@ -3,7 +3,7 @@ Refer to the "General ETH Oberon System Source License" contract available at: h
 
 MODULE ethRandomNumbers;  (** portable *)
 (* Random Number Generator, page 12 *)
-IMPORT Math := oocOakMath, Oberon := Kernel, SYSTEM;
+IMPORT Math := oocOakMath, Oberon := Platform, SYSTEM;
 
 VAR Z, t, d: LONGINT;
 

src/library/s3/ethReals.Mod

@@ -10,7 +10,7 @@ Implemented by Bernd Moesli, Seminar for Applied Mathematics,
 Swiss Federal Institute of Technology Z…rich.
 *)
 
-IMPORT SYSTEM;
+IMPORT SYSTEM, Platform, Configuration;
 
 (* Bernd Moesli
   Seminar for Applied Mathematics
@@ -33,6 +33,7 @@ IMPORT SYSTEM;
   7.11.1995  jt: dynamic endianess test
   22.01.97  pjm: NaN stuff (using quiet NaNs only to avoid traps)
   05.01.98  prk: NaN with INF support
+  17.02.16  dcb: Adapt for 32 bit INTEGER and 64 bit LONGINT.
 *)
 
 VAR
@@ -45,55 +46,109 @@ VAR
 (** Returns the shifted binary exponent (0 <= e < 256). *)
 PROCEDURE Expo* (x: REAL): LONGINT;
 BEGIN
-  RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
+  IF SIZE(INTEGER) = 4 THEN
+    RETURN SHORT(ASH(SYSTEM.VAL(INTEGER, x), -23)) MOD 256
+  ELSIF SIZE(LONGINT) = 4 THEN
+    RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23)) MOD 256
+  ELSE Platform.Halt(-15);
+  END
 END Expo;
 
 (** Returns the shifted binary exponent (0 <= e < 2048). *)
 PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
   VAR i: LONGINT;
 BEGIN
+  IF SIZE(LONGINT) = 8 THEN
+    RETURN ASH(SYSTEM.VAL(LONGINT, x), -50) MOD 256
+  ELSE
     SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
+  END
 END ExpoL;
 
 (** Sets the shifted binary exponent. *)
-PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
+PROCEDURE SetExpo* (e: INTEGER; VAR x: REAL);
-  VAR i: LONGINT;
+  VAR i: INTEGER; l: LONGINT;
 BEGIN
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.GET(SYSTEM.ADR(x), l);
+    l := ASH(ASH(ASH(l, -31), 8) + e MOD 256, 23) + l MOD ASH(1, 23);
+    SYSTEM.PUT(SYSTEM.ADR(x), l)
+  ELSIF SIZE(INTEGER) = 4 THEN
     SYSTEM.GET(SYSTEM.ADR(x), i);
-  i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
+    i := SHORT(ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23));
     SYSTEM.PUT(SYSTEM.ADR(x), i)
+  ELSE Platform.Halt(-15)
+  END
 END SetExpo;
 
 (** Sets the shifted binary exponent. *)
 PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
-  VAR i: LONGINT;
+  VAR i: INTEGER; l: LONGINT;
 BEGIN
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.GET(SYSTEM.ADR(x) + H, l);
+    l := ASH(ASH(ASH(l, -31), 11) + e MOD 2048, 20) + l MOD ASH(1, 20);
+    SYSTEM.PUT(SYSTEM.ADR(x) + H, l)
+  ELSIF SIZE(INTEGER) = 4 THEN
     SYSTEM.GET(SYSTEM.ADR(x) + H, i);
-  i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
+    i := SHORT(ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20));
     SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
+  ELSE Platform.Halt(-15)
+  END
 END SetExpoL;
 
 (** Convert hexadecimal to REAL. *)
 PROCEDURE Real* (h: LONGINT): REAL;
   VAR x: REAL;
-BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
+BEGIN 
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(x), h)
+  ELSIF SIZE(INTEGER) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(INTEGER, h))
+  ELSE Platform.Halt(-15)
+  END;
+  RETURN x
 END Real;
 
 (** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
 PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
   VAR x: LONGREAL;
-BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
+BEGIN 
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(x) + H, h); 
+    SYSTEM.PUT(SYSTEM.ADR(x) + L, l)
+  ELSIF SIZE(INTEGER) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(x) + H, SYSTEM.VAL(INTEGER, h)); 
+    SYSTEM.PUT(SYSTEM.ADR(x) + L, SYSTEM.VAL(INTEGER, l))
+  ELSE Platform.Halt(-15)
+  END;
+  RETURN x
 END RealL;
 
 (** Convert REAL to hexadecimal. *)
 PROCEDURE Int* (x: REAL): LONGINT;
-  VAR i: LONGINT;
+  VAR i: INTEGER; l: LONGINT;
-BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
+BEGIN 
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(l), x); RETURN l
+  ELSIF SIZE(INTEGER) = 4 THEN
+    SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
+  ELSE Platform.Halt(-15)
+  END
 END Int;
 
 (** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
 PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
-BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
+  VAR i: INTEGER;
+BEGIN 
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.GET(SYSTEM.ADR(x) + H, h); 
+    SYSTEM.GET(SYSTEM.ADR(x) + L, l)
+  ELSIF SIZE(INTEGER) = 4 THEN
+    SYSTEM.GET(SYSTEM.ADR(x) + H, i); h := i; 
+    SYSTEM.GET(SYSTEM.ADR(x) + L, i); l := i
+  ELSE Platform.Halt(-15)
+  END
 END IntL;
 
 (** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
@@ -112,8 +167,9 @@ END Ten;
 
 (** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
 PROCEDURE NaNCode* (x: REAL): LONGINT;
+  VAR e: LONGINT;
 BEGIN
-  IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN  (* Infinite or NaN *)
+  IF Expo(x) = 255 THEN  (* Infinite or NaN *)
     RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H  (* lowest 23 bits *)
   ELSE
     RETURN -1
@@ -123,7 +179,7 @@ END NaNCode;
 (** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
 PROCEDURE NaNCodeL* (x: LONGREAL;  VAR h, l: LONGINT);
 BEGIN
-  SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
+  IntL(x, h, l);
   IF ASH(h, -20) MOD 2048 = 2047 THEN  (* Infinite or NaN *)
     h := h MOD 100000H  (* lowest 20 bits *)
   ELSE
@@ -131,37 +187,6 @@ BEGIN
   END
 END NaNCodeL;
 
-(** Returns TRUE iff x is NaN/Infinite. *)
-PROCEDURE IsNaN* (x: REAL): BOOLEAN;
-BEGIN
-  RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
-END IsNaN;
-
-(** Returns TRUE iff x is NaN/Infinite. *)
-PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
-VAR h: LONGINT;
-BEGIN
-  SYSTEM.GET(SYSTEM.ADR(x) + H, h);
-  RETURN ASH(h, -20) MOD 2048 = 2047
-END IsNaNL;
-
-(** Returns NaN with specified code (0 <= l < 8399608). *)
-PROCEDURE NaN* (l: LONGINT): REAL;
-VAR x: REAL;
-BEGIN
-  SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
-  RETURN x
-END NaN;
-
-(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
-PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
-VAR x: LONGREAL;
-BEGIN
-  h := (h MOD 100000H) + 7FF00000H;
-  SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
-  SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
-  RETURN x
-END NaNL;
 (*
 PROCEDURE fcr(): SET;
 CODE {SYSTEM.i386, SYSTEM.FPU}
@@ -192,33 +217,29 @@ BEGIN
   IF Kernel.copro THEN setfcr(s) END
 END SetFCR;
 *)
+
 PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
-BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l); 
+BEGIN 
+  IF SIZE(LONGINT) = 4 THEN
+    SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l); 
+  ELSIF SIZE(INTEGER) = 4 THEN
+    SYSTEM.PUT(adr + H, SYSTEM.VAL(INTEGER, h)); 
+    SYSTEM.PUT(adr + L, SYSTEM.VAL(INTEGER, l)); 
+  ELSE Platform.Halt(-15)
+  END
 END RealX;
 
-PROCEDURE InitHL;
-  VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
 BEGIN
-  (*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
+  RealX(03FF00000H, 000000000H, SYSTEM.ADR(tene[0]));
-  SetFCR(DefaultFCR);
+  RealX(040240000H, 000000000H, SYSTEM.ADR(tene[1]));  (*  1 *)
-  
+  RealX(040590000H, 000000000H, SYSTEM.ADR(tene[2]));  (*  2 *)
-  dmy := 1; i := SYSTEM.ADR(dmy);
+  RealX(0408F4000H, 000000000H, SYSTEM.ADR(tene[3]));  (*  3 *)
-  SYSTEM.GET(i, littleEndian);  (* indirection via i avoids warning on SUN cc -O *)*)
+  RealX(040C38800H, 000000000H, SYSTEM.ADR(tene[4]));  (*  4 *)
-  littleEndian := TRUE; (* endianness will be set for each architecture -- noch *)
+  RealX(040F86A00H, 000000000H, SYSTEM.ADR(tene[5]));  (*  5 *)
-  IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
+  RealX(0412E8480H, 000000000H, SYSTEM.ADR(tene[6]));  (*  6 *)
-END InitHL;
+  RealX(0416312D0H, 000000000H, SYSTEM.ADR(tene[7]));  (*  7 *)
-
+  RealX(04197D784H, 000000000H, SYSTEM.ADR(tene[8]));  (*  8 *)
-BEGIN InitHL;
+  RealX(041CDCD65H, 000000000H, SYSTEM.ADR(tene[9]));  (*  9 *)
-  RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
-  RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
-  RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
-  RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
-  RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
-  RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
-  RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
-  RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
-  RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
-  RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
   RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
   RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
   RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
@@ -231,20 +252,20 @@ BEGIN InitHL;
   RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
   RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
   RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
-  RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
+  RealX(04480F0CFH, 0064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
   
-  RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
+  RealX(00031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0]));  (* -307 *)
-  RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
+  RealX(004F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1]));  (* -284 *)
-  RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
+  RealX(009BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2]));  (* -261 *)
-  RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
+  RealX(00E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3]));  (* -238 *)
   RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4]));  (* -215 *)
   RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5]));  (* -192 *)
   RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6]));  (* -169 *)
   RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7]));  (* -146 *)
   RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8]));  (* -123 *)
   RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9]));  (* -100 *)
-  RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
+  RealX(02FF286D8H, 00EC190DCH, SYSTEM.ADR(ten[10])); (*  -77 *)
-  RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
+  RealX(034B8851AH, 00B548EA4H, SYSTEM.ADR(ten[11])); (*  -54 *)
   RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (*  -31 *)
   RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (*   -8 *)
   RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (*   15 *)
@@ -252,7 +273,7 @@ BEGIN InitHL;
   RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (*   61 *)
   RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (*   84 *)
   RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (*  107 *)
-  RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
+  RealX(05AECDA62H, 0055B2D9EH, SYSTEM.ADR(ten[19])); (*  130 *)
   RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (*  153 *)
   RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (*  176 *)
   RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (*  199 *)

src/library/s3/ethStrings.Mod

@@ -6,7 +6,7 @@ MODULE ethStrings;  (** portable *) (* ejz,  *)
 (** Strings is a utility module that provides procedures to manipulate strings.
     Note: All strings MUST be 0X terminated. *)
 
-  IMPORT Oberon, Texts, Dates := ethDates, Reals := ethReals;
+  IMPORT Texts, Dates := ethDates, Reals := ethReals;
   
   CONST
     CR* = 0DX; (** the Oberon end of line character *)

src/library/s3/ethZip.Mod

@@ -486,6 +486,7 @@ BEGIN
       ELSE
         res := DataError
       END
+    ELSE
     END;
     IF res = Ok THEN
       Files.Close(Files.Base(dst));

src/library/s3/ethZlibDeflate.Mod

@@ -257,6 +257,7 @@ PROCEDURE SetDataType(VAR stream: Stream);
 VAR
   n, ascii, bin: LONGINT;
 BEGIN
+  n := 0; ascii := 0; bin := 0;
   WHILE n < 7 DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
   WHILE n < 128 DO INC(ascii, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
   WHILE n < Literals DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;

src/library/s3/ethZlibInflate.Mod

@@ -777,6 +777,7 @@ MODULE ethZlibInflate;  (** eos  **)
           s.block.state := BlkBad; s.res.code := DataError;
           Flush(s);
           EXIT
+        ELSE
         END
       
       | BlkLens:  (* read length of uncompressed block *)
@@ -890,6 +891,7 @@ MODULE ethZlibInflate;  (** eos  **)
             | 18:  (* repeat code length 0 for 11-138 times, using another 7 bits *)
               IF ~Need(s, node.bits+7) THEN EXIT END;
               Dump(s, node.bits); cnt := 11 + s.buf MOD 128; Dump(s, 7); len := 0
+            ELSE
             END;
             IF s.block.index + cnt > s.block.nlit + s.block.ndist THEN
               SetMsg(s.res, "invalid bit length repeat");
@@ -1125,6 +1127,7 @@ MODULE ethZlibInflate;  (** eos  **)
         | InfBad:  (* error in stream *)
           stream.res.code := DataError;
           EXIT
+        ELSE
         END
       END
     END

src/library/ulm/ulmConstStrings.Mod

@@ -520,6 +520,7 @@ MODULE ulmConstStrings;
 	 | Streams.fromStart: realpos := cnt;
 	 | Streams.fromPos:   realpos := s.pos + cnt;
 	 | Streams.fromEnd:   realpos := s.string.length + cnt;
+    ELSE
 	 END;
 	 IF (realpos < 0) OR (realpos > s.string.length) THEN
 	    RETURN FALSE

src/library/ulm/ulmEvents.Mod

@@ -375,6 +375,7 @@ MODULE ulmEvents;
 		     ptr := ptr.next;
 		  END;
 		  psys.currentPriority := oldPriority;
+      ELSE (* Explicitly ignore unhandled even type reactions *)
       END;
    END CallHandlers;
 

src/library/ulm/ulmPersistentObjects.Mod

@@ -647,6 +647,7 @@ MODULE ulmPersistentObjects;
 			ELSE
 			   form := incrF;
 			END;
+      ELSE
       END;
       IF mode DIV 4 MOD 2 > 0 THEN
 	 INC(form, sizeF);

src/library/ulm/ulmPrint.Mod

@@ -193,6 +193,7 @@ MODULE ulmPrint;
             | 6: arglen[index] := LEN(p7);
             | 7: arglen[index] := LEN(p8);
             | 8: arglen[index] := LEN(p9);
+            ELSE
             END;
             INC(index);
          END;
@@ -210,6 +211,7 @@ MODULE ulmPrint;
          | 6: RETURN p7[at]
          | 7: RETURN p8[at]
          | 8: RETURN p9[at]
+         ELSE
          END;
       END Access;
 
@@ -634,6 +636,7 @@ MODULE ulmPrint;
                               ndigits := 1;
                            END;
                   | "g":   ndigits := SHORT(scale);
+                  ELSE
                   END;
                   Reals.Digits(mantissa, 10, digits, neg,
                                (* force = *) format # "g", ndigits);
@@ -654,6 +657,7 @@ MODULE ulmPrint;
                               END;
                               Print(decpt, (* withexp = *) FALSE, 0);
                            END;
+                  ELSE
                   END;
                   RETURN TRUE
                ELSE

src/library/ulm/ulmResources.Mod

@@ -185,6 +185,7 @@ MODULE ulmResources;
       | communicationResumed: disc.stopped := FALSE;
       | communicationStopped: disc.stopped := TRUE;
       | terminated:           disc.stopped := FALSE; disc.state := terminated;
+      ELSE (* Explicitly ignore unhandled values of change *)
       END;
       GenEvent(resource, change);
 

src/library/ulm/ulmSYSTEM.Mod

@@ -1,9 +1,9 @@
 MODULE ulmSYSTEM;
-IMPORT SYSTEM, Unix, Sys := ulmSys;
+IMPORT SYSTEM, Platform, Sys := ulmSys;
 
 TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
      pstring = POINTER TO ARRAY 1024 OF CHAR;
-     pstatus = POINTER TO Unix.Status;
+     (* pstatus = POINTER TO Platform.Status; *)
 
       TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
           pbytearray* = POINTER TO bytearray;
@@ -52,16 +52,16 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
   PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
                      arg1, arg2, arg3: LONGINT) : BOOLEAN;  
   VAR
-      n : LONGINT;
+      n:    LONGINT;
-      ch : CHAR;
+      ch:   CHAR;
-      pch : pchar;
+      pch:  pchar;
-      pstr : pstring; 
+      pstr: pstring; 
-      pst : pstatus;
+      h:    Platform.FileHandle;
+      (* pst : pstatus; *)
   BEGIN
   
   IF syscall = Sys.read THEN
-    d0 := Unix.Read(SHORT(arg1), arg2, arg3);
+    RETURN Platform.Read(arg1, arg2, arg3, n) = 0;
-    IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
     (*NEW(pch);
     pch := SYSTEM.VAL(pchar, arg2);
     ch := pch^[0];
@@ -75,8 +75,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
     END;
     *)
   ELSIF syscall = Sys.write THEN
-    d0 := Unix.Write(SHORT(arg1), arg2, arg3);
+    RETURN Platform.Write(arg1, arg2, arg3) = 0;
-    IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
     (*NEW(pch);
     pch := SYSTEM.VAL(pchar, arg2);
     n := Write(SYSTEM.VAL(LONGINT, pch), 1);
@@ -84,35 +83,40 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
     *)
   ELSIF syscall = Sys.open THEN  
     pstr := SYSTEM.VAL(pstring, arg1);
-     d0 := Unix.Open(pstr^, SHORT(arg3), arg2);
+    IF SYSTEM.VAL(SET, arg3) * {0,1} # {} THEN
-     IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
+      RETURN Platform.OldRW(pstr^, d0) = 0
+    ELSE
+      RETURN Platform.OldRO(pstr^, d0) = 0
+    END
   ELSIF syscall = Sys.close THEN
-     d0 := Unix.Close(SHORT(arg1));
+    RETURN Platform.Close(arg1) = 0
-     IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
   ELSIF syscall = Sys.lseek THEN
-     d0 := Unix.Lseek(SHORT(arg1), arg2, SHORT(arg3));
+    RETURN Platform.Seek(arg1, arg2, SYSTEM.VAL(INTEGER, arg3)) = 0
-     IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
+  (*
   ELSIF syscall = Sys.ioctl THEN
-     d0 := Unix.Ioctl(SHORT(arg1), SHORT(arg2), arg3);
+     d0 := Platform.Ioctl(arg1, arg2, arg3);
      RETURN d0 >= 0;
   ELSIF syscall = Sys.fcntl THEN
-     d0 := Unix.Fcntl (SHORT(arg1), SHORT(arg2), arg3);
+     d0 := Platform.Fcntl (arg1, arg2, arg3);
      RETURN d0 >= 0;
   ELSIF syscall = Sys.dup THEN
-     d0 := Unix.Dup(SHORT(arg1));
+     d0 := Platform.Dup(arg1);
      RETURN d0 > 0;
   ELSIF syscall = Sys.pipe THEN
-     d0 := Unix.Pipe(arg1);
+     d0 := Platform.Pipe(arg1);
      RETURN d0 >= 0;
   ELSIF syscall = Sys.newstat THEN
      pst := SYSTEM.VAL(pstatus, arg2);
      pstr := SYSTEM.VAL(pstring, arg1);
-     d0 := Unix.Stat(pstr^, pst^);
+     d0 := Platform.Stat(pstr^, pst^);
      RETURN d0 >= 0
   ELSIF syscall = Sys.newfstat THEN
      pst := SYSTEM.VAL(pstatus, arg2);
-     d0 := Unix.Fstat(SHORT(arg1), pst^);
+     d0 := Platform.Fstat(arg1, pst^);
      RETURN d0 >= 0;
+  *)
+  ELSE
+    HALT(99);
   END
 
   END UNIXCALL;

src/library/ulm/ulmScales.Mod

@@ -403,6 +403,7 @@ MODULE ulmScales;
 				 (* abs - abs  or  rel - rel *)
 				 restype := relative;
 			      END;
+       ELSE
 	    END;
 	    ASSERT(ok); (* invalid operation *)
 	 END; END;

src/library/ulm/ulmStreamConditions.Mod

@@ -115,6 +115,7 @@ MODULE ulmStreamConditions;
 	 | write: IF Streams.OutputWillBeBuffered(condition.stream) THEN
 		     RETURN TRUE
 		  END;
+    ELSE
 	 END;
 	 msg.operation := condition.operation;
 	 msg.errors := errors;

src/library/ulm/ulmStreams.Mod

@@ -632,6 +632,7 @@ MODULE ulmStreams;
       | linebuf:  nbuf := 1;
       | onebuf:   nbuf := 1;
       | bufpool:  nbuf := s.bufpool.maxbuf;
+      ELSE (* Explicitly ignore unhandled values of s.bufmode  *)
       END;
    END GetBufferPoolSize;
 

src/library/ulm/ulmSysConversions.Mod

@@ -336,7 +336,7 @@ MODULE ulmSysConversions;
 
 	 (* C type *)
 	 CASE type2 OF
-	 | "a":   size2 := 8; INCL(flags, unsigned); (* char*              *)
+	 | "a":   size2 := SIZE(Address); INCL(flags, unsigned); (* char*              *)
 	 | "c":   size2 := 1;                                    (* /* signed */ char  *)
 	 | "C":   size2 := 1;             INCL(flags, unsigned); (* unsigned char      *)
 	 | "s":   size2 := 2;                                    (* short int          *)

src/library/ulm/ulmSysIO.Mod

@@ -123,6 +123,7 @@ MODULE ulmSysIO;
          a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
    BEGIN
       interrupted := FALSE;
+      a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
       LOOP
          IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
          (*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
@@ -294,6 +295,7 @@ MODULE ulmSysIO;
          d0, d1: LONGINT;
          a0, a1: LONGINT;
    BEGIN
+      a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
       IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN
          newfd := d0;
          RETURN TRUE
@@ -310,6 +312,7 @@ MODULE ulmSysIO;
          fd2: File;
          interrupted: BOOLEAN;
    BEGIN
+      a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
       fd2 := newfd;
       (* handmade close to avoid unnecessary events *)
       IF ~ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, newfd, a0, a1) THEN END;
@@ -331,6 +334,7 @@ MODULE ulmSysIO;
          a0, a1: LONGINT;
          fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
    BEGIN
+      a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
       IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN
          readfd := fds[0]; writefd := fds[1];
          RETURN TRUE

src/library/ulm/ulmSysStat.Mod

@@ -92,136 +92,98 @@ MODULE ulmSysStat;
       rwx* = prot;
 
    TYPE
-      StatRec* =                                (* result of stat(2) and fstat(2) *)
+      StatRec* = RECORD            (* result of stat(2) and fstat(2) *)
-         RECORD
+        device*:  SysTypes.Device; (* ID of device containing a directory entry 
-            device*: SysTypes.Device;   (* ID of device containing
+                                      for this file *)
-                                           a directory entry for this file *)
         inode*:   SysTypes.Inode;  (* inode number *)
-            nlinks*: LONGINT(*INTEGER*);           (* number of links *)
         mode*:    SET;             (* file mode; see mknod(2) *)
-            uid*: INTEGER;              (* user id of the file's owner *)
-            gid*: INTEGER;              (* group id of the file's group *)
-            rdev*: SysTypes.Device;     (* ID of device
-                                           this entry is defined only for
-                                           character special or block
-                                           special files
-                                        *)
-            size*: SysTypes.Offset;     (* file size in bytes *)
-            blksize*: LONGINT;          (* preferred blocksize *)
-            blocks*: LONGINT;           (* # of blocks allocated *)
-            atime*: SysTypes.Time;      (* time of last access *)
-            mtime*: SysTypes.Time;      (* time of last data modification *)
-            ctime*: SysTypes.Time;      (* time of last file status change *)
-         END;
-
-(*      StatRec* =				(* result of stat(2) and fstat(2) *)
-	 RECORD
-	    device*: SysTypes.Device;	(* ID of device containing
-					   a directory entry for this file *)
-	    inode*: SysTypes.Inode;	(* inode number *)
         nlinks*:  LONGINT;         (* number of links *)
-	    mode*: INTEGER(*SET*);			(* file mode; see mknod(2) *)
+        uid*:     LONGINT;         (* user id of the file's owner *)
-	    uid*: INTEGER;		(* user id of the file's owner *)
+        gid*:     LONGINT;         (* group id of the file's group *)
-	    gid*: INTEGER;		(* group id of the file's group *)
+        rdev*:    SysTypes.Device; (* ID of device. this entry is defined only for
-	    pad0: INTEGER;
+                                      character special or block special files *)
-	    rdev*: SysTypes.Device;	(* ID of device
-					   this entry is defined only for
-					   character special or block
-					   special files
-					*)
         size*:    SysTypes.Offset; (* file size in bytes *)
+        
+        (* Blocks and blksize are not available on all platforms.
         blksize*: LONGINT;         (* preferred blocksize *)
         blocks*:  LONGINT;         (* # of blocks allocated *)
+        *)
+        
         atime*:   SysTypes.Time;   (* time of last access *)
-	    atimences* : LONGINT;
         mtime*:   SysTypes.Time;   (* time of last data modification *)
-	    mtimensec* : LONGINT;
         ctime*:   SysTypes.Time;   (* time of last file status change *)
-	    ctimensec* : LONGINT;
-	    unused0*, unused1*, unused2*: LONGINT;
      END;
-*)
-(* Linux kernel struct stat (2.2.17)
-      struct stat {
-	      unsigned short st_dev;
-	      unsigned short __pad1;
-	      unsigned long st_ino;
-	      unsigned short st_mode;
-	      unsigned short st_nlink;
-	      unsigned short st_uid;
-	      unsigned short st_gid;
-	      unsigned short st_rdev;
-	      unsigned short __pad2;
-	      unsigned long  st_size;
-	      unsigned long  st_blksize;
-	      unsigned long  st_blocks;
-	      unsigned long  st_atime;
-	      unsigned long  __unused1;
-	      unsigned long  st_mtime;
-	      unsigned long  __unused2;
-	      unsigned long  st_ctime;
-	      unsigned long  __unused3;
-	      unsigned long  __unused4;
-	      unsigned long  __unused5;
-      };
-*)
 
-   CONST
-      statbufsize = 144(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 or x86; -- noch *)
-   TYPE
-      UnixStatRec = ARRAY statbufsize OF SYS.BYTE;
-   CONST
-      statbufconv =
-      (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*)
-      "lL=dev/lL=ino/lL=nlink/Su=mode/2*iu=uid+gid/-i=pad0/lL=rdev/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; (* noch *)
-   VAR
-      statbuffmt: SysConversions.Format;
 
-   PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
+   PROCEDURE -Aincludesysstat  '#include <sys/stat.h>';
-		  errors: RelatedEvents.Object) : BOOLEAN;
+   PROCEDURE -Aerrno           '#include <errno.h>';
-      VAR
+
-	 d0, d1, d2: LONGINT;
+   PROCEDURE -structstats            "struct stat s";
-	 origbuf: UnixStatRec;
+   PROCEDURE -statdev():     LONGINT "(LONGINT)s.st_dev";
+   PROCEDURE -statino():     LONGINT "(LONGINT)s.st_ino";
+   PROCEDURE -statmode():    LONGINT "(LONGINT)s.st_mode";
+   PROCEDURE -statnlink():   LONGINT "(LONGINT)s.st_nlink";
+   PROCEDURE -statuid():     LONGINT "(LONGINT)s.st_uid";
+   PROCEDURE -statgid():     LONGINT "(LONGINT)s.st_gid";
+   PROCEDURE -statrdev():    LONGINT "(LONGINT)s.st_rdev";
+   PROCEDURE -statsize():    LONGINT "(LONGINT)s.st_size";
+   PROCEDURE -statatime():   LONGINT "(LONGINT)s.st_atime";
+   PROCEDURE -statmtime():   LONGINT "(LONGINT)s.st_mtime";
+   PROCEDURE -statctime():   LONGINT "(LONGINT)s.st_ctime";
+   
+   (* Blocks and blksize are not available on all platforms.
+   PROCEDURE -statblksize(): LONGINT "(LONGINT)s.st_blksize";
+   PROCEDURE -statblocks():  LONGINT "(LONGINT)s.st_blocks";
+   *)
+
+   PROCEDURE -fstat(fd: LONGINT):      INTEGER "fstat(fd, &s)";
+   PROCEDURE -stat (n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
+
+   PROCEDURE -err(): INTEGER "errno";
+
+   PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
    BEGIN
-      IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN
+      structstats;
-	 SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
+      IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END;
-	 RETURN TRUE
+      buf.device  := SYS.VAL(SysTypes.Device, statdev());
-      ELSE
+      buf.inode   := SYS.VAL(SysTypes.Inode,  statino());
-	 SysErrors.Raise(errors, d0, Sys.newstat, path);
+      buf.mode    := SYS.VAL(SET,             statmode());
-	 RETURN FALSE
+      buf.nlinks  := statnlink();
-      END;
+      buf.uid     := statuid();
+      buf.gid     := statgid();
+      buf.rdev    := SYS.VAL(SysTypes.Device, statrdev());
+      buf.size    := SYS.VAL(SysTypes.Offset, statsize());
+      (* Blocks and blksize are not available on all platforms.
+      buf.blksize := statblksize();
+      buf.blocks  := statblocks();
+      *)
+      buf.atime   := SYS.VAL(SysTypes.Time, statatime());
+      buf.mtime   := SYS.VAL(SysTypes.Time, statmtime());
+      buf.ctime   := SYS.VAL(SysTypes.Time, statctime());
+      RETURN TRUE;
    END Stat;
-(* commented temporarily, it is used only in FTPUnixDirLister module *) (*
+
-   PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
+   PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
-		   errors: RelatedEvents.Object) : BOOLEAN;
-      VAR
-	 d0, d1: INTEGER;
-	 origbuf: UnixStatRec;
    BEGIN
-      IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN
+      structstats;
-	 SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
+      IF fstat(SYS.VAL(LONGINT, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
-	 RETURN TRUE
+      buf.device  := SYS.VAL(SysTypes.Device, statdev());
-      ELSE
+      buf.inode   := SYS.VAL(SysTypes.Inode,  statino());
-	 SysErrors.Raise(errors, d0, Sys.newlstat, path);
+      buf.mode    := SYS.VAL(SET,             statmode());
-	 RETURN FALSE
+      buf.nlinks  := statnlink();
-      END;
+      buf.uid     := statuid();
-   END Lstat;
+      buf.gid     := statgid();
-*)
+      buf.rdev    := SYS.VAL(SysTypes.Device, statrdev());
-   PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec;
+      buf.size    := SYS.VAL(SysTypes.Offset, statsize());
-		   errors: RelatedEvents.Object) : BOOLEAN;
+      (* Blocks and blksize are not available on all platforms.
-      VAR
+      buf.blksize := statblksize();
-	 d0, d1, d2: LONGINT;
+      buf.blocks  := statblocks();
-	 origbuf: UnixStatRec;
+      *)
-   BEGIN
+      buf.atime   := SYS.VAL(SysTypes.Time, statatime());
-      IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN
+      buf.mtime   := SYS.VAL(SysTypes.Time, statmtime());
-	 SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
+      buf.ctime   := SYS.VAL(SysTypes.Time, statctime());
-	 RETURN TRUE
+      RETURN TRUE;
-      ELSE
-	 SysErrors.Raise(errors, d0, Sys.newfstat, "");
-	 RETURN FALSE
-      END;
    END Fstat;
 
-BEGIN
+
-   SysConversions.Compile(statbuffmt, statbufconv);
 END ulmSysStat.

src/library/ulm/ulmTCrypt.Mod

@@ -351,6 +351,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
             IF ((SetBits + 1) MOD 2) = 1 THEN
                x := x + {M-1};
             END;
+      ELSE
       END;
    END CreateCCM;
 
@@ -823,6 +824,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
             ELSE
                CreateCCM(p.koeff, reg);
             END;
+      ELSE
       END;
 
       p := proot;

src/library/ulm/ulmTexts.Mod

@@ -229,6 +229,7 @@ MODULE ulmTexts;
 	 | Streams.fromStart: pos := count;
 	 | Streams.fromPos:   pos := count + s.pos;
 	 | Streams.fromEnd:   pos := count + s.len;
+    ELSE
 	 END;
 	 IF (pos >= 0) & (pos <= s.len) THEN
 	    s.pos := pos;

src/library/ulm/ulmTimes.Mod

@@ -200,6 +200,7 @@ MODULE ulmTimes;
 	 | epochUnit:  value := measure.timeval.epoch;
 	 | secondUnit:  value := measure.timeval.second;
 	 | usecUnit:    value := measure.timeval.usec;
+    ELSE
 	 END;
       END; END;
    END InternalGetValue;
@@ -212,6 +213,7 @@ MODULE ulmTimes;
 	 | epochUnit:   measure.timeval.epoch := value;
 	 | secondUnit:  measure.timeval.second := value;
 	 | usecUnit:    measure.timeval.usec := value;
+    ELSE
 	 END;
 	 Normalize(measure.timeval);
       END; END;
@@ -274,6 +276,7 @@ MODULE ulmTimes;
 	    CASE op OF
 	    | Scales.add:  Add(op1.timeval, op2.timeval, result.timeval);
 	    | Scales.sub:  Sub(op1.timeval, op2.timeval, result.timeval);
+       ELSE
 	    END;
 	 END;
       END; END;
@@ -293,7 +296,8 @@ MODULE ulmTimes;
       END ReturnVal;
 
    BEGIN
-      WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
+      WITH op1: ReferenceTime DO 
+         WITH op2: ReferenceTime DO
 	         IF op1.timeval.epoch # op2.timeval.epoch THEN
 	            RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
 	         ELSIF op1.timeval.second # op2.timeval.second THEN
@@ -301,7 +305,9 @@ MODULE ulmTimes;
 	         ELSE
 	            RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
 	         END;
-      END; END;
+         END; 
+      END;
+      RETURN 0;
    END Compare;
 
    (* ========= initialization procedures ========================== *)

src/library/ulm/ulmTypes.Mod

@@ -50,7 +50,7 @@ MODULE ulmTypes;
    IMPORT SYS := SYSTEM;
 
    TYPE
-      Address* = (*SYS.PTR*) LONGINT (*SYS.ADDRESS*);
+      Address* = LONGINT (*SYS.ADDRESS*);
       (* ulm compiler can accept 
          VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
          ...
@@ -58,18 +58,16 @@ MODULE ulmTypes;
          and this is how it is used in ulm oberon system library,
          while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
          Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)      
+     
       UntracedAddress*      = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
       UntracedAddressDesc* = RECORD[1] END;
 
-      intarr64 = ARRAY 8 OF SYS.BYTE; (* to emulate int16 on x86_64; -- noch *)
-      intarr16 = ARRAY 2 OF SYS.BYTE;
-      
       Count*      = LONGINT;
       Size*       = Count;
       Byte*       = SYS.BYTE;
       IntAddress* = LONGINT;
       Int8*       = SHORTINT;
-      Int16* = intarr16(*INTEGER*); (* we don't have 16 bit integer in x86_64 version of voc *) 
+      Int16*      = INTEGER; (* No real 16 bit integer type *)
       Int32*      = INTEGER;
       Real32*     = REAL;
       Real64*     = LONGREAL;
@@ -93,21 +91,17 @@ MODULE ulmTypes;
 
    PROCEDURE ToInt8*(int: LONGINT) : Int8;
    BEGIN
-      RETURN SHORT(SHORT(int))
+      RETURN SYS.VAL(SHORTINT, int)
    END ToInt8;
 
-   PROCEDURE ToInt16*(int: LONGINT; VAR int16: Int16)(* : Int16*);
+   PROCEDURE ToInt16*(int: LONGINT) : Int16;
-   VAR longintarr : intarr64;
    BEGIN
-      (*RETURN SYS.VAL(Int16, int)*)
+      RETURN SYS.VAL(Int16, int)
-      longintarr := SYS.VAL(intarr64, int);
-      int16[0] := longintarr[0];
-      int16[1] := longintarr[1]; (* this will work for little endian -- noch *)
    END ToInt16;
 
    PROCEDURE ToInt32*(int: LONGINT) : Int32;
    BEGIN
-      RETURN SHORT(int)
+      RETURN SYS.VAL(INTEGER, int)
    END ToInt32;
 
    PROCEDURE ToReal32*(real: LONGREAL) : Real32;

src/library/v4/Args.Mod

@@ -3,63 +3,29 @@ MODULE Args;  (* jt, 8.12.94 *)
   (* command line argument handling for voc (jet backend) *)
 
 
-  IMPORT SYSTEM;
+  IMPORT Platform;
 
   TYPE
     ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
     ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
 
-  VAR argc-: INTEGER; argv-: LONGINT;
+  VAR
-  (*PROCEDURE -includestdlib() "#include <stdlib.h>";*)
+    argc-: LONGINT;
-  PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*)
+    argv-: LONGINT;
-  PROCEDURE -Argc(): INTEGER "SYSTEM_argc";
-  PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv";
-  PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr
-    "(Args_ArgPtr)getenv(var)";
 
-  PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR);
-    VAR av: ArgVec;
-  BEGIN
-    IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END
-  END Get;
 
-  PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT);
+PROCEDURE Get*   (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Platform.GetArg(n, val)    END Get;
-    VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
+PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT);       BEGIN Platform.GetIntArg(n, val) END GetInt;
-  BEGIN
+PROCEDURE Pos*   (s: ARRAY OF CHAR): INTEGER;          BEGIN RETURN Platform.ArgPos(s)  END Pos;
-    s := ""; Get(n, s); i := 0;
-    IF s[0] = "-" THEN i := 1 END ;
-    k := 0; d := ORD(s[i]) - ORD("0");
-    WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
-    IF s[0] = "-" THEN d := -d; DEC(i) END ;
-    IF i > 0 THEN val := k END
-  END GetInt;
 
-  PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER;
+PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); 
-    VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
+BEGIN Platform.GetEnv(var, val) END GetEnv;
-  BEGIN
-    i := 0; Get(i, arg);
-    WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ;
-    RETURN i
-  END Pos;
 
-  PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
+PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; 
-    VAR p: ArgPtr;
+BEGIN RETURN Platform.getEnv(var, val) END getEnv;
-  BEGIN
-    p := getenv(var);
-    IF p # NIL THEN COPY(p^, val) END
-  END GetEnv;
 
-  PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
-    VAR p: ArgPtr;
-  BEGIN
-    p := getenv(var);
-    IF p # NIL THEN
-       COPY(p^, val);
-       RETURN TRUE
-    ELSE
-       RETURN FALSE
-    END
-  END getEnv;
 
-BEGIN argc := Argc(); argv := Argv()
+BEGIN
+  argc := Platform.ArgCount;
+  argv := Platform.ArgVector;
 END Args.

src/library/v4/Modules.Mod

@@ -3,7 +3,7 @@ MODULE Modules;  (* jt 6.1.96 *)
   (* access to list of modules and commands, based on ETH Oberon *)
 
 
-  IMPORT SYSTEM, Console;
+  IMPORT SYSTEM, Console, Heap;
 
   CONST
     ModNameLen* = 20;
@@ -37,10 +37,10 @@ MODULE Modules;  (* jt 6.1.96 *)
 
 
   PROCEDURE -modules*(): Module
-      "(Modules_Module)SYSTEM_modules";
+      "(Modules_Module)Heap_modules";
 
   PROCEDURE -setmodules*(m: Module)
-      "SYSTEM_modules = m";
+      "Heap_modules = m";
 
 
   PROCEDURE Append(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR);

src/library/v4/Printer.Mod

@@ -1,6 +1,6 @@
 MODULE Printer;  (*UNIX version: JT 11.5.90, RC 2.7.93,  JS 29.4.94, JT 14.4.95 *)
 
-  IMPORT SYSTEM, Files, Unix, Kernel;
+  IMPORT SYSTEM, Files, Platform;
 
   CONST
     N = 20;
@@ -608,9 +608,6 @@ END;
     REPEAT ch := s2[j]; s1[i] := ch; INC(i); INC(j) UNTIL ch = 0X
   END Append;
 
-  PROCEDURE -system(cmd: ARRAY OF CHAR)
-    "system(cmd)";
-
   PROCEDURE Close*;
     CONST bufSize = 4*1024;
     VAR
@@ -645,7 +642,7 @@ END;
       cmd := "lp -c -s "; 
       IF PrinterName # "Pluto" THEN Append(cmd, "-d "); Append(cmd, PrinterName) END ;
       Append(cmd, " "); Append(cmd, printFileName);
-      system(cmd);
+      i := Platform.System(cmd);
       Files.Delete(printFileName, res);
     END;
     Files.Set(bodyR, NIL, 0);

src/library/v4/Reals.Mod

@@ -2,10 +2,7 @@ MODULE Reals;
   (* JT, 5.2.90 / RC 9.12.91 conversion between reals and strings for HP-700, MB 9.12.91, JT for Ofront, 16.3. 95*)
 
   IMPORT S := SYSTEM;
-(* getting rid of ecvt -- noch
+
-  PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT
-      "(LONGINT)ecvt (x, ndigit, decpt, sign)";
-*)
   PROCEDURE Ten*(e: INTEGER): REAL;
   VAR r, power: LONGREAL;
   BEGIN r := 1.0;
@@ -17,6 +14,7 @@ MODULE Reals;
     RETURN SHORT(r)
   END Ten;
   
+
   PROCEDURE TenL*(e: INTEGER): LONGREAL;
     VAR r, power: LONGREAL;
   BEGIN r := 1.0;
@@ -29,166 +27,90 @@ MODULE Reals;
     END
   END TenL;
   
+ 
   PROCEDURE Expo*(x: REAL): INTEGER;
   BEGIN
-    RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
+    RETURN SHORT(ASH(S.VAL(INTEGER, x), -23) MOD 256)
   END Expo;
   
+ 
   PROCEDURE ExpoL*(x: LONGREAL): INTEGER;
-    VAR h: LONGINT;
+    VAR i: INTEGER; l: LONGINT;
   BEGIN
-    S.GET(S.ADR(x)+4, h);
+    IF SIZE(INTEGER) = 4 THEN
-    RETURN SHORT(ASH(h, -20) MOD 2048)
+      S.GET(S.ADR(x)+4, i); (* Fetch top 32 bits *)
+      RETURN SHORT(ASH(i, -20) MOD 2048)
+    ELSIF SIZE(LONGINT) = 4 THEN
+      S.GET(S.ADR(x)+4, l); (* Fetch top 32 bits *)
+      RETURN SHORT(ASH(l, -20) MOD 2048)
+    ELSE HALT(98)
+    END
   END ExpoL;
   
-  PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
-    CONST expo = {1..8};
-  BEGIN
-    x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23)))
-  END SetExpo;
 
-  PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
+  (* Convert LONGREAL: Write positive integer value of x into array d. 
-    CONST expo = {1..11};
+     The value is stored backwards, i.e. least significant digit
-    VAR h: SET;
+     first. n digits are written, with trailing zeros fill. 
+     On entry x has been scaled to the number of digits required. *)
+  PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
+    VAR i, j, k: LONGINT;
   BEGIN
-    S.GET(S.ADR(x)+4, h);
+    IF x < 0 THEN x := -x END;
-    h := h - expo + S.VAL(SET, ASH(LONG(e), 20));
+    k := 0;
-    S.PUT(S.ADR(x)+4, h)
-  END SetExpoL;
 
-   PROCEDURE Reverse0 (VAR str : ARRAY OF CHAR; start, end : INTEGER);
+    IF (SIZE(LONGINT) < 8) & (n > 9) THEN
-   (* Reverses order of characters in the interval [start..end]. *)
+      (* There are more decimal digits than can be held in a single LONGINT *)
-   VAR
+      i := ENTIER(x /      1000000000.0D0);  (* The 10th and higher digits *)
-     h : CHAR;
+      j := ENTIER(x - (i * 1000000000.0D0)); (* The low 9 digits *)
-   BEGIN
+      (* First generate the low 9 digits. *)
-     WHILE start < end DO
+      IF j < 0 THEN j := 0 END;
-       h := str[start]; str[start] := str[end]; str[end] := h;
+      WHILE k < 9 DO 
-       INC(start); DEC(end)
+        d[k] := CHR(j MOD 10 + 48); j := j DIV 10; INC(k)
-     END
+      END;
-   END Reverse0;
+      (* Fall through to generate the upper digits *)
-   (* these functions ⇅ necessary to get rid of ecvt -- noch *)
-   PROCEDURE IntToStr*(int: LONGINT; VAR str: ARRAY OF CHAR);
-   (* Converts the value of `int' to string form and copies the possibly truncated
-   result to `str'. *)
-   VAR
-     b : ARRAY 21 OF CHAR;
-     s, e: INTEGER;
-     maxLength : SHORTINT; (* maximum number of digits representing a LONGINT value *)
-   BEGIN
-     IF SIZE(LONGINT) = 4 THEN maxLength := 11 END;
-     IF SIZE(LONGINT) = 8 THEN maxLength := 20 END;
-     (* build representation in string 'b' *)
-     IF int = MIN(LONGINT) THEN (* smallest LONGINT, -int is an overflow *)
-       IF SIZE(LONGINT) = 4 THEN
-          b := "-2147483648";
-          e := 11
-       ELSE (* SIZE(LONGINT) = 8 *)
-          b := "-9223372036854775808";
-          e := 20
-       END	  
     ELSE
-       IF int < 0 THEN (* negative sign *)
+      (* We can generate all the digits in one go. *)
-         b[0] := "-"; int := -int; s := 1
+      i := ENTIER(x); 
-       ELSE (* no sign *)
-         s := 0
     END;
-       e := s; (* 's' holds starting position of string *)
-       REPEAT
-         b[e] := CHR(int MOD 10+ORD("0"));
-         int := int DIV 10;
-         INC(e)
-       UNTIL int = 0;
-       b[e] := 0X;
-       Reverse0(b, s, e-1);
-     END;
-       COPY(b, str) (* truncate output if necessary *)
-   END IntToStr;
   
-  PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
-    VAR i, k: LONGINT;
-  BEGIN IF x < 0 THEN x := -x END;
-    i := ENTIER(x); k := 0;
     WHILE k < n DO
       d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
     END
+  END ConvertL;
+
+
+  PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
+  BEGIN ConvertL(x, n, d)
   END Convert;
-(* experimental, -- noch
-  PROCEDURE Convert0*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
-    VAR i, j, k: LONGINT;
-    str : ARRAY 32 OF CHAR;
-  BEGIN
-  (*  IF x = MIN(LONGREAL) THEN x := MAX(LONGREAL) END;*)
-    IF x < 0 THEN x := -x END;
-    i := ENTIER(x);
-    IF i < 0 THEN i := -i END;
-    IntToStr(i, str);
-    IF n >= LEN(d) THEN n := SHORT(LEN(d)) - 1 END;
-    d[n] := 0X;
-    j := n - 1 ; 
-    IF j < 0 THEN j := 0 END;
-    k := 0;
-    REPEAT
-      d[j] := str[k];
-      DEC(j);
-      INC(k);
-    UNTIL (str[k] = 0X) OR (j < 0);	
 
-    WHILE j >= 0 DO d[j] := "0"; DEC(j) END ; 
+  PROCEDURE ToHex(i: INTEGER): CHAR;
-  END Convert0;
-*)
-  (* this seem to work -- noch *)
-  PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
-    VAR i, j, k: LONGINT;
-    str : ARRAY 32 OF CHAR;
   BEGIN
-  (*  IF x = MIN(LONGREAL) THEN x := MAX(LONGREAL) END;*)
+    IF i < 10 THEN RETURN CHR(i+48)
-    IF x < 0 THEN x := -x END;
+    ELSE           RETURN CHR(i+55) END
-    i := ENTIER(x);
+  END ToHex;
-    IF i < 0 THEN i := -i END;
-    IntToStr(i, str);
-    IF n >= LEN(d) THEN n := SHORT(LEN(d)) - 1 END;
-    d[n] := 0X;
-    j := n - 1 ; 
-    IF j < 0 THEN j := 0 END;
-    k := 0;
-    REPEAT
-      d[j] := str[k];
-      DEC(j);
-      INC(k);
-    UNTIL (str[k] = 0X) OR (j < 0);	
 
-    WHILE j >= 0 DO d[j] := "0"; DEC(j) END ; 
+  (* Convert Hex *)
-  END ConvertL;
+  PROCEDURE ConvertH*(y: REAL; VAR d: ARRAY OF CHAR);
-(* getting rid of ecvt -- noch
+  TYPE pc4 = POINTER TO ARRAY 4 OF CHAR;
-  PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
+  VAR p: pc4;  i: INTEGER;
-    VAR decpt, sign: INTEGER; i: LONGINT; buf: LONGINT;
   BEGIN 
-    (*x := x - 0.5; already rounded in ecvt*)
+    p := S.VAL(pc4, S.ADR(y)); i := 0; 
-    buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign));
+    WHILE i<4 DO 
-    i := 0;
+      d[i*2]   := ToHex(ORD(p[i]) DIV 16);
-    WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *)
+      d[i*2+1] := ToHex(ORD(p[i]) MOD 16)
-    i := n - i - 1;
-    WHILE i >= 0 DO d[i] := "0"; DEC(i) END ;
-  END ConvertL;
-*)
-  PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
-    VAR i, k: SHORTINT; len: LONGINT;
-  BEGIN i := 0; len := LEN(b);
-    WHILE i < len DO
-      k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
-      IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ;
-      k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
-      IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ;
-      INC(i)
     END
-  END Unpack;
-  
-  PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR);
-  BEGIN Unpack(y, d)
   END ConvertH;
   
-  PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR);
+  (* Convert Hex Long *)
-  BEGIN Unpack(x, d)
+  PROCEDURE ConvertHL*(y: LONGREAL; VAR d: ARRAY OF CHAR);
+  TYPE pc8 = POINTER TO ARRAY 8 OF CHAR;
+  VAR p: pc8;  i: INTEGER;
+  BEGIN 
+    p := S.VAL(pc8, S.ADR(y)); i := 0; 
+    WHILE i<8 DO 
+      d[i*2]   := ToHex(ORD(p[i]) DIV 16);
+      d[i*2+1] := ToHex(ORD(p[i]) MOD 16)
+    END
   END ConvertHL;
   
 END Reals.

src/library/v4/Sets.Mod

@@ -1,6 +1,6 @@
-MODULE Sets0;
+MODULE Sets;
 
-IMPORT Out := Console;
+IMPORT Texts;
 
 CONST (*size* = 32;*)
       size* = MAX(SET) + 1;
@@ -114,7 +114,7 @@ BEGIN
   i := 0; WHILE i < LEN(s1) DO s := s1[i] * s2[i]; s3[i] := s; INC(i) END
 END Intersect;
 
-(*
+
 PROCEDURE Print*(VAR f: Texts.Writer; s: ARRAY OF SET; w, indent: INTEGER);
   VAR col, i, max: INTEGER;
 BEGIN
@@ -133,27 +133,5 @@ BEGIN
   END ;
   Texts.Write(f, "}")
 END Print;
-*)
 
-PROCEDURE Write*(s: ARRAY OF SET; w, indent: INTEGER);
+END Sets.
-  VAR col, i, max: INTEGER;
-BEGIN
-  i := 0; col := indent; max := SHORT(LEN(s)) * size;
-  Out.Char("{");
-  WHILE i < max DO
-    IF In(s, i) THEN
-      IF col + 4 > w THEN
-        Out.Ln;
-        col := 0; WHILE col < indent DO Out.Char(" "); INC(col) END
-      END ;
-      Out.Int(i, 3); Out.Char(",");
-      INC(col, 4)
-    END ;
-    INC(i)
-  END ;
-  Out.Char("}")
-END Write;
-
-
-
-END Sets0.

src/library/v4/Texts.Mod

@@ -1,9 +1,9 @@
-MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**)  (* << RC, MB, JT *)
+MODULE Texts;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**)  (* << RC, MB, JT *)
   IMPORT
-    Files := Files0, Modules, Reals;
+    Files, Modules, Reals;
 
   (*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *)
-  (* this module is for bootstrapping voc, use Texts instead *)
+
 
   CONST
     Displaywhite = 15;
@@ -12,7 +12,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
     (**FileMsg.id**)
       load* = 0; store* = 1;
     (**Notifier op**)
-      replace* = 0; insert* = 1; delete* = 2;
+      replace* = 0; insert* = 1; delete* = 2; unmark* = 3;
     (**Scanner.class**)
       Inval* = 0; Name* = 1; String* = 2; Int* = 3; Real* = 4; LongReal* = 5; Char* = 6;
 
@@ -72,8 +72,10 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
       head: Run
     END;
 
+    Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
     TextDesc* = RECORD
       len*: LONGINT;
+      notify*: Notifier;
       head, cache: Run;
       corg: LONGINT
     END;
@@ -281,6 +283,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
     len := B.len; v := B.head.next;
     Merge(T, u, v); Splice(un, v, B.head.prev, T);
     INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
+    IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
   END Insert;
 
   PROCEDURE Append* (T: Text; B: Buffer);
@@ -288,6 +291,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
   BEGIN pos := T.len; len := B.len; v := B.head.next;
     Merge(T, T.head.prev, v); Splice(T.head, v, B.head.prev, T);
     INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
+    IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
   END Append;
 
   PROCEDURE Delete* (T: Text; beg, end: LONGINT);
@@ -299,6 +303,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
     Splice(del.head, un, v, NIL);
     Merge(T, u, vn); u.next := vn; vn.prev := u;
     DEC(T.len, end - beg);
+    IF T.notify # NIL THEN T.notify(T, delete, beg, end) END
   END Delete;
 
   PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SHORTINT);
@@ -313,6 +318,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
       IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
     END;
     Merge(T, u, un); u.next := un; un.prev := u;
+    IF T.notify # NIL THEN T.notify(T, replace, beg, end) END
   END ChangeLooks;
 
 
@@ -327,23 +333,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
       Files.Set(R.rider, u(Piece).file, u(Piece).org + R.off)
     END
   END OpenReader;
-(*
+
-  PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
-    VAR u: Run;
-  BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);
-    IF u IS Piece THEN Files.Read(R.rider, ch); R.elem := NIL;
-      IF (ch = 0AX) & u(Piece).ascii THEN ch := CR END  (* << LF to CR *)
-    ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)
-    ELSE ch := 0X; R.elem := NIL; R.eot := TRUE
-    END;
-    IF R.off = u.len THEN INC(R.org, u.len); u := u.next;
-      IF u IS Piece THEN
-        WITH u: Piece DO Files.Set(R.rider, u.file, u.org) END
-      END;
-      R.run := u; R.off := 0
-    END
-  END Read;
-*)
   PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
     VAR u: Run; pos: LONGINT; nextch: CHAR;
   BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);
@@ -364,7 +354,6 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
     END
   END Read;
 
-
   PROCEDURE ReadElem* (VAR R: Reader);
     VAR u, un: Run;
   BEGIN u := R.run;
@@ -557,11 +546,18 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
   END WriteString;
 
   PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
-    VAR i: INTEGER; x0: LONGINT;
+  VAR
-      a: ARRAY 11 OF CHAR;
+    i: INTEGER; x0: LONGINT;
+    a: ARRAY 22 OF CHAR;
   BEGIN i := 0;
     IF x < 0 THEN
-      IF x = MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN
+      IF x = MIN(LONGINT) THEN
+        IF SIZE(LONGINT) = 4 THEN
+          WriteString(W, " -2147483648")
+        ELSE
+          WriteString(W, " -9223372036854775808")
+        END;
+        RETURN
       ELSE DEC(n); x0 := -x
       END
     ELSE x0 := x
@@ -576,7 +572,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
 
   PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
     VAR i: INTEGER; y: LONGINT;
-      a: ARRAY 10 OF CHAR;
+      a: ARRAY 20 OF CHAR;
   BEGIN i := 0; Write(W, " ");
     REPEAT y := x MOD 10H;
       IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;
@@ -680,14 +676,22 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
       REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;
       (*there are 2 <= n <= maxD digits to be written*)
       IF x < 0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
+
+      (* Scale e to be an exponent of 10 rather than 2 *)
       e := SHORT(LONG(e - 1023) * 77 DIV 256);
       IF e >= 0 THEN x := x / Reals.TenL(e) ELSE x := Reals.TenL(-e) * x END ;
-      IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END ;
+      IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
+
+      (* Scale x to the number of digits requested *)
       x0 := Reals.TenL(n-1); x := x0*x + 0.5D0;
       IF x >= 10.0D0*x0 THEN x := 0.1D0 * x; INC(e) END ;
+
+      (* Generate the mantissa digits of x *)
       Reals.ConvertL(x, n, d);
+
       DEC(n); Write(W, d[n]); Write(W, ".");
       REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
+
       Write(W, "D");
       IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
       Write(W, CHR(e DIV 100 + 30H)); e := e MOD 100;
@@ -865,6 +869,7 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
       u := u.next
     END;
     r := msg.r;
+    IF T.notify # NIL THEN T.notify(T, unmark, 0, 0) END
   END Store;
 
   PROCEDURE Close* (T: Text; name: ARRAY OF CHAR);
@@ -877,4 +882,4 @@ MODULE Texts0;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
   END Close;
 
 BEGIN del := NIL; NEW(FontsDefault); FontsDefault.name := "Syntax10.Scn.Fnt"
-END Texts0.
+END Texts.