fixed Longint to Byte Arr function; -- noch

This commit is contained in:
norayr 2016-11-29 16:45:18 +04:00
parent 247852e0b7
commit c549f5847b
3 changed files with 682 additions and 689 deletions

View file

@ -35,7 +35,7 @@
----------------------------------------------------------------------------
*)
MODULE ulmPrint;
MODULE Print;
(* formatted printing;
Print.F[0-9] prints to Streams.stdout
@ -81,7 +81,7 @@ MODULE ulmPrint;
END InitErrorHandling;
PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: INTEGER;
VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF SYS.BYTE;
VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF BYTE;
errors: RelatedEvents.Object);
CONST
maxargs = 9; (* maximal number of arguments *)
@ -133,7 +133,7 @@ MODULE ulmPrint;
END;
END Unget;
PROCEDURE Write(byte: SYS.BYTE);
PROCEDURE Write(byte: BYTE);
BEGIN
IF Streams.WriteByte(out, byte) THEN
INC(out.count);
@ -166,10 +166,10 @@ MODULE ulmPrint;
REPEAT
int := int * base;
IF (fmtchar >= "0") & (fmtchar <= "9") THEN
INC(int, LONG(ORD(fmtchar) - ORD("0")));
INC(int, ORD(fmtchar) - ORD("0"));
ELSIF (base = 16) &
(CAP(fmtchar) >= "A") & (CAP(fmtchar) <= "F") THEN
INC(int, LONG(10 + ORD(CAP(fmtchar)) - ORD("A")));
INC(int, 10 + ORD(CAP(fmtchar)) - ORD("A"));
ELSE
RETURN FALSE
END;
@ -193,13 +193,12 @@ MODULE ulmPrint;
| 6: arglen[index] := LEN(p7);
| 7: arglen[index] := LEN(p8);
| 8: arglen[index] := LEN(p9);
ELSE
END;
INC(index);
END;
END SetSize;
PROCEDURE Access(par: INTEGER; at: LONGINT) : SYS.BYTE;
PROCEDURE Access(par: INTEGER; at: LONGINT) : BYTE;
BEGIN
CASE par OF
| 0: RETURN p1[at]
@ -211,11 +210,10 @@ MODULE ulmPrint;
| 6: RETURN p7[at]
| 7: RETURN p8[at]
| 8: RETURN p9[at]
ELSE
END;
END Access;
PROCEDURE Convert(from: INTEGER; VAR to: ARRAY OF SYS.BYTE);
PROCEDURE Convert(from: INTEGER; VAR to: ARRAY OF BYTE);
VAR i: INTEGER;
BEGIN
i := 0;
@ -226,18 +224,18 @@ MODULE ulmPrint;
PROCEDURE GetInt(index: INTEGER; VAR long: LONGINT) : BOOLEAN;
(* access index-th parameter (counted from 0);
fails if arglen[index] > SIZE(LONGINT)
fails if arglen[index] > SYS.SIZE(LONGINT)
*)
VAR
short: SHORTINT;
(*int16: SYS.INT16;*)
int16: SYS.INT16;
int: INTEGER;
BEGIN
IF arglen[index] = SIZE(SHORTINT) THEN
Convert(index, short); long := short;
(*ELSIF arglen[index] = SIZE(SYS.INT16) THEN
Convert(index, int16); long := int16;*)
ELSIF arglen[index] = SIZE(SYS.INT16) THEN
Convert(index, int16); long := int16;
ELSIF arglen[index] = SIZE(INTEGER) THEN
Convert(index, int); long := int;
ELSIF arglen[index] = SIZE(LONGINT) THEN
@ -468,7 +466,7 @@ MODULE ulmPrint;
lr: LONGREAL;
r: REAL;
shortint: SHORTINT; int: INTEGER; longint: LONGINT;
(*int16: SYS.INT16;*)
int16: SYS.INT16;
long: BOOLEAN;
exponent: INTEGER;
mantissa: LONGREAL;
@ -538,7 +536,7 @@ MODULE ulmPrint;
INC(needed, 3);
END;
END;
INC(needed, SHORT(scale));
INC(needed, scale);
FillLeft(needed);
IF neg THEN
@ -598,10 +596,10 @@ MODULE ulmPrint;
long := FALSE;
Convert(index, int);
lr := int;
(*ELSIF arglen[index] = SIZE(SYS.INT16) THEN
ELSIF arglen[index] = SIZE(SYS.INT16) THEN
long := FALSE;
Convert(index, int16);
lr := int16;*)
lr := int16;
ELSIF arglen[index] = SIZE(SHORTINT) THEN
long := FALSE;
Convert(index, shortint);
@ -636,7 +634,6 @@ MODULE ulmPrint;
ndigits := 1;
END;
| "g": ndigits := SHORT(scale);
ELSE
END;
Reals.Digits(mantissa, 10, digits, neg,
(* force = *) format # "g", ndigits);
@ -651,13 +648,12 @@ MODULE ulmPrint;
ELSE
INC(decpt, exponent);
scale := ndigits-1;
DEC(scale, LONG(exponent));
DEC(scale, exponent);
IF scale < 0 THEN
scale := 0;
END;
Print(decpt, (* withexp = *) FALSE, 0);
END;
ELSE
END;
RETURN TRUE
ELSE
@ -669,14 +665,14 @@ MODULE ulmPrint;
VAR
index: INTEGER;
i: LONGINT;
byte: SYS.BYTE;
byte: BYTE;
len: LONGINT;
BEGIN
IF NextArg(index) THEN
len := 0;
WHILE (len < arglen[index]) &
((scale = -1) OR (len < scale)) &
((*CHR*)SYS.VAL(CHAR, (Access(index, len))) # 0X) DO
(CHR(Access(index, len)) # 0X) DO
INC(len);
END;
FillLeft(len);
@ -759,205 +755,205 @@ MODULE ulmPrint;
(* === public part ============================================== *)
PROCEDURE F*(fmt: ARRAY OF CHAR);
PROCEDURE F(fmt: ARRAY OF CHAR);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END F;
PROCEDURE F1*(fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
PROCEDURE F1(fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END F1;
PROCEDURE F2*(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
PROCEDURE F2(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END F2;
PROCEDURE F3*(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
PROCEDURE F3(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END F3;
PROCEDURE F4*(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF SYS.BYTE);
PROCEDURE F4(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END F4;
PROCEDURE F5*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
PROCEDURE F5(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END F5;
PROCEDURE F6*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
PROCEDURE F6(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END F6;
PROCEDURE F7*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
PROCEDURE F7(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END F7;
PROCEDURE F8*(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
PROCEDURE F8(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(Streams.stdout, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END F8;
PROCEDURE F9*(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
PROCEDURE F9(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE);
BEGIN
Out(Streams.stdout, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END F9;
PROCEDURE S*(out: Streams.Stream; fmt: ARRAY OF CHAR);
PROCEDURE S(out: Streams.Stream; fmt: ARRAY OF CHAR);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END S;
PROCEDURE S1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
PROCEDURE S1(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END S1;
PROCEDURE S2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
PROCEDURE S2(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END S2;
PROCEDURE S3*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
PROCEDURE S3(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END S3;
PROCEDURE S4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF SYS.BYTE);
PROCEDURE S4(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END S4;
PROCEDURE S5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
PROCEDURE S5(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END S5;
PROCEDURE S6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
PROCEDURE S6(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END S6;
PROCEDURE S7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
PROCEDURE S7(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END S7;
PROCEDURE S8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
PROCEDURE S8(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END S8;
PROCEDURE S9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
PROCEDURE S9(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE);
BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END S9;
PROCEDURE SE*(out: Streams.Stream; fmt: ARRAY OF CHAR;
PROCEDURE SE(out: Streams.Stream; fmt: ARRAY OF CHAR;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END SE;
PROCEDURE SE1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE;
PROCEDURE SE1(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, errors);
END SE1;
PROCEDURE SE2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE;
PROCEDURE SE2(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, errors);
END SE2;
PROCEDURE SE3*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3: ARRAY OF SYS.BYTE;
PROCEDURE SE3(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, errors);
END SE3;
PROCEDURE SE4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF SYS.BYTE;
PROCEDURE SE4(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, errors);
END SE4;
PROCEDURE SE5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE;
PROCEDURE SE5(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, errors);
END SE5;
PROCEDURE SE6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE;
PROCEDURE SE6(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, errors);
END SE6;
PROCEDURE SE7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE;
PROCEDURE SE7(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, errors);
END SE7;
PROCEDURE SE8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE;
PROCEDURE SE8(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE;
errors: RelatedEvents.Object);
VAR x: INTEGER;
BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, errors);
END SE8;
PROCEDURE SE9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE;
PROCEDURE SE9(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE;
errors: RelatedEvents.Object);
BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, errors);
@ -965,4 +961,4 @@ MODULE ulmPrint;
BEGIN
InitErrorHandling;
END ulmPrint.
END Print.

View file

@ -19,7 +19,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
i := 0;
REPEAT
SYSTEM.GET(adr + i, b);
lar[i] := b;
bar[i] := b;
INC(i)
UNTIL i = SIZE(LONGINT)
END LongToByteArr;
@ -138,4 +138,5 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
END ulmSYSTEM.

View file

@ -40,7 +40,7 @@
----------------------------------------------------------------------------
*)
MODULE ulmTypes;
MODULE Types;
(* compiler-dependent type definitions;
this version works for Ulm's Oberon Compilers on
@ -51,18 +51,17 @@ MODULE ulmTypes;
TYPE
Address* = SYS.ADDRESS;
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
UntracedAddress* = POINTER[1] TO UntracedAddressDesc;
UntracedAddressDesc* = RECORD[1] END;
Count* = SYS.INT32;
Size* = Count;
Byte* = SYS.BYTE;
IntAddress* = LONGINT;
IntAddress* = SYS.INT32;
Int8* = SYS.INT8;
Int16* = SYS.INT16;
Int32* = SYS.INT32;
Real32* = REAL;
Real32* = LONGREAL;
Real64* = LONGREAL;
CONST
@ -77,14 +76,27 @@ MODULE ulmTypes;
to allow for bit operations on INTEGER values
*)
TYPE
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
VAR msb* : SET;
msbIsMax*, msbIs0*: SHORTINT;
msbindex*, lsbindex*, nofbits*: LONGINT;
SetInt* = INTEGER; (* INTEGER type that corresponds to SET *)
CONST
msb* = SYS.VAL(SET, MIN(SetInt));
(* most significant bit, converted to a SET *)
(* we expect msbIsMax XOR msbIs0 to be 1;
this is checked for by an assertion
*)
msbIsMax* = SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
(* is 1, if msb equals {MAX(SET)} *)
msbIs0* = SYS.VAL(SHORTINT, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex* = msbIsMax * MAX(SET);
(* set element that corresponds to the most-significant-bit *)
lsbindex* = MAX(SET) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits* = MAX(SET) + 1;
(* number of elements in SETs *)
PROCEDURE ToInt8*(int: LONGINT) : Int8;
BEGIN
RETURN SYS.VAL(SHORTINT, int)
RETURN SHORT(SHORT(int))
END ToInt8;
PROCEDURE ToInt16*(int: LONGINT) : Int16;
@ -94,7 +106,7 @@ MODULE ulmTypes;
PROCEDURE ToInt32*(int: LONGINT) : Int32;
BEGIN
RETURN SYS.VAL(INTEGER, int)
RETURN int
END ToInt32;
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
@ -104,25 +116,9 @@ MODULE ulmTypes;
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
BEGIN
RETURN real
RETURN SHORT(real)
END ToReal64;
BEGIN
msb := SYS.VAL(SET, MIN(SetInt));
(* most significant bit, converted to a SET *)
(* we expect msbIsMax XOR msbIs0 to be 1;
this is checked for by an assertion
*)
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
(* is 1, if msb equals {MAX(SET)} *)
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex := msbIsMax * MAX(SET);
(* set element that corresponds to the most-significant-bit *)
lsbindex := MAX(SET) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits := MAX(SET) + 1;
(* number of elements in SETs *)
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
END ulmTypes.
END Types.