#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 2 %ownstring(90) copyright = " Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved."
static _imp_string90 COPYRIGHT =
_imp_str_init(" Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.");
// 3
// 4 !* 09May 96 uiocp17
// 5 !* Flattened for translation to C
// 6 !* 27-Nov-92 uiocp16
// 7 !* Simple IMP version all library duplicat material chopped out
// 8 !*
// 9
// 10 %externalroutine Stop %alias "s_stop"
void STOP(void) {
// 11
// 12 %externalroutinespec iocp %alias "s_iocp"(%integer ep,n)
extern void IOCP(int EP, int N) __asm__("s_iocp");
// 13 %externalroutinespec exit %alias "exit"
extern void EXIT(void) __asm__("exit");
// 14
// 15 iocp(11,0) { flush buffer }
IOCP(11, 0);
// 16 printstring("
_imp_PRINTSTRING(_imp_str_literal("\nProgram stopped\n"));
// 17+ Program stopped
// 18+ ")
// 19
// 20 exit
EXIT();
// 21
// 22 %end;! Stop
return;
} /* end of STOP */
// 23 %conststring(1) %array Hex(0:15) =
const _imp_string1 HEX[16] = {_imp_str_init("0"), _imp_str_init("1"), _imp_str_init("2"), _imp_str_init("3"),
_imp_str_init("4"), _imp_str_init("5"), _imp_str_init("6"), _imp_str_init("7"),
_imp_str_init("8"), _imp_str_init("9"), _imp_str_init("A"), _imp_str_init("B"),
_imp_str_init("C"), _imp_str_init("D"), _imp_str_init("E"), _imp_str_init("F")};
// 24+ "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"
// 25
// 26 %externalroutine Phexbyte(%integer n)
void PHEXBYTE(int N) {
// 27 printstring(Hex((n>>4)&15))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string1) tmp = HEX[(unsigned int)N >> 4 & 15] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 28 printstring(Hex(n&15))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string1) tmp = HEX[N & 15] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 29 %end;! Phexbyte
return;
} /* end of PHEXBYTE */
// 30 !
// 31 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 32 !
// 33
// 34
// 35
// 36 !************************************************************
// 37 !* *
// 38 !* IOCP - IMP stream input/output package *
// 39 !* (This is a cut down version for the Fortran compiler *
// 40 !* *
// 41 !************************************************************
// 42
// 43 %constinteger Stdin = 0,
// 44+ Stdout = 1,
// 45+ Stderr = 2
// 46
// 47 %externalroutinespec Close (%integer id) { Sys Call }
extern void CLOSE(int ID);
// 48 %externalintegerfnspec Open (%integer ad,mode)
extern int OPEN(int AD, int MODE);
// 49 %externalintegerfnspec Filewrite %alias "write" (%integer id,bytead,len)
extern int FILEWRITE(int ID, int BYTEAD, int LEN) __asm__("write");
// 50 %externalintegerfnspec Fileread %alias "read" (%integer id,bytead,len)
extern int FILEREAD(int ID, int BYTEAD, int LEN) __asm__("read");
// 51
// 52 %ownintegerarray streamtable(0:100)
static int STREAMTABLE[101];
// 53
// 54 %externalroutine Openfile(%integer stream, %string(128) name)
void OPENFILE(int STREAM, _imp_string128 NAME) {
// 55 %integer i
int I;
// 56 %ownbyteintegerarray cname(0:127)
static unsigned char CNAME[128];
// 57
// 58 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop
{
// Double-sided test on STREAM (Part I)
int tmp;
if (0 > (tmp = STREAM)) goto L_0001;
// Double-sided test on STREAM (Part II)
if (tmp <= 100) goto L_0002;
}
L_0001:;
_imp_PRINTSTRING(_imp_str_literal(" invalid stream number "));
_imp_stop(0);
L_0002:;
// 59 string(addr(cname(0)))=name.tostring(0)
*_imp_STRING(_imp_ADDR(/*?*/ &CNAME[0])) =
*({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &NAME, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
})
;
// 60 i=open(addr(cname(1)),0) { open reading }
I = OPEN(_imp_ADDR(/*?*/ &CNAME[1]), 0);
// 61 streamtable(stream)=i
STREAMTABLE[STREAM] = I;
// 62 %end;! Openfile
return;
} /* end of OPENFILE */
// 63
// 64 %externalroutine Openinput(%integer stream, %string(128) name)
void OPENINPUT(int STREAM, _imp_string128 NAME) {
// 65 %integer i
int I;
// 66 %ownbyteintegerarray cname(0:127)
static unsigned char CNAME[128];
// 67
// 68 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop
{
// Double-sided test on STREAM (Part I)
int tmp;
if (0 > (tmp = STREAM)) goto L_0003;
// Double-sided test on STREAM (Part II)
if (tmp <= 100) goto L_0004;
}
L_0003:;
_imp_PRINTSTRING(_imp_str_literal(" invalid stream number "));
_imp_stop(0);
L_0004:;
// 69 string(addr(cname(0)))=name.tostring(0)
*_imp_STRING(_imp_ADDR(/*?*/ &CNAME[0])) =
*({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &NAME, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
})
;
// 70 i=open(addr(cname(1)),0) { open reading }
I = OPEN(_imp_ADDR(/*?*/ &CNAME[1]), 0);
// 71 streamtable(stream)=i
STREAMTABLE[STREAM] = I;
// 72 %end;! Openfile
return;
} /* end of OPENINPUT */
// 73
// 74 %externalroutine Openoutput(%integer stream, %string(128) name)
void OPENOUTPUT(int STREAM, _imp_string128 NAME) {
// 75 %integer i
int I;
// 76 %ownbyteintegerarray cname(0:127)
static unsigned char CNAME[128];
// 77
// 78 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop
{
// Double-sided test on STREAM (Part I)
int tmp;
if (0 > (tmp = STREAM)) goto L_0005;
// Double-sided test on STREAM (Part II)
if (tmp <= 100) goto L_0006;
}
L_0005:;
_imp_PRINTSTRING(_imp_str_literal(" invalid stream number "));
_imp_stop(0);
L_0006:;
// 79 string(addr(cname(0)))=name.tostring(0)
*_imp_STRING(_imp_ADDR(/*?*/ &CNAME[0])) =
*({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &NAME, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
})
;
// 80 i=open(addr(cname(1)),1) { open for writing }
I = OPEN(_imp_ADDR(/*?*/ &CNAME[1]), 1);
// 81 streamtable(stream)=i
STREAMTABLE[STREAM] = I;
// 82 %end;! Openfile
return;
} /* end of OPENOUTPUT */
// 83
// 84 %externalroutine Closeoutput
void CLOSEOUTPUT(void) {
// 85 %end
return;
} /* end of CLOSEOUTPUT */
// 86
// 87 %externalroutine Closeinput
void CLOSEINPUT(void) {
// 88 %end
return;
} /* end of CLOSEINPUT */
// 89
// 90 !*
// 91 %STRING(15) %FN Itos(%INTEGER K)
static _imp_string15 ITOS(int K) {
// 92 %INTEGER REM,NUM,NF
int REM;
int NUM;
int NF;
// 93 %STRING(15) STR
_imp_string15 STR;
// 94
// 95 STR=""
_imp_strncpy(/*?*/ &STR, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 15);
// 96 NF=0
NF = 0;
// 97 %IF K<0 %START
if (K >= 0) goto L_0007;
// 98 NF=1
NF = 1;
// 99 K = K *(-1)
K = K * (-1);
// 100 %FINISH
L_0007:;
// 101 %CYCLE
L_0008:;
// 102 NUM=K
NUM = K;
// 103 K = K//10
K = ((long)K / (long)10);
// 104 REM = NUM-(K*10)
REM = NUM - K * 10;
// 105 STR = TOSTRING(REM+'0').STR
_imp_strncpy(/*?*/ &STR, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp = _imp_join(({
__typeof__(_imp_string1) tmp; /*D*/
tmp = _imp_TOSTRING(REM + 48);
(void *)&tmp;
}),
(_imp_string *)/*?*/ &STR);
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 15);
// 106 %IF K=0 %THEN %EXIT
if (K != 0) goto L_0009;
goto L_000A;
L_0009:;
// 107 %REPEAT
goto L_0008;
L_000A:;
// 108 %IF NF=1 %THEN STR = "-".STR
if (NF != 1) goto L_000B;
_imp_strncpy(/*?*/ &STR, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("-"), (_imp_string *)/*?*/ &STR);
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 15);
L_000B:;
// 109 %RESULT = STR
return *(_imp_string15 *)/*?*/ &STR;
// 110 %END;! Itos
} /* end of ITOS */
// 111 !
// 112 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 113 !
// 114
// 115
// 116 %routine Ioerr(%integer ep,n,%string(255) s)
static void IOERR(int EP, int N, _imp_string255 S) {
// 117 %integer i
int I;
// 118 s = "
_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_string255 tmp = _imp_join(
(_imp_string *)/*?*/ &*({
_imp_string255 tmp = _imp_join(
(_imp_string *)/*?*/ &*({
_imp_string255 tmp = _imp_join(
(_imp_string *)/*?*/ _imp_str_literal_ptr("\nIOCP ERROR "),
(_imp_string *)/*?*/ &S);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(" ep = "));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string15) tmp; /*E*/
tmp = ITOS(EP);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(" n = "));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string15) tmp; /*E*/
tmp = ITOS(N);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("\n"));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 255);
// 119+ IOCP ERROR ".s." ep = ".itos(ep)." n = ".itos(n)."
// 120+ "
// 121 i = Filewrite(Stderr,(addr(s) )+1,length(S))
I = FILEWRITE(2, _imp_ADDR(/*?*/ &S) + 1, *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 122 %end;! Ioerr
return;
} /* end of IOERR */
// 123 !
// 124 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 125 %externalintegerfn Iocp %alias "s_iocp"(%integer ep,n)
int IOCP(int EP, int N) {
// 126 %switch entry(1:19)
int ENTRY_index;
int ENTRY_line;
char *ENTRY_file;
static const void *ENTRY[19] = {&&case_ENTRY_1, &&case_ENTRY_2, &&case_ENTRY_3, &&case_ENTRY_default,
&&case_ENTRY_5, &&case_ENTRY_default, &&case_ENTRY_7, &&case_ENTRY_8,
&&case_ENTRY_9, &&case_ENTRY_default, &&case_ENTRY_11, &&case_ENTRY_default,
&&case_ENTRY_default, &&case_ENTRY_default, &&case_ENTRY_15, &&case_ENTRY_16,
&&case_ENTRY_17, &&case_ENTRY_18, &&case_ENTRY_19};
// 127 %constinteger Maxlinelen = 132
// 128 %ownbyteintegerarray Line(0:Maxlinelen+1)
static unsigned char LINE[134];
// 129 %ownbyteintegerarray inbuf(0:4096)
static unsigned char INBUF[4097];
// 130 %owninteger left,inptr
static int LEFT;
static int INPTR;
// 131 %owninteger endgiven=0
static int ENDGIVEN = 0;
// 132 %integer bytead,len
int BYTEAD;
int LEN;
// 133 %owninteger Lptr
static int LPTR;
// 134 %integer i,ch,j
int I;
int CH;
int J;
// 135 %owninteger OutID = Stdout, InID = Stdin
static int OUTID = 1;
static int INID = 0;
// 136
// 137 !%string(255) mess
// 138
// 139 ! mess = "
// 140 ! IOCP( ".itos(ep)." ".itos(n)." Lptr = ".itos(lptr)
// 141 ! i = Filewrite(1,(addr(mess)*2) + 1, length(mess))
// 142 !
// 143
// 144 !
// 145
// 146
// 147 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 148 !
// 149
// 150
// 151
// 152
// 153 %unless 1<=ep<=19 %then IOERR(ep,n," Bad entry ") %and OutID=Stderr
{
// Double-sided test on EP (Part I)
int tmp;
if (1 > (tmp = EP)) goto L_000C;
// Double-sided test on EP (Part II)
if (tmp <= 19) goto L_000D;
}
L_000C:;
IOERR(EP, N, _imp_str_literal(" Bad entry "));
OUTID = 2;
L_000D:;
// 154 ->entry(ep)
ENTRY_line = __LINE__;
ENTRY_file = __FILE__;
ENTRY_index = EP;
goto case_ENTRY_dispatch;
// 155
// 156 entry(*): IOERR(ep,n," Entry not implemented ")
case_ENTRY_default:;
IOERR(EP, N, _imp_str_literal(" Entry not implemented "));
// 157 OutID=Stderr
OUTID = 2;
// 158
// 159 ! entry(4):
// 160 entry(1): { READSYMBOL }
case_ENTRY_1:;
// 161 entry(2): { NEXTSYMBOL }
case_ENTRY_2:;
// 162 entry(18): { nextsymbol }
case_ENTRY_18:;
// 163 %if left=0 %start
if (LEFT != 0) goto L_000F;
// 164 left = Fileread(streamtable(inid),addr(inbuf(0)) ,4096)
LEFT = FILEREAD(STREAMTABLE[INID], _imp_ADDR(/*?*/ &INBUF[0]), 4096);
// 165 %if left=0 %start
if (LEFT != 0) goto L_0010;
// 166 %if endgiven=0 %start
if (ENDGIVEN != 0) goto L_0011;
// 167 endgiven=1
ENDGIVEN = 1;
// 168 printstring("End of input file")
_imp_PRINTSTRING(_imp_str_literal("End of input file"));
// 169 %result=0
return 0;
// 170 %finish %else %stop
L_0011:;
_imp_stop(0);
// 171 %finish
L_0010:;
// 172 %if left = -1 %then printstring(" read fails ") %and %result=0
if (LEFT != -1) goto L_0012;
_imp_PRINTSTRING(_imp_str_literal(" read fails "));
return 0;
L_0012:;
// 173 inptr=-1
INPTR = -1;
// 174 %finish
L_000F:;
// 175
// 176 %if ep=1 %start
if (EP != 1) goto L_0013;
// 177 inptr=inptr+1
INPTR = INPTR + 1;
// 178 left=left-1
LEFT = LEFT - 1;
// 179 %result = inbuf(inptr)
return INBUF[INPTR];
// 180 %finishelsestart
L_0013:;
// 181 %result=inbuf(inptr+1)
return INBUF[INPTR + 1];
// 182 %finish
// 183
// 184 entry(3): { PRINTSYMBOL }
case_ENTRY_3:;
// 185 entry(5): { PRINTCH }
case_ENTRY_5:;
// 186 %result=0 %if OutID<0
if (OUTID >= 0) goto L_0014;
return 0;
L_0014:;
// 187 Line(Lptr) = n
LINE[LPTR] = N;
// 188 Lptr = Lptr + 1
LPTR = LPTR + 1;
// 189 %if ch = NL %or Lptr >= Maxlinelen %start
if (CH == 10) goto L_0015;
if (LPTR < 132) goto L_0016;
L_0015:;
// 190 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 191 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0017;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0017:;
// 192 Lptr = 0
LPTR = 0;
// 193 %finish
L_0016:;
// 194 %result=0
return 0;
// 195
// 196 entry(15): {only valid symbols PRINTSTRING }
case_ENTRY_15:;
// 197 entry(7): { PRINTSTRING }
case_ENTRY_7:;
// 198 %result=0 %if OutID<0
if (OUTID >= 0) goto L_0018;
return 0;
L_0018:;
// 199 bytead = n
BYTEAD = N;
// 200 Len = byteinteger(bytead)
LEN = *_imp_BYTEINTEGER(BYTEAD);
// 201 %result=0 %if len = 0
if (LEN != 0) goto L_0019;
return 0;
L_0019:;
// 202 %cycle i = 1,1,Len
// %for I = 1, 1, LEN %cycle
{
int _final = LEN;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, LEN");
I = 0;
L_001A:
if (I == _final) goto L_001B;
I += 1;
// 203 ch = byteinteger(bytead+i)
CH = *_imp_BYTEINTEGER(BYTEAD + I);
// 204 Line(Lptr) = ch
LINE[LPTR] = CH;
// 205 Lptr = Lptr + 1
LPTR = LPTR + 1;
// 206 %if ch = NL %or Lptr >= Maxlinelen %start
if (CH == 10) goto L_001D;
if (LPTR < 132) goto L_001E;
L_001D:;
// 207 j = FileWRITE(OutID,addr(Line(0)) ,Lptr)
J = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 208 %if j#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (J == LPTR) goto L_001F;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_001F:;
// 209 Lptr = 0
LPTR = 0;
// 210 %finish
L_001E:;
// 211 %repeat
goto L_001A;
}
L_001B:;
// 212 %result=0
return 0;
// 213
// 214 entry(8): { SELECTINPUT }
case_ENTRY_8:;
// 215 InID = n
INID = N;
// 216 %result=0
return 0;
// 217
// 218
// 219 entry(9): %if n=0 %then n=1 { map 0 to STDOUT }
case_ENTRY_9:;
if (N != 0) goto L_0020;
N = 1;
L_0020:;
// 220 { SELECTOUTPUT }
// 221 %if Lptr>0 %start
if (LPTR <= 0) goto L_0021;
// 222 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 223 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0022;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0022:;
// 224 Lptr = 0
LPTR = 0;
// 225 %finish
L_0021:;
// 226 OutID = n
OUTID = N;
// 227 %result=0
return 0;
// 228
// 229 entry(11): %result=0 %if OutID<0
case_ENTRY_11:;
if (OUTID >= 0) goto L_0023;
return 0;
L_0023:;
// 230 { Flush buffer }
// 231 %if Lptr>0 %start
if (LPTR <= 0) goto L_0024;
// 232 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 233 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0025;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0025:;
// 234 Lptr = 0
LPTR = 0;
// 235 %finish
L_0024:;
// 236 %result=0
return 0;
// 237
// 238 entry(16): %result=0 %if OutID<0
case_ENTRY_16:;
if (OUTID >= 0) goto L_0026;
return 0;
L_0026:;
// 239 { CLOSE }
// 240 %if Lptr>0 %start
if (LPTR <= 0) goto L_0027;
// 241 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 242 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0028;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0028:;
// 243 Lptr = 0
LPTR = 0;
// 244 %finish
L_0027:;
// 245 CLOSE(n) %unless n < 3
if (N < 3) goto L_0029;
CLOSE(N);
L_0029:;
// 246 %result=0
return 0;
// 247
// 248 entry(17): { PRINTSYMBOL n times }
case_ENTRY_17:;
// 249 %result=0 %if OutID<0
if (OUTID >= 0) goto L_002A;
return 0;
L_002A:;
// 250 ch = n&255
CH = N & 255;
// 251 %if n> 0 %thenstart
if (N <= 0) goto L_002B;
// 252 %cycle i=1,1,(n>>8)&255
// %for I = 1, 1, (unsigned int)N >> 8 & 255 %cycle
{
int _final = (unsigned int)N >> 8 & 255;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, (unsigned int)N >> 8 & 255");
I = 0;
L_002C:
if (I == _final) goto L_002D;
I += 1;
// 253 Line(Lptr) = ch
LINE[LPTR] = CH;
// 254 Lptr = Lptr + 1
LPTR = LPTR + 1;
// 255 %if Lptr >= Maxlinelen %start
if (LPTR < 132) goto L_002F;
// 256 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 257 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0030;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0030:;
// 258 Lptr = 0
LPTR = 0;
// 259 %finish
L_002F:;
// 260 %repeat
goto L_002C;
}
L_002D:;
// 261 %if ch=NL %start
if (CH != 10) goto L_0031;
// 262 i = FileWRITE(OutID,addr(Line(0)) ,Lptr)
I = FILEWRITE(OUTID, _imp_ADDR(/*?*/ &LINE[0]), LPTR);
// 263 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr
if (I == LPTR) goto L_0032;
IOERR(EP, N, _imp_str_literal(" Write fails "));
OUTID = 2;
L_0032:;
// 264 Lptr = 0
LPTR = 0;
// 265 %finish
L_0031:;
// 266
// 267 %finish
L_002B:;
// 268 %result=0
return 0;
// 269 entry(19): ! return output line ptr
case_ENTRY_19:;
// 270 %result=Lptr
return LPTR;
// 271 %end; !Iocp
case_ENTRY_dispatch:
if (ENTRY_index < 1 || ENTRY_index > 19)
_imp_signalf(6, 3, ENTRY_index, "->ENTRY(%d) out of bounds at %s line %d", ENTRY_index, ENTRY_file, ENTRY_line);
goto *ENTRY[ENTRY_index - 1];
} /* end of IOCP */
// 272 !
// 273 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 274 !
// 275
// 276
// 277
// 278 !%externalroutine Fdiag %alias "f_fdiag"(%integer LNB,gla,PC,ADIAGS,first,%integername flag)
// 279 !%end;! Fdiag
// 280 !
// 281 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
// 282 !
// 283 %endoffile