DEFINITION MODULE R3IO;
PROCEDURE R3TOSTRFIX(X:REAL3;D:CARDINAL;VAR S:ARRAY OF CHAR);
PROCEDURE R3TOSTR(X:REAL3;D:CARDINAL;VAR S:ARRAY OF CHAR);
PROCEDURE STRTOR3(S:ARRAY OF CHAR;VAR OK:BOOLEAN):REAL3;
PROCEDURE SUBSTRTOR3(S:ARRAY OF CHAR;VAR P:CARDINAL;VAR OK1:BOOLEAN):REAL3;
PROCEDURE WRR3FIX(X:REAL3;W,D:CARDINAL);
PROCEDURE WRR3(X:REAL3;W,D:CARDINAL);
VAR OK:BOOLEAN;
PROCEDURE RDR3():REAL3;
END R3IO.
 
IMPLEMENTATION MODULE R3IO;
FROM NUMIO IMPORT WRINT,STRTOCARD,SUBSTRTOCARD;
FROM STDIO IMPORT RDSTR,WRSTRLEN;
 
PROCEDURE STRTOR3(S:ARRAY OF CHAR;VAR OK:BOOLEAN):REAL3;
HEX CD (@WRINT-25H) CD (@STOR3) 08 C3 (@STRTOCARD+6) END STRTOR3;
 
PROCEDURE SUBSTRTOR3(S:ARRAY OF CHAR;VAR P:CARDINAL;VAR OK1:BOOLEAN):REAL3;
HEX CD (@WRINT-4CH) CD (@STOR3) 08 C3 (@SUBSTRTOCARD+6) END SUBSTRTOR3;
 
PROCEDURE STOR3;HEX
F5 08 37 08 CD (@WRINT-5CH) 38 1F 06 04 CD (@WRINT-98H+4) 08 38
0B E3 47 79 CD (@M10P+10) 47 EB E1 0E FF CD (@40) 0C
CC (@13) E5 A7 08 30 E1 0E 00 D9 FE 2E 20 28 CD
(@WRINT-6CH) D9 06 04 CD (@WRINT-98H+6) 08 C5 F5 CD (@40) 47 AF
91 CD (@M10P+10) 57 F1 C1 47 7A 38 06 D1 C5 CD (@13)
C1 A7 08 E5 30 DD D9 FE 45 28 04 FE 65 20 16 CD
(@WRINT-25H+13H) CD (@WRINT-0AAH) 08 47 7D E1 38 0F CD (@M10P+10) 47 F1
78 C0 EE 80 C9 E1 08 D9 30 F4 DD CB 00 86 C9 END STOR3;
 
PROCEDURE M10P(X:REAL3;N:INTEGER):REAL3;HEX
D1 C1 79 E1 3B C1 D5 D5 3B D5 CB 7F 28 02 3D 2F
F5 11 (@MULDIV+1CH) CD (@MULDIV) 47 F1 0F 0F F5 11 (@MULDIV+25H) CD
(@MULDIV) 47 F1 0F 0F 11 (@MULDIV+2EH) END M10P;
PROCEDURE MULDIV;
HEX F5 E6 03 4F 87 81 4F 0D F1 79 17 78 D8 E5 EB 06
00 09 5E 23 56 23 46 E1 C2 (@21) C3 (@5) 00 40
03 00 90 06 00 F4 09 80 38 0D 78 7D 1A A9 D1 27
94 3A 35 END MULDIV;
 
PROCEDURE TOILG;
HEX DD E1 C1 D9 E1 C1 D1 D9 E1 3B F1 11 00 00 D5 D5
D5 1E 30 D5 D5 33 C5 D9 C5 E5 D9 DD E5 E5 DD 21
0C 00 DD 39 87 E2 (@TOILG+2BH) DD 34 FE 4F CB 2F 08 7C
FE 10 30 01 0D FE 70 38 01 0C 79 CB 77 28 02 ED
44 5F 16 00 21 00 4D CD (@2+7) 7C CB 3F CB 79 28
01 2F D9 4F D9 E1 C9 END TOILG;
 
