#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 !Misc Imp Library
// 2
// 3 %external %integer a7
int A7;
// 4 %option "-low-nocheck-nodiag-noline"
// 5
// 6 %systemintegerfn freestore
extern int FREESTORE(void) {
// 7 %external {@724(a5)} %integername heapfront
int *HEAPFRONT;
// 8 %result = a7-heapfront
return A7 - *HEAPFRONT;
// 9 ! *move.l sp,d0
// 10 ! *sub.l d6,d0
// 11 %end
} /* end of FREESTORE */
// 12
// 13 %systemroutine newline
extern void NEWLINE(void) {
// 14 printsymbol(nl)
_imp_PRINTSYMBOL(10);
// 15 %end
return;
} /* end of NEWLINE */
// 16
// 17 %systemroutine newlines(%integer n)
extern void NEWLINES(int N) {
// 18 %while n>0 %cycle
L_0001:;
if (N <= 0) goto L_0002;
// 19 n = n-1; printsymbol(nl)
N = N - 1;
_imp_PRINTSYMBOL(10);
// 20 %repeat
goto L_0001;
L_0002:;
// 21 %end
return;
} /* end of NEWLINES */
// 22
// 23 %systemroutine space
extern void SPACE(void) {
// 24 printsymbol(' ')
_imp_PRINTSYMBOL(32);
// 25 %end
return;
} /* end of SPACE */
// 26
// 27 %systemroutine spaces(%integer n)
extern void SPACES(int N) {
// 28 %while n>0 %cycle
L_0003:;
if (N <= 0) goto L_0004;
// 29 n = n-1; printsymbol(' ')
N = N - 1;
_imp_PRINTSYMBOL(32);
// 30 %repeat
goto L_0003;
L_0004:;
// 31 %end
return;
} /* end of SPACES */
// 32
// 33 %systemstring(255)%fn readstring
extern _imp_string255 READSTRING(void) {
// 34 ! a STRING is deemed a sequence of non-control characters,
// 35 ! hence, as for numbers, leading control characters are skipped,
// 36 ! and the terminating one is not.
// 37 %string(255)s
_imp_string255 S;
// 38 %integer k
int K;
// 39 s = ""
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 40 readsymbol(k) %until k>' '
L_0005:;
_imp_READSYMBOL(/*?*/ &K);
if (K > 32) goto L_0006;
goto L_0005;
L_0006:;
// 41 %cycle
L_0007:;
// 42 s = s.tostring(k)
/* 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(K); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 43 %exitif nextsymbol<=' '
if (_imp_NEXTSYMBOL() > 32) goto L_0008;
goto L_0009;
L_0008:;
// 44 readsymbol(k)
_imp_READSYMBOL(/*?*/ &K);
// 45 %repeat
goto L_0007;
L_0009:;
// 46 %result = s
return *(_imp_string255 *)/*?*/ &S;
// 47 %end
} /* end of READSTRING */
// 48
// 49 %systemroutine readline(%string(255)%name s)
extern void READLINE(_imp_string255 *S) {
// 50 ! a LINE is a sequence of non-NL characters and may be empty,
// 51 ! hence blank lines are not skipped, and leading and trailing
// 52 ! spaces are significant. The terminating NL is skipped, to
// 53 ! make it "pipe-compatible" with printline.
// 54 %integer k
int K;
// 55 s = ""
*S = _imp_str_literal("");
// 56 %cycle
L_000A:;
// 57 readsymbol(k); %exitif k=nl
_imp_READSYMBOL(/*?*/ &K);
if (K != 10) goto L_000B;
goto L_000C;
L_000B:;
// 58 s = s.tostring(k)
*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(K); (void *)&tmp;})); (_imp_string255 *)&tmp;})
/* clang-format on */
;
// 59 %repeat
goto L_000A;
L_000C:;
// 60 %end
return;
} /* end of READLINE */
// 61
// 62 %systemroutine printline(%string(255)s)
extern void PRINTLINE(_imp_string255 S) {
// 63 printstring(s)
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = S/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 64 printsymbol(nl)
_imp_PRINTSYMBOL(10);
// 65 %end
return;
} /* end of PRINTLINE */
// 66
// 67 %systemroutine to lower(%string(*)%name s)
extern void TOLOWER(_imp_string *S) {
// 68 %integer i
int I;
// 69 %bytename b
unsigned char *B;
// 70 i = length(s); %returnif i=0
I = *_imp_LENGTH((_imp_string255 *)/*p*/ S);
if (I != 0) goto L_000D;
return;
L_000D:;
// 71 b == charno(s,1)
B = (unsigned char *)_imp_CHARNO((_imp_string255 *)/*p*/ S, 1);
// 72 %cycle
L_000E:;
// 73 b = b!32 %if 'A'<=b<='Z'
{
// Double-sided test on B (Part I)
unsigned char tmp;
if (65 > (tmp = *B)) goto L_000F;
// Double-sided test on B (Part II)
if (tmp > 90) goto L_000F;
}
*B = *B | 32;
L_000F:;
// 74 b == b++1
B = (unsigned char *)B + 1;
// 75 i = i-1
I = I - 1;
// 76 %repeatuntil i<=0
if (I <= 0) goto L_0010;
goto L_000E;
L_0010:;
// 77 %end
return;
} /* end of TOLOWER */
// 78
// 79 %systemroutine to upper(%string(*)%name s)
extern void TOUPPER(_imp_string *S) {
// 80 %integer i
int I;
// 81 %bytename b
unsigned char *B;
// 82 i = length(s); %returnif i=0
I = *_imp_LENGTH((_imp_string255 *)/*p*/ S);
if (I != 0) goto L_0011;
return;
L_0011:;
// 83 b == charno(s,1)
B = (unsigned char *)_imp_CHARNO((_imp_string255 *)/*p*/ S, 1);
// 84 %cycle
L_0012:;
// 85 b = b&95 %if 'a'<=b<='z'
{
// Double-sided test on B (Part I)
unsigned char tmp;
if (97 > (tmp = *B)) goto L_0013;
// Double-sided test on B (Part II)
if (tmp > 122) goto L_0013;
}
*B = *B & 95;
L_0013:;
// 86 b == b++1
B = (unsigned char *)B + 1;
// 87 i = i-1
I = I - 1;
// 88 %repeatuntil i<=0
if (I <= 0) goto L_0014;
goto L_0012;
L_0014:;
// 89 %end
return;
} /* end of TOUPPER */
// 90
// 91 %systemroutine to mixed(%string(*)%name s)
extern void TOMIXED(_imp_string *S) {
// 92 ! "Beautify" S by turning every leading letter into upper case.
// 93 ! de disgustibus non est putandum
// 94 %integer case=0,i
int CASE;
CASE = 0;
int I;
// 95 %bytename b
unsigned char *B;
// 96 i = length(s); %returnif i=0
I = *_imp_LENGTH((_imp_string255 *)/*p*/ S);
if (I != 0) goto L_0015;
return;
L_0015:;
// 97 b == charno(s,1)
B = (unsigned char *)_imp_CHARNO((_imp_string255 *)/*p*/ S, 1);
// 98 %cycle
L_0016:;
// 99 %if 'a'<=b!32<='z' %then b = b&95+case %and case = 32 %else case = 0
{
// Double-sided test on *B | 32 (Part I)
unsigned char tmp;
if (97 > (tmp = *B | 32)) goto L_0017;
// Double-sided test on *B | 32 (Part II)
if (tmp > 122) goto L_0017;
}
*B = (*B & 95) + CASE;
CASE = 32;
goto L_0018;
L_0017:;
CASE = 0;
L_0018:;
// 100 b == b++1
B = (unsigned char *)B + 1;
// 101 i = i-1
I = I - 1;
// 102 %repeatuntil i<=0
if (I <= 0) goto L_0019;
goto L_0016;
L_0019:;
// 103 %end
return;
} /* end of TOMIXED */
// 104
// 105 %systemstring(9)%fn itoh(%integer n)
extern _imp_string9 ITOH(int N) {
// 106 %string(9)s=""
_imp_string9 S;
/* clang-format off */
_imp_strncpy(/*?*/&S, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/9);
/* clang-format on */
// 107 %integer i,k
int I;
int K;
// 108 %for i = 28,-4,0 %cycle
// %for I = 28, -4, 0 %cycle
{
I = 32;
L_001A:
if (I == 0) goto L_001B;
I -= 4;
// 109 k = n>>i&15; k = k+7 %if k>9; s = s.tostring(k+'0')
K = (unsigned int)N >> I & 15;
if (K <= 9) goto L_001D;
K = K + 7;
L_001D:;
/* 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(K + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/9);
/* clang-format on */
// 110 %repeat
goto L_001A;
}
L_001B:;
// 111 %result = s
return *(_imp_string9 *)/*?*/ &S;
// 112 %end
} /* end of ITOH */
// 113
// 114 %systemintegerfn htoi(%string(255)s)
extern int HTOI(_imp_string255 S) {
// 115 %integer n=0,p=0,k
int N;
N = 0;
int P;
P = 0;
int K;
// 116 %cycle
L_001E:;
// 117 p = p+1
P = P + 1;
// 118 %result = n %if p>length(s)
if (P <= *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S)) goto L_001F;
return N;
L_001F:;
// 119 k = charno(s,p); %continueif k<=' '
K = *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, P);
if (K > 32) goto L_0020;
goto L_001C;
L_0020:;
// 120 k = k-'0'
K = K - 48;
// 121 %if k>9 %start
if (K <= 9) goto L_0021;
// 122 k = k-7 %if k-7>9
if (K - 7 <= 9) goto L_0022;
K = K - 7;
L_0022:;
// 123 k = k-32 %if k>15
if (K <= 15) goto L_0023;
K = K - 32;
L_0023:;
// 124 %finish
L_0021:;
// 125 %result = n %unless 0<=k<=15
{
// Double-sided test on K (Part I)
int tmp;
if (0 > (tmp = K)) goto L_0024;
// Double-sided test on K (Part II)
if (tmp <= 15) goto L_0025;
}
L_0024:;
return N;
L_0025:;
// 126 n = n<<4+k
N = (N << 4) + K;
// 127 %repeat
L_001C:;
goto L_001E;
// 128 %end
} /* end of HTOI */
// 129
// 130 %systemintegerfn stoi(%string(255) S)
extern int STOI(_imp_string255 S) {
// 131 %integer i,k
int I;
int K;
// 132 %integer sign=0, val=0
int SIGN;
SIGN = 0;
int VAL;
VAL = 0;
// 133 i = 0
I = 0;
// 134 %while i < length(s) %cycle
L_0026:;
if (I >= *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S)) goto L_0027;
// 135 i = i+1; k = charno(s,i)
I = I + 1;
K = *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, I);
// 136 %continue %if k <= ' '
if (K > 32) goto L_0028;
goto L_0029;
L_0028:;
// 137 %if k = '-' %start
if (K != 45) goto L_002A;
// 138 sign = 1
SIGN = 1;
// 139 %else %if '0' <= k <= '9'
goto L_002B;
L_002A:;
{
// Double-sided test on K (Part I)
int tmp;
if (48 > (tmp = K)) goto L_002C;
// Double-sided test on K (Part II)
if (tmp > 57) goto L_002C;
}
// 140 val = val<<3+val+val+k-'0'
VAL = (VAL << 3) + VAL + VAL + K - 48;
// 141 %else
goto L_002B;
L_002C:;
// 142 %signal 4, 1, k{, "Non-numeric character"
_imp_signal(4, 1, K, "");
// 143 %finish
L_002B:;
// 144 %repeat
L_0029:;
goto L_0026;
L_0027:;
// 145 %result = val %if sign = 0
if (SIGN != 0) goto L_002D;
return VAL;
L_002D:;
// 146 %result = -val
return -VAL;
// 147 %end
} /* end of STOI */
// 148
// 149 %systemstring(127)%fn itos(%integer v,p)
extern _imp_string127 ITOS(int V, int P) {
// 150 %string(127)store
_imp_string127 STORE;
// 151 %bytename l
unsigned char *L;
// 152 %routine printsymbol(%integer x)
void PRINTSYMBOL(int X) {
// 153 l = l+1; charno(store,l) = x
*L = *L + 1;
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &STORE, *L) = X;
// 154 %end
return;
} /* end of PRINTSYMBOL */
// 155 %routine spaces(%integer x)
void SPACES(int X) {
// 156 x = x-1 %and printsymbol(' ') %while x>0
L_002E:;
if (X <= 0) goto L_002F;
X = X - 1;
PRINTSYMBOL(32);
goto L_002E;
L_002F:;
// 157 %end
return;
} /* end of SPACES */
// 158 %routine write(%integer n,p)
void WRITE(int N, int P) {
// 159 %integer q,r
int Q;
int R;
// 160 %if p>0 %start
if (P <= 0) goto L_0030;
// 161 p = \p; printsymbol(' ') %and p = p+1 %if n>=0
P = (~P);
if (N < 0) goto L_0031;
PRINTSYMBOL(32);
P = P + 1;
L_0031:;
// 162 %finish
L_0030:;
// 163 p = -120 %if p<-120
if (P >= -120) goto L_0032;
P = -120;
L_0032:;
// 164 q = n//10; !68K! *move.l d1,r
Q = ((long)N / (long)10);
// 165 %if q=0 %start
if (Q != 0) goto L_0033;
// 166 p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
if (N >= 0) goto L_0034;
P = P + 1;
L_0034:;
SPACES((-1) - P);
if (N >= 0) goto L_0035;
PRINTSYMBOL(45);
L_0035:;
// 167 %else
goto L_0036;
L_0033:;
// 168 p = p+1 %if p<0; write(q,p)
if (P >= 0) goto L_0037;
P = P + 1;
L_0037:;
WRITE(Q, P);
// 169 %finish
L_0036:;
// 170 printsymbol(|r|+'0')
PRINTSYMBOL(_imp_IMOD(R) + 48);
// 171 %end
return;
} /* end of WRITE */
// 172 store = ""; l == length(store)
/* clang-format off */
_imp_strncpy(/*?*/&STORE, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
L = (unsigned char *)_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &STORE);
// 173 write(v,p)
WRITE(V, P);
// 174 %result = store
return *(_imp_string127 *)/*?*/ &STORE;
// 175 %end
} /* end of ITOS */
// 176
// 177 %systemstring(127)%fn rtos(%real r,%integer n,m)
extern _imp_string127 RTOS(float R, int N, int M) {
// 178 %constreal pmax = 2147483647.0
const float PMAX = 2147483647.0;
// 179 %real y,z
float Y;
float Z;
// 180 %integer i=0,l,count=0,sign
int I;
I = 0;
int L;
int COUNT;
COUNT = 0;
int SIGN;
// 181 %string(127) result = ""
_imp_string127 RESULT;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
// 182 !
// 183 sign = ' '
SIGN = 32;
// 184 sign = '-' %if r < 0
if (R >= 0) goto L_0038;
SIGN = 45;
L_0038:;
// 185 y = |r|+0.5/10.0\{^}m; !modulus, rounded
Y = _imp_MOD(R) + (double)(0.5 / (_imp_REXP(10.0, M)));
// 186 %if y > pmax %start
if (Y <= PMAX) goto L_0039;
// 187 count = count+1 %and y = y/10.0 %until y < 10.0
L_003A:;
COUNT = COUNT + 1;
Y = (double)(Y / 10.0);
if (Y < 10.0) goto L_003B;
goto L_003A;
L_003B:;
// 188 %finish
L_0039:;
// 189 z = 1.0
Z = 1.0;
// 190 %cycle
L_003C:;
// 191 i = i+1; z = z*10.0
I = I + 1;
Z = Z * 10.0;
// 192 %repeat %until z > y
if (Z > Y) goto L_003D;
goto L_003C;
L_003D:;
// 193 result = result." " %for l = 1,1,n-i; !l not used before here
// %for L = 1, 1, N - I %cycle
{
int _final = N - I;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle L = 1, 1, N - I");
L = 0;
L_003E:
if (L == _final) goto L_003F;
L += 1;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, (_imp_string *)/*?*/_imp_str_literal_ptr(" ")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
goto L_003E;
}
L_003F:;
// 194 result = result.tostring(sign) %unless sign = ' ' %and n <= 0
if (SIGN != 32) goto L_0040;
if (N <= 0) goto L_0041;
L_0040:;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(SIGN); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
L_0041:;
// 195 %cycle
L_0042:;
// 196 z = z/10.0
Z = (double)(Z / 10.0);
// 197 l = int pt(y/z)
L = _imp_INTPT((double)(Y / Z));
// 198 y = y-l*z
Y = Y - L * Z;
// 199 result = result.tostring(l+'0')
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(L + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
// 200 i = i-1
I = I - 1;
// 201 %exit %if i+m <= 0
if (I + M > 0) goto L_0043;
goto L_0044;
L_0043:;
// 202 result = result."." %if i = 0
if (I != 0) goto L_0045;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, (_imp_string *)/*?*/_imp_str_literal_ptr(".")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
L_0045:;
// 203 %repeat
goto L_0042;
L_0044:;
// 204 result = result."@".itos(count,0) %if count # 0
if (COUNT == 0) goto L_0046;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, (_imp_string *)/*?*/_imp_str_literal_ptr("@")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string127) tmp; /*E*/ tmp = ITOS(COUNT, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
L_0046:;
// 205 %result = result
return *(_imp_string127 *)/*?*/ &RESULT;
// 206 %end; !rtos
} /* end of RTOS */
// 207
// 208 %systemstring(127)%fn rtof(%real x, %integer n)
extern _imp_string127 RTOF(float X, int N) {
// 209 %real y,round
float Y;
float ROUND;
// 210 %integer count=-99,sign=0
int COUNT;
COUNT = -99;
int SIGN;
SIGN = 0;
// 211 %string(127) result=""
_imp_string127 RESULT;
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
// 212 !
// 213 %if x # 0 %start
if (X == 0) goto L_0047;
// 214 x = -x %and sign = 1 %if x < 0
if (X >= 0) goto L_0048;
X = -X;
SIGN = 1;
L_0048:;
// 215 !Adjust X so that 1.0 <= rounded(X) < 10.0
// 216 count = 0; round = 0.5\{^}n
COUNT = 0;
ROUND = _imp_REXP(0.5, N);
// 217 y = 1.0-round
Y = 1.0 - ROUND;
// 218 %if x < y %start; !ie rounded(X) < 1.0
if (X >= Y) goto L_0049;
// 219 count = count-1 %and x = x*10.0 %until x >= y
L_004A:;
COUNT = COUNT - 1;
X = X * 10.0;
if (X >= Y) goto L_004B;
goto L_004A;
L_004B:;
// 220 %finish %else %start
goto L_004C;
L_0049:;
// 221 y = 10.0-round
Y = 10.0 - ROUND;
// 222 %while x >= y %cycle; !ie rounded(X) > 10.0
L_004D:;
if (X < Y) goto L_004E;
// 223 count = count+1; x = x/10.0
COUNT = COUNT + 1;
X = (double)(X / 10.0);
// 224 %repeat
goto L_004D;
L_004E:;
// 225 %finish
L_004C:;
// 226 x = -x %if sign # 0
if (SIGN == 0) goto L_004F;
X = -X;
L_004F:;
// 227 %finish
L_0047:;
// 228 result = rtos(x,1,n)
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string127) tmp;/*B*/ tmp = RTOS(X, 1, N); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
// 229 result = result."@".itos(count,0)
/* clang-format off */
_imp_strncpy(/*?*/&RESULT, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&RESULT, (_imp_string *)/*?*/_imp_str_literal_ptr("@")); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string127) tmp; /*E*/ tmp = ITOS(COUNT, 0); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/127);
/* clang-format on */
// 230 %result = result
return *(_imp_string127 *)/*?*/ &RESULT;
// 231 %end; !flrtos
} /* end of RTOF */
// 232
// 233 !Original grotty faulty version
// 234 !%systemrealfn stor(%string(255)input)
// 235 ! !reads a real from the string, assuming string starts with the real
// 236 ! !(or blank spaces followed by a real)
// 237 ! %integer sign=0,sym,pos=0
// 238 ! %real value,exp
// 239 ! !
// 240 ! input=input."!"; !check that there is a finish character
// 241 ! %cycle
// 242 ! sym = charno(input,pos+1)
// 243 ! %exit %if sym > ' '
// 244 ! pos=pos+1
// 245 ! %repeat
// 246 ! %if sym = '-' %start
// 247 ! sign = 1
// 248 ! pos=pos+1; sym = charno(input,pos+1)
// 249 ! %finish
// 250 ! value = 0
// 251 ! %if sym # '.' %start
// 252 ! %signal 6,5,pos %unless '0' <= sym <= '9'; !charno out of range
// 253 ! %cycle
// 254 ! value = value*10.0+(sym-'0')
// 255 ! pos=pos+1; sym = charno(input{,pos+1)
// 256 ! %repeat %until %not '0' <= sym <= '9'
// 257 ! %finish
// 258 ! %if sym = '.' %start
// 259 ! exp = 10.0
// 260 ! %cycle
// 261 ! pos=pos+1; sym = charno(input,pos+1)
// 262 ! %exit %unless '0' <= sym <= '9'
// 263 ! value = value+(sym-'0')/exp
// 264 ! exp = exp*10.0
// 265 ! %repeat
// 266 ! %finish
// 267 ! %if sym = '@' %start
// 268 ! pos = pos+1
// 269 ! sym = charno(input,pos+1); pos = pos+1
// 270 ! value = value*10.0\(sym-'0')
// 271 ! %finish
// 272 ! value = -value %if sign # 0
// 273 ! %result = value
// 274 !%end; !stor
// 275
// 276 !Working version, courtesy of RMM (as if it wasn't obvious
// 277 !from the grotesque 'aesthetic' source layout)
// 278
// 279 %system %real %function S To R (%string (255) Input)
extern float STOR(_imp_string255 INPUT) {
// 280 %integer Sign = 0,
int SIGN;
SIGN = 0;
int SYM;
int POS;
POS = 1;
// 281+ Sym,
// 282+ Pos = 1
// 283 %long %real Value,
double VALUE;
double EXP;
// 284+ Exp
// 285
// 286 %routine Next
void NEXT(void) {
// 287 Pos = Pos + 1
POS = POS + 1;
// 288 %if Pos > Length (Input) %start
if (POS <= *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &INPUT)) goto L_0050;
// 289 Sym = 0
SYM = 0;
// 290 %else
goto L_0051;
L_0050:;
// 291 Sym = Char No (Input, Pos)
SYM = *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &INPUT, POS);
// 292 %finish
L_0051:;
// 293 %end
return;
} /* end of NEXT */
// 294
// 295 Sym = Char No (Input, Pos)
SYM = *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &INPUT, POS);
// 296 %if Sym = '-' %start
if (SYM != 45) goto L_0052;
// 297 Sign = 1
SIGN = 1;
// 298 Next
NEXT();
// 299 %finish
L_0052:;
// 300 Value = 0
VALUE = 0;
// 301 %if Sym # '.' %start
if (SYM == 46) goto L_0053;
// 302 %signal 6, 5, Pos %unless '0' <= Sym <= '9' {Char No out of range}
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_0054;
// Double-sided test on SYM (Part II)
if (tmp <= 57) goto L_0055;
}
L_0054:;
_imp_signal(6, 5, POS, "");
L_0055:;
// 303 %cycle
L_0056:;
// 304 Value = Value*10.0 + (Sym - '0')
VALUE = VALUE * 10.0 + (SYM - 48);
// 305 Next
NEXT();
// 306 %repeat %until %not '0' <= Sym <= '9'
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_0057;
// Double-sided test on SYM (Part II)
if (tmp > 57) goto L_0057;
}
goto L_0056;
L_0057:;
// 307 %finish
L_0053:;
// 308 %if Sym = '.' %start
if (SYM != 46) goto L_0058;
// 309 Exp = 10.0
EXP = 10.0;
// 310 %cycle
L_0059:;
// 311 Next
NEXT();
// 312 %exit %unless '0' <= Sym <= '9'
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_005A;
// Double-sided test on SYM (Part II)
if (tmp <= 57) goto L_005B;
}
L_005A:;
goto L_005C;
L_005B:;
// 313 Value = Value + (Sym - '0')/Exp
VALUE = VALUE + (double)((SYM - 48) / EXP);
// 314 Exp = Exp * 10.0
EXP = EXP * 10.0;
// 315 %repeat
goto L_0059;
L_005C:;
// 316 %finish
L_0058:;
// 317 %if Sym = '@' %start
if (SYM != 64) goto L_005D;
// 318 Sym = S To I (Sub String (Input, Pos + 1, Length (Input)))
SYM = STOI(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = _imp_SUBSTRING((_imp_string255 *)/*p*//*?*/&INPUT, POS + 1, *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&INPUT))/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 319 Value = Value * 10.0\Sym
VALUE = VALUE * (_imp_REXP(10.0, SYM));
// 320 %finish
L_005D:;
// 321 Value = -Value %if Sign # 0
if (SIGN == 0) goto L_005E;
VALUE = -VALUE;
L_005E:;
// 322 %result = Value
return VALUE;
// 323 %end {S To R}
} /* end of STOR */
// 324
// 325 %systemrealfn ftor(%string(255)s)
extern float FTOR(_imp_string255 S) {
// 326 %result = stor(s)
return STOR(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = S/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 327 %end
} /* end of FTOR */
// 328
// 329 %systemstring(255)%fn infilename
extern _imp_string255 INFILENAME(void) {
// 330 %result = "[INFILENAME]"
return *(_imp_string255 *)/*?*/ _imp_str_literal_ptr("[INFILENAME]");
// 331 %end
} /* end of INFILENAME */
// 332
// 333 %systemstring(255)%fn outfilename
extern _imp_string255 OUTFILENAME(void) {
// 334 %result = "[OUTFILENAME]"
return *(_imp_string255 *)/*?*/ _imp_str_literal_ptr("[OUTFILENAME]");
// 335 %end
} /* end of OUTFILENAME */
// 336
// 337 %systemintegerfn xread %alias "read"
extern int XREAD(void) {
// 338 %integer i,k,sign,ten=10,max='9'
int I;
int K;
int SIGN;
int TEN;
TEN = 10;
int MAX;
MAX = 57;
// 339 %cycle
L_005F:;
// 340 k = next symbol
K = _imp_NEXTSYMBOL();
// 341 %exit %if k > ' '
if (K <= 32) goto L_0060;
goto L_0061;
L_0060:;
// 342 skip symbol
_imp_SKIPSYMBOL();
// 343 %repeat
goto L_005F;
L_0061:;
// 344 sign = 0
SIGN = 0;
// 345 %if k = '-' %start
if (K != 45) goto L_0062;
// 346 sign = 1
SIGN = 1;
// 347 skip symbol; k = next symbol
_imp_SKIPSYMBOL();
K = _imp_NEXTSYMBOL();
// 348 %finish
L_0062:;
// 349 %cycle
L_0063:;
// 350 %signal 4,1,nextsymbol{,"Non-numeric character to READ" %unless '0'<=k<=max
_imp_signal(4, 1, _imp_NEXTSYMBOL(), "");
// 351 i = k-'0'
I = K - 48;
// ?access
// 352 %cycle
L_0064:;
// 353 skip symbol
_imp_SKIPSYMBOL();
// 354 k = next symbol
K = _imp_NEXTSYMBOL();
// 355 k = k-32 %if k>='a'
if (K < 97) goto L_0065;
K = K - 32;
L_0065:;
// 356 %if k>'9' %start
if (K <= 57) goto L_0066;
// 357 %exitif k<'A'
if (K >= 65) goto L_0067;
goto L_0068;
L_0067:;
// 358 k = k-7
K = K - 7;
// 359 %finish
L_0066:;
// 360 %exit %unless '0' <= k <= max
{
// Double-sided test on K (Part I)
int tmp;
if (48 > (tmp = K)) goto L_0069;
// Double-sided test on K (Part II)
if (tmp <= MAX) goto L_006A;
}
L_0069:;
goto L_0068;
L_006A:;
// 361 i = i*ten-'0'+k
I = I * TEN - 48 + K;
// 362 %repeat
goto L_0064;
L_0068:;
// 363 %exitunless k='_'-7
if (K == 95 - 7) goto L_006B;
goto L_006C;
L_006B:;
// 364 ten = i; max = '0'+ten-1
TEN = I;
MAX = 48 + TEN - 1;
// 365 skipsymbol; k = nextsymbol
_imp_SKIPSYMBOL();
K = _imp_NEXTSYMBOL();
// 366 k = k-32 %if k>='a'
if (K < 97) goto L_006D;
K = K - 32;
L_006D:;
// 367 %if k>'9' %start
if (K <= 57) goto L_006E;
// 368 k = -1 %if k<'A'
if (K >= 65) goto L_006F;
K = -1;
L_006F:;
// 369 k = k-7
K = K - 7;
// 370 %finish
L_006E:;
// 371 %repeat
goto L_0063;
L_006C:;
// 372 i = -i %if sign # 0
if (SIGN == 0) goto L_0070;
I = -I;
L_0070:;
// 373 %result = i
return I;
// 374 %end
} /* end of XREAD */
// 375
// 376 %systemrealfn readreal
extern float READREAL(void) {
// 377 %integer sign=0,sym
int SIGN;
SIGN = 0;
int SYM;
// 378 %real value,exp
float VALUE;
float EXP;
// 379
// 380 %routine read(%integername n)
void READ(int *N) {
// 381 n = xread
*N = XREAD();
// 382 %end
return;
} /* end of READ */
// 383
// 384 %cycle
L_0071:;
// 385 sym = nextsymbol
SYM = _imp_NEXTSYMBOL();
// 386 %exit %if sym > ' '
if (SYM <= 32) goto L_0072;
goto L_0073;
L_0072:;
// 387 skipsymbol
_imp_SKIPSYMBOL();
// 388 %repeat
goto L_0071;
L_0073:;
// 389 %if sym = '-' %start
if (SYM != 45) goto L_0074;
// 390 sign = 1
SIGN = 1;
// 391 skip symbol; sym = nextsymbol
_imp_SKIPSYMBOL();
SYM = _imp_NEXTSYMBOL();
// 392 %finish
L_0074:;
// 393 value = 0
VALUE = 0;
// 394 %if sym # '.' %start
if (SYM == 46) goto L_0075;
// 395 %signal 4,1,sym{,"Non-numeric character to READ" %unless '0' <= sym <= '9'
_imp_signal(4, 1, SYM, "");
// 396 %cycle
L_0076:;
// ?access
// 397 value = value*10.0+(sym-'0')
VALUE = VALUE * 10.0 + (SYM - 48);
// 398 skip symbol; sym = nextsymbol
_imp_SKIPSYMBOL();
SYM = _imp_NEXTSYMBOL();
// 399 %repeat %until %not '0' <= sym <= '9'
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_0077;
// Double-sided test on SYM (Part II)
if (tmp > 57) goto L_0077;
}
goto L_0076;
L_0077:;
// 400 %finish
L_0075:;
// 401 %if sym = '.' %start
if (SYM != 46) goto L_0078;
// 402 exp = 10.0
EXP = 10.0;
// 403 %cycle
L_0079:;
// 404 skip symbol; sym = nextsymbol
_imp_SKIPSYMBOL();
SYM = _imp_NEXTSYMBOL();
// 405 %exit %unless '0' <= sym <= '9'
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_007A;
// Double-sided test on SYM (Part II)
if (tmp <= 57) goto L_007B;
}
L_007A:;
goto L_007C;
L_007B:;
// 406 value = value+(sym-'0')/exp
VALUE = VALUE + (double)((SYM - 48) / EXP);
// 407 exp = exp*10.0
EXP = EXP * 10.0;
// 408 %repeat
goto L_0079;
L_007C:;
// 409 %finish
L_0078:;
// 410 %if sym = '@' %start
if (SYM != 64) goto L_007D;
// 411 skipsymbol
_imp_SKIPSYMBOL();
// 412 read(sym)
READ(/*?*/ &SYM);
// 413 value = value*10.0\sym {^}
VALUE = VALUE * (_imp_REXP(10.0, SYM));
// 414 %finish
L_007D:;
// 415 value = -value %if sign # 0
if (SIGN == 0) goto L_007E;
VALUE = -VALUE;
L_007E:;
// 416 %result = value
return VALUE;
// 417 %end; !read real
} /* end of READREAL */
// 418
// 419 %systemroutine write(%integer n,p)
extern void WRITE(int N, int P) {
// 420 %integer q,r
int Q;
int R;
// 421 %if p>0 %start
if (P <= 0) goto L_007F;
// 422 p = \p; printsymbol(' ') %and p = p+1 %if n>=0
P = (~P);
if (N < 0) goto L_0080;
_imp_PRINTSYMBOL(32);
P = P + 1;
L_0080:;
// 423 %finish
L_007F:;
// 424 p = -120 %if p<-120
if (P >= -120) goto L_0081;
P = -120;
L_0081:;
// 425 q = n//10; !68K! *move.l d1,r
Q = ((long)N / (long)10);
// 426 %if q=0 %start
if (Q != 0) goto L_0082;
// 427 p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
if (N >= 0) goto L_0083;
P = P + 1;
L_0083:;
SPACES((-1) - P);
if (N >= 0) goto L_0084;
_imp_PRINTSYMBOL(45);
L_0084:;
// 428 %else
goto L_0085;
L_0082:;
// 429 p = p+1 %if p<0; write(q,p)
if (P >= 0) goto L_0086;
P = P + 1;
L_0086:;
WRITE(Q, P);
// 430 %finish
L_0085:;
// 431 printsymbol(|r|+'0')
_imp_PRINTSYMBOL(_imp_IMOD(R) + 48);
// 432 %end
return;
} /* end of WRITE */
// 433
// 434 %systemroutine print(%real x, %integer n,m)
extern void PRINT(float X, int N, int M) {
// 435 %constreal pmax = 2147483647.0
const float PMAX = 2147483647.0;
// 436 %real y,z
float Y;
float Z;
// 437 %integer i=0,l,count=0,sign
int I;
I = 0;
int L;
int COUNT;
COUNT = 0;
int SIGN;
// 438 sign = ' '
SIGN = 32;
// 439 sign = '-' %if x < 0
if (X >= 0) goto L_0087;
SIGN = 45;
L_0087:;
// 440 y = |x|+0.5/10.0\{^}m; !modulus, rounded
Y = _imp_MOD(X) + (double)(0.5 / (_imp_REXP(10.0, M)));
// 441 %if y > pmax %start
if (Y <= PMAX) goto L_0088;
// 442 count = count+1 %and y = y/10.0 %until y < 10.0
L_0089:;
COUNT = COUNT + 1;
Y = (double)(Y / 10.0);
if (Y < 10.0) goto L_008A;
goto L_0089;
L_008A:;
// 443 %finish
L_0088:;
// 444 z = 1.0
Z = 1.0;
// 445 %cycle
L_008B:;
// 446 i = i+1; z = z*10.0
I = I + 1;
Z = Z * 10.0;
// 447 %repeat %until z > y
if (Z > Y) goto L_008C;
goto L_008B;
L_008C:;
// 448 spaces(n-i)
SPACES(N - I);
// 449 printsymbol(sign) %unless sign = ' ' %and n <= 0
if (SIGN != 32) goto L_008D;
if (N <= 0) goto L_008E;
L_008D:;
_imp_PRINTSYMBOL(SIGN);
L_008E:;
// 450 %cycle
L_008F:;
// 451 z = z/10.0
Z = (double)(Z / 10.0);
// 452 l = int pt(y/z)
L = _imp_INTPT((double)(Y / Z));
// 453 y = y-l*z
Y = Y - L * Z;
// 454 printsymbol(l+'0')
_imp_PRINTSYMBOL(L + 48);
// 455 i = i-1
I = I - 1;
// 456 %exit %if i+m <= 0
if (I + M > 0) goto L_0090;
goto L_0091;
L_0090:;
// 457 print symbol('.') %if i = 0
if (I != 0) goto L_0092;
_imp_PRINTSYMBOL(46);
L_0092:;
// 458 %repeat
goto L_008F;
L_0091:;
// 459 printsymbol('@') %and write(count,0) %if count # 0
if (COUNT == 0) goto L_0093;
_imp_PRINTSYMBOL(64);
WRITE(COUNT, 0);
L_0093:;
// 460 %end; !print
return;
} /* end of PRINT */
// 461
// 462 %systemroutine printfl(%real x, %integer n)
extern void PRINTFL(float X, int N) {
// 463 %real y,round
float Y;
float ROUND;
// 464 %integer count=-99,sign=0
int COUNT;
COUNT = -99;
int SIGN;
SIGN = 0;
// 465 %if x # 0 %start
if (X == 0) goto L_0094;
// 466 x = -x %and sign = 1 %if x < 0
if (X >= 0) goto L_0095;
X = -X;
SIGN = 1;
L_0095:;
// 467 !Adjust X so that 1.0 <= rounded(X) < 10.0
// 468 count = 0; round = 0.5\{^}n
COUNT = 0;
ROUND = _imp_REXP(0.5, N);
// 469 y = 1.0-round
Y = 1.0 - ROUND;
// 470 %if x < y %start; !ie rounded(X) < 1.0
if (X >= Y) goto L_0096;
// 471 count = count-1 %and x = x*10.0 %until x >= y
L_0097:;
COUNT = COUNT - 1;
X = X * 10.0;
if (X >= Y) goto L_0098;
goto L_0097;
L_0098:;
// 472 %finish %else %start
goto L_0099;
L_0096:;
// 473 y = 10.0-round
Y = 10.0 - ROUND;
// 474 %while x >= y %cycle; !ie rounded(X) > 10.0
L_009A:;
if (X < Y) goto L_009B;
// 475 count = count+1; x = x/10.0
COUNT = COUNT + 1;
X = (double)(X / 10.0);
// 476 %repeat
goto L_009A;
L_009B:;
// 477 %finish
L_0099:;
// 478 x = -x %if sign # 0
if (SIGN == 0) goto L_009C;
X = -X;
L_009C:;
// 479 %finish
L_0094:;
// 480 print(x,1,n)
PRINT(X, 1, N);
// 481 printsymbol('@')
_imp_PRINTSYMBOL(64);
// 482 write(count,0)
WRITE(COUNT, 0);
// 483 %end; !printfl
return;
} /* end of PRINTFL */
// 484
// 485 %systemroutine phex1(%integer x)
extern void PHEX1(int X) {
// 486 x = x&15; x = x+7 %if x>9; printsymbol(x+'0')
X = X & 15;
if (X <= 9) goto L_009D;
X = X + 7;
L_009D:;
_imp_PRINTSYMBOL(X + 48);
// 487 %end
return;
} /* end of PHEX1 */
// 488
// 489 %systemroutine phex2(%integer x)
extern void PHEX2(int X) {
// 490 phex1(x>>4); phex1(x)
PHEX1((unsigned int)X >> 4);
PHEX1(X);
// 491 %end
return;
} /* end of PHEX2 */
// 492
// 493 %systemroutine phex4(%integer x)
extern void PHEX4(int X) {
// 494 phex2(x>>8); phex2(x)
PHEX2((unsigned int)X >> 8);
PHEX2(X);
// 495 %end
return;
} /* end of PHEX4 */
// 496
// 497 %systemroutine phex(%integer x)
extern void PHEX(int X) {
// 498 phex4(x>>16); phex4(x)
PHEX4((unsigned int)X >> 16);
PHEX4(X);
// 499 %end
return;
} /* end of PHEX */
// 500
// 501 %systemintegerfn rhex
extern int RHEX(void) {
// 502 %integer n=0,s
int N;
N = 0;
int S;
// 503 %onevent 4 %start
if (!_imp_on_event(4)) goto L_009E;
// 504 %signal 4,1,s{,"Non-numeric character to RHEX"
_imp_signal(4, 1, S, "");
// 505 %finish
L_009E:;
// 506 %cycle
L_009F:;
// 507 s = nextsymbol; %exitif s>' '
S = _imp_NEXTSYMBOL();
if (S <= 32) goto L_00A0;
goto L_00A1;
L_00A0:;
// 508 skipsymbol
_imp_SKIPSYMBOL();
// 509 %repeat
goto L_009F;
L_00A1:;
// 510 s = s&95 %if s>='a'
if (S < 97) goto L_00A2;
S = S & 95;
L_00A2:;
// 511 %signal 4 %unless '0'<=s<='9' %or 'A'<=s<='F'
{
// Double-sided test on S (Part I)
int tmp;
if (48 > (tmp = S)) goto L_00A3;
// Double-sided test on S (Part II)
if (tmp <= 57) goto L_00A4;
}
L_00A3:;
{
// Double-sided test on S (Part I)
int tmp;
if (65 > (tmp = S)) goto L_00A5;
// Double-sided test on S (Part II)
if (tmp <= 70) goto L_00A4;
}
L_00A5:;
_imp_signal(4, 0, 0, "");
L_00A4:;
// 512 %while '0'<=s<='9' %or 'A'<=s<='F' %cycle
L_00A6:;
{
// Double-sided test on S (Part I)
int tmp;
if (48 > (tmp = S)) goto L_00A7;
// Double-sided test on S (Part II)
if (tmp <= 57) goto L_00A8;
}
L_00A7:;
{
// Double-sided test on S (Part I)
int tmp;
if (65 > (tmp = S)) goto L_00A9;
// Double-sided test on S (Part II)
if (tmp > 70) goto L_00A9;
}
L_00A8:;
// 513 s = s-'0'; s = s-7 %if s>9
S = S - 48;
if (S <= 9) goto L_00AA;
S = S - 7;
L_00AA:;
// 514 n = n<<4+s; skipsymbol; s = nextsymbol
N = (N << 4) + S;
_imp_SKIPSYMBOL();
S = _imp_NEXTSYMBOL();
// 515 s = s&95 %if s>='a'
if (S < 97) goto L_00AB;
S = S & 95;
L_00AB:;
// 516 %repeat
goto L_00A6;
L_00A9:;
// 517 %result = n
return N;
// 518 %end
} /* end of RHEX */
// 519
// 520 %systempredicate resolves(%string(*)%name var,match,fore,aft)
extern int RESOLVES(_imp_string *VAR, _imp_string *MATCH, _imp_string *FORE, _imp_string *AFT) {
// 521 !!Resolve the string specified by VAR into FORE and AFT split by MATCH
// 522 !![FORE and/or AFT absent is conventionally represented by an address
// 523 !! of zero]
// 524 !!@0%string(*) null
// 525 %conststring(*)%name null == 0
const _imp_string *NULL = 0;
// 526 %integer i
int I;
// 527
// 528 %integerfn resol(%string(*)%name var,match)
int RESOL(_imp_string * VAR, _imp_string * MATCH) {
// 529 !Return index position of first occurrence of MATCH within VAR
// 530 %label yes,no
// __label__ /* block-scoped label (GCC) */ YES;
// __label__ /* block-scoped label (GCC) */ NO;
// 531 !68K! *clr.l d0
// 532 !68K! *clr.w d1
// 533 !68K! *move.b (a1)+,d1 {length(match)
// 534 !68K! *beq yes {match="" ->
// 535 !68K! *clr.w d2
// 536 !68K! *move.b (a0)+,d2 {length(var)
// 537 !68K! *sub.b d1,d2
// 538 !68K! *bcs no {length(match)>length(var) -> {*bug: was bmi
// 539 !68K! *subq.w #1,d1
// 540 loop1:
U_1002:;
// 541 !68K! *lea 0(a0,d0),a2
// 542 !68K! *move.l a1,a3
// 543 !68K! *move d1,d3
// 544 loop2:
U_1003:;
// 545 !68K! *cmpm (a2)+,(a3)+
// 546 !68K! *dbne d3,loop2 {*bug?was dbeq
// 547 !68K! *beq yes
// 548 !68K! *addq.w #1,d0
// 549 !68K! *dbra d2,loop1
// 550 no: !68K! *moveq #-1,d0
U_1001:;
// 551 yes:!68K! *addq.l #1,d0
U_1000:;
// 552 !** (to be) re-coded for efficiency **
// 553 ! %integer i=0,j,l
// 554 ! l = length(match)
// 555 ! %cycle
// 556 ! %result = 0 %if i > length(var)-l
// 557 ! i = i+1
// 558 ! j = 0
// 559 ! %cycle
// 560 ! %result = i %if j = l
// 561 ! j = j+1
// 562 ! %repeat %until charno(var,i+j-1) # charno(match,j)
// 563 ! %repeat
// 564 %result=0
return 0;
// 565 %end
} /* end of RESOL */
// ?LOOP2 unused
// ?LOOP1 unused
// ?NO unused
// ?YES unused
// ?MATCH unused
// ?VAR unused
// 566
// 567 %routine assign(%string(*)%name dest, %integer from,to)
void ASSIGN(_imp_string * DEST, int FROM, int TO) {
// 568 !! **NB use of TOSTRING is compiled in-line **
// 569 !! **OK when DEST is also source **
// 570 dest = ""
*DEST = _imp_str_literal("");
// 571 %while from <= to %cycle
L_00AC:;
if (FROM > TO) goto L_00AD;
// 572 dest = dest.tostring(charno(var,from)); from = from+1
*DEST = *
/* clang-format off */
*({_imp_string255 tmp = _imp_join(({__typeof__(_imp_string255) tmp; /*D*/ tmp = *DEST; (void *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(*_imp_CHARNO((_imp_string255 *)/*p*/VAR, FROM)); (void *)&tmp;})); (_imp_string255 *)&tmp;})
/* clang-format on */
;
FROM = FROM + 1;
// 573 %repeat
goto L_00AC;
L_00AD:;
// 574 %end
return;
} /* end of ASSIGN */
// 575
// 576 %routine do aft
void DOAFT(void) {
// 577 assign(aft,i+length(match),length(var)) %unless aft==null
/* clang-format off */
if (_imp_ADDR((void *)(AFT)) == _imp_ADDR((void *)(NULL))) goto L_00AE;
/* clang-format on */
ASSIGN((_imp_string255 *)/*p*/ AFT, I + *_imp_LENGTH((_imp_string255 *)/*p*/ MATCH),
*_imp_LENGTH((_imp_string255 *)/*p*/ VAR));
L_00AE:;
// 578 %end
return;
} /* end of DOAFT */
// 579
// 580 i = resol(var,match)
I = RESOL((_imp_string255 *)/*p*/ VAR, (_imp_string255 *)/*p*/ MATCH);
// 581 %false %if i = 0
if (I != 0) goto L_00AF;
return 0 /*FALSE*/;
L_00AF:;
// 582 %if fore ## null %start
/* clang-format off */
if (_imp_ADDR((void *)(FORE)) == _imp_ADDR((void *)(NULL))) goto L_00B0;
/* clang-format on */
// 583 %if fore ## var %start
/* clang-format off */
if (_imp_ADDR((void *)(FORE)) == _imp_ADDR((void *)(VAR))) goto L_00B1;
/* clang-format on */
// 584 assign(fore,1,i-1)
ASSIGN((_imp_string255 *)/*p*/ FORE, 1, I - 1);
// 585 do aft
DOAFT();
// 586 %finish %else %start
goto L_00B2;
L_00B1:;
// 587 do aft
DOAFT();
// 588 length(var) = i-1
*_imp_LENGTH((_imp_string255 *)/*p*/ VAR) = I - 1;
// 589 %finish
L_00B2:;
// 590 %finish %else do aft
goto L_00B3;
L_00B0:;
DOAFT();
L_00B3:;
// 591 %true
return 1 /*TRUE*/;
// 592 %end
} /* end of RESOLVES */
// 593
// 594 ! Bulk move
// 595
// 596 %systemroutine smoveblock(%integer bytes,from,to)
extern void SMOVEBLOCK(int BYTES, int FROM, int TO) {
// 597 !"signed" move block
// 598 !if bytes>0 then move (from)+ to (to)+ but
// 599 !if bytes<0 then from:=from-bytes, to:=to-bytes, move -(from) to -(to)
// 600 %label f1,f2,f3,f4,f5,f6,f7,b0,b1,b2,b3,b4,b5,b6,b7,end
// __label__ /* block-scoped label (GCC) */ F1;
// __label__ /* block-scoped label (GCC) */ F2;
// __label__ /* block-scoped label (GCC) */ F3;
// __label__ /* block-scoped label (GCC) */ F4;
// __label__ /* block-scoped label (GCC) */ F5;
// __label__ /* block-scoped label (GCC) */ F6;
// __label__ /* block-scoped label (GCC) */ F7;
// __label__ /* block-scoped label (GCC) */ B0;
// __label__ /* block-scoped label (GCC) */ B1;
// __label__ /* block-scoped label (GCC) */ B2;
// __label__ /* block-scoped label (GCC) */ B3;
// __label__ /* block-scoped label (GCC) */ B4;
// __label__ /* block-scoped label (GCC) */ B5;
// __label__ /* block-scoped label (GCC) */ B6;
// __label__ /* block-scoped label (GCC) */ B7;
// __label__ /* block-scoped label (GCC) */ END;
// 601 !68K! *move.l d1,a0
// 602 !68K! *move.l d2,a1
// 603 !68K! *eor d1,d2
// 604 !68K! *tst.l d0
// 605 !68K! *bmi b0; !copy backwards ->
// 606 !68K! *beq end; !copy nothing ->
// 607 !68K! *btst #0,d2; !if (from!!to)&1#0 then
// 608 !68K! *bne f5; !copy bytewise ->
// 609 !68K! *btst #0,d1; !if from&1=0 then
// 610 !68K! *beq f1; !go for longword loop ->
// 611 !68K! *move.b (a0)+,(a1)+; !copy first byte to even up
// 612 !68K! *subq.l #1,d0
// 613 f1: !68K! *moveq #3,d2
U_1004:;
// 614 !68K! *and d0,d2; !remainder for byte loop
// 615 !68K! *subq.l #4,d0
// 616 !68K! *bmi f4; !bytes<4 ->
// 617 !68K! *lsr.l #2,d0; !longwords-1
// 618 !68K! *bra f3
// 619 f2: !68K! *swap d0; !longword loop
U_1005:;
// 620 f3: !68K! *move.l (a0)+,(a1)+
U_1006:;
// 621 !68K! *dbra d0,f3
// 622 !68K! *swap d0
// 623 !68K! *dbra d0,f2
// 624 f4: !68K! *move.l d2,d0
U_1007:;
// 625 f5: !68K! *subq.l #1,d0; !bytes-1
U_1008:;
// 626 !68K! *bmi end
// 627 !68K! *bra f7
// 628 f6: !68K! *swap d0; !byte loop
U_1009:;
// 629 f7: !68K! *move.b (a0)+,(a1)+
U_100A:;
// 630 !68K! *dbra d0,f7
// 631 !68K! *swap d0
// 632 !68K! *dbra d0,f6
// 633 !68K! *bra end
// 634 b0: !68K! *neg.l d0; !backwards copy
U_100B:;
// 635 !68K! *add.l d0,a0; !adjust addresses for -()
// 636 !68K! *add.l d0,a1
// 637 !68K! *btst #0,d2
// 638 !68K! *bne b5
// 639 !68K! *move a0,d1; !!
// 640 !68K! *btst #0,d1
// 641 !68K! *beq b1
// 642 !68K! *move.b -(a0),-(a1)
// 643 !68K! *subq.l #1,d0
// 644 b1: !68K! *moveq #3,d2
U_100C:;
// 645 !68K! *and d0,d2
// 646 !68K! *subq.l #4,d0
// 647 !68K! *bmi b4
// 648 !68K! *lsr.l #2,d0
// 649 !68K! *bra b3
// 650 b2: !68K! *swap d0
U_100D:;
// 651 b3: !68K! *move.l -(a0),-(a1)
U_100E:;
// 652 !68K! *dbra d0,b3
// 653 !68K! *swap d0
// 654 !68K! *dbra d0,b2
// 655 b4: !68K! *move.l d2,d0
U_100F:;
// 656 b5: !68K! *subq.l #1,d0
U_1010:;
// 657 !68K! *bmi end
// 658 !68K! *bra b7
// 659 b6: !68K! *swap d0
U_1011:;
// 660 b7: !68K! *move.b -(a0),-(a1)
U_1012:;
// 661 !68K! *dbra d0,b7
// 662 !68K! *swap d0
// 663 !68K! *dbra d0,b6
// 664 end:
U_1013:;
// 665 %end
return;
} /* end of SMOVEBLOCK */
// ?END unused
// ?B7 unused
// ?B6 unused
// ?B5 unused
// ?B4 unused
// ?B3 unused
// ?B2 unused
// ?B1 unused
// ?B0 unused
// ?F7 unused
// ?F6 unused
// ?F5 unused
// ?F4 unused
// ?F3 unused
// ?F2 unused
// ?F1 unused
// ?TO unused
// ?FROM unused
// ?BYTES unused
// 666
// 667 %systemroutine moveblock(%integer bytes,from,to)
extern void MOVEBLOCK(int BYTES, int FROM, int TO) {
// 668 !in case of overlap copy without propagating
// 669 ! %returnif bytes<=0
// 670 ! bytes = -bytes %if from<to<from+bytes
// 671 ! smoveblock(bytes,from,to)
// 672 %label x,y
// __label__ /* block-scoped label (GCC) */ X;
// __label__ /* block-scoped label (GCC) */ Y;
// 673 !68K! *tst.l d0
// 674 !68K! *ble y
// 675 !68K! *cmp.l d2,d1
// 676 !68K! *bge x
// 677 !68K! *move.l d1,d3
// 678 !68K! *add.l d0,d3
// 679 !68K! *cmp.l d3,d2
// 680 !68K! *bge x
// 681 !68K! *neg.l d0
// 682 x:!68K! *jsr smoveblock
U_1014:;
// 683 y:
U_1015:;
// 684 %end
return;
} /* end of MOVEBLOCK */
// ?Y unused
// ?X unused
// ?TO unused
// ?FROM unused
// ?BYTES unused
// 685
// 686 %systemstring(31)%fn DATETIME
extern _imp_string31 DATETIME(void) {
// 687 %external {@16_1110} %integerfn %spec FCOMMR(%integer c,%string(255)p,
extern int FCOMMR(int C, _imp_string255 P, unsigned char *B, int MAX);
// 688+ %bytename b,%integer max)
// 689 %string(31)s
_imp_string31 S;
// 690 length(s) = fcommr('G'<<8,"",charno(s,1),31)
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) =
FCOMMR(71 << 8, _imp_str_literal(""), _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), 31);
// 691 %result = s
return *(_imp_string31 *)/*?*/ &S;
// 692 %end
} /* end of DATETIME */
// 693
// 694 %systemstring(8)%fn DATE; !** No owns
extern _imp_string8 DATE(void) {
// 695 !%string(31)s
// 696 ! s = datetime; length(s) = 8; %result = s
// 697 !68K! *BSR DATETIME; !ad -> A0
// 698 !68K! *MOVE.B #8,(A0); !alter length
// 699 %result=""
return *(_imp_string8 *)/*?*/ _imp_str_literal_ptr("");
// 700 %end
} /* end of DATE */
// 701
// 702 %systemstring(5)%fn TIME; !** No owns
extern _imp_string5 TIME(void) {
// 703 !%string(31)s
// 704 !%integer p
// 705 ! s = datetime; p = addr(s)+length(s)-5
// 706 ! byteinteger(p) = 5; %result = string(p)
// 707 !68K! *BSR DATETIME
// 708 !68K! *LEA 10(A0),A0; *MOVE.B #5,(A0); !adjust start & length
// 709 %result=""
return *(_imp_string5 *)/*?*/ _imp_str_literal_ptr("");
// 710 %end
} /* end of TIME */
// 711
// 712 %systemintegerfn cputime
extern int CPUTIME(void) {
// 713 !68K! *jsr 16_1130
// 714 %result=0
return 0;
// 715 %end
} /* end of CPUTIME */
// 716
// 717 ! PAM stuff
// 718
// 719 !Parameter records:
// 720 %recordformat INFO(%string(255) name,
struct INFO {
union {
struct {
_imp_string255 NAME;
int ADDR;
short int SIZE;
short int FLAGS;
struct INFO *LINK;
};
};
};
// 721+ %integer addr,%short size,flags,
// 722+ %record(info)%name link)
// 723 !Base record
// 724 %recordformat PAMINFO(%byte groupsep,keyflag, %short allflags,
struct PAMINFO {
union {
struct {
unsigned char GROUPSEP;
unsigned char KEYFLAG;
short int ALLFLAGS;
struct INFO *CHAIN;
};
};
};
// 725+ %record(info)%name chain)
// 726 %externalrecord(paminfo)%map PAM
struct PAMINFO *PAM(void) {
// 727 !%record(paminfo)%name p
// 728 ! %if pamaddr=0 %start
// 729 ! p == new(p); pamaddr = addr(p)
// 730 ! p = 0
// 731 ! p_groupsep = '/'; p_keyflag = '-'
// 732 ! %else
// 733 ! p == record(pamaddr)
// 734 ! %finish
// 735 ! %result == p
// 736 %ownrecord(paminfo)p{=paminfo('/','-',0,nil)
static struct PAMINFO P;
// 737 %result == p
return /*?*/ &P;
// 738 %end
} /* end of PAM */
// 739
// 740 %systemroutine openinput(%integer s,%string(255)f)
extern void OPENINPUT(int S, _imp_string255 F) {
// 741 { *jsr 16_10f0
// 742 %end
return;
} /* end of OPENINPUT */
// ?F unused
// ?S unused
// 743
// 744 %systemroutine openoutput(%integer s,%string(255)f)
extern void OPENOUTPUT(int S, _imp_string255 F) {
// 745 { *jsr 16_10f4
// 746 %end
return;
} /* end of OPENOUTPUT */
// ?F unused
// ?S unused
// 747
// 748 ! Setinput and Setoutput
// 749
// 750 %external {@16_1108} %integerfn %spec FCOMM(%integer cn,%string(255)s)
extern int FCOMM(int CN, _imp_string255 S);
// 751 %external {@16_110C} %integerfn %spec FCOMMW(%integer cn,%string(255) s,
extern int FCOMMW(int CN, _imp_string255 S, unsigned char *BUFFER, int SIZE);
// 752+ %bytename buffer,%integer size)
// 753 %external {@16_1110} %integerfn %spec FCOMMR(%integer c,%string(255)p,
extern int FCOMMR(int C, _imp_string255 P, unsigned char *B, int MAX);
// 754+ %bytename b,%integer max)
// 755 %external {@16_35c4} %short USERNO
short int USERNO;
// 756 %external {@16_3fa8} %byte LDTE,LSAP,RDTE,RSAP
unsigned char LDTE;
unsigned char LSAP;
unsigned char RDTE;
unsigned char RSAP;
// 757 %external {@16_1100} %routine %spec ETHERWRITE(%integer port,%bytename buf,%integer size)
extern void ETHERWRITE(int PORT, unsigned char *BUF, int SIZE);
// 758 %external {@16_1104} %integerfn %spec ETHERREAD(%integer port,%bytename buf,%integer max)
extern int ETHERREAD(int PORT, unsigned char *BUF, int MAX);
// 759 %recordformat sf(%integer ptr,lim,server,extra)
struct SF {
union {
struct {
int PTR;
int LIM;
int SERVER;
int EXTRA;
};
};
};
// 760 %external {@16_35c6} %record(sf)%name curin
struct SF *CURIN;
// 761 %external {@16_35ca} %record(sf)%name curout
struct SF *CUROUT;
// 762
// 763 %integerfn fromhdh(%integername pos,%integer lim)
static int FROMHDH(int *POS, int LIM) {
// 764 %integer n=0,k
int N;
N = 0;
int K;
// 765 %cycle
L_00B4:;
// 766 %result = n %if pos>=lim; pos = pos+1
if (*POS < LIM) goto L_00B5;
return N;
L_00B5:;
*POS = *POS + 1;
// 767 k = byteinteger(pos-1)-'0'; %result = n %if k<0
K = *_imp_BYTEINTEGER(*POS - 1) - 48;
if (K >= 0) goto L_00B6;
return N;
L_00B6:;
// 768 n = n<<4+k
N = (N << 4) + K;
// 769 %repeat
goto L_00B4;
// 770 %end
} /* end of FROMHDH */
// 771
// 772 %string(5)%fn tohdh(%integer n)
static _imp_string5 TOHDH(int N) {
// 773 %string(5)h
_imp_string5 H;
// 774 %integer i
int I;
// 775 h = ""
/* clang-format off */
_imp_strncpy(/*?*/&H, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/5);
/* clang-format on */
// 776 h = h.tostring(n>>i&15+'0') %for i=12,-4,0
// %for I = 12, -4, 0 %cycle
{
I = 16;
L_00B7:
if (I == 0) goto L_00B8;
I -= 4;
/* clang-format off */
_imp_strncpy(/*?*/&H, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&H, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(((unsigned int)N >> I & 15) + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/5);
/* clang-format on */
goto L_00B7;
}
L_00B8:;
// 777 %result = h
return *(_imp_string5 *)/*?*/ &H;
// 778 %end
} /* end of TOHDH */
// 779
// 780 %systemroutine setinput(%integer pos)
extern void SETINPUT(int POS) {
// 781 %integer x,lo,hi
int X;
int LO;
int HI;
// 782 %returnif curin_extra=0; !Not file =>
if (CURIN->EXTRA != 0) goto L_00BA;
return;
L_00BA:;
// 783 !! hi = (curin_lim+511)&\511
// 784 hi = (curin_lim+511)&(\511)
HI = CURIN->LIM + 511 & (~511);
// 785 lo = hi-512
LO = HI - 512;
// 786 curin_lim = hi
CURIN->LIM = HI;
// 787 curin_ptr = hi
CURIN->PTR = HI;
// 788 x = fcomm(M'U0'+curin_extra,tohdh(pos>>9))
X = FCOMM(21808 + CURIN->EXTRA,
/* clang-format off */
*({ __typeof__(_imp_string5) tmp = TOHDH((unsigned int)POS >> 9)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 789 %returnif pos&511=0; !No part-block =>
if (POS & 511 != 0) goto L_00BB;
return;
L_00BB:;
// 790 x = fcommr(M'X0'+curin_extra,"",byteinteger(lo),512)
X = FCOMMR(22576 + CURIN->EXTRA, _imp_str_literal(""), _imp_BYTEINTEGER(LO), 512);
// 791 %returnif x<pos&511; !File too short =>
if (X >= POS & 511) goto L_00BC;
return;
L_00BC:;
// 792 curin_lim = lo+x
CURIN->LIM = LO + X;
// 793 curin_ptr = lo+pos&511
CURIN->PTR = LO + (POS & 511);
// 794 %end
return;
} /* end of SETINPUT */
// 795
// 796 %systemroutine resetinput
extern void RESETINPUT(void) {
// 797 setinput(0)
SETINPUT(0);
// 798 %end
return;
} /* end of RESETINPUT */
// 799
// 800 %systemroutine setoutput(%integer pos)
extern void SETOUTPUT(int POS) {
// 801 %string(5)block
_imp_string5 BLOCK;
// 802 %integer x
int X;
// 803 %returnif curout_extra=0; !Not file =>
if (CUROUT->EXTRA != 0) goto L_00BD;
return;
L_00BD:;
// 804 curout_ptr = curout_lim-512
CUROUT->PTR = CUROUT->LIM - 512;
// 805 block = tohdh(pos>>9)
/* clang-format off */
_imp_strncpy(/*?*/&BLOCK, ({__typeof__(_imp_string5) tmp;/*B*/ tmp = TOHDH((unsigned int)POS >> 9); (void *)&tmp;}), /*max:*/5);
/* clang-format on */
// 806 %if pos&511#0 %start; !Part-block
if (POS & 511 == 0) goto L_00BE;
// 807 x = fcommr(M'R0'+curout_extra,block,byteinteger(curout_ptr),512)
X = FCOMMR(21040 + CUROUT->EXTRA,
/* clang-format off */
*({ __typeof__(_imp_string5) tmp = BLOCK/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
,
_imp_BYTEINTEGER(CUROUT->PTR), 512);
// 808 curout_ptr = curout_ptr+pos&511
CUROUT->PTR = CUROUT->PTR + (POS & 511);
// 809 %finish
L_00BE:;
// 810 x = fcomm(M'U0'+curout_extra,block)
X = FCOMM(21808 + CUROUT->EXTRA,
/* clang-format off */
*({ __typeof__(_imp_string5) tmp = BLOCK/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 811 %end
return;
} /* end of SETOUTPUT */
// 812
// 813 %systemroutine resetoutput
extern void RESETOUTPUT(void) {
// 814 setoutput(0)
SETOUTPUT(0);
// 815 %end
return;
} /* end of RESETOUTPUT */
// 816
// 817 %integerfn open and shut(%string(255)%name file)
static int OPENANDSHUT(_imp_string255 *FILE) {
// 818 %string(255)s
_imp_string255 S;
// 819 %bytename b
unsigned char *B;
// 820 %integer xno,blocks,pad
int XNO;
int BLOCKS;
int PAD;
// 821 %integerfn get
int GET(void) {
// 822 %integer n=0,k
int N;
N = 0;
int K;
// 823 %cycle
L_00BF:;
// 824 k = b-'0'; b == b++1
K = *B - 48;
B = (unsigned char *)B + 1;
// 825 %result = n %if k<0
if (K >= 0) goto L_00C0;
return N;
L_00C0:;
// 826 n = n<<4+k
N = (N << 4) + K;
// 827 %repeat
goto L_00BF;
// 828 %end
} /* end of GET */
// 829 %result = 0 %if file=""
/* clang-format off */
if (_imp_strcmp((_imp_string *)FILE, (_imp_string *)/*?*/_imp_str_literal_ptr("")) != 0) goto L_00C1;
/* clang-format on */
return 0;
L_00C1:;
// 830 s = "S".tostring(userno+'0').file.tostring(nl)
/* 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 *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("S"), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(USERNO + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string255) tmp; /*E*/ tmp = *FILE; (void *)&tmp;})); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(10); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 831 etherwrite(lsap,charno(s,1),length(s))
ETHERWRITE(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 832 length(s) = etherread(lsap,charno(s,1),255)-1
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) =
ETHERREAD(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), 255) - 1;
// 833 %if charno(s,1)='-' %start
if (*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1) != 45) goto L_00C2;
// 834 %signal 3,4,charno(s,2)-'0'{,substring(s,3,length(s))
_imp_signal(3, 4, *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 2) - 48, "");
// 835 %finish
L_00C2:;
// 836 b == charno(s,1)
B = (unsigned char *)_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1);
// 837 xno = get; blocks = get; pad = get
XNO = GET();
BLOCKS = GET();
PAD = GET();
// 838 s = "K".tostring(xno+'0').tostring(nl)
/* 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 *)/*?*/_imp_str_literal_ptr("K"), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(XNO + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(10); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 839 etherwrite(lsap,charno(s,1),length(s))
ETHERWRITE(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 840 length(s) = etherread(lsap,charno(s,1),255)
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) =
ETHERREAD(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), 255);
// 841 %result = blocks<<9-pad
return (BLOCKS << 9) - PAD;
// 842 %end
} /* end of OPENANDSHUT */
// 843
// 844 %systempredicate exists(%string(255)file)
extern int EXISTS(_imp_string255 FILE) {
// 845 %integer x
int X;
// 846 %onevent 3 %start
if (!_imp_on_event(3)) goto L_00C3;
// 847 %false
return 0 /*FALSE*/;
// 848 %finish
L_00C3:;
// 849 toupper(file)
TOUPPER((_imp_string255 *)/*p*/ /*?*/ &FILE);
// 850 %trueif file="" %or file=":N" %or file=":" %or file=":T"
/* clang-format off */
if (_imp_strcmp((_imp_string *)/*?*/&FILE, (_imp_string *)/*?*/_imp_str_literal_ptr("")) == 0) goto L_00B9;
/* clang-format on */
/* clang-format off */
if (_imp_strcmp((_imp_string *)/*?*/&FILE, (_imp_string *)/*?*/_imp_str_literal_ptr(":N")) == 0) goto L_00B9;
/* clang-format on */
/* clang-format off */
if (_imp_strcmp((_imp_string *)/*?*/&FILE, (_imp_string *)/*?*/_imp_str_literal_ptr(":")) == 0) goto L_00B9;
/* clang-format on */
/* clang-format off */
if (_imp_strcmp((_imp_string *)/*?*/&FILE, (_imp_string *)/*?*/_imp_str_literal_ptr(":T")) != 0) goto L_00C4;
/* clang-format on */
L_00B9:;
return 1 /*TRUE*/;
L_00C4:;
// 851 x = openandshut(file)
X = OPENANDSHUT((_imp_string255 *)/*p*/ /*?*/ &FILE);
// 852 %true
return 1 /*TRUE*/;
// 853 %end
} /* end of EXISTS */
// 854
// 855 %systemintegerfn filesize(%string(255)file)
extern int FILESIZE(_imp_string255 FILE) {
// 856 %result = openandshut(file)
return OPENANDSHUT((_imp_string255 *)/*p*/ /*?*/ &FILE);
// 857 %end
} /* end of FILESIZE */
// 858
// 859 %systemroutine open append(%integer stream,%string(255)file)
extern void OPENAPPEND(int STREAM, _imp_string255 FILE) {
// 860 ! Open the specified file for output on the specified stream,
// 861 ! such that information is added at the end.
// 862 ! (Hidden) result is the size of the information in the file already.
// 863 %string(255)s
_imp_string255 S;
// 864 %record(sf)%name cb
struct SF *CB;
// 865 %integer pos,lim,xno,blocks,pad,size
int POS;
int LIM;
int XNO;
int BLOCKS;
int PAD;
int SIZE;
// 866 ! Open anything for output first - to get file driver addr into CB
// 867 openoutput(stream,"pub:"); selectoutput(stream)
OPENOUTPUT(STREAM, _imp_str_literal("pub:"));
_imp_SELECTOUTPUT(STREAM);
// 868 cb == curout
CB = (struct SF *)CUROUT;
// 869 xno = cb_extra
XNO = CB->EXTRA;
// 870 ! Close it again - but don't use CLOSEOUTPUT as this will zap the driver
// 871 cb_extra = 0
CB->EXTRA = 0;
// 872 s = "K".tostring(xno+'0').tostring(nl)
/* 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 *)/*?*/_imp_str_literal_ptr("K"), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(XNO + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(10); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 873 etherwrite(lsap,charno(s,1),length(s))
ETHERWRITE(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 874 length(s) = etherread(lsap,charno(s,1),255)
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) =
ETHERREAD(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), 255);
// 875 ! Now open-mod the file we want
// 876 s = "A".tostring(userno+'0').file.tostring(nl)
/* 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 *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("A"), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(USERNO + 48); (void *)&tmp;})); (_imp_string255 *)&tmp;}), (_imp_string *)/*?*/&FILE); (_imp_string255 *)&tmp;}), ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(10); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 877 etherwrite(lsap,charno(s,1),length(s))
ETHERWRITE(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 878 length(s) = etherread(lsap,charno(s,1),255)
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) =
ETHERREAD(LSAP, _imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1), 255);
// 879 %if charno(s,1)='-' %start; !failed to open
if (*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 1) != 45) goto L_00C5;
// 880 %if charno(s,2)=';' %start; !does not exist: use ordinary seq output
if (*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 2) != 59) goto L_00C6;
// 881 openoutput(stream,file); selectoutput(0)
OPENOUTPUT(STREAM,
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = FILE/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
_imp_SELECTOUTPUT(0);
// 882 !68K! *clr.l d0; %return
// 883 %finish
L_00C6:;
// 884 %signal 3,3,charno(s,2)-'0'{,substring(s,3,length(s)-1)
_imp_signal(3, 3, *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, 2) - 48, "");
// 885 %finish
L_00C5:;
// 886 pos = addr(s)+1; lim = pos+length(s)
POS = _imp_ADDR(/*?*/ &S) + 1;
LIM = POS + *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S);
// 887 xno = fromhdh(pos,lim); blocks = fromhdh(pos,lim); pad = fromhdh(pos,lim)
XNO = FROMHDH(/*?*/ &POS, LIM);
BLOCKS = FROMHDH(/*?*/ &POS, LIM);
PAD = FROMHDH(/*?*/ &POS, LIM);
// 888 cb_extra = xno
CB->EXTRA = XNO;
// 889 size = blocks<<9-pad
SIZE = (BLOCKS << 9) - PAD;
// 890 setoutput(size)
SETOUTPUT(SIZE);
// 891 !68K! *move.l size,d0
// 892 %end
return;
} /* end of OPENAPPEND */
// 893
// 894 %systemroutine close append; !no longer required
extern void CLOSEAPPEND(void) {
// 895 closeoutput
_imp_CLOSEOUTPUT();
// 896 %end
return;
} /* end of CLOSEAPPEND */
// 897
// 898 %endoffile