ulmSYSTEM implements SYSTEM.UNIXCALL with two calls (read and write a

character), ported ulmIO which uses those calls.


Former-commit-id: 2cf9f399e3

src/lib/ulm/gnuc/ulmSYSTEM.Mod

@@ -0,0 +1,67 @@
+MODULE ulmSYSTEM;
+IMPORT SYSTEM;
+
+CONST
+      READ = 3;
+      WRITE = 4;
+      
+TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
+
+        PROCEDURE -Write(adr, n: LONGINT): LONGINT
+	  "write(1/*stdout*/, adr, n)";
+
+	PROCEDURE -read(VAR ch: CHAR): LONGINT
+	  "read(0/*stdin*/, ch, 1)";
+
+
+  PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
+  VAR oldflag : BOOLEAN;
+  BEGIN
+     oldflag := flag;
+     flag := TRUE;
+     RETURN oldflag;
+  END TAS;
+
+  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;
+      ch : CHAR;
+      pch : pchar;
+  BEGIN
+  
+  IF syscall = READ THEN
+    NEW(pch);
+    pch := SYSTEM.VAL(pchar, arg2);
+    ch := pch^[0];
+    n := read(ch);
+    IF n # 1 THEN 
+       ch := 0X;
+       RETURN FALSE
+    ELSE
+       pch^[0] := ch;
+       RETURN TRUE
+    END;
+  ELSIF syscall = WRITE THEN
+    NEW(pch);
+    pch := SYSTEM.VAL(pchar, arg2);
+    n := Write(SYSTEM.VAL(LONGINT, pch), 1);
+    IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
+  END
+
+  END UNIXCALL;
+
+
+  PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
+  BEGIN
+
+  END UNIXFORK;
+
+  PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
+                       VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
+  BEGIN
+
+  END UNIXSIGNAL;
+
+
+END ulmSYSTEM.

src/lib/ulm/ulmIO.Mod