PROCEDURE NORMLZ;
HEX 08 47 08 ED 44 CD (@M10P+10) 47 04 3E 01 18 02 29 8F 10 FC
4F C6 30 FE 3A 38 05 DD 34 FF D6 0A DD 77 00 D9 C9 END NORMLZ;
 
PROCEDURE SQOZE;
HEX FE 06 38 02 3E 06 DD E5 47 04 18 11 AF 5D 54 29
8F 29 8F 19 CE 18 29 8F DD 77 01 DD 23 10 ED DD
E1 C9 END SQOZE;
 
PROCEDURE GET;
HEX A7 C8 47 DD 7E 00 A7 20 04 3E 30 28 02 DD 23 0D
F8 77 23 10 EE C9 END GET;
 
PROCEDURE R3TOSTRFIX(X:REAL3;D:CARDINAL;VAR S:ARRAY OF CHAR);
HEX CD (@TOILG) 47 D9 83 47 D9 78 CD (@NORMLZ) 78 D9 CB 7F
28 13 3C 20 05 79 FE 05 30 0E E1 C1 D9 7B D9 CD
(@ZPZ) C3 (@PUT0) CD (@SQOZE) E1 C1 DD CB FE 46 1E 2D
C4 (@PUT1) DD 5E FF D9 79 D9 3C 28 15 FA (@R3TOSTRFIX+97) 08
CB 43 C4 (@PUT1) 08 CD (@GET) CD (@PUT0+4) D9 7B D9 18
0A CD (@PUT1) CD (@PUT0+4) D9 78 D9 3C CD (@GET) C3 (@PUT0)
   2F CD (@ZPZ) DD 5E FF CD (@PUT1) 18 EA END R3TOSTRFIX;
 
PROCEDURE R3TOSTR(X:REAL3;D:CARDINAL;VAR S:ARRAY OF CHAR);
HEX CD (@TOILG) CD (@NORMLZ) 3E FF 8B D9 CD (@SQOZE) E1 C1 DD
CB FE 46 1E 20 28 02 1E 2D CD (@PUT1) DD 5E FF CB
43 28 08 CD (@PUT1) D9 0C D9 18 05 3E 01 CD (@GET)
CD (@PUT0+4) D9 7B D9 CD (@GET) 1E 45 CD (@PUT1)
D9 79 D9 1E 2B CB 7F 28 04 1E 2D ED 44 F5 CD (@PUT1)
   F1 C3 (@CTOS0+9) END R3TOSTR;
 
PROCEDURE ZPZ(N:CARDINAL);
HEX F5 1E 30 CD (@PUT1) CD (@PUT0+4) F1 1E 30 C3 (@PUT1+2)
END ZPZ; 
 
PROCEDURE CTOS0(X:SHORTCARD;VAR S:ARRAY OF CHAR);
HEX D1 C1 E1 3B F1 3B D5 D5 D5 1E 2F 1C D6 0A 30 FB
C6 3A F5 CD (@PUT1) F1 5F CD (@PUT1) 1E 00 CD (@PUT1) END CTOS0;
PROCEDURE PUT0;
HEX 1E 00 18 02 1E 2E END PUT0;
PROCEDURE PUT1;
HEX 3E 01 A7 C8 47 0D F8 73 23 10 FA C9 END PUT1;
 
TYPE TEMPSTR=ARRAY[0..31] OF CHAR;
 
PROCEDURE WRR3FIX(X:REAL3;W,D:CARDINAL);
VAR S:TEMPSTR;
BEGIN
R3TOSTRFIX(X,D,S);
WRSTRLEN(S,W)
END WRR3FIX;
 
PROCEDURE WRR3(X:REAL3;W,D:CARDINAL);
VAR S:TEMPSTR;
BEGIN
R3TOSTR(X,D,S);
WRSTRLEN(S,W)
END WRR3;
 
PROCEDURE RDR3():REAL3;
VAR S:TEMPSTR;
BEGIN
RDSTR(S);
RETURN STRTOR3(S,OK)
END RDR3;
 
END R3IO.
