vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 07:32:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Implement Out.Real and Out.LongReal.

Browse source
This commit is contained in:
David Brown 2016-10-08 17:02:46 +01:00
parent b71526ff5c
commit a828ff79a4
199 changed files with 1670 additions and 285 deletions
Download patch file Download diff file Expand all files Collapse all files

2
bootstrap/unix-48/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */
#define SHORTINT int8
#define INTEGER int16

4
bootstrap/unix-48/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__MOVE("1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}

2
bootstrap/unix-48/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Configuration__h
#define Configuration__h

2
bootstrap/unix-48/Files.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Files.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
#ifndef Files__h
#define Files__h

2
bootstrap/unix-48/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Heap.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
#ifndef Heap__h
#define Heap__h

2
bootstrap/unix-48/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Modules.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Modules__h
#define Modules__h

2
bootstrap/unix-48/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPB__h
#define OPB__h

2
bootstrap/unix-48/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPC__h
#define OPC__h

2
bootstrap/unix-48/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPM__h
#define OPM__h

2
bootstrap/unix-48/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPP__h
#define OPP__h

2
bootstrap/unix-48/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */
#ifndef OPS__h
#define OPS__h

2
bootstrap/unix-48/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPT__h
#define OPT__h

2
bootstrap/unix-48/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef OPV__h
#define OPV__h

267
bootstrap/unix-48/Out.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16
@ -7,6 +7,7 @@
#include "SYSTEM.h"
#include "Platform.h"
#include "Strings.h"
@ -18,7 +19,13 @@ export void Out_LongReal (LONGREAL x, int16 n);
export void Out_Open (void);
export void Out_Real (REAL x, int16 n);
export void Out_String (CHAR *str, LONGINT str__len);
export REAL Out_Ten (int16 e);
static LONGREAL Out_TenL (int16 e);
static void Out_digit (int64 n, CHAR *s, LONGINT s__len, int16 *i);
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, int16 *i);
#define Out_Entier32(x) (int32)(x)
#define Out_Entier64(x) (int64)(x)
void Out_Open (void)
{
@ -36,7 +43,7 @@ void Out_String (CHAR *str, LONGINT str__len)
int16 error;
__DUP(str, str__len, CHAR);
l = 0;
while ((l < str__len && str[l] != 0x00)) {
while ((l < str__len && str[__X(l, str__len)] != 0x00)) {
l += 1;
}
error = Platform_Write(1, (address)str, l);
@ -60,13 +67,13 @@ void Out_Int (int64 x, int64 n)
x = __DIV(x, 10);
i = 1;
while (x != 0) {
s[i] = (CHAR)(48 + __MOD(x, 10));
s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
x = __DIV(x, 10);
i += 1;
}
}
if (negative) {
s[i] = '-';
s[__X(i, 22)] = '-';
i += 1;
}
while (n > (int64)i) {
@ -75,28 +82,262 @@ void Out_Int (int64 x, int64 n)
}
while (i > 0) {
i -= 1;
Out_Char(s[i]);
Out_Char(s[__X(i, 22)]);
}
}
void Out_Real (REAL x, int16 n)
{
}
void Out_LongReal (LONGREAL x, int16 n)
{
}
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
}
static void Out_digit (int64 n, CHAR *s, LONGINT s__len, int16 *i)
{
*i -= 1;
s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
}
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, int16 *i)
{
int16 j, l;
__DUP(t, t__len, CHAR);
l = Strings_Length(t, t__len);
if (l > *i) {
l = *i;
}
*i -= l;
j = 0;
while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)];
j += 1;
}
__DEL(t);
}
REAL Out_Ten (int16 e)
{
REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
while (e > 0) {
if (__ODD(e)) {
r = r * power;
}
power = power * power;
e = __ASHR(e, 1);
}
_o_result = r;
return _o_result;
}
void Out_Real (REAL x, int16 n)
{
int16 e;
int32 f;
CHAR s[30];
int16 i;
REAL x0;
BOOLEAN nn, en;
int32 m;
int16 d;
nn = __VAL(int32, x) < 0;
if (nn) {
n -= 1;
}
e = (int16)__MASK(__ASHR(__VAL(int32, x), 23), -256);
f = __MASK(__VAL(int32, x), -8388608);
i = 30;
if (e == 255) {
if (f == 0) {
Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
} else {
Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
}
} else {
if (e == 0) {
Out_prepend((CHAR*)"E+00", 5, (void*)s, 30, &i);
m = 0;
} else {
if (nn) {
x = -x;
}
e = __ASHR((e - 127) * 77, 8);
if (e >= 0) {
x = x / (REAL)Out_Ten(e);
} else {
x = Out_Ten(-e) * x;
}
if (x >= (REAL)10) {
x = 1.0000000e-001 * x;
e += 1;
}
en = e < 0;
if (en) {
e = -e;
}
d = 2;
while (d > 0) {
Out_digit(e, (void*)s, 30, &i);
e = __DIV(e, 10);
d -= 1;
}
if (en) {
Out_prepend((CHAR*)"E-", 3, (void*)s, 30, &i);
} else {
Out_prepend((CHAR*)"E+", 3, (void*)s, 30, &i);
}
x0 = Out_Ten(7);
x = x0 * x + 5.0000000e-001;
if (x >= (REAL)10 * x0) {
x = 1.0000000e-001 * x;
e += 1;
}
m = Out_Entier32(x);
}
d = 8;
while ((((d > 2 && d > n - 5)) && (int)__MOD(m, 10) == 0)) {
m = __DIV(m, 10);
d -= 1;
}
while (d > 1) {
Out_digit(m, (void*)s, 30, &i);
m = __DIV(m, 10);
d -= 1;
}
i -= 1;
s[__X(i, 30)] = '.';
Out_digit(m, (void*)s, 30, &i);
}
n -= 30 - i;
while (n > 0) {
Out_Char(' ');
n -= 1;
}
if (nn) {
Out_Char('-');
}
while (i < 30) {
Out_Char(s[__X(i, 30)]);
i += 1;
}
}
static LONGREAL Out_TenL (int16 e)
{
LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
while (e > 0) {
if (__ODD(e)) {
r = r * power;
}
power = power * power;
e = __ASHR(e, 1);
}
_o_result = r;
return _o_result;
}
void Out_LongReal (LONGREAL x, int16 n)
{
int16 e;
int64 f;
CHAR s[30];
int16 i;
LONGREAL x0;
BOOLEAN nn, en;
int64 m;
int16 d;
nn = __VAL(int64, x) < 0;
if (nn) {
n -= 1;
}
e = (int16)__MASK(__ASHR((__VAL(int64, x)), 52), -2048);
f = __MASK((__VAL(int64, x)), -4503599627370496);
i = 30;
if (e == 2047) {
if (f == 0) {
Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
} else {
Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
}
} else {
if (e == 0) {
Out_prepend((CHAR*)"D+000", 6, (void*)s, 30, &i);
m = 0;
} else {
if (nn) {
x = -x;
}
e = (int16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Out_TenL(e);
} else {
x = Out_TenL(-e) * x;
}
if (x >= (LONGREAL)10) {
x = 1.00000000000000e-001 * x;
e += 1;
}
en = e < 0;
if (en) {
e = -e;
}
d = 3;
while (d > 0) {
Out_digit(e, (void*)s, 30, &i);
e = __DIV(e, 10);
d -= 1;
}
if (en) {
Out_prepend((CHAR*)"D-", 3, (void*)s, 30, &i);
} else {
Out_prepend((CHAR*)"D+", 3, (void*)s, 30, &i);
}
x0 = Out_TenL(15);
x = x0 * x + 5.00000000000000e-001;
if (x >= (LONGREAL)10 * x0) {
x = 1.00000000000000e-001 * x;
e += 1;
}
m = Out_Entier64(x);
}
d = 16;
while ((((d > 2 && d > n - 6)) && __MOD(m, 10) == 0)) {
m = __DIV(m, 10);
d -= 1;
}
while (d > 1) {
Out_digit(m, (void*)s, 30, &i);
m = __DIV(m, 10);
d -= 1;
}
i -= 1;
s[__X(i, 30)] = '.';
Out_digit(m, (void*)s, 30, &i);
}
n -= 30 - i;
while (n > 0) {
Out_Char(' ');
n -= 1;
}
if (nn) {
Out_Char('-');
}
while (i < 30) {
Out_Char(s[__X(i, 30)]);
i += 1;
}
}
export void *Out__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Out", 0);
__REGCMD("Ln", Out_Ln);
__REGCMD("Open", Out_Open);

3
bootstrap/unix-48/Out.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Out__h
#define Out__h
@ -15,6 +15,7 @@ import void Out_LongReal (LONGREAL x, int16 n);
import void Out_Open (void);
import void Out_Real (REAL x, int16 n);
import void Out_String (CHAR *str, LONGINT str__len);
import REAL Out_Ten (int16 e);
import void *Out__init(void);

2
bootstrap/unix-48/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Platform.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Platform__h
#define Platform__h

2
bootstrap/unix-48/Reals.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Reals.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Reals__h
#define Reals__h

2
bootstrap/unix-48/Strings.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Strings.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Strings__h
#define Strings__h

2
bootstrap/unix-48/Texts.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/Texts.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef Texts__h
#define Texts__h

2
bootstrap/unix-48/errors.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/errors.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef errors__h
#define errors__h

2
bootstrap/unix-48/extTools.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/extTools.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef extTools__h
#define extTools__h

2
bootstrap/unix-48/vt100.c
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#define SHORTINT int8
#define INTEGER int16

2
bootstrap/unix-48/vt100.h
View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/10/04]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
/* voc 1.95 [2016/10/08]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */
#ifndef vt100__h
#define vt100__h