File: RealInOut.mod

package info (click to toggle)
m2c 0.6-4
  • links: PTS
  • area: main
  • in suites: potato
  • size: 2,096 kB
  • ctags: 1,907
  • sloc: ansic: 18,088; sh: 168; makefile: 60
file content (115 lines) | stat: -rw-r--r-- 2,855 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
IMPLEMENTATION MODULE RealInOut;
FROM ASCII IMPORT nul;
FROM String IMPORT Length;
FROM InOut IMPORT ReadString,WriteString,Write;
IMPORT RealConv;

CONST
 Cbitinchar=8;

 PROCEDURE ReadReal(VAR x:REAL);
  VAR str:ARRAY[0..80] OF CHAR;
  BEGIN
   ReadString(str);RealConv.StrToReal(str,x);
   Done:=RealConv.RCStatus=RealConv.Done;
  END ReadReal;

 PROCEDURE ReadShortReal(VAR x:SHORTREAL);
  VAR str:ARRAY[0..80] OF CHAR;
  BEGIN
   ReadString(str);RealConv.StrToShortReal(str,x);
   Done:=RealConv.RCStatus=RealConv.Done;
  END ReadShortReal;

 PROCEDURE ReadLongReal(VAR x:LONGREAL);
  VAR str:ARRAY[0..80] OF CHAR;
  BEGIN
   ReadString(str);RealConv.StrToLongReal(str,x);
   Done:=RealConv.RCStatus=RealConv.Done;
  END ReadLongReal;

 PROCEDURE WriteReal(x:REAL; n:CARDINAL);
  BEGIN
   WriteLongReal(x,n);
  END WriteReal;

 PROCEDURE WriteLongReal(x:LONGREAL; n:CARDINAL);
  VAR str:ARRAY[0..80] OF CHAR; l:CARDINAL;
  BEGIN
   RealConv.LongRealToStr(x,str);l:=Length(str);
   WHILE n>l DO Write(" ");DEC(n); END;
   WriteString(str);
  END WriteLongReal;

 PROCEDURE WriteRealOct(x:REAL);
  VAR str:ARRAY[0..80] OF CHAR; l,i:CARDINAL;
    union:RECORD
	   CASE :BOOLEAN OF
	FALSE: x:REAL; |
	TRUE : chararr: ARRAY[0..SIZE(REAL)-1] OF CHAR;
	   END;
	  END;
  BEGIN
   union.x:=x; CharArrToOct(union.chararr,str);
   l:=Length(str);
   IF l#0 THEN
    FOR i:=0 TO l-1 DO Write(str[i]); END;
   END;
  END WriteRealOct;

 PROCEDURE WriteShortRealOct(x:SHORTREAL);
  VAR str:ARRAY[0..80] OF CHAR; l,i:CARDINAL;
    union:RECORD
	   CASE :BOOLEAN OF
	FALSE: x:SHORTREAL; |
	TRUE : chararr: ARRAY[0..SIZE(SHORTREAL)-1] OF CHAR;
	   END;
	  END;
  BEGIN
   union.x:=x; CharArrToOct(union.chararr,str);
   l:=Length(str);
   IF l#0 THEN
    FOR i:=0 TO l-1 DO Write(str[i]); END;
   END;
  END WriteShortRealOct;

 PROCEDURE WriteLongRealOct(x:LONGREAL);
  VAR str:ARRAY[0..80] OF CHAR; l,i:CARDINAL;
    union:RECORD
	   CASE :BOOLEAN OF
	FALSE: x:LONGREAL; |
	TRUE : chararr: ARRAY[0..SIZE(LONGREAL)-1] OF CHAR;
	   END;
	  END;
  BEGIN
   union.x:=x; CharArrToOct(union.chararr,str);
   l:=Length(str);
   IF l#0 THEN
    FOR i:=0 TO l-1 DO Write(str[i]); END;
   END;
  END WriteLongRealOct;

 (*-------- internal procedure ------------*)

 PROCEDURE CharArrToOct(VAR input:ARRAY OF CHAR;VAR str:ARRAY OF CHAR);
  VAR noct,predbit,rest,c,i,j:CARDINAL;
  BEGIN
   noct:=(HIGH(input) * Cbitinchar - 1) DIV 3 + 1;str[noct]:=nul;
   predbit:=0; rest:=0;
   FOR i:=CARDINAL(HIGH(input)) TO 0 BY -1 DO
    c:=ORD(input[i]);
    FOR j:=1 TO predbit DO c:=c*2; END;
    c:=c+rest;INC(predbit,Cbitinchar);
    WHILE predbit>=3 DO
     DEC(predbit,3);
     DEC(noct);str[noct]:=CHR(c MOD 8 + ORD("0"));
     c:=c DIV 8;
    END;
    rest:=c;
   END;
   IF noct # 0 THEN str[0]:=CHR(rest+ORD("0")); END;
  END CharArrToOct;

BEGIN
 Done:=TRUE;
END RealInOut.