#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %reals %long
// 2
// 3 ! This program shows explicitly the results of write(m,n) for each significant
// 4 ! size of m and n, and tests the extreme cases of MIN and MAX INT.
// 5
// 6 ! First, we replace the standard output calls with local versions which
// 7 ! keep track of 'outpos', to help with formatting output into columns:
// 8
// 9 ! In order to do this for the in-built 'write' etc, we have reimplemented local copies
// 10 ! of the current library versions which have been tested and confirmed to be identical.
// 11
// 12 ! The output table is rather wide and may need to be viewed using a small font.
// 13
// 14
// 15 ! When translated to C we do get some warnings from GCC of constants being out of range.
// 16
// 17 ! The approximate range of a standard float is:
// 18 ! Maximum positive value:
// 19 ! \(\approx 3.402823 \times 10^{38}\)
// 20 ! Minimum positive normalized value:
// 21 ! \(\approx 1.175494 \times 10^{-38}\)
// 22 ! Because floating-point numbers can represent both positive and negative values,
// 23 ! the full operational range is roughly \(-3.4 \times 10^{38}\) to \(+3.4 \times 10^{38}\).
// 24 ! It can also represent values infinitely close to zero, with a precision of about 6 to 7 decimal digits.
// 25
// 26 ! On most modern systems, the range of a double in C is approximately
// 27 ! \(\pm 1.7 \times 10^{-308}\) to \(\pm 1.7 \times 10^{308}\).
// 28 ! Maximum Finite Value: The largest absolute value a double can hold is
// 29 ! approximately 1.7976931348623157E+308. Going beyond this result triggers
// 30 ! an overflow, resulting in positive or negative infinity (INF)
// 31 ! Minimum Positive Normal Value: The smallest positive number that can be
// 32 ! represented with full precision is approximately 2.2250738585072014E-308.
// 33 ! Numbers smaller than this enter the subnormal range or round down to zero (underflow).
// 34
// 35
// 36 %own %integer outpos = 0
static int OUTPOS = 0;
// 37
// 38 %routine intrinsic printsymbol(%integer ch)
static void INTRINSICPRINTSYMBOL(int CH) {
// 39 printsymbol(ch)
_imp_PRINTSYMBOL(CH);
// 40 %end
return;
} /* end of INTRINSICPRINTSYMBOL */
// 41
// 42 %routine printsymbol(%integer ch)
static void PRINTSYMBOL(int CH) {
// 43 intrinsic printsymbol(ch)
INTRINSICPRINTSYMBOL(CH);
// 44 %if ch = 'J'&31 %or ch = 'M'&31 %or ch = 'L'&31 %start ;! nl cr ff
if (CH == 74 & 31) goto L_0001;
if (CH == 77 & 31) goto L_0001;
if (CH != 76 & 31) goto L_0002;
L_0001:;
// 45 outpos = 0
OUTPOS = 0;
// 46 %else %if ch = 'H'&31 ;! bs
goto L_0003;
L_0002:;
if (CH != 72 & 31) goto L_0004;
// 47 outpos = outpos - 1 %if outpos > 0
if (OUTPOS <= 0) goto L_0005;
OUTPOS = OUTPOS - 1;
L_0005:;
// 48 %else %if ch = 'I'&31 ;! tab
goto L_0003;
L_0004:;
if (CH != 73 & 31) goto L_0006;
// 49 outpos = (outpos + 8) & (\7) ;! at least on linux
OUTPOS = OUTPOS + 8 & (~7);
// 50 %else
goto L_0003;
L_0006:;
// 51 outpos = outpos + 1
OUTPOS = OUTPOS + 1;
// 52 %finish
L_0003:;
// 53 %end
return;
} /* end of PRINTSYMBOL */
// 54
// 55 %routine newline
static void NEWLINE(void) {
// 56 printsymbol(nl)
PRINTSYMBOL(10);
// 57 %end
return;
} /* end of NEWLINE */
// 58
// 59 %routine newlines(%integer n)
static void NEWLINES(int N) {
// 60 %integer i
int I;
// 61 %return %if n <= 0
if (N > 0) goto L_0007;
return;
L_0007:;
// 62 newline %for i = 1, 1, n
// %for I = 1, 1, N %cycle
{
int _final = N;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, N");
I = 0;
L_0008:
if (I == _final) goto L_0009;
I += 1;
NEWLINE();
goto L_0008;
}
L_0009:;
// 63 %end
return;
} /* end of NEWLINES */
// 64
// 65 %routine space
static void SPACE(void) {
// 66 printsymbol(' ')
PRINTSYMBOL(32);
// 67 %end
return;
} /* end of SPACE */
// 68
// 69 %routine spaces(%integer n)
static void SPACES(int N) {
// 70 %integer i
int I;
// 71 %return %if n <= 0
if (N > 0) goto L_000B;
return;
L_000B:;
// 72 space %for i = 1, 1, n
// %for I = 1, 1, N %cycle
{
int _final = N;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, N");
I = 0;
L_000C:
if (I == _final) goto L_000D;
I += 1;
SPACE();
goto L_000C;
}
L_000D:;
// 73 %end
return;
} /* end of SPACES */
// 74
// 75 %routine printstring(%string (255) s)
static void PRINTSTRING(_imp_string255 S) {
// 76 %integer i
int I;
// 77 printsymbol(charno(s, i)) %for i = 1, 1, length(s)
// %for I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&S) %cycle
{
int _final = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S);
if (invalid_for_loop(1, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&S)");
I = 0;
L_000E:
if (I == _final) goto L_000F;
I += 1;
PRINTSYMBOL(*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, I));
goto L_000E;
}
L_000F:;
// 78 %end
return;
} /* end of PRINTSTRING */
// 79
// 80 %routine write(%integer m, n)
static void WRITE(int M, int N) {
// 81 printstring("Please don't ever use plain 'write' in this program. Use write68k for now."); newline
PRINTSTRING(_imp_str_literal("Please don't ever use plain 'write' in this program. Use write68k for now."));
NEWLINE();
// 82 printstring("The implementation in the current Imp77 is severely broken w.r.t. formatting."); newline
PRINTSTRING(_imp_str_literal("The implementation in the current Imp77 is severely broken w.r.t. formatting."));
NEWLINE();
// 83 %stop
_imp_stop(0);
// 84 %end
} /* end of WRITE */
// ?N unused
// ?M unused
// 85
// 86 %begin ; ! Sorry, all original comments {in brackets} were lost in an unfortunate reformatting.
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 87
// 88
// 89 ! -----------------------------------------------------------------------------------------
// 90
// 91 %routine write3l(%integer n, places);! Same as current Imp library
void WRITE3L(int N, int PLACES) {
// 92
// 93 ! Write an integer on the current output stream, to
// 94 ! occupy PLACES character spaces on the page.
// 95 ! Nominally based on PrintString(I to S(n, places))
// 96 ! This version doesn't use strings though, and is
// 97 ! therefore smaller and quicker. It builds the
// 98 ! characters "backwards" in an array
// 99
// 100 %routine decimal(%integer n, %integer %name places, digits, vec)
void DECIMAL(int N, int *PLACES, int *DIGITS, int *VEC) {
// 101 %integer p, sign, d, x
int P;
int SIGN;
int D;
int X;
// 102 vec = vec + 15
*VEC = *VEC + 15;
// 103 sign = '-'
SIGN = 45;
// 104 %if n >= 0 %start
if (N < 0) goto L_0010;
// 105 n = -n
N = -N;
// 106 sign = ' '
SIGN = 32;
// 107 sign = 0 %if places <= 0
if (*PLACES > 0) goto L_0011;
SIGN = 0;
L_0011:;
// 108 %finish
L_0010:;
// 109 %if places <= 0 %then places = -places %else places = places + 1
if (*PLACES > 0) goto L_0012;
*PLACES = -*PLACES;
goto L_0013;
L_0012:;
*PLACES = *PLACES + 1;
L_0013:;
// 110 p = vec
P = *VEC;
// 111 %cycle
L_0014:;
// 112 x = n // 10
X = ((long)N / (long)10);
// 113 d = n - x * 10
D = N - X * 10;
// 114 n = x
N = X;
// 115 vec = vec - 1
*VEC = *VEC - 1;
// 116 byteinteger(vec) = '0' - d
*_imp_BYTEINTEGER(*VEC) = 48 - D;
// 117 %repeat %until n = 0
if (N == 0) goto L_0015;
goto L_0014;
L_0015:;
// 118 %if sign # 0 %start
if (SIGN == 0) goto L_0016;
// 119 vec = vec - 1
*VEC = *VEC - 1;
// 120 byteinteger(vec) = sign
*_imp_BYTEINTEGER(*VEC) = SIGN;
// 121 %finish
L_0016:;
// 122 digits = p - vec
*DIGITS = P - *VEC;
// 123 %end
return;
} /* end of DECIMAL */
// 124 %string (32) ch
_imp_string32 CH;
// 125 ! Enough room for a 32 bit integer, plus sign
// 126 %integer new, digit, sign, i
int NEW;
int DIGIT;
int SIGN;
int I;
// 127 length(ch) = 0
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = 0;
// 128 ! First collect the digits
// 129 %if n = 0 %start
if (N != 0) goto L_0017;
// 130 length(ch) = length(ch) + 1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) + 1;
// 131 charno(ch, length(ch)) = '0'
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) = 48;
// 132 sign = 0
SIGN = 0;
// 133 %else
goto L_0018;
L_0017:;
// 134 sign = 1
SIGN = 1;
// 135 ! we make everything negative to avoid the -ve MaxInt wrap problem
// 136 %if n > 0 %start
if (N <= 0) goto L_0019;
// 137 sign = 0
SIGN = 0;
// 138 n = -n
N = -N;
// 139 %finish
L_0019:;
// 140 %while n # 0 %cycle
L_001A:;
if (N == 0) goto L_001B;
// 141 new = n // 10
NEW = ((long)N / (long)10);
// 142 digit = (new * 10) - n
DIGIT = NEW * 10 - N;
// 143 length(ch) = length(ch) + 1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) + 1;
// 144 charno(ch, length(ch)) = digit + '0'
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) = DIGIT + 48;
// 145 n = new
N = NEW;
// 146 %repeat
goto L_001A;
L_001B:;
// 147 %finish
L_0018:;
// 148 ! Now deal with the sign, taking into account the slightly
// 149 ! idiosyncratic behaviour on positive numbers
// 150 %if sign # 0 %start
if (SIGN == 0) goto L_001C;
// 151 length(ch) = length(ch) + 1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) + 1;
// 152 charno(ch, length(ch)) = '-'
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) = 45;
// 153 %else
goto L_001D;
L_001C:;
// 154 %if places > 0 %start
if (PLACES <= 0) goto L_001E;
// 155 length(ch) = length(ch) + 1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) + 1;
// 156 charno(ch, length(ch)) = ' '
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) = 32;
// 157 %finish
L_001E:;
// 158 %finish
L_001D:;
// 159 ! Now we adjust Places, also slightly mysteriously
// 160 %if places <= 0 %then places = -places %else places = places + 1
if (PLACES > 0) goto L_001F;
PLACES = -PLACES;
goto L_0020;
L_001F:;
PLACES = PLACES + 1;
L_0020:;
// 161 ! The array at CH now contains the characters (backwards)
// 162 ! and the character count is in NEXT
// 163 %while places > length(ch) %cycle
L_0021:;
if (PLACES <= *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) goto L_0022;
// 164 length(ch) = length(ch) + 1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH) + 1;
// 165 charno(ch, length(ch)) = ' '
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH)) = 32;
// 166 places = places - 1
PLACES = PLACES - 1;
// 167 %repeat
goto L_0021;
L_0022:;
// 168 %for i = length(ch), -1, 1 %cycle
// %for I = *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&CH), -1, 1 %cycle
{
int _initial = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &CH);
if (invalid_for_loop(_initial, -1, 1))
_imp_signal(5, 1, 0, "Illegal cycle I = *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&CH), -1, 1");
I = _initial - (-1);
L_0023:
if (I == 1) goto L_0024;
I -= 1;
// 169 printsymbol(charno(ch, i))
PRINTSYMBOL(*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &CH, I));
// 170 %repeat
goto L_0023;
}
L_0024:;
// 171 %end
return;
} /* end of WRITE3L */
// ?DECIMAL unused
// 172
// 173 ! -----------------------------------------------------------------------------------------
// 174
// 175 %routine vax write(%integer n, p)
void VAXWRITE(int N, int P) {
// 176 %string(63)%fn itos(%integer n, p)
_imp_string63 ITOS(int N, int P) {
// 177 %string(255) answer
_imp_string255 ANSWER;
// 178 %byteintegerarray a(0:64)
unsigned char A[65];
struct _imp_dv A_dv = {A, sizeof(unsigned char) /*, dims, <bounds> */};
// 179 %integer sign, sym, pt, val
int SIGN;
int SYM;
int PT;
int VAL;
// 180 val = p
VAL = P;
// 181 %if p > 0 %then p = p+1 %else p = -p
if (P <= 0) goto L_0025;
P = P + 1;
goto L_0026;
L_0025:;
P = -P;
L_0026:;
// 182 p = 63 %if p > 63
if (P <= 63) goto L_0027;
P = 63;
L_0027:;
// 183 sign = ' '
SIGN = 32;
// 184 sign = 0 %if val <= 0
if (VAL > 0) goto L_0028;
SIGN = 0;
L_0028:;
// 185 pt = 0
PT = 0;
// 186 %if n < 0 %start
if (N >= 0) goto L_0029;
// 187 sign = '-'
SIGN = 45;
// 188 %if n = 16_80000000 %start
if (N != -2147483648) goto L_002A;
// 189 string(addr(a(pt))) = "8463847412"
*_imp_STRING(_imp_ADDR(/*?*/ &A[PT])) = _imp_str_literal("8463847412");
// 190 pt = pt + 10
PT = PT + 10;
// 191 -> set
goto U_1000;
// 192 %finish
L_002A:;
// 193 n = -n
N = -N;
// 194 %finish
L_0029:;
// 195 %cycle
L_002B:;
// 196 sym = n-n//10*10
SYM = N - ((long)N / (long)10) * 10;
// 197 pt = pt+1
PT = PT + 1;
// 198 a(pt) = sym+'0'
A[PT] = SYM + 48;
// 199 n = n//10
N = ((long)N / (long)10);
// 200 %repeat %until n = 0
if (N == 0) goto L_002C;
goto L_002B;
L_002C:;
// 201 set:
U_1000:;
// 202 %if sign # 0 %start
if (SIGN == 0) goto L_002D;
// 203 pt = pt+1; a(pt) = sign
PT = PT + 1;
A[PT] = SIGN;
// 204 %finish
L_002D:;
// 205 %while pt < p %cycle
L_002E:;
if (PT >= P) goto L_002F;
// 206 pt = pt+1; a(pt) = ' '
PT = PT + 1;
A[PT] = 32;
// 207 %repeat
goto L_002E;
L_002F:;
// 208 answer = ""
/* clang-format off */
_imp_strncpy(/*?*/&ANSWER, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 209 %cycle
L_0030:;
// 210 answer = answer.tostring(a(pt))
/* clang-format off */
_imp_strncpy(/*?*/&ANSWER, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&ANSWER, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(A[PT]); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 211 pt = pt-1
PT = PT - 1;
// 212 %repeat %until pt = 0
if (PT == 0) goto L_0031;
goto L_0030;
L_0031:;
// 213 %result = answer
return *(_imp_string63 *)/*?*/ &ANSWER;
// 214 %end
} /* end of ITOS */
// 215 space %and p = p-1 %while p > 62
L_0032:;
if (P <= 62) goto L_0033;
SPACE();
P = P - 1;
goto L_0032;
L_0033:;
// 216 printstring(itos(n, p))
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string63) tmp = ITOS(N, P)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 217 %end
return;
} /* end of VAXWRITE */
// 218
// 219 ! -----------------------------------------------------------------------------------------
// 220
// 221 %routine write68k(%integer v, p)
void WRITE68K(int V, int P) {
// 222 %integer vv, q, pos
int VV;
int Q;
int POS;
// 223 %byte %integer %array store(0 : 15)
unsigned char STORE[16];
struct _imp_dv STORE_dv = {STORE, sizeof(unsigned char) /*, dims, <bounds> */};
// 224 vv = v
VV = V;
// 225 vv = -vv %if vv > 0
if (VV <= 0) goto L_0034;
VV = -VV;
L_0034:;
// 226 pos = 15
POS = 15;
// 227 %while vv <= -10 %cycle
L_0035:;
if (VV > -10) goto L_0036;
// 228 q = vv // 10
Q = ((long)VV / (long)10);
// 229 store(pos) = q * 10 - vv + '0'
STORE[POS] = Q * 10 - VV + 48;
// 230 pos = pos - 1
POS = POS - 1;
// 231 vv = q
VV = Q;
// 232 %repeat
goto L_0035;
L_0036:;
// 233 store(pos) = '0' - vv
STORE[POS] = 48 - VV;
// 234 %if p <= 0 %start
if (P > 0) goto L_0037;
// 235 spaces(pos - 16 - p) %if p < 0
if (P >= 0) goto L_0038;
SPACES(POS - 16 - P);
L_0038:;
// 236 %finish %else %start
goto L_0039;
L_0037:;
// 237 spaces(pos - 16 + p)
SPACES(POS - 16 + P);
// 238 printsymbol(' ') %if v >= 0
if (V < 0) goto L_003A;
PRINTSYMBOL(32);
L_003A:;
// 239 %finish
L_0039:;
// 240 printsymbol('-') %if v < 0
if (V >= 0) goto L_003B;
PRINTSYMBOL(45);
L_003B:;
// 241 printsymbol(store(pos)) %and pos = pos + 1 %until pos = 16
L_003C:;
PRINTSYMBOL(STORE[POS]);
POS = POS + 1;
if (POS == 16) goto L_003D;
goto L_003C;
L_003D:;
// 242 %end
return;
} /* end of WRITE68K */
// 243
// 244 ! -----------------------------------------------------------------------------------------
// 245
// 246 %routine emaswrite(%integer value, places)
void EMASWRITE(int VALUE, int PLACES) {
// 247 !***********************************************************************
// 248 !* SIMPLE MINDED ALL IMP VERSION NOT USING STRINGS *
// 249 !***********************************************************************
// 250 %string (15) %fn swrite %alias "S#SWRITE"(%integer value, places)
_imp_string15 SWRITE(int VALUE, int PLACES) {
// 251 !***********************************************************************
// 252 !* SIMPLE MINDED ALL IMP VERSION *
// 253 !***********************************************************************
// 254 %string (1) sign
_imp_string1 SIGN;
// 255 %string (255{15}) res
_imp_string255 RES;
// 256 %integer work, ptr
int WORK;
int PTR;
// 257 %string (1) %array ch(0 : 15)
_imp_string1 CH[16];
struct _imp_dv CH_dv = {CH, sizeof(_imp_string) /*, dims, <bounds> */};
// 258 res = ""
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 259 sign = " "
/* clang-format off */
_imp_strncpy(/*?*/&SIGN, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(" "); (void *)&tmp;}), /*max:*/1);
/* clang-format on */
// 260 %if value = X'80000000' %then %start
if (VALUE != -2147483648) goto L_003E;
// 261 res = "-2147483548"
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal("-2147483548"); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 262 !res = " " . res %for ptr = 1, 1, places - 10 ;! causes run-time string overflow
// 263 %if places <= 0 %start
if (PLACES > 0) goto L_003F;
// 264 places = -15 %if places < -15
if (PLACES >= -15) goto L_0040;
PLACES = -15;
L_0040:;
// 265 res = " " . res %while length(res) < |places|
L_0041:;
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &RES) >= _imp_IMOD(PLACES)) goto L_0042;
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr(" "), (_imp_string *)/*?*/&RES); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
goto L_0041;
L_0042:;
// 266 %else
goto L_0043;
L_003F:;
// 267 places = 14 %if places > 14
if (PLACES <= 14) goto L_0044;
PLACES = 14;
L_0044:;
// 268 res = " " . res %while length(res) < places
L_0045:;
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &RES) >= PLACES) goto L_0046;
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr(" "), (_imp_string *)/*?*/&RES); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
goto L_0045;
L_0046:;
// 269 res = " " . res
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr(" "), (_imp_string *)/*?*/&RES); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 270 %finish
L_0043:;
// 271 %result = res
return *(_imp_string15 *)/*?*/ &RES;
// 272 %finish
L_003E:;
// 273 %if value = X'80000000' %then %result = "-2147483648"
if (VALUE != -2147483648) goto L_0047;
return *(_imp_string15 *)/*?*/ _imp_str_literal_ptr("-2147483648");
L_0047:;
// 274 %if value < 0 %then sign = "-" %and value = -value
if (VALUE >= 0) goto L_0048;
/* clang-format off */
_imp_strncpy(/*?*/&SIGN, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal("-"); (void *)&tmp;}), /*max:*/1);
/* clang-format on */
VALUE = -VALUE;
L_0048:;
// 275 ptr = 0
PTR = 0;
// 276 %cycle
L_0049:;
// 277 work = value // 10
WORK = ((long)VALUE / (long)10);
// 278 ch(ptr) = tostring(value - 10 * work + '0')
/* clang-format off */
_imp_strncpy(/*?*/&CH[PTR], ({__typeof__(_imp_string1) tmp;/*B*/ tmp = _imp_TOSTRING(VALUE - 10 * WORK + 48); (void *)&tmp;}), /*max:*/1);
/* clang-format on */
// 279 value = work
VALUE = WORK;
// 280 ptr = ptr + 1
PTR = PTR + 1;
// 281 %repeat %until value = 0
if (VALUE == 0) goto L_004A;
goto L_0049;
L_004A:;
// 282 res = res . " " %for work = ptr, 1, places - 1
// %for WORK = PTR, 1, PLACES - 1 %cycle
{
int _initial = PTR, _final = PLACES - 1;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle WORK = PTR, 1, PLACES - 1");
WORK = _initial - (1);
L_004B:
if (WORK == _final) goto L_004C;
WORK += 1;
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RES, (_imp_string *)/*?*/_imp_str_literal_ptr(" ")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
goto L_004B;
}
L_004C:;
// 283 work = ptr - 1
WORK = PTR - 1;
// 284 res = res . sign
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RES, (_imp_string *)/*?*/&SIGN); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 285 res = res . ch(ptr) %for ptr = work, -1, 0
// %for PTR = WORK, -1, 0 %cycle
{
int _initial = WORK;
if (invalid_for_loop(_initial, -1, 0)) _imp_signal(5, 1, 0, "Illegal cycle PTR = WORK, -1, 0");
PTR = _initial - (-1);
L_004D:
if (PTR == 0) goto L_004E;
PTR -= 1;
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RES, (_imp_string *)/*?*/&CH[PTR]); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
goto L_004D;
}
L_004E:;
// 286 %result = res
return *(_imp_string15 *)/*?*/ &RES;
// 287 %end
} /* end of SWRITE */
// 288 %integer sign, work, ptr
int SIGN;
int WORK;
int PTR;
// 289 %byte %integer %array ch(0 : 15)
unsigned char CH[16];
struct _imp_dv CH_dv = {CH, sizeof(unsigned char) /*, dims, <bounds> */};
// 290 sign = ' '
SIGN = 32;
// 291 %if value = X'80000000' %then printstring(swrite(value, places)) %and %return
if (VALUE != -2147483648) goto L_004F;
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string15) tmp = SWRITE(VALUE, PLACES)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
return;
L_004F:;
// 292 %if value < 0 %then sign = '-' %and value = -value
if (VALUE >= 0) goto L_0050;
SIGN = 45;
VALUE = -VALUE;
L_0050:;
// 293 ptr = 0
PTR = 0;
// 294 %cycle
L_0051:;
// 295 work = value // 10
WORK = ((long)VALUE / (long)10);
// 296 ch(ptr) = value - 10 * work
CH[PTR] = VALUE - 10 * WORK;
// 297 value = work
VALUE = WORK;
// 298 ptr = ptr + 1
PTR = PTR + 1;
// 299 %repeat %until value = 0
if (VALUE == 0) goto L_0052;
goto L_0051;
L_0052:;
// 300 %if places > ptr %then spaces(places - ptr)
if (PLACES <= PTR) goto L_0053;
SPACES(PLACES - PTR);
L_0053:;
// 301 work = ptr - 1
WORK = PTR - 1;
// 302 printsymbol(sign)
PRINTSYMBOL(SIGN);
// 303 printsymbol(ch(ptr) + '0') %for ptr = work, -1, 0
// %for PTR = WORK, -1, 0 %cycle
{
int _initial = WORK;
if (invalid_for_loop(_initial, -1, 0)) _imp_signal(5, 1, 0, "Illegal cycle PTR = WORK, -1, 0");
PTR = _initial - (-1);
L_0054:
if (PTR == 0) goto L_0055;
PTR -= 1;
PRINTSYMBOL(CH[PTR] + 48);
goto L_0054;
}
L_0055:;
// 304 %end
return;
} /* end of EMASWRITE */
// 305
// 306 ! -----------------------------------------------------------------------------------------
// 307
// 308 %routine emasi77write(%integer num, pl)
void EMASI77WRITE(int NUM, int PL) {
// 309 %string (63) %function itos(%integer n, places)
_imp_string63 ITOS(int N, int PLACES) {
// 310 !
// 311 ! ITOS0
// 312 !
// 313 ! Returns a string representing the argument as
// 314 ! a decimal number, without any space justification
// 315 ! or padding.
// 316 !
// 317 %const %integer maxdigits = 255 - 64
// 318 %const %integer maxint = 16_7FFFFFFF
// 319 %const %integer minint = 16_80000000
// 320 %const %integer minintlastdigit = '8'
// 321 %string (maxdigits) %function itos0(%integer n)
_imp_string191 ITOS0(int N) {
// 322 %string (maxdigits) res
_imp_string191 RES;
// 323 %integer s, p, e
int S;
int P;
int E;
// 324 s = 0
S = 0;
// 325 %if n < 0 %start
if (N >= 0) goto L_0056;
// 326 s = -1
S = -1;
// 327 ! mark -ve
// 328 %if n = minint %start
if (N != -2147483648) goto L_0057;
// 329 ! special case
// 330 n = maxint
N = 2147483647;
// 331 ! rely on "max int = (-min int) - 1"
// 332 s = 1
S = 1;
// 333 ! mark special
// 334 %finish %else %start
goto L_0058;
L_0057:;
// 335 n = -n
N = -N;
// 336 %finish
L_0058:;
// 337 %finish
L_0056:;
// 338 p = addr(res) + maxdigits
P = _imp_ADDR(/*?*/ &RES) + 191;
// 339 e = p
E = P;
// 340 ! end point
// 341 byteinteger(p) = rem(n, 10) + '0' %and n = n // 10 %and p = p - 1 %until n = 0
L_0059:;
*_imp_BYTEINTEGER(P) = _imp_REM(N, 10) + 48;
N = ((long)N / (long)10);
P = P - 1;
if (N == 0) goto L_005A;
goto L_0059;
L_005A:;
// 342 %if s # 0 %start
if (S == 0) goto L_005B;
// 343 ! negative
// 344 byteinteger(p) = '-'
*_imp_BYTEINTEGER(P) = 45;
// 345 p = p - 1
P = P - 1;
// 346 %if s > 0 %start
if (S <= 0) goto L_005C;
// 347 ! min int
// 348 charno(res, maxdigits) = minintlastdigit
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &RES, 191) = 56;
// 349 %finish
L_005C:;
// 350 %finish
L_005B:;
// 351 byteinteger(p) = e - p
*_imp_BYTEINTEGER(P) = E - P;
// 352 ! length byte
// 353 %result = string(p)
return *(_imp_string191 *)_imp_STRING(P);
// 354 %end
} /* end of ITOS0 */
// 355 %string (63 + maxdigits) res
_imp_string254 RES;
// 356 %integer p, slen
int P;
int SLEN;
// 357 p = addr(res) + 62
P = _imp_ADDR(/*?*/ &RES) + 62;
// 358 ! digit string right justified
// 359 string(p) = itos0(n)
*_imp_STRING(P) = ITOS0(N);
// 360 slen = byteinteger(p)
SLEN = *_imp_BYTEINTEGER(P);
// 361 %if n > 0 %and places > 0 %start
if (N <= 0) goto L_005D;
if (PLACES <= 0) goto L_005D;
// 362 byteinteger(p) = ' '
*_imp_BYTEINTEGER(P) = 32;
// 363 p = p - 1
P = P - 1;
// 364 slen = slen + 1
SLEN = SLEN + 1;
// 365 %finish
L_005D:;
// 366 %if places <= 0 %start
if (PLACES > 0) goto L_005E;
// 367 places = -places
PLACES = -PLACES;
// 368 %finish %else %start
goto L_005F;
L_005E:;
// 369 places = places + 1
PLACES = PLACES + 1;
// 370 %finish
L_005F:;
// 371 places = 63 %if places > 63
if (PLACES <= 63) goto L_0060;
PLACES = 63;
L_0060:;
// 372 %while slen < places %cycle
L_0061:;
if (SLEN >= PLACES) goto L_0062;
// 373 byteinteger(p) = ' '
*_imp_BYTEINTEGER(P) = 32;
// 374 p = p - 1
P = P - 1;
// 375 slen = slen + 1
SLEN = SLEN + 1;
// 376 %repeat
goto L_0061;
L_0062:;
// 377 byteinteger(p) = slen
*_imp_BYTEINTEGER(P) = SLEN;
// 378 %result = string(p)
return *(_imp_string63 *)_imp_STRING(P);
// 379 %end
} /* end of ITOS */
// 380 %string (63) res
_imp_string63 RES;
// 381 res = itos(num, pl)
/* clang-format off */
_imp_strncpy(/*?*/&RES, ({__typeof__(_imp_string63) tmp;/*B*/ tmp = ITOS(NUM, PL); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 382 pl = \pl %if pl < 0
if (PL >= 0) goto L_0063;
PL = (~PL);
L_0063:;
// 383 spaces(pl - 62)
SPACES(PL - 62);
// 384 printstring(res)
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string63) tmp = RES/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 385 %end
return;
} /* end of EMASI77WRITE */
// 386
// 387 ! -----------------------------------------------------------------------------------------
// 388
// 389 %routine mouseswrite(%integer n, p)
void MOUSESWRITE(int N, int P) {
// 390 %string (72) %fn itos(%integer n, p)
_imp_string72 ITOS(int N, int P) {
// 391 %byte %array s(0 : 72)
unsigned char S[73];
struct _imp_dv S_dv = {S, sizeof(unsigned char) /*, dims, <bounds> */};
// 392 %integer x, sign
int X;
int SIGN;
// 393 x = 73
X = 73;
// 394 sign = 0
SIGN = 0;
// 395 %if p > 0 %start
if (P <= 0) goto L_0064;
// 396 sign = ' '
SIGN = 32;
// 397 p = 72 - p
P = 72 - P;
// 398 %else
goto L_0065;
L_0064:;
// 399 p = p + 73
P = P + 73;
// 400 %finish
L_0065:;
// 401 p = 1 %if p <= 0
if (P > 0) goto L_0066;
P = 1;
L_0066:;
// 402 %if n < 0 %start
if (N >= 0) goto L_0067;
// 403 sign = '-'
SIGN = 45;
// 404 n = -n
N = -N;
// 405 %if n < 0 %start
if (N >= 0) goto L_0068;
// 406 !max int
// 407 n = n // (-10)
N = ((long)N / (long)(-10));
// 408 x = x - 1
X = X - 1;
// 409 s(x) = '8'
S[X] = 56;
// 410 %finish
L_0068:;
// 411 %finish
L_0067:;
// 412 %cycle
L_0069:;
// 413 x = x - 1
X = X - 1;
// 414 s(x) = rem(n, 10) + '0'
S[X] = _imp_REM(N, 10) + 48;
// 415 n = n // 10
N = ((long)N / (long)10);
// 416 %repeat %until n = 0
if (N == 0) goto L_006A;
goto L_0069;
L_006A:;
// 417 %if sign # 0 %start
if (SIGN == 0) goto L_006B;
// 418 x = x - 1
X = X - 1;
// 419 s(x) = sign
S[X] = SIGN;
// 420 %finish
L_006B:;
// 421 %while x > p %cycle
L_006C:;
if (X <= P) goto L_006D;
// 422 x = x - 1
X = X - 1;
// 423 s(x) = ' '
S[X] = 32;
// 424 %repeat
goto L_006C;
L_006D:;
// 425 x = x - 1
X = X - 1;
// 426 s(x) = 72 - x
S[X] = 72 - X;
// 427 %result = string(addr(s(x)))
return *(_imp_string72 *)_imp_STRING(_imp_ADDR(/*?*/ &S[X]));
// 428 %end
} /* end of ITOS */
// 429 printstring(itos(n, p))
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string72) tmp = ITOS(N, P)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 430 %end
return;
} /* end of MOUSESWRITE */
// 431
// 432 ! -----------------------------------------------------------------------------------------
// 433
// 434 %ROUTINE DEC10 WRITE(%INTEGER N, S)
void DEC10WRITE(int N, int S) {
auto void P(int N);
// 435 %ROUTINESPEC P(%INTEGER N)
// 436 %INTEGER SIGN
int SIGN;
// 437 %IF S<=0 %THEN SIGN=S %ELSE SIGN = ' '; !GIVE NO SIGN FOR WRITE(N,0)
if (S > 0) goto L_006E;
SIGN = S;
goto L_006F;
L_006E:;
SIGN = 32;
L_006F:;
// 438 S=|S|; S=63 %IF S>63
S = _imp_IMOD(S);
if (S <= 63) goto L_0070;
S = 63;
L_0070:;
// 439 %IF N < 0 %START ;! doesn't use negative trick but could be easily modified to.
if (N >= 0) goto L_0071;
// 440 N = -N
N = -N;
// 441 SIGN = '-'
SIGN = 45;
// 442 %FINISH
L_0071:;
// 443 P(N)
P(N);
// 444 %ROUTINE P(%INTEGER N)
void P(int N) {
// 445 S = S-1
S = S - 1;
// 446 P(N//10) %IF N >= 10
if (N < 10) goto L_0072;
P(((long)N / (long)10));
L_0072:;
// 447 %IF SIGN > 0 %START
if (SIGN <= 0) goto L_0073;
// 448 SPACES(S-1)
SPACES(S - 1);
// 449 PRINTSYMBOL(SIGN); SIGN = 0
PRINTSYMBOL(SIGN);
SIGN = 0;
// 450 %FINISH %ELSE %IF SIGN<0 %THEN SPACES(S) %AND SIGN=0; !FOR -VE S
goto L_0074;
L_0073:;
if (SIGN >= 0) goto L_0075;
SPACES(S);
SIGN = 0;
L_0075:;
L_0074:;
// 451 PRINTSYMBOL(REM(N,10)+'0')
PRINTSYMBOL(_imp_REM(N, 10) + 48);
// 452 %END
return;
} /* end of P */
// 453 %END
return;
} /* end of DEC10WRITE */
auto void EMASPRINTFL(double X, int N);
// 454
// 455 ! -----------------------------------------------------------------------------------------
// 456
// 457 ! #########################################################################################
// 458
// 459 %ROUTINESPEC EMAS PRINTFL (%LONGREAL X, %INTEGER N)
// 460
// 461 %ROUTINE EMAS PRINT(%LONGREAL X, %INTEGER N,M)
void EMASPRINT(double X, int N, int M) {
// 462 !***********************************************************************
// 463 !* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
// 464 !* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
// 465 !* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
// 466 !* *
// 467 !* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
// 468 !* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
// 469 !***********************************************************************
// 470 %CONSTLONGREAL DZ=0
const double DZ = 0;
// 471 %LONGREAL Y,Z,ROUND,FACTOR
double Y;
double Z;
double ROUND;
double FACTOR;
// 472 %INTEGER I,J,L,MORIG
int I;
int J;
int L;
int MORIG;
// 473 %BYTEINTEGER SIGN
unsigned char SIGN;
// 474 M=M&63; ! DEAL WITH STUPID PARAMS
M = M & 63;
// 475 MORIG=M
MORIG = M;
// 476 %IF N<0 %THEN N=1; N=N&31; ! DEAL WITH STUPID PARAMS
if (N >= 0) goto L_0076;
N = 1;
L_0076:;
N = N & 31;
// 477 X=X+DZ; ! NORMALISE
X = X + DZ;
// 478 SIGN=' '; ! '+' IMPLIED
SIGN = 32;
// 479 %IF X<0 %THEN SIGN='-'
if (X >= 0) goto L_0077;
SIGN = 45;
L_0077:;
// 480 Y=|X|; ! ALL WORK DONE WITH Y
Y = _imp_MOD(X);
// 481 ROUND=0.5/10^M; ! ROUNDING FACTOR
ROUND = (double)(0.5 / (_imp_REXP(10, M)));
// 482 %IF Y>1.0*10^16 %OR N=0 %THENSTART; ! MEANINGLESS FIGURES GENERATED
if (Y > 1.0 * (_imp_REXP(10, 16))) goto L_000A;
if (N != 0) goto L_0078;
L_000A:;
// 483 %IF N>M %THEN M=N; ! FOR FIXED POINT PRINTING
if (N <= M) goto L_0079;
M = N;
L_0079:;
// 484 EMAS PRINTFL(X,M); ! OF ENORMOUS NUMBERS
EMASPRINTFL(X, M);
// 485 %RETURN; ! SO PRINT IN FLOATING FORM
return;
// 486 %FINISH
L_0078:;
// 487 I=0; Z=1; Y=Y+ROUND
I = 0;
Z = 1;
Y = Y + ROUND;
// 488 %CYCLE; ! COUNT LEADING PLACES
L_007A:;
// 489 I=I+1; Z=10*Z; ! NO DANGER OF OVERFLOW HERE
I = I + 1;
Z = 10 * Z;
// 490 %REPEAT %UNTIL Z>Y
if (Z > Y) goto L_007B;
goto L_007A;
L_007B:;
// 491 PRINTSYMBOL(SIGN)
PRINTSYMBOL(SIGN);
// 492 J=I-1; Z=10^J
J = I - 1;
Z = _imp_REXP(10, J);
// 493 FACTOR=1/10
FACTOR = (double)(1 / 10);
// 494 %CYCLE
L_007C:;
// 495 %CYCLE
L_007D:;
// 496 L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
L = _imp_INTPT((double)(Y / Z));
// 497 Y=Y-L*Z; Z=Z*FACTOR; ! AND REDUCE TOTAL
Y = Y - L * Z;
Z = Z * FACTOR;
// 498 PRINTSYMBOL(L+'0')
PRINTSYMBOL(L + 48);
// 499 J=J-1
J = J - 1;
// 500 %REPEAT %UNTIL J<0
if (J < 0) goto L_007E;
goto L_007D;
L_007E:;
// 501 %IF M=0 %THEN %EXIT; ! NO DECIMAL PART TO BE O/P
if (M != 0) goto L_007F;
goto L_0080;
L_007F:;
// 502 PRINTSTRING(".")
PRINTSTRING(_imp_str_literal("."));
// 503 J=M-1; Z=10^(J-1); M=0
J = M - 1;
Z = _imp_REXP(10, J - 1);
M = 0;
// 504 Y=10*Y*Z
Y = 10 * Y * Z;
// 505 %REPEAT
goto L_007C;
L_0080:;
// 506 %if MORIG>0 %start { Chop any redundant trailing 0s}
if (MORIG <= 0) goto L_0081;
// 507 !opline_length=opline_length-1 %while %c
// 508 ! opline_l(opline_length-1)='0' %and opline_l(opline_length-2)#'.'
// 509 %finish
L_0081:;
// 510 %END; ! OF ROUTINE PRINT
return;
} /* end of EMASPRINT */
// 511
// 512 %ROUTINE EMAS PRINTFL (%LONGREAL X, %INTEGER N)
void EMASPRINTFL(double X, int N) {
// 513 !***********************************************************************
// 514 !* PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE *
// 515 !* DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS. *
// 516 !* CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X *
// 517 !***********************************************************************
// 518 %LONGREAL SIGN,ROUND,FACTOR,LB,UB
double SIGN;
double ROUND;
double FACTOR;
double LB;
double UB;
// 519 %CONSTLONGREAL DZ=0
const double DZ = 0;
// 520 %INTEGER COUNT,INC
int COUNT;
int INC;
// 521 inc=integer(addr(x))
INC = *_imp_INTEGER(_imp_ADDR(/*?*/ &X));
// 522 %if inc>>20&x'7ff'=x'7ff' %start
if ((unsigned int)INC >> 20 & 2047 != 2047) goto L_0082;
// 523 printstring("NAN");
PRINTSTRING(_imp_str_literal("NAN"));
// 524 !outhex(inc);
// 525 !outhex(integer(addr(x)+4))
// 526 !outsym('}');
// 527 %return
return;
// 528 %finish
L_0082:;
// 529 ROUND=0.5/10^N; ! TO ROUND SCALED NO
ROUND = (double)(0.5 / (_imp_REXP(10, N)));
// 530 LB=1-ROUND; UB=10-ROUND
LB = 1 - ROUND;
UB = 10 - ROUND;
// 531 SIGN=1
SIGN = 1;
// 532 X=X+DZ; ! NORMALISE
X = X + DZ;
// 533 %IF X=0 %THEN COUNT=0 %ELSESTART
if (X != 0) goto L_0083;
COUNT = 0;
goto L_0084;
L_0083:;
// 534 %IF X<0 %THEN X=-X %AND SIGN=-SIGN
if (X >= 0) goto L_0085;
X = -X;
SIGN = -SIGN;
L_0085:;
// 535 INC=1; COUNT=0
INC = 1;
COUNT = 0;
// 536 FACTOR=1/10
FACTOR = (double)(1 / 10);
// 537 %IF X<=1 %THEN FACTOR=10 %AND INC=-1
if (X > 1) goto L_0086;
FACTOR = 10;
INC = -1;
L_0086:;
// 538 ! FORCE INTO RANGE 1->10
// 539 %WHILE X<LB %OR X>=UB %CYCLE
L_0087:;
if (X < LB) goto L_0088;
if (X < UB) goto L_0089;
L_0088:;
// 540 X=X*FACTOR; COUNT=COUNT+INC
X = X * FACTOR;
COUNT = COUNT + INC;
// 541 %REPEAT
goto L_0087;
L_0089:;
// 542 %FINISH
L_0084:;
// 543 EMAS PRINT(SIGN*X,1,N)
EMASPRINT(SIGN * X, 1, N);
// 544 %if count#0 %start
if (COUNT == 0) goto L_008A;
// 545 PRINTSTRING("@") ;! original had 'E' - was that correct?
PRINTSTRING(_imp_str_literal("@"));
// 546 WRITE68K(COUNT,0)
WRITE68K(COUNT, 0);
// 547 %finish
L_008A:;
// 548 %END; ! OF ROUTINE PRINTFL
return;
} /* end of EMASPRINTFL */
auto void ERCCPRINTFL(double X, int N);
// 549
// 550 ! -----------------------------------------------------------------------------------------
// 551 %ROUTINESPEC ERCC PRINTFL(%LONGREAL X, %INTEGER N)
// 552 %ROUTINE ERCC PRINT(%LONGREAL X, %INTEGER N,M)
void ERCCPRINT(double X, int N, int M) {
// 553 !***********************************************************************
// 554 !* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
// 555 !* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
// 556 !* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
// 557 !* *
// 558 !* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
// 559 !* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
// 560 !***********************************************************************
// 561 %CONSTLONGREAL PMAX= 1@16
const double PMAX = 1E16;
// 562 %CONSTLONGREAL DZ=0
const double DZ = 0;
// 563 %LONGREAL Y,Z,ROUND,FACTOR
double Y;
double Z;
double ROUND;
double FACTOR;
// 564 %INTEGER I,J,L
int I;
int J;
int L;
// 565 %BYTEINTEGER SIGN
unsigned char SIGN;
// 566 M=M&63; ! DEAL WITH STUPID PARAMS
M = M & 63;
// 567 %IF N<0 %THEN N=1; N=N&31; ! DEAL WITH STUPID PARAMS
if (N >= 0) goto L_008B;
N = 1;
L_008B:;
N = N & 31;
// 568 X=X+DZ; ! NORMALISE
X = X + DZ;
// 569 SIGN=' '; ! '+' IMPLIED
SIGN = 32;
// 570 %IF X<0 %THEN SIGN='-'
if (X >= 0) goto L_008C;
SIGN = 45;
L_008C:;
// 571 Y=|X|; ! ALL WORK DONE WITH Y
Y = _imp_MOD(X);
// 572 ROUND=0.5/10^M; ! ROUNDING FACTOR
ROUND = (double)(0.5 / (_imp_REXP(10, M)));
// 573 %IF Y>PMAX %OR N=0 %THENSTART; ! MEANINGLESS FIGURES GENERATED
if (Y > PMAX) goto L_008D;
if (N != 0) goto L_008E;
L_008D:;
// 574 %IF N>M %THEN M=N; ! FOR FIXED POINT PRINTING
if (N <= M) goto L_008F;
M = N;
L_008F:;
// 575 ERCC PRINTFL(X,M); ! OF ENORMOUS NUMBERS
ERCCPRINTFL(X, M);
// 576 %RETURN; ! SO PRINT IN FLOATING FORM
return;
// 577 %FINISH
L_008E:;
// 578 I=0; Z=1; Y=Y+ROUND
I = 0;
Z = 1;
Y = Y + ROUND;
// 579 %CYCLE; ! COUNT LEADING PLACES
L_0090:;
// 580 I=I+1; Z=10*Z; ! NO DANGER OF OVERFLOW HERE
I = I + 1;
Z = 10 * Z;
// 581 %REPEAT %UNTIL Z>Y
if (Z > Y) goto L_0091;
goto L_0090;
L_0091:;
// 582 SPACES(N-I); ! O.K FOR ZERO OR -VE SPACES
SPACES(N - I);
// 583 PRINT SYMBOL(SIGN)
PRINTSYMBOL(SIGN);
// 584 J=I-1; Z=10^J
J = I - 1;
Z = _imp_REXP(10, J);
// 585 FACTOR=1/10
FACTOR = (double)(1 / 10);
// 586 %CYCLE
L_0092:;
// 587 %CYCLE
L_0093:;
// 588 L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
L = _imp_INTPT((double)(Y / Z));
// 589 Y=Y-L*Z; Z=Z*FACTOR; ! AND REDUCE TOTAL
Y = Y - L * Z;
Z = Z * FACTOR;
// 590 PRINT SYMBOL(L+'0')
PRINTSYMBOL(L + 48);
// 591 J=J-1
J = J - 1;
// 592 %REPEAT %UNTIL J<0
if (J < 0) goto L_0094;
goto L_0093;
L_0094:;
// 593 %IF M=0 %THENRETURN; ! NO DECIMAL PART TO BE O/P
if (M != 0) goto L_0095;
return;
L_0095:;
// 594 PRINTSTRING(".")
PRINTSTRING(_imp_str_literal("."));
// 595 J=M-1; Z=10^(J-1); M=0
J = M - 1;
Z = _imp_REXP(10, J - 1);
M = 0;
// 596 Y=10*Y*Z
Y = 10 * Y * Z;
// 597 %REPEAT
goto L_0092;
// 598 %END; ! OF ROUTINE PRINT
} /* end of ERCCPRINT */
// 599
// 600 %ROUTINE ERCC PRINTFL(%LONGREAL X, %INTEGER N)
void ERCCPRINTFL(double X, int N) {
// 601 !***********************************************************************
// 602 !* PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE *
// 603 !* DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS. *
// 604 !* CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X *
// 605 !***********************************************************************
// 606 %CONSTLONGREAL DZ=0
const double DZ = 0;
// 607 %LONGREAL SIGN,ROUND,FACTOR,LB,UB
double SIGN;
double ROUND;
double FACTOR;
double LB;
double UB;
// 608 %INTEGER COUNT,INC
int COUNT;
int INC;
// 609 ROUND=0.5/10^N; ! TO ROUND SCALED NO
ROUND = (double)(0.5 / (_imp_REXP(10, N)));
// 610 LB=1-ROUND; UB=10-ROUND
LB = 1 - ROUND;
UB = 10 - ROUND;
// 611 SIGN=1
SIGN = 1;
// 612 X=X+DZ; ! NORMALISE
X = X + DZ;
// 613 %IF X=0 %THEN COUNT=-99 %ELSESTART
if (X != 0) goto L_0096;
COUNT = -99;
goto L_0097;
L_0096:;
// 614 %IF X<0 %THEN X=-X %AND SIGN=-SIGN
if (X >= 0) goto L_0098;
X = -X;
SIGN = -SIGN;
L_0098:;
// 615 INC=1; COUNT=0
INC = 1;
COUNT = 0;
// 616 FACTOR=1/10
FACTOR = (double)(1 / 10);
// 617 %IF X<=1 %THEN FACTOR=10 %AND INC=-1
if (X > 1) goto L_0099;
FACTOR = 10;
INC = -1;
L_0099:;
// 618 ! FORCE INTO RANGE 1->10
// 619 %WHILE X<LB %OR X>=UB %CYCLE
L_009A:;
if (X < LB) goto L_009B;
if (X < UB) goto L_009C;
L_009B:;
// 620 X=X*FACTOR; COUNT=COUNT+INC
X = X * FACTOR;
COUNT = COUNT + INC;
// 621 %REPEAT
goto L_009A;
L_009C:;
// 622 %FINISH
L_0097:;
// 623 ERCC PRINT(SIGN*X,1,N)
ERCCPRINT(SIGN * X, 1, N);
// 624 PRINTSTRING("@")
PRINTSTRING(_imp_str_literal("@"));
// 625 emasWRITE(COUNT,2)
EMASWRITE(COUNT, 2);
// 626 %END; ! OF ROUTINE PRINTFL
return;
} /* end of ERCCPRINTFL */
// 627 ! -----------------------------------------------------------------------------------------
// 628
// 629 %routine vax printfl(%long %real r, %integer places)
void VAXPRINTFL(double R, int PLACES) {
// 630 %string (63) %fn ftos(%long %real r, %integer p)
_imp_string63 FTOS(double R, int P) {
// 631 %routine vax fraction(%long %real r, %integer places, %string (*) %name s)
void VAXFRACTION(double R, int PLACES, _imp_string *S) {
// 632 %long %real %fn fracpt(%long %real x)
double FRACPT(double X) {
// 633 %long %real z
double Z;
// 634 z = x - intpt(x)
Z = X - _imp_INTPT(X);
// 635 z = z + 1.0 %if z < 0
if (Z >= 0) goto L_009D;
Z = Z + 1.0;
L_009D:;
// 636 %result = z
return Z;
// 637 %end
} /* end of FRACPT */
// 638 %return %if places <= 0
if (PLACES > 0) goto L_009E;
return;
L_009E:;
// 639 s = s . "."
*S = *
/* clang-format off */
*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string255) tmp; /*D*/ tmp = *S; (void *)&tmp;}), (_imp_string *)/*?*/_imp_str_literal_ptr(".")); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 640 %while places > 0 %cycle
L_009F:;
if (PLACES <= 0) goto L_00A0;
// 641 places = places - 1
PLACES = PLACES - 1;
// 642 r = fracpt(r) * 10
R = FRACPT(R) * 10;
// 643 s = s . tostring(intpt(r) + '0')
*S = *
/* clang-format off */
*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string255) tmp; /*D*/ tmp = *S; (void *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(_imp_INTPT(R) + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 644 %repeat
goto L_009F;
L_00A0:;
// 645 %end
return;
} /* end of VAXFRACTION */
// 646 %routine round(%long %real %name v, %integer p)
void ROUND(double *V, int P) {
// 647 %long %real x
double X;
// 648 %return %if v = 0
if (*V != 0) goto L_00A1;
return;
L_00A1:;
// 649 %if v < 0 %then x = -0.5 %else x = 0.5
if (*V >= 0) goto L_00A2;
X = -0.5;
goto L_00A3;
L_00A2:;
X = 0.5;
L_00A3:;
// 650 %cycle
L_00A4:;
// 651 p = p - 1
P = P - 1;
// 652 %exit %if p < 0
if (P >= 0) goto L_00A5;
goto L_00A6;
L_00A5:;
// 653 x = x / 10
X = (double)(X / 10);
// 654 %repeat
goto L_00A4;
L_00A6:;
// 655 v = v + x
*V = *V + X;
// 656 %end
return;
} /* end of ROUND */
// 657 {XOWN}%string (63) s = ""
_imp_string63 S;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 658 %integer exp, sym
int EXP;
int SYM;
// 659 !p = 7 %if p > 7 ;! WHY?????????????????????????? p = 7 %if p > 7
// 660 ! removing the p<=7 constraint makes this behave the same as EMAS PRINTFL
// 661 %if r < 0 %then sym = '-' %and r = -r %else sym = ' '
if (R >= 0) goto L_00A7;
SYM = 45;
R = -R;
goto L_00A8;
L_00A7:;
SYM = 32;
L_00A8:;
// 662 %if r = 0 %start
if (R != 0) goto L_00A9;
// 663 exp = -99
EXP = -99;
// 664 %else
goto L_00AA;
L_00A9:;
// 665 exp = 0
EXP = 0;
// 666 exp = exp + 1 %and r = r / 10 %while r >= 10
L_00AB:;
if (R < 10) goto L_00AC;
EXP = EXP + 1;
R = (double)(R / 10);
goto L_00AB;
L_00AC:;
// 667 exp = exp - 1 %and r = r * 10 %while r < 1
L_00AD:;
if (R >= 1) goto L_00AE;
EXP = EXP - 1;
R = R * 10;
goto L_00AD;
L_00AE:;
// 668 %finish
L_00AA:;
// 669 round(r, p)
ROUND(/*?*/ &R, P);
// 670 exp = exp + 1 %and r = r / 10 %if r >= 10
if (R < 10) goto L_00AF;
EXP = EXP + 1;
R = (double)(R / 10);
L_00AF:;
// 671 s = s . tostring(intpt(r) + '0')
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(_imp_INTPT(R) + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 672 vax fraction(r, p, s)
VAXFRACTION(R, P, (_imp_string255 *)/*p*/ /*?*/ &S);
// 673 %result = tostring(sym) . s . "@" . itos(exp, 0)
return *(_imp_string63 *)/*?*/ &
/* clang-format off */
*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string1) tmp; /*D*/ tmp = _imp_TOSTRING(SYM); (void *)&tmp;}), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}), (_imp_string *)/*?*/_imp_str_literal_ptr("@")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string255) tmp; /*E*/ tmp = _imp_ITOS(EXP, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 674 %end
} /* end of FTOS */
// 675 places = \places %if places < 0
if (PLACES >= 0) goto L_00B0;
PLACES = (~PLACES);
L_00B0:;
// 676 spaces(places - 62)
SPACES(PLACES - 62);
// 677 printstring(ftos(r, places))
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string63) tmp = FTOS(R, PLACES)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 678 %end
return;
} /* end of VAXPRINTFL */
// 679
// 680 ! -----------------------------------------------------------------------------------------
// 681
// 682 %long %real %fn dec10 fracpt(%long %real x)
double DEC10FRACPT(double X) {
// 683 %long %real z
double Z;
// 684 z = x - intpt(x)
Z = X - _imp_INTPT(X);
// 685 z = z + 1.0 %if z < 0
if (Z >= 0) goto L_00B1;
Z = Z + 1.0;
L_00B1:;
// 686 %result = x - intpt(x)
return X - _imp_INTPT(X);
// 687
// 688 %end
} /* end of DEC10FRACPT */
// 689
// 690 %ROUTINE DEC10 FRACTION(%LONG %REAL R, %INTEGER PLACES)
void DEC10FRACTION(double R, int PLACES) {
// 691 %RETURN %IF PLACES <= 0
if (PLACES > 0) goto L_00B2;
return;
L_00B2:;
// 692 PRINTSYMBOL('.')
PRINTSYMBOL(46);
// 693 %WHILE PLACES>0 %CYCLE
L_00B3:;
if (PLACES <= 0) goto L_00B4;
// 694 R = dec10 FRACPT(R)*10.0 ; ! first digit after the point of a 0.xxxxxxx positive number.
R = DEC10FRACPT(R) * 10.0;
// 695 PLACES = PLACES-1
PLACES = PLACES - 1;
// 696 PRINTSYMBOL(INTPT(R)+'0')
PRINTSYMBOL(_imp_INTPT(R) + 48);
// 697 %REPEAT
goto L_00B3;
L_00B4:;
// 698 %END
return;
} /* end of DEC10FRACTION */
// 699
// 700 %ROUTINE DEC10 PRINTFL(%LONG %REAL R, %INTEGER P)
void DEC10PRINTFL(double R, int P) {
// 701 %INTEGER EXP,SIGN, pp
int EXP;
int SIGN;
int PP;
// 702 %real roundup
double ROUNDUP;
// 703 SIGN=' '
SIGN = 32;
// 704 SIGN='-' %AND R = -R %IF R < 0
if (R >= 0) goto L_00B5;
SIGN = 45;
R = -R;
L_00B5:;
// 705 PRINTSYMBOL(SIGN)
PRINTSYMBOL(SIGN);
// 706 %IF R = 0 %START
if (R != 0) goto L_00B6;
// 707 EXP = 0 ;! Was EXP = 99 for completely unknown reasons.
EXP = 0;
// 708 %ELSE
goto L_00B7;
L_00B6:;
// 709 ! Normalise:
// 710 EXP = 0
EXP = 0;
// 711 EXP = EXP + 1 %AND R = R*0.1 %WHILE R >= 10.0
L_00B8:;
if (R < 10.0) goto L_00B9;
EXP = EXP + 1;
R = R * 0.1;
goto L_00B8;
L_00B9:;
// 712 EXP = EXP - 1 %AND R = R*10.0 %WHILE R < 1.0
L_00BA:;
if (R >= 1.0) goto L_00BB;
EXP = EXP - 1;
R = R * 10.0;
goto L_00BA;
L_00BB:;
// 713 ! R should now be a single digit followed by a decimal part, with the exponent adjusted appropriately
// 714 ! Round to P places:
// 715 roundup = 0.5
ROUNDUP = 0.5;
// 716 %IF P <= 0 %START
if (P > 0) goto L_00BC;
// 717 !R = R+0.5 ;! round to an int?
// 718 pp = 0
PP = 0;
// 719 %ELSE
goto L_00BD;
L_00BC:;
// 720 ! This was just not working so I've replaced it with the 'pp' code below. I suspect faulty exponentiation?
// 721 !R = R + 0.5*10\(-P)
// 722 !R = R + 0.5*10^(-P)
// 723 pp = p
PP = P;
// 724 %FINISH
L_00BD:;
// 725 %while pp > 0 %then roundup = roundup / 10 %and pp = pp - 1
L_00BE:;
if (PP <= 0) goto L_00BF;
ROUNDUP = (double)(ROUNDUP / 10);
PP = PP - 1;
goto L_00BE;
L_00BF:;
// 726 R = R + roundup
R = R + ROUNDUP;
// 727 %FINISH
L_00B7:;
// 728 PRINTSYMBOL(INT PT(R)+'0')
PRINTSYMBOL(_imp_INTPT(R) + 48);
// 729 DEC10 FRACTION(R,P)
DEC10FRACTION(R, P);
// 730 PRINTSYMBOL('@'); WRITE68K(EXP,1)
PRINTSYMBOL(64);
WRITE68K(EXP, 1);
// 731 %END
return;
} /* end of DEC10PRINTFL */
// 732
// 733 %ROUTINE DEC10 PRINT(%LONG %REAL R, %INTEGER B,A)
void DEC10PRINT(double R, int B, int A) {
// 734 %LONG %REAL RM
double RM;
// 735 %CONSTINTEGER MAX INT=16_7FFFFFFF
// 736 %INTEGER SIGN
int SIGN;
// 737 %ROUTINE P(%INTEGER N)
void P(int N) {
// 738 B = B-1
B = B - 1;
// 739 P(N//10) %IF N >= 10
if (N < 10) goto L_00C0;
P(((long)N / (long)10));
L_00C0:;
// 740 %IF SIGN # 0 %START
if (SIGN == 0) goto L_00C1;
// 741 SPACES(B-1)
SPACES(B - 1);
// 742 PRINTSYMBOL(SIGN); SIGN = 0
PRINTSYMBOL(SIGN);
SIGN = 0;
// 743 %FINISH
L_00C1:;
// 744 PRINTSYMBOL(REM(N,10)+'0')
PRINTSYMBOL(_imp_REM(N, 10) + 48);
// 745 %END
return;
} /* end of P */
// 746 RM=|R|
RM = _imp_MOD(R);
// 747 DEC10 PRINTFL(R, B+A) %AND %RETURN %IF RM> MAX INT
if (RM <= 2147483647) goto L_00C2;
DEC10PRINTFL(R, B + A);
return;
L_00C2:;
// 748 %IF A<=0 %START
if (A > 0) goto L_00C3;
// 749 RM=RM+0.5
RM = RM + 0.5;
// 750 %ELSE
goto L_00C4;
L_00C3:;
// 751 !RM=RM+0.5*10\(-A)
// 752 RM=RM+0.5*10^(-A)
RM = RM + 0.5 * (_imp_REXP(10, -A));
// 753 %FINISH
L_00C4:;
// 754 %IF B<=0 %THEN SIGN=0 %ELSE SIGN=' '
if (B > 0) goto L_00C5;
SIGN = 0;
goto L_00C6;
L_00C5:;
SIGN = 32;
L_00C6:;
// 755 %IF R<0 %THEN SIGN='-'
if (R >= 0) goto L_00C7;
SIGN = 45;
L_00C7:;
// 756 P(INT PT(RM)); !THUS ALLOWING FOR -0.1 ETC.
P(_imp_INTPT(RM));
// 757 DEC10 FRACTION(RM,A)
DEC10FRACTION(RM, A);
// 758 %END
return;
} /* end of DEC10PRINT */
// 759
// 760 ! -----------------------------------------------------------------------------------------
// 761
// 762 %routine print 68k(%long %real x, %integer n,m)
void PRINT68K(double X, int N, int M) {
// 763 %constreal pmax = 2147483647.0
const double PMAX = 2147483647.0;
// 764 %long %real y,z,POW
double Y;
double Z;
double POW;
// 765 %integer i=0,l,count=0,sign
int I;
I = 0;
int L;
int COUNT;
COUNT = 0;
int SIGN;
// 766 sign = ' '
SIGN = 32;
// 767 sign = '-' %if x < 0
if (X >= 0) goto L_00C8;
SIGN = 45;
L_00C8:;
// 768 !y = |x|+0.5/10.0\{^}m; !modulus, rounded
// 769 POW = 10.0^|m|
POW = _imp_REXP(10.0, _imp_IMOD(M));
// 770 POW = 0.5/POW
POW = (double)(0.5 / POW);
// 771 y = |x|
Y = _imp_MOD(X);
// 772 y = y+POW; !modulus, rounded
Y = Y + POW;
// 773 %if y > pmax %start
if (Y <= PMAX) goto L_00C9;
// 774 count = count+1 %and y = y/10.0 %until y < 10.0
L_00CA:;
COUNT = COUNT + 1;
Y = (double)(Y / 10.0);
if (Y < 10.0) goto L_00CB;
goto L_00CA;
L_00CB:;
// 775 %finish
L_00C9:;
// 776 z = 1.0
Z = 1.0;
// 777 %cycle
L_00CC:;
// 778 i = i+1; z = z*10.0
I = I + 1;
Z = Z * 10.0;
// 779 %repeat %until z > y
if (Z > Y) goto L_00CD;
goto L_00CC;
L_00CD:;
// 780 spaces(n-i)
SPACES(N - I);
// 781 printsymbol(sign) %unless sign = ' ' %and n <= 0 ;! n < 0 just makes a difference of one space character
if (SIGN != 32) goto L_00CE;
if (N <= 0) goto L_00CF;
L_00CE:;
PRINTSYMBOL(SIGN);
L_00CF:;
// 782 %cycle
L_00D0:;
// 783 z = z/10.0
Z = (double)(Z / 10.0);
// 784 l = int pt(y/z)
L = _imp_INTPT((double)(Y / Z));
// 785 y = y-l*z
Y = Y - L * Z;
// 786 printsymbol(l+'0')
PRINTSYMBOL(L + 48);
// 787 i = i-1
I = I - 1;
// 788 %exit %if i+m <= 0
if (I + M > 0) goto L_00D1;
goto L_00D2;
L_00D1:;
// 789 print symbol('.') %if i = 0
if (I != 0) goto L_00D3;
PRINTSYMBOL(46);
L_00D3:;
// 790 %repeat
goto L_00D0;
L_00D2:;
// 791 printsymbol('@') %and write 68k(count,0) %if count # 0
if (COUNT == 0) goto L_00D4;
PRINTSYMBOL(64);
WRITE68K(COUNT, 0);
L_00D4:;
// 792 %end; !print
return;
} /* end of PRINT68K */
// 793
// 794 %routine printfl 68k(%long %real x, %integer n)
void PRINTFL68K(double X, int N) {
// 795 %long %real y,round
double Y;
double ROUND;
// 796 %integer count=-99,sign=0
int COUNT;
COUNT = -99;
int SIGN;
SIGN = 0;
// 797 %if x # 0 %start
if (X == 0) goto L_00D5;
// 798 x = -x %and sign = 1 %if x < 0
if (X >= 0) goto L_00D6;
X = -X;
SIGN = 1;
L_00D6:;
// 799 !Adjust X so that 1.0 <= rounded(X) < 10.0
// 800 !count = 0; round = 0.5\{^}n
// 801 count = 0; round = 0.5^|n|
COUNT = 0;
ROUND = _imp_REXP(0.5, _imp_IMOD(N));
// 802 y = 1.0-round
Y = 1.0 - ROUND;
// 803 %if x < y %start; !ie rounded(X) < 1.0
if (X >= Y) goto L_00D7;
// 804 count = count-1 %and x = x*10.0 %until x >= y
L_00D8:;
COUNT = COUNT - 1;
X = X * 10.0;
if (X >= Y) goto L_00D9;
goto L_00D8;
L_00D9:;
// 805 %finish %else %start
goto L_00DA;
L_00D7:;
// 806 y = 10.0-round
Y = 10.0 - ROUND;
// 807 %while x >= y %cycle; !ie rounded(X) > 10.0
L_00DB:;
if (X < Y) goto L_00DC;
// 808 count = count+1; x = x/10.0
COUNT = COUNT + 1;
X = (double)(X / 10.0);
// 809 %repeat
goto L_00DB;
L_00DC:;
// 810 %finish
L_00DA:;
// 811 x = -x %if sign # 0
if (SIGN == 0) goto L_00DD;
X = -X;
L_00DD:;
// 812 %finish
L_00D5:;
// 813 print 68k(x,1,n)
PRINT68K(X, 1, N);
// 814 printsymbol('@')
PRINTSYMBOL(64);
// 815 write 68k(count,0)
WRITE68K(COUNT, 0);
// 816 %end; !printfl
return;
} /* end of PRINTFL68K */
// 817
// 818 ! -----------------------------------------------------------------------------------------
// 819 %routine mousesprintfl(%real r, %integer places)
void MOUSESPRINTFL(double R, int PLACES) {
// 820 %routine round(%real %name v, %integer p)
void ROUND(double *V, int P) {
// 821 %real x
double X;
// 822 %return %if v = 0
if (*V != 0) goto L_00DE;
return;
L_00DE:;
// 823 %if v < 0 %then x = -0.5 %else x = 0.5
if (*V >= 0) goto L_00DF;
X = -0.5;
goto L_00E0;
L_00DF:;
X = 0.5;
L_00E0:;
// 824 %cycle
L_00E1:;
// 825 p = p - 1
P = P - 1;
// 826 %exit %if p < 0
if (P >= 0) goto L_00E2;
goto L_00E3;
L_00E2:;
// 827 x = x / 10
X = (double)(X / 10);
// 828 %repeat
goto L_00E1;
L_00E3:;
// 829 v = v + x
*V = *V + X;
// 830 %end
return;
} /* end of ROUND */
// 831 %routine fraction(%real r, %integer places, %string (*) %name s)
void FRACTION(double R, int PLACES, _imp_string *S) {
// 832 %long %real %fn fracpt(%long %real x)
double FRACPT(double X) {
// 833 %long %real z
double Z;
// 834 z = x - intpt(x)
Z = X - _imp_INTPT(X);
// 835 z = z + 1.0 %if z < 0
if (Z >= 0) goto L_00E4;
Z = Z + 1.0;
L_00E4:;
// 836 %result = z
return Z;
// 837 %end
} /* end of FRACPT */
// 838 !%realfn MOUSES FRACPT(%real r) ;! dependent on machine representation of floating point.
// 839 ! %integer m,x,z
// 840 ! %if |R| >= 1.0 %start
// 841 ! x = integer(addr(r))
// 842 ! z = x>>24&b'01111111'
// 843 ! %result = 0 %if z > x'46'
// 844 ! m = -1
// 845 ! m = m<<4 %and z = z+1 %while z < x'46'
// 846 ! x = x&(m!x'FF000000')
// 847 ! r = r-real(addr(x))
// 848 ! %finish
// 849 ! r = r+1 %if r < 0
// 850 ! %result = r
// 851 !%end
// 852
// 853 %return %if places <= 0
if (PLACES > 0) goto L_00E5;
return;
L_00E5:;
// 854 s = s . "."
*S = *
/* clang-format off */
*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string255) tmp; /*D*/ tmp = *S; (void *)&tmp;}), (_imp_string *)/*?*/_imp_str_literal_ptr(".")); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 855 %while places > 0 %cycle
L_00E6:;
if (PLACES <= 0) goto L_00E7;
// 856 places = places - 1
PLACES = PLACES - 1;
// 857 r = fracpt(r) * 10
R = FRACPT(R) * 10;
// 858 s = s . tostring(intpt(r) + '0')
*S = *
/* clang-format off */
*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string255) tmp; /*D*/ tmp = *S; (void *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(_imp_INTPT(R) + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 859 %repeat
goto L_00E6;
L_00E7:;
// 860 %end
return;
} /* end of FRACTION */
// 861 %string (64) %fn ftos(%real r, %integer p)
_imp_string64 FTOS(double R, int P) {
// 862 {XOWN}%string (64) s = ""
_imp_string64 S;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/64);
/* clang-format on */
// 863 %integer exp, sym
int EXP;
int SYM;
// 864 p = 7 %if p > 7
if (P <= 7) goto L_00E8;
P = 7;
L_00E8:;
// 865 %if r < 0 %then sym = '-' %and r = -r %else sym = ' '
if (R >= 0) goto L_00E9;
SYM = 45;
R = -R;
goto L_00EA;
L_00E9:;
SYM = 32;
L_00EA:;
// 866 %if r = 0 %start
if (R != 0) goto L_00EB;
// 867 exp = -99
EXP = -99;
// 868 %else
goto L_00EC;
L_00EB:;
// 869 exp = 0
EXP = 0;
// 870 exp = exp + 1 %and r = r / 10 %while r >= 10
L_00ED:;
if (R < 10) goto L_00EE;
EXP = EXP + 1;
R = (double)(R / 10);
goto L_00ED;
L_00EE:;
// 871 exp = exp - 1 %and r = r * 10 %while r < 1
L_00EF:;
if (R >= 1) goto L_00F0;
EXP = EXP - 1;
R = R * 10;
goto L_00EF;
L_00F0:;
// 872 %finish
L_00EC:;
// 873 round(r, p)
ROUND(/*?*/ &R, P);
// 874 exp = exp + 1 %and r = r / 10 %if r >= 10
if (R < 10) goto L_00F1;
EXP = EXP + 1;
R = (double)(R / 10);
L_00F1:;
// 875 s = s . tostring(intpt(r) + '0')
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(_imp_INTPT(R) + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/64);
/* clang-format on */
// 876 fraction(r, p, s)
FRACTION(R, P, (_imp_string255 *)/*p*/ /*?*/ &S);
// 877 s = s . "@" . itos(exp, 0)
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("@")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string255) tmp; /*E*/ tmp = _imp_ITOS(EXP, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/64);
/* clang-format on */
// 878 %result = s
return *(_imp_string64 *)/*?*/ &S;
// 879 %end
} /* end of FTOS */
// 880 printstring(ftos(r, places))
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string64) tmp = FTOS(R, PLACES)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 881 %end
return;
} /* end of MOUSESPRINTFL */
// 882 ! -----------------------------------------------------------------------------------------
// 883
// 884 ! Convert a floating point number to a string, along the lines of
// 885 ! +/-nnn.nnn@+/-nn, to occupy Places character spaces
// 886 ! with sf significant figures.
// 887 ! Rounding/truncation will occur to ensure sf limits
// 888 !
// 889 ! %longreal f = floating point number to convert to a string
// 890 ! %integer sf = number of significant figures required
// 891 ! places = number of characters in converted string
// 892 !
// 893 ! N.B. sf must be in the range of accuracy of %longreal (<15)
// 894 ! places must be slightly greater than sf
// 895 ! (to allow for sign and scientific notation)
// 896 ! sign uses 1 character (+ is omitted)
// 897 ! decimal point uses 1 character
// 898 ! scientific notation could use :
// 899 ! 1 char for "@" ndicating scientific notation
// 900 ! 1 char for sign of exponent (sign always present)
// 901 ! 1+ char for integer exponent
// 902 !
// 903 ! N.B. scientific notation is only used if the decimal string could
// 904 ! not fit in the places required
// 905 !
// 906 ! eg. F to S (0.003999, 3, 7) -> " 0.004 " (note rounding creates zeros after the 4)
// 907 ! or
// 908 ! eg. F to S (0.003999, 3, 4) -> " 4.00@-3" (converted to scientific notation to fit)
// 909 ! eg. F to S (0.003999, 3, 6) -> " 0.004" (fits exactly)
// 910 !
// 911 %string(255) %function imp77 F to S( %longreal f, %integer sf, places)
_imp_string255 IMP77FTOS(double F, int SF, int PLACES) {
// 912 %string(255) s,sx
_imp_string255 S;
_imp_string255 SX;
// 913 %string(15) science
_imp_string15 SCIENCE;
// 914 %integer dc,carry
int DC;
int CARRY;
// 915 %integer sign,exponent, digit, point
int SIGN;
int EXPONENT;
int DIGIT;
int POINT;
// 916
// 917 %if (sf > 14) %then sf = 14
if (SF <= 14) goto L_00F2;
SF = 14;
L_00F2:;
// 918
// 919 %begin
{ /*%begin*/
// 920 %integer i
int I;
// 921 %integerarray digits(1:sf+1)
int DIGITS[SF + 1 - 1 + 1];
struct _imp_dv DIGITS_dv = {DIGITS, sizeof(int) /*, dims, <bounds> */};
// 922
// 923 sign = 0
SIGN = 0;
// 924
// 925 %for i = 1,1,sf+1 %cycle
// %for I = 1, 1, SF + 1 %cycle
{
int _final = SF + 1;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, SF + 1");
I = 0;
L_00F3:
if (I == _final) goto L_00F4;
I += 1;
// 926 digits(i) = 0
DIGITS[I - 1] = 0;
// 927 %repeat
goto L_00F3;
}
L_00F4:;
// 928
// 929 %if (f < 0) %then sign = 1 %and f = -f
if (F >= 0) goto L_00F6;
SIGN = 1;
F = -F;
L_00F6:;
// 930
// 931 ! clear the floating point string
// 932 length(s) = 0
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) = 0;
// 933
// 934 %if (f = 0) %start
if (F != 0) goto L_00F7;
// 935 ! convert to positive zero
// 936 sign = 0
SIGN = 0;
// 937 dc = 2
DC = 2;
// 938 sf = 2
SF = 2;
// 939 exponent = 0
EXPONENT = 0;
// 940 point = 1
POINT = 1;
// 941 %finish %else %start
goto L_00F8;
L_00F7:;
// 942 ! prepare the exponent, point values for (f # 0)
// 943 ! evaluate the exponent value
// 944 exponent = 0
EXPONENT = 0;
// 945 %while f < 1 %cycle
L_00F9:;
if (F >= 1) goto L_00FA;
// 946 f = f * 10
F = F * 10;
// 947 exponent = exponent - 1
EXPONENT = EXPONENT - 1;
// 948 %repeat
goto L_00F9;
L_00FA:;
// 949
// 950 %while f >= 10 %cycle
L_00FB:;
if (F < 10) goto L_00FC;
// 951 f = f / 10
F = (double)(F / 10);
// 952 exponent = exponent + 1
EXPONENT = EXPONENT + 1;
// 953 %repeat
goto L_00FB;
L_00FC:;
// 954
// 955 ! locate the decimal point
// 956 point = 1
POINT = 1;
// 957 ! zero the digit count
// 958 dc = 0
DC = 0;
// 959
// 960 ! Loop to get the significant figure digits with an extra digit
// 961 ! so we can use it to round the the required sig figs
// 962 ! Rounding as we go through this loop can "oversize" the digit.
// 963 ! The next stage does the rounding to the correct sig fig.
// 964 %for i = 1,1,sf + 1 %cycle
// %for I = 1, 1, SF + 1 %cycle
{
int _final = SF + 1;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, SF + 1");
I = 0;
L_00FD:
if (I == _final) goto L_00FE;
I += 1;
// 965 digit = int pt(f)
DIGIT = _imp_INTPT(F);
// 966 %if (digit > 9) %then digit = 9
if (DIGIT <= 9) goto L_0100;
DIGIT = 9;
L_0100:;
// 967 dc = dc + 1
DC = DC + 1;
// 968 digits(dc) = digit
DIGITS[DC - 1] = DIGIT;
// 969 f = (f - digit)*10
F = (F - DIGIT) * 10;
// 970 %repeat
goto L_00FD;
}
L_00FE:;
// 971
// 972 ! do the rounding to the sf significant figures
// 973 %if (digits(dc) > 4) %start
if (DIGITS[DC - 1] <= 4) goto L_0101;
// 974 ! we need to possibly round up the digits sequence
// 975 carry = 1
CARRY = 1;
// 976 %for i = dc - 1,-1,1 %cycle
// %for I = DC - 1, -1, 1 %cycle
{
int _initial = DC - 1;
if (invalid_for_loop(_initial, -1, 1)) _imp_signal(5, 1, 0, "Illegal cycle I = DC - 1, -1, 1");
I = _initial - (-1);
L_0102:
if (I == 1) goto L_0103;
I -= 1;
// 977 digits(i) = digits(i) + carry
DIGITS[I - 1] = DIGITS[I - 1] + CARRY;
// 978 %if (digits(i) > 9) %start
if (DIGITS[I - 1] <= 9) goto L_0105;
// 979 carry = 1
CARRY = 1;
// 980 digits(i) = 0
DIGITS[I - 1] = 0;
// 981 %finish %else %start
goto L_0106;
L_0105:;
// 982 carry = 0
CARRY = 0;
// 983 %finish
L_0106:;
// 984 %repeat
goto L_0102;
}
L_0103:;
// 985 %finish
L_0101:;
// 986 ! ignore the rounding digit
// 987 dc = dc - 1
DC = DC - 1;
// 988
// 989 ! Now eliminate any trailing zeros
// 990 ! We assume that rounding has created
// 991 ! a sequence of trailing zeros
// 992 %while (digits(dc) = 0) %and (dc > 1) %cycle
L_0107:;
if (DIGITS[DC - 1] != 0) goto L_0108;
if (DC <= 1) goto L_0108;
// 993 dc = dc - 1
DC = DC - 1;
// 994 %repeat
goto L_0107;
L_0108:;
// 995 sf = dc
SF = DC;
// 996 %finish
L_00F8:;
// 997
// 998 length(s) = 0
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) = 0;
// 999 point = 1
POINT = 1;
// 1000 %for i = 1,1,sf %cycle
// %for I = 1, 1, SF %cycle
{
int _final = SF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, SF");
I = 0;
L_0109:
if (I == _final) goto L_010A;
I += 1;
// 1001 s = s.tostring(digits(i) + '0')
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(DIGITS[I - 1] + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1002 %if (point = i) %then s = s."."
if (POINT != I) goto L_010B;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr(".")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_010B:;
// 1003 %repeat
goto L_0109;
}
L_010A:;
// 1004 %if (sf = point) %then s = s."0"
if (SF != POINT) goto L_010C;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("0")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_010C:;
// 1005 %if (exponent < 0) %then s=s."@-".itos(-exponent,0)
if (EXPONENT >= 0) goto L_010D;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("@-")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string255) tmp; /*E*/ tmp = _imp_ITOS(-EXPONENT, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_010D:;
// 1006 %if (exponent > 0) %then s=s."@+".itos(exponent,0)
if (EXPONENT <= 0) goto L_010E;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("@+")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string255) tmp; /*E*/ tmp = _imp_ITOS(EXPONENT, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_010E:;
// 1007 science = s
/* clang-format off */
_imp_strncpy(/*?*/&SCIENCE, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = S; (void *)&tmp;}), /*max:*/15);
/* clang-format on */
// 1008
// 1009 ! So, now for the other floating point layouts
// 1010 ! we should see which version will fit into the places allowed
// 1011 ! 1) 0.00000nnnn (point <= 0)
// 1012 ! OR
// 1013 ! 2) nnnn.0 (point = sf)
// 1014 ! OR
// 1015 ! 3) nnnn00000.0 (point > sf)
// 1016 !
// 1017 length(s) = 0
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) = 0;
// 1018 point = exponent + 1
POINT = EXPONENT + 1;
// 1019 ! First form the sig fig digit string
// 1020 ! possibly including a decimal point
// 1021 %for i = 1,1,sf %cycle
// %for I = 1, 1, SF %cycle
{
int _final = SF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, SF");
I = 0;
L_010F:
if (I == _final) goto L_0110;
I += 1;
// 1022 s = s.tostring(digits(i) + '0')
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(DIGITS[I - 1] + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1023 %if (point = i) %then s = s."."
if (POINT != I) goto L_0111;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr(".")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_0111:;
// 1024 %repeat
goto L_010F;
}
L_0110:;
// 1025
// 1026 ! Checking for format (1)
// 1027 ! 1) 0.00000nnnn (point <= 0)
// 1028 %if (point <= 0) %start
if (POINT > 0) goto L_0112;
// 1029 %for i=1,1,-point %cycle
// %for I = 1, 1, -POINT %cycle
{
int _final = -POINT;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, -POINT");
I = 0;
L_0113:
if (I == _final) goto L_0114;
I += 1;
// 1030 s = "0".s
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("0"), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1031 %repeat
goto L_0113;
}
L_0114:;
// 1032 s = "0.".s
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("0."), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1033 %finish
L_0112:;
// 1034
// 1035 ! Checking for format (2)
// 1036 ! 2) nnnn.0 (point = sf)
// 1037 %if (point = sf) %start
if (POINT != SF) goto L_0115;
// 1038 s = s."0"
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("0")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1039 %finish
L_0115:;
// 1040
// 1041 ! Checking for format (3)
// 1042 ! 3) nnnn00000.0 (point > sf)
// 1043 %if (point > sf) %start
if (POINT <= SF) goto L_0116;
// 1044 %for i = 1,1,(point - sf) %cycle
// %for I = 1, 1, POINT - SF %cycle
{
int _final = POINT - SF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, POINT - SF");
I = 0;
L_0117:
if (I == _final) goto L_0118;
I += 1;
// 1045 s = s."0"
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr("0")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1046 %repeat
goto L_0117;
}
L_0118:;
// 1047 s = s.".0"
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr(".0")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1048 %finish
L_0116:;
// 1049
// 1050 ! Check to see which fits scientific v decimal notation
// 1051 ! Preference is for the decimal notation
// 1052 %if (length(s) > places) %start
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) <= PLACES) goto L_0119;
// 1053 s = science
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string15) tmp;/*B*/ tmp = SCIENCE; (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1054 %finish
L_0119:;
// 1055
// 1056 %if (sign # 0) %start
if (SIGN == 0) goto L_011A;
// 1057 s = "-".s
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("-"), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1058 %finish %else %start
goto L_011B;
L_011A:;
// 1059 s = " ".s
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr(" "), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1060 %finish
L_011B:;
// 1061
// 1062 %if (length(s) < places) %start
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) >= PLACES) goto L_011C;
// 1063 %while (length(s) < places) %cycle
L_011D:;
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) >= PLACES) goto L_011E;
// 1064 s = s." "
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&S, (_imp_string *)/*?*/_imp_str_literal_ptr(" ")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 1065 %repeat
goto L_011D;
L_011E:;
// 1066 %finish
L_011C:;
// 1067 %end
goto end_1000;
end_1000:;
}
// 1068
// 1069 %result = s
return *(_imp_string255 *)/*?*/ &S;
// 1070 %end
} /* end of IMP77FTOS */
// ?SX unused
// 1071
// 1072 %routine imp77 print(%longreal f, %integer sf,places)
void IMP77PRINT(double F, int SF, int PLACES) {
// 1073 printstring( imp77 F to S( f, sf, places ) )
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = IMP77FTOS(F, SF, PLACES)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 1074 %end
return;
} /* end of IMP77PRINT */
// 1075
// 1076 ! Print a floating point number out, along the lines of
// 1077 ! +/-nnn.nnn@+/-nn, to occupy Places character spaces.
// 1078 ! Note - there's a bug in this code such that it does not
// 1079 ! round the number properly. EG 3.999999999 to 4 places
// 1080 ! should be 4.00 but we print 3.99
// 1081
// 1082 %routine imp77 printfl(%longreal x, %integer places)
void IMP77PRINTFL(double X, int PLACES) {
// 1083 %integer exponent, digit, point, printexpo
int EXPONENT;
int DIGIT;
int POINT;
int PRINTEXPO;
// 1084
// 1085 %if x = 0 %start
if (X != 0) goto L_011F;
// 1086 printsymbol('0')
PRINTSYMBOL(48);
// 1087 printsymbol('.')
PRINTSYMBOL(46);
// 1088 printsymbol('0')
PRINTSYMBOL(48);
// 1089 %while places > 3 %cycle
L_0120:;
if (PLACES <= 3) goto L_0121;
// 1090 printsymbol('0')
PRINTSYMBOL(48);
// 1091 places = places - 1
PLACES = PLACES - 1;
// 1092 %repeat
goto L_0120;
L_0121:;
// 1093 %return
return;
// 1094 %finish
L_011F:;
// 1095
// 1096 %if x < 0 %then printsymbol('-') %and x = -x %and places = places - 1
if (X >= 0) goto L_0122;
PRINTSYMBOL(45);
X = -X;
PLACES = PLACES - 1;
L_0122:;
// 1097
// 1098 %if places < 3 %then places = 3
if (PLACES >= 3) goto L_0123;
PLACES = 3;
L_0123:;
// 1099
// 1100 exponent = 0
EXPONENT = 0;
// 1101 printexpo = 0
PRINTEXPO = 0;
// 1102
// 1103 %while x < 1 %cycle
L_0124:;
if (X >= 1) goto L_0125;
// 1104 x = x * 10
X = X * 10;
// 1105 exponent = exponent - 1
EXPONENT = EXPONENT - 1;
// 1106 %repeat
goto L_0124;
L_0125:;
// 1107
// 1108 %while x >= 10 %cycle
L_0126:;
if (X < 10) goto L_0127;
// 1109 x = x / 10
X = (double)(X / 10);
// 1110 exponent = exponent + 1
EXPONENT = EXPONENT + 1;
// 1111 %repeat
goto L_0126;
L_0127:;
// 1112
// 1113 ! Now X is between 1.0 and 9.99 and exponent is set accordingly
// 1114 ! If the exponent is "large" we will use scientific notation
// 1115 point = places - 2; ! for useful digits after the "0."
POINT = PLACES - 2;
// 1116 %if exponent >= places %or exponent < -point %start
if (EXPONENT >= PLACES) goto L_00F5;
if (EXPONENT >= -POINT) goto L_0128;
L_00F5:;
// 1117 printexpo = exponent
PRINTEXPO = EXPONENT;
// 1118 exponent = 0
EXPONENT = 0;
// 1119 places = places - 2
PLACES = PLACES - 2;
// 1120 %finish
L_0128:;
// 1121
// 1122 ! Now the exponent is small-ish
// 1123 %if exponent < 0 %start; ! 0.nnnn
if (EXPONENT >= 0) goto L_0129;
// 1124 printsymbol('0')
PRINTSYMBOL(48);
// 1125 printsymbol('.')
PRINTSYMBOL(46);
// 1126 places = places - 2
PLACES = PLACES - 2;
// 1127
// 1128 %while exponent < -1 %cycle
L_012A:;
if (EXPONENT >= -1) goto L_012B;
// 1129 printsymbol('0')
PRINTSYMBOL(48);
// 1130 exponent = exponent + 1
EXPONENT = EXPONENT + 1;
// 1131 places = places - 1
PLACES = PLACES - 1;
// 1132 %repeat
goto L_012A;
L_012B:;
// 1133
// 1134 point = -1; ! because we've already passed that
POINT = -1;
// 1135 %else; ! nnn.nnn
goto L_012C;
L_0129:;
// 1136 point = exponent
POINT = EXPONENT;
// 1137 %finish
L_012C:;
// 1138
// 1139 %while places > 0 %cycle
L_012D:;
if (PLACES <= 0) goto L_012E;
// 1140 digit = int pt(x)
DIGIT = _imp_INTPT(X);
// 1141 ! Rounding as we go through this loop can "oversize" the digit. This
// 1142 ! of course tells us that we should have printed (eg) 40000 but we
// 1143 ! are now stuck with printing 39999
// 1144 %if digit > 9 %then digit = 9
if (DIGIT <= 9) goto L_012F;
DIGIT = 9;
L_012F:;
// 1145 printsymbol(digit + '0')
PRINTSYMBOL(DIGIT + 48);
// 1146 x = (x - digit)*10
X = (X - DIGIT) * 10;
// 1147 %if point = 0 %then printsymbol('.') %and places = places - 1
if (POINT != 0) goto L_0130;
PRINTSYMBOL(46);
PLACES = PLACES - 1;
L_0130:;
// 1148 point = point - 1
POINT = POINT - 1;
// 1149 places = places - 1
PLACES = PLACES - 1;
// 1150 %repeat
goto L_012D;
L_012E:;
// 1151
// 1152 %if printexpo # 0 %start
if (PRINTEXPO == 0) goto L_0131;
// 1153 printsymbol('@')
PRINTSYMBOL(64);
// 1154 write68k(printexpo, 1)
WRITE68K(PRINTEXPO, 1);
// 1155 %finish
L_0131:;
// 1156 %end
return;
} /* end of IMP77PRINTFL */
// 1157
// 1158 ! #########################################################################################
// 1159
// 1160 %routine writetest(%string (255) procname, %routine testedwrite(%integer n, p))
void WRITETEST(_imp_string255 PROCNAME, void (*TESTEDWRITE)(int N, int P)) {
// 1161 %const %integer GAP = 15 ;! allow for largest int (+ or -) plus manditory spaces
// 1162 %const %integer COLS = 13 ;! 1 beyond what is an exact fit
// 1163 %integer n, m, shift, startpos, ALIGN
int N;
int M;
int SHIFT;
int STARTPOS;
int ALIGN;
// 1164 %for ALIGN = 1, -2, -1 %cycle
// %for ALIGN = 1, -2, -1 %cycle
{
ALIGN = 3;
L_0132:
if (ALIGN == -1) goto L_0133;
ALIGN -= 2;
// 1165 n = 1
N = 1;
// 1166 printstring(procname)
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = PROCNAME/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 1167 printstring(": ")
PRINTSTRING(_imp_str_literal(": "));
// 1168 newlines(2)
NEWLINES(2);
// 1169 %if ALIGN < 0 %then %start
if (ALIGN >= 0) goto L_0135;
// 1170 printstring("In IMP77, the total number of print positions to be used is defined"); newline
PRINTSTRING(_imp_str_literal("In IMP77, the total number of print positions to be used is defined"));
NEWLINE();
// 1171 printstring("by the modulus of the second parameter (n). If this parameter is"); newline
PRINTSTRING(_imp_str_literal("by the modulus of the second parameter (n). If this parameter is"));
NEWLINE();
// 1172 printstring("negative, no space character should output before a positive value:"); newline
PRINTSTRING(_imp_str_literal("negative, no space character should output before a positive value:"));
NEWLINE();
// 1173 newlines(2)
NEWLINES(2);
// 1174 %finish
L_0135:;
// 1175 printstring(" \ n | write(m,n):"); newline
PRINTSTRING(_imp_str_literal(" \\ n | write(m,n):"));
NEWLINE();
// 1176 printstring(" \ |"); newline
PRINTSTRING(_imp_str_literal(" \\ |"));
NEWLINE();
// 1177 printstring(" \ |"); newline
PRINTSTRING(_imp_str_literal(" \\ |"));
NEWLINE();
// 1178 printstring(" m \|"); newline
PRINTSTRING(_imp_str_literal(" m \\|"));
NEWLINE();
// 1179 printstring(" ----+ ")
PRINTSTRING(_imp_str_literal(" ----+ "));
// 1180 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 13 %cycle
{
M = -1;
L_0136:
if (M == 13) goto L_0137;
M += 1;
// 1181 startpos = outpos
STARTPOS = OUTPOS;
// 1182 write68k(ALIGN*m,0)
WRITE68K(ALIGN * M, 0);
// 1183 spaces(GAP-(outpos-startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1184 %repeat
goto L_0136;
}
L_0137:;
// 1185 newline
NEWLINE();
// 1186 printstring("MIN INT ")
PRINTSTRING(_imp_str_literal("MIN INT "));
// 1187 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 13 %cycle
{
M = -1;
L_0138:
if (M == 13) goto L_0139;
M += 1;
// 1188 startpos = outpos
STARTPOS = OUTPOS;
// 1189 printsymbol('[')
PRINTSYMBOL(91);
// 1190 !tested write(-2147483648, m)
// 1191 testedwrite(16_80000000, ALIGN*m)
TESTEDWRITE(-2147483648, ALIGN * M);
// 1192 printsymbol(']')
PRINTSYMBOL(93);
// 1193 spaces(gap - (outpos - startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1194 %repeat
goto L_0138;
}
L_0139:;
// 1195 newline
NEWLINE();
// 1196 n = 1000000000
N = 1000000000;
// 1197 shift = 9
SHIFT = 9;
// 1198 %cycle
L_013A:;
// 1199 printstring(" -10^")
PRINTSTRING(_imp_str_literal(" -10^"));
// 1200 write68k(shift, 0)
WRITE68K(SHIFT, 0);
// 1201 spaces(2)
SPACES(2);
// 1202 %for m = cols, -1, 0 %cycle
// %for M = 13, -1, 0 %cycle
{
M = 14;
L_013B:
if (M == 0) goto L_013C;
M -= 1;
// 1203 ! examine the number of characters between the [] brackets
// 1204 startpos = outpos
STARTPOS = OUTPOS;
// 1205 printsymbol('[')
PRINTSYMBOL(91);
// 1206 testedwrite(-n, ALIGN*(cols - m))
TESTEDWRITE(-N, ALIGN * (13 - M));
// 1207 printsymbol(']')
PRINTSYMBOL(93);
// 1208 spaces(gap - (outpos - startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1209 %repeat
goto L_013B;
}
L_013C:;
// 1210 newline
NEWLINE();
// 1211 n = n // 10
N = ((long)N / (long)10);
// 1212 shift = shift - 1
SHIFT = SHIFT - 1;
// 1213 %repeat %until n = 0
if (N == 0) goto L_013D;
goto L_013A;
L_013D:;
// 1214 printstring(" 0 ")
PRINTSTRING(_imp_str_literal(" 0 "));
// 1215 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 13 %cycle
{
M = -1;
L_013E:
if (M == 13) goto L_013F;
M += 1;
// 1216 startpos = outpos
STARTPOS = OUTPOS;
// 1217 printsymbol('[')
PRINTSYMBOL(91);
// 1218 testedwrite(0, ALIGN*m)
TESTEDWRITE(0, ALIGN * M);
// 1219 printsymbol(']')
PRINTSYMBOL(93);
// 1220 spaces(gap - (outpos - startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1221 %repeat
goto L_013E;
}
L_013F:;
// 1222 newline
NEWLINE();
// 1223 n = 1
N = 1;
// 1224 shift = 1
SHIFT = 1;
// 1225 %cycle
L_0140:;
// 1226 printstring(" 10^")
PRINTSTRING(_imp_str_literal(" 10^"));
// 1227 write68k(shift - 1, 0)
WRITE68K(SHIFT - 1, 0);
// 1228 spaces(2)
SPACES(2);
// 1229 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 13 %cycle
{
M = -1;
L_0141:
if (M == 13) goto L_0142;
M += 1;
// 1230 ! examine the number of characters between the [] brackets
// 1231 startpos = outpos
STARTPOS = OUTPOS;
// 1232 printsymbol('[')
PRINTSYMBOL(91);
// 1233 testedwrite(n, ALIGN*m)
TESTEDWRITE(N, ALIGN * M);
// 1234 printsymbol(']')
PRINTSYMBOL(93);
// 1235 spaces(gap - (outpos - startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1236 %repeat
goto L_0141;
}
L_0142:;
// 1237 newline
NEWLINE();
// 1238 %exit %if n = 1000000000
if (N != 1000000000) goto L_0143;
goto L_0144;
L_0143:;
// 1239 n = n * 10
N = N * 10;
// 1240 shift = shift + 1
SHIFT = SHIFT + 1;
// 1241 %repeat
goto L_0140;
L_0144:;
// 1242 printstring("MAX INT ")
PRINTSTRING(_imp_str_literal("MAX INT "));
// 1243 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 13 %cycle
{
M = -1;
L_0145:
if (M == 13) goto L_0146;
M += 1;
// 1244 startpos = outpos
STARTPOS = OUTPOS;
// 1245 printsymbol('[')
PRINTSYMBOL(91);
// 1246 testedwrite(2147483647, ALIGN*m)
TESTEDWRITE(2147483647, ALIGN * M);
// 1247 printsymbol(']')
PRINTSYMBOL(93);
// 1248 spaces(gap - (outpos - startpos))
SPACES(15 - (OUTPOS - STARTPOS));
// 1249 %repeat
goto L_0145;
}
L_0146:;
// 1250 newlines(3)
NEWLINES(3);
// 1251 %repeat
goto L_0132;
}
L_0133:;
// 1252 %end
return;
} /* end of WRITETEST */
// 1253
// 1254 ! #########################################################################################
// 1255
// 1256 %routine printfltest(%string (255) procname, %routine testedprintfl(%longreal n, %integer p))
void PRINTFLTEST(_imp_string255 PROCNAME, void (*TESTEDPRINTFL)(double N, int P)) {
// 1257 %const %integer GAP = 26 ;! allow for accuracy of long reals
// 1258 %const %integer COLS = 17
// 1259 %long %real n, k
double N;
double K;
// 1260 %integer m, exponent, startpos, ALIGN
int M;
int EXPONENT;
int STARTPOS;
int ALIGN;
// 1261 %for ALIGN = 1, 1, 1 %cycle ; ! %for ALIGN = 1, -2, -1 %cycle
// %for ALIGN = 1, 1, 1 %cycle
{
if (invalid_for_loop(1, 1, 1)) _imp_signal(5, 1, 0, "Illegal cycle ALIGN = 1, 1, 1");
ALIGN = 0;
L_0147:
if (ALIGN == 1) goto L_0148;
ALIGN += 1;
// 1262 n = 1
N = 1;
// 1263 %if ALIGN < 0 %then printstring("Possibly left-justified ")
if (ALIGN >= 0) goto L_0149;
PRINTSTRING(_imp_str_literal("Possibly left-justified "));
L_0149:;
// 1264 printstring(procname)
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = PROCNAME/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 1265 !%if neg < 0 %then printstring(" with negative numbers")
// 1266 printstring(": ")
PRINTSTRING(_imp_str_literal(": "));
// 1267 newlines(2)
NEWLINES(2);
// 1268
// 1269 printstring(" \ n | printfl(m,n):"); newline
PRINTSTRING(_imp_str_literal(" \\ n | printfl(m,n):"));
NEWLINE();
// 1270 printstring(" \ |"); newline
PRINTSTRING(_imp_str_literal(" \\ |"));
NEWLINE();
// 1271 printstring(" \ |"); newline
PRINTSTRING(_imp_str_literal(" \\ |"));
NEWLINE();
// 1272 printstring(" m \|"); newline
PRINTSTRING(_imp_str_literal(" m \\|"));
NEWLINE();
// 1273 printstring(" ----+ ")
PRINTSTRING(_imp_str_literal(" ----+ "));
// 1274 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 17 %cycle
{
M = -1;
L_014A:
if (M == 17) goto L_014B;
M += 1;
// 1275 startpos = outpos
STARTPOS = OUTPOS;
// 1276 write68k(m,0)
WRITE68K(M, 0);
// 1277 spaces(GAP-(outpos-startpos))
SPACES(26 - (OUTPOS - STARTPOS));
// 1278 %if REM(m, 6)=5 %then newline %and print string(" ");
if (_imp_REM(M, 6) != 5) goto L_014C;
NEWLINE();
PRINTSTRING(_imp_str_literal(" "));
L_014C:;
// 1279 %repeat
goto L_014A;
}
L_014B:;
// 1280 newline
NEWLINE();
// 1281 n = 1.23456789012345678901234567890
N = 1.23456789012345678901234567890;
// 1282
// 1283 k = 1@100; exponent = 100
K = 1E100;
EXPONENT = 100;
// 1284 %cycle
L_014D:;
// 1285 printstring("-1@")
PRINTSTRING(_imp_str_literal("-1@"));
// 1286 write68k(exponent, 0)
WRITE68K(EXPONENT, 0);
// 1287 space %while outpos < 8
L_014E:;
if (OUTPOS >= 8) goto L_014F;
SPACE();
goto L_014E;
L_014F:;
// 1288 %for m = cols, -1, 0 %cycle
// %for M = 17, -1, 0 %cycle
{
M = 18;
L_0150:
if (M == 0) goto L_0151;
M -= 1;
// 1289 ! examine the number of characters between the [] brackets
// 1290 startpos = outpos
STARTPOS = OUTPOS;
// 1291 printsymbol('[')
PRINTSYMBOL(91);
// 1292 testedprintfl(-k*n, ALIGN*(cols - m))
TESTEDPRINTFL(-(K * N), ALIGN * (17 - M));
// 1293 printsymbol(']')
PRINTSYMBOL(93);
// 1294 spaces(gap - (outpos - startpos))
SPACES(26 - (OUTPOS - STARTPOS));
// 1295 %if REM(cols-m, 6)=5 %then newline %and print string(" ");
if (_imp_REM(17 - M, 6) != 5) goto L_0152;
NEWLINE();
PRINTSTRING(_imp_str_literal(" "));
L_0152:;
// 1296 %repeat
goto L_0150;
}
L_0151:;
// 1297 newline
NEWLINE();
// 1298 %if exponent = 100 %start
if (EXPONENT != 100) goto L_0153;
// 1299 k = 1@10; exponent = 10
K = 1E10;
EXPONENT = 10;
// 1300 %else %if exponent = 10
goto L_0154;
L_0153:;
if (EXPONENT != 10) goto L_0155;
// 1301 k = 1@1; exponent = 1
K = 1E1;
EXPONENT = 1;
// 1302 %else %if exponent = 1
goto L_0154;
L_0155:;
if (EXPONENT != 1) goto L_0156;
// 1303 k = 1@0; exponent = 0
K = 1;
EXPONENT = 0;
// 1304 %else %if exponent = 0
goto L_0154;
L_0156:;
if (EXPONENT != 0) goto L_0157;
// 1305 k = 1@-1; exponent = -1
K = 1E-1;
EXPONENT = -1;
// 1306 %else %if exponent = -1
goto L_0154;
L_0157:;
if (EXPONENT != -1) goto L_0158;
// 1307 k = 1@-10; exponent = -10
K = 1E-10;
EXPONENT = -10;
// 1308 %else %if exponent = -10
goto L_0154;
L_0158:;
if (EXPONENT != -10) goto L_0159;
// 1309 k = 1@-100; exponent = -100
K = 1E-100;
EXPONENT = -100;
// 1310 %finish %else %exit
goto L_0154;
L_0159:;
goto L_015A;
L_0154:;
// 1311 %repeat
goto L_014D;
L_015A:;
// 1312
// 1313 printstring(" 0@0 ")
PRINTSTRING(_imp_str_literal(" 0@0 "));
// 1314 %for m = 0, 1, cols %cycle
// %for M = 0, 1, 17 %cycle
{
M = -1;
L_015B:
if (M == 17) goto L_015C;
M += 1;
// 1315 startpos = outpos
STARTPOS = OUTPOS;
// 1316 printsymbol('[')
PRINTSYMBOL(91);
// 1317 testedprintfl(0, ALIGN*m)
TESTEDPRINTFL(0, ALIGN * M);
// 1318 printsymbol(']')
PRINTSYMBOL(93);
// 1319 spaces(gap - (outpos - startpos))
SPACES(26 - (OUTPOS - STARTPOS));
// 1320 %if REM(m, 6)=5 %then newline %and print string(" ");
if (_imp_REM(M, 6) != 5) goto L_015D;
NEWLINE();
PRINTSTRING(_imp_str_literal(" "));
L_015D:;
// 1321 %repeat
goto L_015B;
}
L_015C:;
// 1322 newline
NEWLINE();
// 1323
// 1324 k = 1@100; exponent = 100
K = 1E100;
EXPONENT = 100;
// 1325 %cycle
L_015E:;
// 1326 printstring(" 1@")
PRINTSTRING(_imp_str_literal(" 1@"));
// 1327 write68k(exponent, 0)
WRITE68K(EXPONENT, 0);
// 1328 space %while outpos < 8
L_015F:;
if (OUTPOS >= 8) goto L_0160;
SPACE();
goto L_015F;
L_0160:;
// 1329 %for m = cols, -1, 0 %cycle
// %for M = 17, -1, 0 %cycle
{
M = 18;
L_0161:
if (M == 0) goto L_0162;
M -= 1;
// 1330 ! examine the number of characters between the [] brackets
// 1331 startpos = outpos
STARTPOS = OUTPOS;
// 1332 printsymbol('[')
PRINTSYMBOL(91);
// 1333 testedprintfl(k*n, ALIGN*(cols - m))
TESTEDPRINTFL(K * N, ALIGN * (17 - M));
// 1334 printsymbol(']')
PRINTSYMBOL(93);
// 1335 spaces(gap - (outpos - startpos))
SPACES(26 - (OUTPOS - STARTPOS));
// 1336 %if REM(cols-m, 6)=5 %then newline %and print string(" ");
if (_imp_REM(17 - M, 6) != 5) goto L_0163;
NEWLINE();
PRINTSTRING(_imp_str_literal(" "));
L_0163:;
// 1337 %repeat
goto L_0161;
}
L_0162:;
// 1338 newline
NEWLINE();
// 1339 %if exponent = 100 %start
if (EXPONENT != 100) goto L_0164;
// 1340 k = 1@10; exponent = 10
K = 1E10;
EXPONENT = 10;
// 1341 %else %if exponent = 10
goto L_0165;
L_0164:;
if (EXPONENT != 10) goto L_0166;
// 1342 k = 1@1; exponent = 1
K = 1E1;
EXPONENT = 1;
// 1343 %else %if exponent = 1
goto L_0165;
L_0166:;
if (EXPONENT != 1) goto L_0167;
// 1344 k = 1; exponent = 0
K = 1;
EXPONENT = 0;
// 1345 %else %if exponent = 0
goto L_0165;
L_0167:;
if (EXPONENT != 0) goto L_0168;
// 1346 k = 0.1; exponent = -1
K = 0.1;
EXPONENT = -1;
// 1347 %else %if exponent = -1
goto L_0165;
L_0168:;
if (EXPONENT != -1) goto L_0169;
// 1348 k = 1@-10; exponent = -10
K = 1E-10;
EXPONENT = -10;
// 1349 %else %if exponent = -10
goto L_0165;
L_0169:;
if (EXPONENT != -10) goto L_016A;
// 1350 k = 1@-100; exponent = -100
K = 1E-100;
EXPONENT = -100;
// 1351 %finish %else %exit
goto L_0165;
L_016A:;
goto L_016B;
L_0165:;
// 1352 %repeat
goto L_015E;
L_016B:;
// 1353
// 1354 newlines(3)
NEWLINES(3);
// 1355 %repeat
goto L_0147;
}
L_0148:;
// 1356 %end
return;
} /* end of PRINTFLTEST */
// 1357
// 1358
// 1359 ! WRITE TESTS write(num, places)
// 1360
// 1361 writetest("Copy of current (imp2024) write", write3l)
WRITETEST(_imp_str_literal("Copy of current (imp2024) write"), WRITE3L);
// 1362 writetest("EMAS write", emaswrite)
WRITETEST(_imp_str_literal("EMAS write"), EMASWRITE);
// 1363 writetest("EMAS write (from imp77 compatibility library)", emasi77write)
WRITETEST(_imp_str_literal("EMAS write (from imp77 compatibility library)"), EMASI77WRITE);
// 1364 writetest("Vax write", vaxwrite)
WRITETEST(_imp_str_literal("Vax write"), VAXWRITE);
// 1365 writetest("Dec10 (imp77) write", dec10 write)
WRITETEST(_imp_str_literal("Dec10 (imp77) write"), DEC10WRITE);
// 1366 writetest("Mouses (imp77) write", mouseswrite)
WRITETEST(_imp_str_literal("Mouses (imp77) write"), MOUSESWRITE);
// 1367 writetest("APM (imp68k) write", write68k)
WRITETEST(_imp_str_literal("APM (imp68k) write"), WRITE68K);
// 1368
// 1369 ! PRINTFL TESTS printfl(num, places)
// 1370
// 1371 ! Current imp77 library uses some weird names. I've extracted the equivalents of
// 1372 ! the standard printfl and print, and renamed them to avoid confusion.
// 1373 ! Their output is not compatible with the ercc, vax, or dec10 versions :-(
// 1374
// 1375 ! As with write, I had to provide a local copy in order to support 'outpos'
// 1376 ! which is necessary to handle padding correctly when the spacing of the
// 1377 ! routine under test is unknown.
// 1378
// 1379 printfltest("copy of current (imp2024) printfl (called 'print' in the imp2024 library)", imp77 printfl)
PRINTFLTEST(_imp_str_literal("copy of current (imp2024) printfl (called 'print' in the imp2024 library)"),
IMP77PRINTFL);
// 1380 printfltest("EMAS (imp9) printfl", emas printfl)
PRINTFLTEST(_imp_str_literal("EMAS (imp9) printfl"), EMASPRINTFL);
// 1381 printfltest("ERCC (imp80) printfl", ercc printfl)
PRINTFLTEST(_imp_str_literal("ERCC (imp80) printfl"), ERCCPRINTFL);
// 1382 printfltest("Vax (imp77) printfl", vax printfl)
PRINTFLTEST(_imp_str_literal("Vax (imp77) printfl"), VAXPRINTFL);
// 1383 printfltest("Dec10 (imp77) printfl", dec10 printfl)
PRINTFLTEST(_imp_str_literal("Dec10 (imp77) printfl"), DEC10PRINTFL);
// 1384 printfltest("Mouses (imp77) printfl", mouses printfl)
PRINTFLTEST(_imp_str_literal("Mouses (imp77) printfl"), MOUSESPRINTFL);
// 1385 printfltest("APM (imp68k) printfl", dec10 printfl)
PRINTFLTEST(_imp_str_literal("APM (imp68k) printfl"), DEC10PRINTFL);
// 1386
// 1387 ! TO DO: PRINT TESTS print(num, iplaces, dplaces)
// 1388
// 1389
// 1390 %end %of %programm
_imp_stop(0);
return 0;
end_0:;
}