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

character), ported ulmIO which uses those calls.
This commit is contained in:
Norayr Chilingarian 2013-10-11 20:57:16 +04:00
parent 3071be3c36
commit 2cf9f399e3
2 changed files with 304 additions and 0 deletions

View file

@ -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.

237
src/lib/ulm/ulmIO.Mod Normal file
View file

@ -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.