@@ -0,0 +1,237 @@
+MODULE ulmIO;
+
+   IMPORT SYS := ulmSYSTEM, SYSTEM;
+
+   CONST nl = 0AX;
+
+   (* conversions *)
+
+   CONST
+      oct = 0;
+      dec = 1;
+      hex = 2;
+   TYPE 
+      Basetype = SHORTINT; (* oct..hex *)
+
+   (* basic IO *)
+
+   VAR
+      Done*: BOOLEAN;
+      oldch: CHAR;
+      readAgain: BOOLEAN;
+
+   (* ==================== conversions ================================= *)
+
+   PROCEDURE ConvertNumber(num, len: LONGINT; btyp: Basetype; neg: BOOLEAN;
+      VAR str: ARRAY OF CHAR);
+
+      (* conversion of a number into a string of characters *)
+      (* num must get the absolute value of the number      *)
+      (* len is the minimal length of the generated string  *)
+      (* neg means: "the number is negative" for btyp = dec *)
+
+      CONST
+	 NumberLen = 11;
+      VAR 
+	 digits          : ARRAY NumberLen+1 OF CHAR;
+	 base            : INTEGER;
+	 cnt, ix         : INTEGER;
+	 maxlen          : LONGINT;
+	 dig             : LONGINT;
+
+   BEGIN 
+      ASSERT(num >= 0);
+      ix := 1;
+      WHILE ix <= NumberLen DO
+	 digits[ix] := "0";
+	 INC(ix);
+      END;                              (* initialisation *)
+      IF btyp = oct THEN 
+	 base := 8;
+      ELSIF btyp = dec THEN 
+	 base := 10;
+      ELSIF btyp = hex THEN 
+	 base := 10H;
+      END;
+      cnt := 0;
+      REPEAT 
+	 INC(cnt);
+	 dig := num MOD base;
+	 num := num DIV base;
+	 IF dig < 10 THEN 
+	    dig := dig + ORD("0");
+	 ELSE 
+	    dig := dig - 10 + ORD("A");
+	 END;
+	 digits[cnt] := CHR(dig);
+      UNTIL num = 0;
+      (* (* i don't like this *)
+      IF btyp = oct THEN 
+	 cnt := 11;
+      ELSIF btyp = hex THEN 
+	 cnt := 8;
+      ELSIF neg THEN 
+      *)
+      IF neg THEN
+	 INC(cnt);
+	 digits[cnt] := "-";
+      END;
+      maxlen := LEN(str);          (* get maximal length *)
+      IF len > maxlen THEN 
+	 len := SHORT(maxlen); 
+      END;
+      IF cnt > maxlen THEN 
+	 cnt := SHORT(maxlen); 
+      END;
+      ix := 0;
+      WHILE len > cnt DO 
+	 str[ix] := " ";
+	 INC(ix);
+	 DEC(len);
+      END;
+      WHILE cnt > 0 DO 
+	 str[ix] := digits[cnt];
+	 INC(ix);
+	 DEC(cnt);
+      END;
+      IF ix < maxlen THEN 
+	 str[ix] := 0X;
+      END;
+   END ConvertNumber;
+
+   PROCEDURE ConvertInteger(num: LONGINT; len: INTEGER; VAR str: ARRAY OF 
+      CHAR);
+   (* conversion of an integer decimal number to a string *)
+   BEGIN 
+      IF num = MIN(LONGINT) THEN
+	 COPY("-2147483648", str); (* need fix, it's 32 bit only; -- noch *)
+      ELSE
+	 ConvertNumber(ABS(num),len,dec,num < 0,str);
+      END;
+   END ConvertInteger;
+
+   (* ========================= terminal ============================ *)
+
+   PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
+      CONST read = 3;
+      (*VAR r0, r1: INTEGER;*)
+      VAR r0, r1: LONGINT; (* in ulm system INTEGER and LONGINT have the same 4 byte size; -- noch *)
+   BEGIN
+      RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
+   END ReadChar;
+
+   PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
+      CONST write = 4;
+      (*VAR r0, r1: INTEGER;*)
+      VAR r0, r1: LONGINT;     (* same here *)
+   BEGIN
+      RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
+   END WriteChar;
+
+   PROCEDURE Read*(VAR ch: CHAR);
+   BEGIN
+      Done := TRUE;
+      IF readAgain THEN
+	 ch := oldch;
+	 readAgain := FALSE;
+      ELSIF ~ReadChar(ch) THEN
+	 Done := FALSE;
+	 ch := 0X;
+      ELSE
+	 oldch := ch;
+      END;
+   END Read;
+
+   PROCEDURE ReadAgain*;
+   BEGIN
+      IF readAgain THEN
+	 Done := FALSE;
+      ELSE
+	 Done := TRUE;
+	 readAgain := TRUE;
+      END;
+   END ReadAgain;
+
+   PROCEDURE Write*(ch: CHAR);
+   BEGIN
+      Done := WriteChar(ch);
+   END Write;
+
+   PROCEDURE WriteLn*;
+      CONST nl = 0AX;
+   BEGIN
+      Write(nl);
+   END WriteLn;
+
+   PROCEDURE WriteString*(s: ARRAY OF CHAR);
+      VAR i: INTEGER;
+   BEGIN
+      i := 0;
+      WHILE (i < LEN(s)) & (s[i] # 0X) DO
+	 Write(s[i]);
+	 INC(i);
+      END;
+   END WriteString;
+
+   PROCEDURE InitIO;
+   BEGIN
+      readAgain := FALSE;
+      Done := TRUE;
+   END InitIO;
+
+   PROCEDURE WriteInt*(arg: LONGINT);
+      VAR field: ARRAY 12 OF CHAR;
+   BEGIN
+      ConvertInteger(arg, 1, field);
+      WriteString(field);
+   END WriteInt;
+
+   PROCEDURE ReadInt*(VAR arg: INTEGER);
+      VAR ch: CHAR;
+	  minus: BOOLEAN;
+   BEGIN
+      minus := FALSE;
+      REPEAT
+	 Read(ch);
+	 IF ~Done THEN RETURN END;
+	 IF ch = "-" THEN
+	    minus := TRUE;
+	 ELSIF (ch # " ") & (ch # nl) & ((ch < "0") OR (ch > "9")) THEN
+	    WriteString("--- Integer expected on input"); WriteLn;
+	 END;
+      UNTIL (ch >= "0") & (ch <= "9");
+      arg := ORD(ch) - ORD("0");
+      REPEAT
+	 Read(ch);
+	 IF ~Done THEN RETURN END;
+	 IF (ch >= "0") & (ch <= "9") THEN
+	    arg := arg*10 + (ORD(ch) - ORD("0"));
+	 END;
+      UNTIL (ch < "0") OR (ch > "9");
+      ReadAgain;
+      IF minus THEN arg := -arg; END;
+   END ReadInt;
+
+   PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR);
+      VAR
+	 index: INTEGER;
+	 ch: CHAR;
+	 ok: BOOLEAN;
+   BEGIN
+      index := 0; ok := TRUE;
+      LOOP
+	 IF ~ReadChar(ch) THEN ok := FALSE; EXIT END;
+	 IF ch = nl THEN EXIT END;
+	 IF index < LEN(string) THEN
+	    string[index] := ch; INC(index);
+	 END;
+      END;
+      IF index < LEN(string) THEN
+	 string[index] := 0X;
+      END;
+      Done := ok OR (index > 0);
+   END ReadLine;
+
+BEGIN
+   InitIO;
+END ulmIO.