#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1
// 2 ! %include "impcore.types.inc"
// 3 ! Curious naming strategy because we don't want to clobber
// 4 ! the built-in functions and maps like "integer" or "int"
// 5 ! Types extracted from general names
// 6 %constinteger integer type = 1
// 7 %constinteger real type = 2
// 8 %constinteger string type = 3
// 9 %constinteger record type = 4
// 10 %constinteger byte type = 5
// 11 %constinteger short type = 6
// 12 %constinteger long type = 7
// 13 %constinteger long real type = 8
// 14
// 15 ! Note the size of the various types
// 16 %constinteger integersize = 4
// 17 %constinteger realsize = 4
// 18 ! we don't define stringsize as it could be in range 1..255
// 19 ! However, max value of stringsize = bytesize + 255*bytesize
// 20 ! we don't define recordsize as it depends on the record format
// 21 %constinteger bytesize = 1
// 22 %constinteger shortsize = 2
// 23 %constinteger longsize = 4
// 24 %constinteger longrealsize = 8
// 25
// 26 ! Access the file primitives (written in C) via the IMP wrapper
// 27 %external %integer %fn %spec get error
extern int GETERROR(void);
// 28 %external %integer %fn %spec get stderr handle
extern int GETSTDERRHANDLE(void);
// 29 %external %integer %fn %spec get stdin handle
extern int GETSTDINHANDLE(void);
// 30 %external %integer %fn %spec get stdout handle
extern int GETSTDOUTHANDLE(void);
// 31 %external %integer %fn %spec openfile( %integer mode address, %integer file name address )
extern int OPENFILE(int MODEADDRESS, int FILENAMEADDRESS);
// 32 %external %integer %fn %spec tell( %integer handle )
extern int TELL(int HANDLE);
// 33 %external %routine %spec file rewind( %integer handle )
extern void FILEREWIND(int HANDLE);
// 34 %external %routine %spec file seek( %integer handle, displacement, pos )
extern void FILESEEK(int HANDLE, int DISPLACEMENT, int POS);
// 35 %external %routine %spec close( %integer handle )
extern void CLOSE(int HANDLE);
// 36 %external %predicate %spec eof( %integer handle )
extern int EOF(int HANDLE);
// 37 %external %integer %fn %spec readbytes( %integer handle, count, itemsz, %byte %name buffer )
extern int READBYTES(int HANDLE, int COUNT, int ITEMSZ, unsigned char *BUFFER);
// 38 %external %integer %fn %spec writebytes( %integer handle, count, itemsz,%byte %name buffer )
extern int WRITEBYTES(int HANDLE, int COUNT, int ITEMSZ, unsigned char *BUFFER);
// 39 %external %integer %fn %spec get char( %integer handle )
extern int GETCHAR(int HANDLE);
// 40 %external %routine %spec put char( %integer handle,ch )
extern void PUTCHAR(int HANDLE, int CH);
// 41 %external %routine %spec flush( %integer handle )
extern void FLUSH(int HANDLE);
// 42
// 43 %external %integer %spec rtl diagnose %alias "_imp_rtlflags"
extern int RTLDIAGNOSE __asm__("_imp_rtlflags");
// 44
// 45 %predicate ok read type( %integer type )
static int OKREADTYPE(int TYPE) {
// 46 %true %if (type = integer type)
if (TYPE != 1) goto L_0001;
return 1 /*TRUE*/;
L_0001:;
// 47 %true %if (type = real type)
if (TYPE != 2) goto L_0002;
return 1 /*TRUE*/;
L_0002:;
// 48 %true %if (type = string type)
if (TYPE != 3) goto L_0003;
return 1 /*TRUE*/;
L_0003:;
// 49 %true %if (type = record type)
if (TYPE != 4) goto L_0004;
return 1 /*TRUE*/;
L_0004:;
// 50 %true %if (type = byte type)
if (TYPE != 5) goto L_0005;
return 1 /*TRUE*/;
L_0005:;
// 51 %true %if (type = short type)
if (TYPE != 6) goto L_0006;
return 1 /*TRUE*/;
L_0006:;
// 52 %true %if (type = long type)
if (TYPE != 7) goto L_0007;
return 1 /*TRUE*/;
L_0007:;
// 53 %true %if (type = long real type)
if (TYPE != 8) goto L_0008;
return 1 /*TRUE*/;
L_0008:;
// 54
// 55 %false
return 0 /*FALSE*/;
// 56 %end { of "ok read type" }
} /* end of OKREADTYPE */
// 57
// 58 %predicate ok write type( %integer type )
static int OKWRITETYPE(int TYPE) {
// 59 %true %if (type = integer type)
if (TYPE != 1) goto L_0009;
return 1 /*TRUE*/;
L_0009:;
// 60 %true %if (type = real type)
if (TYPE != 2) goto L_000A;
return 1 /*TRUE*/;
L_000A:;
// 61 %true %if (type = string type)
if (TYPE != 3) goto L_000B;
return 1 /*TRUE*/;
L_000B:;
// 62 %true %if (type = record type)
if (TYPE != 4) goto L_000C;
return 1 /*TRUE*/;
L_000C:;
// 63 %true %if (type = byte type)
if (TYPE != 5) goto L_000D;
return 1 /*TRUE*/;
L_000D:;
// 64 %true %if (type = short type)
if (TYPE != 6) goto L_000E;
return 1 /*TRUE*/;
L_000E:;
// 65 %true %if (type = long type)
if (TYPE != 7) goto L_000F;
return 1 /*TRUE*/;
L_000F:;
// 66 %true %if (type = long real type)
if (TYPE != 8) goto L_0010;
return 1 /*TRUE*/;
L_0010:;
// 67
// 68 %false
return 0 /*FALSE*/;
// 69 %end { of "ok write type" }
} /* end of OKWRITETYPE */
// 70
// 71 ! To ensure that the compiler can compile itself
// 72 ! We need a minimum number of INPUT/OUTPUT Streams
// 73 ! These minimum numbers depend on the depth of %include files
// 74 ! for MAX INPUT STREAM
// 75 ! The number of output files used by the takeon, pass1, pass2
// 76 ! programs will affect the value of MAX OUTPUI STREAM
// 77 ! Currently, the bare minimum value for MAX INPUT STREAM is 4
// 78 ! Currently, the bare minimum value for MAX OUTPUT STREAM is 3
// 79
// 80 ! It is perfectly legal to increase the values of MAX XXX STREAM
// 81 ! to be more than the minimum MAX XXX STREAM values given above
// 82 %constant %integer MAX INPUT STREAM = 10
// 83 %constant %integer MAX OUTPUT STREAM = 10
// 84
// 85 %constant %integer IS INPUT = 0 << 0
// 86 %constant %integer IS OUTPUT = 1 << 0
// 87 %constant %integer IS TEXT = 0 << 1
// 88 %constant %integer IS BINARY = 1 << 1
// 89
// 90 %constant %integer uninitialised = 0
// 91 %constant %integer initialised = 1
// 92
// 93 %record %format impstream ( %integer empty,lookahead, flags, %string(255) file name, %integer handle )
struct IMPSTREAM {
union {
struct {
int EMPTY;
int LOOKAHEAD;
int FLAGS;
_imp_string255 FILENAME;
int HANDLE;
};
};
};
// 94 %record %format impinput ( %integer current stream,
struct IMPINPUT {
union {
struct {
int CURRENTSTREAM;
struct IMPSTREAM STREAMS[11];
};
};
};
// 95+ %record(impstream) %array streams(0:MAX INPUT STREAM) )
// 96 %record %format impoutput ( %integer current stream, previous stream,
struct IMPOUTPUT {
union {
struct {
int CURRENTSTREAM;
int PREVIOUSSTREAM;
struct IMPSTREAM STREAMS[11];
};
};
};
// 97+ %record(impstream) %array streams(0:MAX OUTPUT STREAM) )
// 98
// 99 %own %record (impinput) in
static struct IMPINPUT IN;
// 100 %own %record (impoutput) out
static struct IMPOUTPUT OUT;
// 101 %own %record (impstream) null stream
static struct IMPSTREAM NULLSTREAM;
// 102 %own %record (impstream) error stream
static struct IMPSTREAM ERRORSTREAM;
// 103
// 104 %own %integer initialised state = uninitialised
static int INITIALISEDSTATE = 0;
// 105 %external %integer fileerror %alias "_errno"
int FILEERROR __asm__("_errno");
// 106
// 107 %own %integer eof flag = 1
static int EOFFLAG = 1;
// 108
// 109 !------------------------------------------------------------------------------
// 110 ! Initialisation routines
// 111 !------------------------------------------------------------------------------
// 112
// 113 !--------------------------------------------------------------------------
// 114 %external %predicate need to initialise
int NEEDTOINITIALISE(void) {
// 115 %true %if (initialised state = uninitialised)
if (INITIALISEDSTATE != 0) goto L_0011;
return 1 /*TRUE*/;
L_0011:;
// 116 %false
return 0 /*FALSE*/;
// 117 %end { of "need to initialise" }
} /* end of NEEDTOINITIALISE */
// 118
// 119 !--------------------------------------------------------------------------
// 120 %routine initialise stream( %record(impstream) %name s )
static void INITIALISESTREAM(struct IMPSTREAM *S) {
// 121 s_handle = 0
S->HANDLE = 0;
// 122 length(s_file name) = 0
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S->FILENAME) = 0;
// 123 s_flags = 0
S->FLAGS = 0;
// 124 s_lookahead = -1
S->LOOKAHEAD = -1;
// 125 s_empty = 1
S->EMPTY = 1;
// 126 %end { of "initialise stream" }
return;
} /* end of INITIALISESTREAM */
// 127
// 128 !--------------------------------------------------------------------------
// 129 %routine finalise stream( %record(impstream) %name s )
static void FINALISESTREAM(struct IMPSTREAM *S) {
// 130 %if (s_handle # 0) %then close( s_handle )
if (S->HANDLE == 0) goto L_0012;
CLOSE(S->HANDLE);
L_0012:;
// 131 initialise stream( s )
INITIALISESTREAM(S);
// 132 %end { of "finalise stream" }
return;
} /* end of FINALISESTREAM */
// 133
// 134 !--------------------------------------------------------------------------
// 135 %routine initialise input system
static void INITIALISEINPUTSYSTEM(void) {
// 136 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 137 %integer i
int I;
// 138
// 139 in_current stream = 0
IN.CURRENTSTREAM = 0;
// 140
// 141 %for i = 0,1,MAX INPUT STREAM %cycle
// %for I = 0, 1, 10 %cycle
{
I = -1;
L_0013:
if (I == 10) goto L_0014;
I += 1;
// 142 streamX == in_streams(i)
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[I];
// 143 initialise stream( streamX )
INITIALISESTREAM(STREAMX);
// 144 %repeat
goto L_0013;
}
L_0014:;
// 145 in_streams(0)_handle = get std in handle
IN.STREAMS[0].HANDLE = GETSTDINHANDLE();
// 146 in_streams(0)_file name = "stdin"
_imp_strncpy(/*?*/ &IN.STREAMS[0].FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("stdin");
(void *)&tmp;
}),
/*max:*/ 255);
// 147 %end { of "initialise input stream" }
return;
} /* end of INITIALISEINPUTSYSTEM */
// 148
// 149 !--------------------------------------------------------------------------
// 150 %routine terminate input system
static void TERMINATEINPUTSYSTEM(void) {
// 151 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 152 %integer i
int I;
// 153
// 154 in_current stream = -1
IN.CURRENTSTREAM = -1;
// 155
// 156 %for i = 1,1,MAX INPUT STREAM %cycle
// %for I = 1, 1, 10 %cycle
{
I = 0;
L_0016:
if (I == 10) goto L_0017;
I += 1;
// 157 streamX == in_streams(i)
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[I];
// 158 finalise stream( streamX )
FINALISESTREAM(STREAMX);
// 159 %repeat
goto L_0016;
}
L_0017:;
// 160 %end { of "terminate input stream" }
return;
} /* end of TERMINATEINPUTSYSTEM */
// 161
// 162 !--------------------------------------------------------------------------
// 163 %routine initialise output system
static void INITIALISEOUTPUTSYSTEM(void) {
// 164 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 165
// 166 %integer i
int I;
// 167
// 168 out_current stream = 0
OUT.CURRENTSTREAM = 0;
// 169 out_previous stream = 0
OUT.PREVIOUSSTREAM = 0;
// 170
// 171 %for i = 0,1,MAX OUTPUT STREAM %cycle
// %for I = 0, 1, 10 %cycle
{
I = -1;
L_0018:
if (I == 10) goto L_0019;
I += 1;
// 172 streamX == out_streams(i)
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[I];
// 173 initialise stream( streamX )
INITIALISESTREAM(STREAMX);
// 174 %repeat
goto L_0018;
}
L_0019:;
// 175
// 176 streamX == out_streams(0)
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[0];
// 177
// 178 streamX_handle = get std out handle
STREAMX->HANDLE = GETSTDOUTHANDLE();
// 179 streamX_file name = "stdout"
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("stdout");
(void *)&tmp;
}),
/*max:*/ 255);
// 180 streamX_flags = IS OUTPUT ! IS TEXT
STREAMX->FLAGS = 1 | 0;
// 181
// 182 ! Don't forget to initialise the debug output stream
// 183 streamX == error stream
STREAMX = (struct IMPSTREAM *)/*?*/ &ERRORSTREAM;
// 184 initialise stream( streamX )
INITIALISESTREAM(STREAMX);
// 185 streamX_handle = get std err handle
STREAMX->HANDLE = GETSTDERRHANDLE();
// 186 streamX_file name = "stderr"
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("stderr");
(void *)&tmp;
}),
/*max:*/ 255);
// 187 streamX_flags = IS OUTPUT ! IS TEXT
STREAMX->FLAGS = 1 | 0;
// 188 %end { of "initialise output stream" }
return;
} /* end of INITIALISEOUTPUTSYSTEM */
// 189
// 190 !--------------------------------------------------------------------------
// 191 %routine terminate output system
static void TERMINATEOUTPUTSYSTEM(void) {
// 192 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 193 %integer i
int I;
// 194
// 195 out_current stream = -1
OUT.CURRENTSTREAM = -1;
// 196 out_previous stream = -1
OUT.PREVIOUSSTREAM = -1;
// 197
// 198 %for i = 1,1,MAX OUTPUT STREAM %cycle
// %for I = 1, 1, 10 %cycle
{
I = 0;
L_001A:
if (I == 10) goto L_001B;
I += 1;
// 199 streamX == out_streams(i)
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[I];
// 200 finalise stream( streamX )
FINALISESTREAM(STREAMX);
// 201 %repeat
goto L_001A;
}
L_001B:;
// 202 %end { of "terminate output system" }
return;
} /* end of TERMINATEOUTPUTSYSTEM */
// 203
// 204 !--------------------------------------------------------------------------
// 205 %external %routine initialise io system
void INITIALISEIOSYSTEM(void) {
// 206
// 207 null stream_handle = 0
NULLSTREAM.HANDLE = 0;
// 208 null stream_file name = "null"
_imp_strncpy(/*?*/ &NULLSTREAM.FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("null");
(void *)&tmp;
}),
/*max:*/ 255);
// 209
// 210 initialise input system
INITIALISEINPUTSYSTEM();
// 211 initialise output system
INITIALISEOUTPUTSYSTEM();
// 212
// 213 initialised state = initialised
INITIALISEDSTATE = 1;
// 214 %end { of "initialise io system" }
return;
} /* end of INITIALISEIOSYSTEM */
// 215
// 216 !--------------------------------------------------------------------------
// 217 %external %routine terminate io system
void TERMINATEIOSYSTEM(void) {
// 218 terminate input system
TERMINATEINPUTSYSTEM();
// 219 terminate output system
TERMINATEOUTPUTSYSTEM();
// 220
// 221 initialised state = uninitialised
INITIALISEDSTATE = 0;
// 222 %end { of "terminate io system" }
return;
} /* end of TERMINATEIOSYSTEM */
// 223
// 224 !--------------------------------------------------------------------------
// 225 %external %routine allow eof event
void ALLOWEOFEVENT(void) {
// 226 eof flag = 1
EOFFLAG = 1;
// 227 %end { of "allow eof event" }
return;
} /* end of ALLOWEOFEVENT */
// 228
// 229 !--------------------------------------------------------------------------
// 230 %external %routine block eof event
void BLOCKEOFEVENT(void) {
// 231 eof flag = 0
EOFFLAG = 0;
// 232 %end { of "block eof event" }
return;
} /* end of BLOCKEOFEVENT */
// 233
// 234 !--------------------------------------------------------------------------
// 235 %external %integer %function get max input stream
int GETMAXINPUTSTREAM(void) {
// 236 %result = MAX INPUT STREAM
return 10;
// 237 %end { of "get max input stream" }
} /* end of GETMAXINPUTSTREAM */
// 238
// 239 !--------------------------------------------------------------------------
// 240 %external %integer %function get max output stream
int GETMAXOUTPUTSTREAM(void) {
// 241 %result = MAX OUTPUT STREAM
return 10;
// 242 %end { of "get max output stream" }
} /* end of GETMAXOUTPUTSTREAM */
// 243
// 244 !--------------------------------------------------------------------------
// 245 ! This converts an IMP string in-situ to become a C string
// 246 ! We just need the address of the IMP string
// 247 %routine imptocstring( %string(*) %name impstring )
static void IMPTOCSTRING(_imp_string *IMPSTRING) {
// 248 %integer len,i
int LEN;
int I;
// 249 %byte %integer %name src
unsigned char *SRC;
// 250
// 251 %if addr( impstring ) # 0 %start
if (_imp_ADDR(IMPSTRING) == 0) goto L_001C;
// 252 ! Find the length of the IMP format string
// 253 len = length( impstring )
LEN = *_imp_LENGTH((_imp_string255 *)/*p*/ IMPSTRING);
// 254
// 255 ! Convert to a C format string
// 256 ! We do this in one step 0..len-1
// 257 ! copying from impstring(i+1) to impstring(i)
// 258 ! lastly, store 0 in impstring(len)
// 259 %for i = 0,1,len - 1 %cycle
// %for I = 0, 1, LEN - 1 %cycle
{
int _final = LEN - 1;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, LEN - 1");
I = -1;
L_001D:
if (I == _final) goto L_001E;
I += 1;
// 260 src == byteinteger( addr( impstring ) + i + 1)
SRC = (unsigned char *)_imp_BYTEINTEGER(_imp_ADDR(IMPSTRING) + I + 1);
// 261 charno( impstring, i ) = src
*_imp_CHARNO((_imp_string255 *)/*p*/ IMPSTRING, I) = *SRC;
// 262 %repeat
goto L_001D;
}
L_001E:;
// 263 charno( impstring, len ) = 0
*_imp_CHARNO((_imp_string255 *)/*p*/ IMPSTRING, LEN) = 0;
// 264 %finish
L_001C:;
// 265 %end { of "imp to c string" }
return;
} /* end of IMPTOCSTRING */
// 266
// 267 !--------------------------------------------------------------------------
// 268 %own %string(31) input prompt = "prompt ->"
static _imp_string31 INPUTPROMPT = _imp_str_init("prompt ->");
// 269 %own %integer tty needs a prompt = 1
static int TTYNEEDSAPROMPT = 1;
// 270
// 271 !--------------------------------------------------------------------------
// 272 %external %routine prompt( %string(31) s )
void PROMPT(_imp_string31 S) {
// 273 input prompt = s
_imp_strncpy(/*?*/ &INPUTPROMPT, ({
__typeof__(_imp_string31) tmp; /*B*/
tmp = S;
(void *)&tmp;
}),
/*max:*/ 31);
// 274 %end { of "prompt" }
return;
} /* end of PROMPT */
// 275
// 276 !--------------------------------------------------------------------------
// 277 %external %string(31) %function current prompt
_imp_string31 CURRENTPROMPT(void) {
// 278
// 279 %result = input prompt
return *(_imp_string31 *)/*?*/ &INPUTPROMPT;
// 280 %end { of "current prompt" }
} /* end of CURRENTPROMPT */
// 281
// 282 !------------------------------------------------------------------------------
// 283 ! Input routines
// 284 !------------------------------------------------------------------------------
// 285
// 286 !--------------------------------------------------------------------------
// 287 %external %integer %function readbuffer( %name ptr, %integer count )
int READBUFFER(_imp_name *PTR, int COUNT) {
// 288 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 289 %integer i,actualcount
int I;
int ACTUALCOUNT;
// 290 %integer len,adr,type
int LEN;
int ADR;
int TYPE;
// 291 %integer itemsz
int ITEMSZ;
// 292
// 293 len = size of(ptr)
LEN = _imp_SIZEOF(PTR);
// 294 adr = addr(ptr)
ADR = _imp_ADDR(PTR);
// 295 type = type of(ptr)
TYPE = _imp_TYPEOF(PTR);
// 296
// 297 %if (rtl diagnose&128 # 0) %start
if (RTLDIAGNOSE & 128 == 0) goto L_0020;
// 298 select output( 0 )
_imp_SELECTOUTPUT(0);
// 299 print string("READBUFFER: address(ptr)=".int2ascii(adr,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("READBUFFER: address(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(ADR, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 300 print string("READBUFFER: size of(ptr)=".int2ascii(len,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("READBUFFER: size of(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(LEN, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 301 print string("READBUFFER: type of(ptr)=".int2ascii(type,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("READBUFFER: type of(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(TYPE, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 302 print string("READBUFFER: count=".itos(count,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("READBUFFER: count="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(COUNT, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 303 select output( old output stream )
_imp_SELECTOUTPUT(_imp_OLDOUTPUTSTREAM());
// 304 %finish
L_0020:;
// 305
// 306 %signal 5,5,type %unless ok read type(type)
if (OKREADTYPE(TYPE)) goto L_0021;
_imp_signal(5, 5, TYPE, "");
L_0021:;
// 307
// 308 ! assume we are reading data into a byte array (or string)
// 309 ! itemsz = get item size(ptr)
// 310 itemsz = len
ITEMSZ = LEN;
// 311
// 312 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0022;
INITIALISEIOSYSTEM();
L_0022:;
// 313
// 314 ! can't select an invalid stream id (not stdin)
// 315 %signal 9, 9 %unless (0 < in_current stream <= MAX INPUT STREAM)
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = IN.CURRENTSTREAM)) goto L_0015;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0023;
}
L_0015:;
_imp_signal(9, 9, 0, "");
L_0023:;
// 316 ! can't select a closed file
// 317 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 318
// 319 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0024;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_0024:;
// 320
// 321 ! We actually load the buffer as an array of bytes
// 322 ! We need the stream handle, count of items space, item size, buffer address
// 323 ! Where, count * itemsz = size in bytes of buffer storage
// 324 actualcount = readbytes( streamX_handle, count, itemsz, byteinteger( addr(ptr) ) )
ACTUALCOUNT = READBYTES(STREAMX->HANDLE, COUNT, ITEMSZ, _imp_BYTEINTEGER(_imp_ADDR(PTR)));
// 325
// 326 ! Now to store the read bytes into the appropriate data type variable
// 327 %if (type = integer type) %start
if (TYPE != 1) goto L_0025;
// 328 %finish %else %if (type = real type) %start
goto L_0026;
L_0025:;
if (TYPE != 2) goto L_0027;
// 329 %finish %else %if (type = string type) %start
goto L_0026;
L_0027:;
if (TYPE != 3) goto L_0028;
// 330 ! If we are storing in an IMP string then we need to convert the stored buffer
// 331 ! from C string format (zero start index) to IMP string format
// 332 %if (0 <= len <= 255) %start
{
// Double-sided test on LEN (Part I)
int tmp;
if (0 > (tmp = LEN)) goto L_0029;
// Double-sided test on LEN (Part II)
if (tmp > 255) goto L_0029;
}
// 333 ! It is a string!!
// 334 ! Therefore we need to move the chars from n to n+1 location
// 335 ! Thus, we can store the IMP string length in location 0 (its expected location)
// 336 ! Use actualcount as number of chars in the string
// 337 ! JDM should check that actualcount < count else buffer overflow
// 338 %for i=actualcount-1,-1,0 %cycle
// %for I = ACTUALCOUNT - 1, -1, 0 %cycle
{
int _initial = ACTUALCOUNT - 1;
if (invalid_for_loop(_initial, -1, 0)) _imp_signal(5, 1, 0, "Illegal cycle I = ACTUALCOUNT - 1, -1, 0");
I = _initial - (-1);
L_002A:
if (I == 0) goto L_002B;
I -= 1;
// 339 charno( string(addr(ptr)), i + 1 ) = charno( string(addr(ptr)), i )
*_imp_CHARNO((_imp_string255 *)/*p*/ _imp_STRING(_imp_ADDR(PTR)), I + 1) =
*_imp_CHARNO((_imp_string255 *)/*p*/ _imp_STRING(_imp_ADDR(PTR)), I);
// 340 %repeat
goto L_002A;
}
L_002B:;
// 341 charno( string(addr(ptr)),0 ) = actualcount
*_imp_CHARNO((_imp_string255 *)/*p*/ _imp_STRING(_imp_ADDR(PTR)), 0) = ACTUALCOUNT;
// 342 %finish
L_0029:;
// 343 %finish %else %if (type = record type) %start
goto L_0026;
L_0028:;
if (TYPE != 4) goto L_002D;
// 344 %finish %else %if (type = byte type) %start
goto L_0026;
L_002D:;
if (TYPE != 5) goto L_002E;
// 345 %finish %else %if (type = short type) %start
goto L_0026;
L_002E:;
if (TYPE != 6) goto L_002F;
// 346 %finish %else %if (type = long type) %start
goto L_0026;
L_002F:;
if (TYPE != 7) goto L_0030;
// 347 %finish %else %if (type = long real type) %start
goto L_0026;
L_0030:;
if (TYPE != 8) goto L_0031;
// 348 %finish
L_0031:;
L_0026:;
// 349
// 350 %result = actualcount
return ACTUALCOUNT;
// 351 %end { of "read buffer" }
} /* end of READBUFFER */
// 352
// 353 !--------------------------------------------------------------------------
// 354 %external %integer %function input stream
int INPUTSTREAM(void) {
// 355 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0032;
INITIALISEIOSYSTEM();
L_0032:;
// 356
// 357 %result = in_current stream
return IN.CURRENTSTREAM;
// 358 %end { of "input stream" }
} /* end of INPUTSTREAM */
// 359
// 360 !--------------------------------------------------------------------------
// 361 %external %routine reset input
void RESETINPUT(void) {
// 362 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 363
// 364 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0033;
INITIALISEIOSYSTEM();
L_0033:;
// 365
// 366 ! can't select an invalid stream id (not stdin)
// 367 %signal 9, 9 %unless (0 < in_current stream <= MAX INPUT STREAM)
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = IN.CURRENTSTREAM)) goto L_0034;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0035;
}
L_0034:;
_imp_signal(9, 9, 0, "");
L_0035:;
// 368 ! can't select a closed file
// 369 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 370
// 371 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0036;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_0036:;
// 372
// 373 file rewind( streamX_handle )
FILEREWIND(STREAMX->HANDLE);
// 374 %end { of "reset input" }
return;
} /* end of RESETINPUT */
// 375
// 376 !--------------------------------------------------------------------------
// 377 %external %routine seek input( %integer displacement, pos )
void SEEKINPUT(int DISPLACEMENT, int POS) {
// 378 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 379
// 380 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0037;
INITIALISEIOSYSTEM();
L_0037:;
// 381
// 382 ! can't select an invalid stream id (not stdin)
// 383 %signal 9, 9 %unless (0 < in_current stream <= MAX INPUT STREAM)
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = IN.CURRENTSTREAM)) goto L_0038;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0039;
}
L_0038:;
_imp_signal(9, 9, 0, "");
L_0039:;
// 384 ! can't select a closed file
// 385 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 386
// 387 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_003A;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_003A:;
// 388
// 389 %if (0 <= pos <= 2) %then file seek( streamX_handle, displacement, pos )
{
// Double-sided test on POS (Part I)
int tmp;
if (0 > (tmp = POS)) goto L_003B;
// Double-sided test on POS (Part II)
if (tmp > 2) goto L_003B;
}
FILESEEK(STREAMX->HANDLE, DISPLACEMENT, POS);
L_003B:;
// 390 %end { of "seek input" }
return;
} /* end of SEEKINPUT */
// 391
// 392 !--------------------------------------------------------------------------
// 393 %external %integer %function tell input
int TELLINPUT(void) {
// 394 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 395
// 396 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_003C;
INITIALISEIOSYSTEM();
L_003C:;
// 397
// 398 ! can't select an invalid stream id (not stdin)
// 399 %signal 9, 9 %unless (0 < in_current stream <= MAX INPUT STREAM)
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = IN.CURRENTSTREAM)) goto L_003D;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_003E;
}
L_003D:;
_imp_signal(9, 9, 0, "");
L_003E:;
// 400 ! can't select a closed file
// 401 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 402
// 403 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_003F;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_003F:;
// 404
// 405 %result = tell( streamX_handle )
return TELL(STREAMX->HANDLE);
// 406 %end { of "tell input" }
} /* end of TELLINPUT */
// 407
// 408 !--------------------------------------------------------------------------
// 409 %external %string(255) %function input name
_imp_string255 INPUTNAME(void) {
// 410 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 411 %string(255) name
_imp_string255 NAME;
// 412
// 413 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0040;
INITIALISEIOSYSTEM();
L_0040:;
// 414
// 415 ! can't select an invalid stream id
// 416 %signal 9, 9 %unless (0 <= in_current stream <= MAX INPUT STREAM)
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 > (tmp = IN.CURRENTSTREAM)) goto L_0041;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0042;
}
L_0041:;
_imp_signal(9, 9, 0, "");
L_0042:;
// 417 ! can't select a closed file
// 418 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 419
// 420 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0043;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_0043:;
// 421
// 422 name = streamX_file name
_imp_strncpy(/*?*/ &NAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = STREAMX->FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 423
// 424 %result = name
return *(_imp_string255 *)/*?*/ &NAME;
// 425 %end { of "input name" }
} /* end of INPUTNAME */
// 426
// 427 !--------------------------------------------------------------------------
// 428 %external %routine select input( %integer stream id )
void SELECTINPUT(int STREAMID) {
// 429 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 430
// 431 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0044;
INITIALISEIOSYSTEM();
L_0044:;
// 432
// 433 ! can't select an invalid stream id
// 434 %signal 9, 9 %unless (0 <= stream id <= MAX INPUT STREAM)
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 > (tmp = STREAMID)) goto L_0045;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_0046;
}
L_0045:;
_imp_signal(9, 9, 0, "");
L_0046:;
// 435 ! can't select a closed file
// 436 streamX == in_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[STREAMID];
// 437
// 438 %signal 9, 4, stream id %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0047;
_imp_signal(9, 4, STREAMID, "");
L_0047:;
// 439
// 440 in_current stream = stream id
IN.CURRENTSTREAM = STREAMID;
// 441 %end { of "select input" }
return;
} /* end of SELECTINPUT */
// 442
// 443 !--------------------------------------------------------------------------
// 444 %external %routine close input
void CLOSEINPUT(void) {
// 445 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 446
// 447 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0048;
INITIALISEIOSYSTEM();
L_0048:;
// 448
// 449 ! can't close terminal input
// 450 ! can't close an already closed file
// 451 %if (0 < in_current stream <= MAX INPUT STREAM ) %start
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = IN.CURRENTSTREAM)) goto L_0049;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp > 10) goto L_0049;
}
// 452 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 453
// 454 %if (streamX_handle # 0) %start
if (STREAMX->HANDLE == 0) goto L_004A;
// 455 close( streamX_handle )
CLOSE(STREAMX->HANDLE);
// 456 initialise stream( streamX )
INITIALISESTREAM(STREAMX);
// 457 %finish
L_004A:;
// 458 %finish
L_0049:;
// 459 %end { of "close input" }
return;
} /* end of CLOSEINPUT */
// 460
// 461 !--------------------------------------------------------------------------
// 462 %external %routine open input( %integer stream id, %string(255) file name )
void OPENINPUT(int STREAMID, _imp_string255 FILENAME) {
// 463 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 464 %integer handle
int HANDLE;
// 465 %integer flags = IS INPUT ! IS TEXT
int FLAGS;
FLAGS = 0 | 0;
// 466 %string(4) mode = "r"
_imp_string4 MODE;
_imp_strncpy(/*?*/ &MODE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("r");
(void *)&tmp;
}),
/*max:*/ 4);
// 467 %string(255) xxx
_imp_string255 XXX;
// 468 %string(4) yyy
_imp_string4 YYY;
// 469
// 470 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_004B;
INITIALISEIOSYSTEM();
L_004B:;
// 471
// 472 ! Error out if streamid not in legal range
// 473 %signal 9, 9, stream id %unless (0 < stream id <= MAX INPUT STREAM )
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 >= (tmp = STREAMID)) goto L_004C;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_004D;
}
L_004C:;
_imp_signal(9, 9, STREAMID, "");
L_004D:;
// 474
// 475 ! If file not open
// 476 streamX == in_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[STREAMID];
// 477
// 478 %if (streamX_handle = 0) %start
if (STREAMX->HANDLE != 0) goto L_004E;
// 479
// 480 xxx = filename
_imp_strncpy(/*?*/ &XXX, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 481 yyy = mode
_imp_strncpy(/*?*/ &YYY, ({
__typeof__(_imp_string4) tmp; /*B*/
tmp = MODE;
(void *)&tmp;
}),
/*max:*/ 4);
// 482
// 483 ! Tweak xxx,yyy to be C strings
// 484 ! Why? because we are sending them to a C function expecting C strings
// 485 imptocstring( xxx )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &XXX);
// 486 imptocstring( yyy )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &YYY);
// 487
// 488 handle = openfile( addr(yyy), addr(xxx) )
HANDLE = OPENFILE(_imp_ADDR(/*?*/ &YYY), _imp_ADDR(/*?*/ &XXX));
// 489
// 490 %if (handle = 0) %start
if (HANDLE != 0) goto L_004F;
// 491
// 492 select output( 0 )
_imp_SELECTOUTPUT(0);
// 493 print string("OPENINPUT: unable to open filename='".filename."' for stream(".itos(stream id,0).")")
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) 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_str_literal_ptr("OPENINPUT: unable to open filename='"),
(_imp_string *)/*?*/ &FILENAME);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("' for stream("));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(STREAMID, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(")"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 494 newline
_imp_NEWLINE();
// 495 select output( old output stream )
_imp_SELECTOUTPUT(_imp_OLDOUTPUTSTREAM());
// 496
// 497 %signal 9, 2, get error
_imp_signal(9, 2, GETERROR(), "");
// 498 %else
L_004F:;
// 499 streamX == in_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[STREAMID];
// 500
// 501 streamX_handle = handle
STREAMX->HANDLE = HANDLE;
// 502 streamX_file name = file name
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 503 streamX_flags = flags
STREAMX->FLAGS = FLAGS;
// 504 %finish
// 505 %finish
L_004E:;
// 506 %end { of "open input" }
return;
} /* end of OPENINPUT */
// 507
// 508 !--------------------------------------------------------------------------
// 509 %external %routine open binary input( %integer stream id, %string(255) file name )
void OPENBINARYINPUT(int STREAMID, _imp_string255 FILENAME) {
// 510 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 511 %integer handle
int HANDLE;
// 512 %integer flags = IS INPUT ! IS BINARY
int FLAGS;
FLAGS = 0 | 2;
// 513 %string(4) mode = "rb"
_imp_string4 MODE;
_imp_strncpy(/*?*/ &MODE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("rb");
(void *)&tmp;
}),
/*max:*/ 4);
// 514 %string(255) xxx
_imp_string255 XXX;
// 515 %string(4) yyy
_imp_string4 YYY;
// 516
// 517 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0050;
INITIALISEIOSYSTEM();
L_0050:;
// 518
// 519 %signal 9, 9, stream id %unless (0 < stream id <= MAX INPUT STREAM )
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 >= (tmp = STREAMID)) goto L_0051;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_0052;
}
L_0051:;
_imp_signal(9, 9, STREAMID, "");
L_0052:;
// 520
// 521 ! If file not open
// 522 streamX == in_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[STREAMID];
// 523
// 524 %if (streamX_handle = 0) %start
if (STREAMX->HANDLE != 0) goto L_0053;
// 525
// 526 xxx = filename
_imp_strncpy(/*?*/ &XXX, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 527 yyy = mode
_imp_strncpy(/*?*/ &YYY, ({
__typeof__(_imp_string4) tmp; /*B*/
tmp = MODE;
(void *)&tmp;
}),
/*max:*/ 4);
// 528
// 529 ! Tweak xxx,yyy to be C strings
// 530 ! Why? because we are sending them to a C function expecting C strings
// 531 imptocstring( xxx )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &XXX);
// 532 imptocstring( yyy )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &YYY);
// 533
// 534 handle = openfile( addr(yyy), addr(xxx) )
HANDLE = OPENFILE(_imp_ADDR(/*?*/ &YYY), _imp_ADDR(/*?*/ &XXX));
// 535
// 536 %if (handle = 0) %start
if (HANDLE != 0) goto L_0054;
// 537
// 538 select output( 0 )
_imp_SELECTOUTPUT(0);
// 539 print string("OPENBINARYINPUT: unable to open filename='".filename."' for stream(".itos(stream id,0).")")
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) 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_str_literal_ptr("OPENBINARYINPUT: unable to open filename='"),
(_imp_string *)/*?*/ &FILENAME);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("' for stream("));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(STREAMID, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(")"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 540 newline
_imp_NEWLINE();
// 541 select output( old output stream )
_imp_SELECTOUTPUT(_imp_OLDOUTPUTSTREAM());
// 542
// 543 %signal 9, 2, get error
_imp_signal(9, 2, GETERROR(), "");
// 544 %else
L_0054:;
// 545 streamX == in_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[STREAMID];
// 546
// 547 streamX_handle = handle
STREAMX->HANDLE = HANDLE;
// 548 streamX_file name = file name
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 549 streamX_flags = flags
STREAMX->FLAGS = FLAGS;
// 550 %finish
// 551 %finish
L_0053:;
// 552 %end { of "open binary input" }
return;
} /* end of OPENBINARYINPUT */
// 553
// 554 !--------------------------------------------------------------------------
// 555 %external %integer %function next symbol
int NEXTSYMBOL(void) {
// 556 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 557 %integer i
int I;
// 558
// 559 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0055;
INITIALISEIOSYSTEM();
L_0055:;
// 560
// 561 %signal 9, 9, in_current stream %unless (0 <= in_current stream <= MAX INPUT STREAM )
{
// Double-sided test on IN.CURRENTSTREAM (Part I)
int tmp;
if (0 > (tmp = IN.CURRENTSTREAM)) goto L_0056;
// Double-sided test on IN.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0057;
}
L_0056:;
_imp_signal(9, 9, IN.CURRENTSTREAM, "");
L_0057:;
// 562
// 563 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 564
// 565 %signal 9, 4, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0058;
_imp_signal(9, 4, IN.CURRENTSTREAM, "");
L_0058:;
// 566
// 567 ! Check to see if we already have a lookahead char (actually integer)
// 568 %if (streamX_empty = 1) %start
if (STREAMX->EMPTY != 1) goto L_0059;
// 569 %if (in_current stream = 0) %start
if (IN.CURRENTSTREAM != 0) goto L_005A;
// 570 %if (tty needs a prompt # 0) %start
if (TTYNEEDSAPROMPT == 0) goto L_005B;
// 571 tty needs a prompt = 0
TTYNEEDSAPROMPT = 0;
// 572
// 573 %for i = 1,1,length( input prompt ) %cycle
// %for I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&INPUTPROMPT) %cycle
{
int _final = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &INPUTPROMPT);
if (invalid_for_loop(1, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*//*?*/&INPUTPROMPT)");
I = 0;
L_005C:
if (I == _final) goto L_005D;
I += 1;
// 574 put char( error stream_handle, charno( input prompt, i ) )
PUTCHAR(ERRORSTREAM.HANDLE, *_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &INPUTPROMPT, I));
// 575 %repeat
goto L_005C;
}
L_005D:;
// 576
// 577 %finish
L_005B:;
// 578 %finish
L_005A:;
// 579
// 580 ! remember ch for future use
// 581 streamX_lookahead = get char ( streamX_handle )
STREAMX->LOOKAHEAD = GETCHAR(STREAMX->HANDLE);
// 582 streamX_empty = 0
STREAMX->EMPTY = 0;
// 583
// 584 ! Are we attempting to read after the end of file
// 585 %signal 9,0, in_current stream %if (eof flag = 1) %and (streamX_lookahead < 0)
if (EOFFLAG != 1) goto L_005F;
if (STREAMX->LOOKAHEAD >= 0) goto L_005F;
_imp_signal(9, 0, IN.CURRENTSTREAM, "");
L_005F:;
// 586
// 587 ! NL => we should prompt next time
// 588 %if (in_current stream = 0) %and (streamX_lookahead = nl) %then tty needs a prompt = 1
if (IN.CURRENTSTREAM != 0) goto L_0060;
if (STREAMX->LOOKAHEAD != 10) goto L_0060;
TTYNEEDSAPROMPT = 1;
L_0060:;
// 589
// 590 %finish
L_0059:;
// 591
// 592 streamX_empty = 0
STREAMX->EMPTY = 0;
// 593 %result = streamX_lookahead
return STREAMX->LOOKAHEAD;
// 594 %end { of "next symbol" }
} /* end of NEXTSYMBOL */
// 595
// 596 !--------------------------------------------------------------------------
// 597 %external %routine read symbol( %integer %name ch )
void READSYMBOL(int *CH) {
// 598 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 599 %integer type
int TYPE;
// 600
// 601 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0061;
INITIALISEIOSYSTEM();
L_0061:;
// 602
// 603 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 604 streamX_lookahead = next symbol
STREAMX->LOOKAHEAD = NEXTSYMBOL();
// 605
// 606 ! Are we attempting to read after the end of file
// 607 %signal 9,1, in_current stream %if (eof flag = 1) %and (streamX_lookahead < 0)
if (EOFFLAG != 1) goto L_0062;
if (STREAMX->LOOKAHEAD >= 0) goto L_0062;
_imp_signal(9, 1, IN.CURRENTSTREAM, "");
L_0062:;
// 608
// 609 ! indicate we need to read the next char in the input stream
// 610 ! on the next call to either next symbol, read symbol
// 611 streamX_empty = 1
STREAMX->EMPTY = 1;
// 612
// 613 type = typeof( ch )
TYPE = _imp_TYPEOF(CH);
// 614
// 615 %if (type = integer type) %start
if (TYPE != 1) goto L_0063;
// 616 ch = streamX_lookahead
*CH = STREAMX->LOOKAHEAD;
// 617 %finish %else %if (type = byte type) %start
goto L_0064;
L_0063:;
if (TYPE != 5) goto L_0065;
// 618 ch = streamX_lookahead&16_ff
*CH = STREAMX->LOOKAHEAD & 255;
// 619 %finish %else %if (type = short type) %start
goto L_0064;
L_0065:;
if (TYPE != 6) goto L_0066;
// 620 ch = streamX_lookahead&16_ffff
*CH = STREAMX->LOOKAHEAD & 65535;
// 621 %finish %else %if (type = long type) %start
goto L_0064;
L_0066:;
if (TYPE != 7) goto L_0067;
// 622 ch = streamX_lookahead
*CH = STREAMX->LOOKAHEAD;
// 623 %finish %else %signal 1,1,9
goto L_0064;
L_0067:;
_imp_signal(1, 1, 9, "");
L_0064:;
// 624
// 625 ! ch = streamX_lookahead
// 626
// 627 %end { of "read symbol" }
return;
} /* end of READSYMBOL */
// 628
// 629 !--------------------------------------------------------------------------
// 630 %external %routine skipsymbol
void SKIPSYMBOL(void) {
// 631 %integer trash
int TRASH;
// 632
// 633 readsymbol(trash)
READSYMBOL(/*?*/ &TRASH);
// 634 %end { of "skip symbol" }
return;
} /* end of SKIPSYMBOL */
// 635
// 636 !--------------------------------------------------------------------------
// 637 %external %predicate file end
int FILEEND(void) {
// 638 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 639
// 640 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0068;
INITIALISEIOSYSTEM();
L_0068:;
// 641
// 642 streamX == in_streams( in_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &IN.STREAMS[IN.CURRENTSTREAM];
// 643
// 644 ! can't select a closed file
// 645 %signal 9, 5, in_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0069;
_imp_signal(9, 5, IN.CURRENTSTREAM, "");
L_0069:;
// 646
// 647 %false %if eof( streamX_handle )
if (!(EOF(STREAMX->HANDLE))) goto L_006A;
return 0 /*FALSE*/;
L_006A:;
// 648 %true
return 1 /*TRUE*/;
// 649 %end { of "file end" }
} /* end of FILEEND */
// 650
// 651 !------------------------------------------------------------------------------
// 652 ! Output routines
// 653 !------------------------------------------------------------------------------
// 654
// 655 !--------------------------------------------------------------------------
// 656 %external %integer %function writebuffer( %name ptr, %integer count )
int WRITEBUFFER(_imp_name *PTR, int COUNT) {
// 657 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 658 %integer len,adr,type
int LEN;
int ADR;
int TYPE;
// 659 %integer itemsz
int ITEMSZ;
// 660
// 661 len = size of(ptr)
LEN = _imp_SIZEOF(PTR);
// 662 adr = addr(ptr)
ADR = _imp_ADDR(PTR);
// 663 type = type of(ptr)
TYPE = _imp_TYPEOF(PTR);
// 664
// 665 %if (rtl diagnose&128 # 0) %start
if (RTLDIAGNOSE & 128 == 0) goto L_006B;
// 666 select output( 0 )
_imp_SELECTOUTPUT(0);
// 667 print string("WRITEBUFFER: address(ptr)=".int2ascii(adr,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("WRITEBUFFER: address(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(ADR, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 668 print string("WRITEBUFFER: size of(ptr)=".int2ascii(len,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("WRITEBUFFER: size of(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(LEN, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 669 print string("WRITEBUFFER: type of(ptr)=".int2ascii(type,16,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("WRITEBUFFER: type of(ptr)="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_INT2ASCII(TYPE, 16, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 670 print string("WRITEBUFFER: count=".itos(count,0) ); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("WRITEBUFFER: count="), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(COUNT, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 671 select output( old output stream )
_imp_SELECTOUTPUT(_imp_OLDOUTPUTSTREAM());
// 672 %finish
L_006B:;
// 673
// 674 ! check if we can write a valid data type
// 675 %signal 5,5,type %unless ok write type(type) %and (len = count)
if (!(OKWRITETYPE(TYPE))) goto L_006C;
if (LEN == COUNT) goto L_006D;
L_006C:;
_imp_signal(5, 5, TYPE, "");
L_006D:;
// 676
// 677 ! assume we are writing data from a byte array (or string)
// 678 ! itemsz = get item size(ptr)
// 679 itemsz = len
ITEMSZ = LEN;
// 680
// 681 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_006E;
INITIALISEIOSYSTEM();
L_006E:;
// 682
// 683 ! can't select an invalid stream id (not stdout)
// 684 %signal 9, 9 %unless (0 < out_currentstream <= MAX OUTPUT STREAM)
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = OUT.CURRENTSTREAM)) goto L_006F;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0070;
}
L_006F:;
_imp_signal(9, 9, 0, "");
L_0070:;
// 685 ! can't select a closed file
// 686 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 687
// 688 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0071;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_0071:;
// 689
// 690 ! We don't need to know the variables data-type (from type of(ptr))
// 691 ! We just need the variable size and its address
// 692
// 693 ! We can then write into the buffer as an array of bytes
// 694 ! We need the stream handle, count of items space, item size, buffer address
// 695 ! Where, count * itemsz = size in bytes of buffer storage
// 696 %result = writebytes( streamX_handle, count, itemsz, byteinteger( addr(ptr) ) )
return WRITEBYTES(STREAMX->HANDLE, COUNT, ITEMSZ, _imp_BYTEINTEGER(_imp_ADDR(PTR)));
// 697 %end { of "write buffer" }
} /* end of WRITEBUFFER */
// 698
// 699 !--------------------------------------------------------------------------
// 700 %external %integer %function output stream
int OUTPUTSTREAM(void) {
// 701 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0072;
INITIALISEIOSYSTEM();
L_0072:;
// 702
// 703 %result = out_current stream
return OUT.CURRENTSTREAM;
// 704 %end { of "output stream" }
} /* end of OUTPUTSTREAM */
// 705
// 706 !--------------------------------------------------------------------------
// 707 %external %integer %function old output stream
int OLDOUTPUTSTREAM(void) {
// 708 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0073;
INITIALISEIOSYSTEM();
L_0073:;
// 709
// 710 %result = out_previous stream
return OUT.PREVIOUSSTREAM;
// 711 %end { of "previous output stream" }
} /* end of OLDOUTPUTSTREAM */
// 712
// 713 !--------------------------------------------------------------------------
// 714 %external %routine reset output
void RESETOUTPUT(void) {
// 715 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 716
// 717 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0074;
INITIALISEIOSYSTEM();
L_0074:;
// 718
// 719 ! can't select an invalid stream id (not stdout)
// 720 %signal 9, 9 %unless (0 < out_currentstream <= MAX OUTPUT STREAM)
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = OUT.CURRENTSTREAM)) goto L_0075;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0076;
}
L_0075:;
_imp_signal(9, 9, 0, "");
L_0076:;
// 721 ! can't select a closed file
// 722 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 723
// 724 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0077;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_0077:;
// 725
// 726 file rewind( streamX_handle )
FILEREWIND(STREAMX->HANDLE);
// 727 %end { of "reset output" }
return;
} /* end of RESETOUTPUT */
// 728
// 729 !--------------------------------------------------------------------------
// 730 %external %routine seek output( %integer displacement, pos )
void SEEKOUTPUT(int DISPLACEMENT, int POS) {
// 731 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 732
// 733 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0078;
INITIALISEIOSYSTEM();
L_0078:;
// 734
// 735 ! can't select an invalid stream id (not stdout)
// 736 %signal 9, 9 %unless (0 < out_currentstream <= MAX OUTPUT STREAM)
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = OUT.CURRENTSTREAM)) goto L_0079;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_007A;
}
L_0079:;
_imp_signal(9, 9, 0, "");
L_007A:;
// 737 ! can't select a closed file
// 738 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 739
// 740 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_007B;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_007B:;
// 741
// 742 %if (0 <= pos <= 2) %start
{
// Double-sided test on POS (Part I)
int tmp;
if (0 > (tmp = POS)) goto L_007C;
// Double-sided test on POS (Part II)
if (tmp > 2) goto L_007C;
}
// 743 file seek( streamX_handle, displacement, pos )
FILESEEK(STREAMX->HANDLE, DISPLACEMENT, POS);
// 744 %finish
L_007C:;
// 745 %end { of "seek output" }
return;
} /* end of SEEKOUTPUT */
// 746
// 747 !--------------------------------------------------------------------------
// 748 %external %integer %function tell output
int TELLOUTPUT(void) {
// 749 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 750
// 751 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_007D;
INITIALISEIOSYSTEM();
L_007D:;
// 752
// 753 ! can't select an invalid stream id (not stdout)
// 754 %signal 9, 9 %unless (0 < out_currentstream <= MAX OUTPUT STREAM)
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = OUT.CURRENTSTREAM)) goto L_007E;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_007F;
}
L_007E:;
_imp_signal(9, 9, 0, "");
L_007F:;
// 755 ! can't select a closed file
// 756 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 757
// 758 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0080;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_0080:;
// 759
// 760 %result = tell( streamX_handle )
return TELL(STREAMX->HANDLE);
// 761 %end { of "tell output" }
} /* end of TELLOUTPUT */
// 762
// 763 !--------------------------------------------------------------------------
// 764 %external %string(255) %function output name
_imp_string255 OUTPUTNAME(void) {
// 765 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 766
// 767 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0081;
INITIALISEIOSYSTEM();
L_0081:;
// 768
// 769 ! can't select an invalid stream id
// 770 %signal 9, 9 %unless (0 <= out_current stream <= MAX OUTPUT STREAM)
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 > (tmp = OUT.CURRENTSTREAM)) goto L_0082;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_0083;
}
L_0082:;
_imp_signal(9, 9, 0, "");
L_0083:;
// 771 ! can't select a closed file
// 772 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 773
// 774 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0084;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_0084:;
// 775
// 776 %result = streamX_file name
return *(_imp_string255 *)/*?*/ &STREAMX->FILENAME;
// 777 %end { of "output name" }
} /* end of OUTPUTNAME */
// 778
// 779 !--------------------------------------------------------------------------
// 780 %external %routine select output( %integer stream id )
void SELECTOUTPUT(int STREAMID) {
// 781 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 782
// 783 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0085;
INITIALISEIOSYSTEM();
L_0085:;
// 784
// 785 ! can't select an invalid stream id
// 786 %signal 9, 9 %unless (0 <= stream id <= MAX OUTPUT STREAM)
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 > (tmp = STREAMID)) goto L_0086;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_0087;
}
L_0086:;
_imp_signal(9, 9, 0, "");
L_0087:;
// 787
// 788 ! can't select a closed file
// 789 streamX == out_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[STREAMID];
// 790
// 791 %signal 9, 5, stream id %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_0088;
_imp_signal(9, 5, STREAMID, "");
L_0088:;
// 792
// 793 out_previous stream = out_current stream
OUT.PREVIOUSSTREAM = OUT.CURRENTSTREAM;
// 794 out_current stream = stream id
OUT.CURRENTSTREAM = STREAMID;
// 795 %end { of "select output" }
return;
} /* end of SELECTOUTPUT */
// 796
// 797 !--------------------------------------------------------------------------
// 798 %external %routine close output
void CLOSEOUTPUT(void) {
// 799 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 800
// 801 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0089;
INITIALISEIOSYSTEM();
L_0089:;
// 802
// 803 ! can't close terminal output
// 804 ! can't close an already closed file
// 805 %if (0 < out_current stream <= MAX OUTPUT STREAM ) %start
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 >= (tmp = OUT.CURRENTSTREAM)) goto L_008A;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp > 10) goto L_008A;
}
// 806 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 807
// 808 %if (streamX_handle # 0) %start
if (STREAMX->HANDLE == 0) goto L_008B;
// 809 close( streamX_handle )
CLOSE(STREAMX->HANDLE);
// 810 initialise stream( streamX )
INITIALISESTREAM(STREAMX);
// 811 %finish
L_008B:;
// 812 %finish
L_008A:;
// 813 %end { of "close output" }
return;
} /* end of CLOSEOUTPUT */
// 814
// 815 !--------------------------------------------------------------------------
// 816 %external %routine open output( %integer stream id, %string(255) file name )
void OPENOUTPUT(int STREAMID, _imp_string255 FILENAME) {
// 817 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 818 %integer handle
int HANDLE;
// 819 %integer flags = IS OUTPUT ! IS TEXT
int FLAGS;
FLAGS = 1 | 0;
// 820 %string(4) mode = "w"
_imp_string4 MODE;
_imp_strncpy(/*?*/ &MODE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("w");
(void *)&tmp;
}),
/*max:*/ 4);
// 821 %string(255) xxx
_imp_string255 XXX;
// 822 %string(4) yyy
_imp_string4 YYY;
// 823
// 824 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_008C;
INITIALISEIOSYSTEM();
L_008C:;
// 825
// 826 ! Error out if streamid not in legal range
// 827 %signal 9, 9, stream id %unless (0 < stream id <= MAX OUTPUT STREAM )
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 >= (tmp = STREAMID)) goto L_008D;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_008E;
}
L_008D:;
_imp_signal(9, 9, STREAMID, "");
L_008E:;
// 828
// 829 ! If file not open
// 830 streamX == out_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[STREAMID];
// 831
// 832 %if (streamX_handle = 0) %start
if (STREAMX->HANDLE != 0) goto L_008F;
// 833 xxx = filename
_imp_strncpy(/*?*/ &XXX, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 834 yyy = mode
_imp_strncpy(/*?*/ &YYY, ({
__typeof__(_imp_string4) tmp; /*B*/
tmp = MODE;
(void *)&tmp;
}),
/*max:*/ 4);
// 835
// 836 ! Tweak xxx,yyy to be C strings
// 837 ! Why? because we are sending them to a C function expecting C strings
// 838 imptocstring( xxx )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &XXX);
// 839 imptocstring( yyy )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &YYY);
// 840
// 841 handle = openfile( addr(yyy), addr(xxx) )
HANDLE = OPENFILE(_imp_ADDR(/*?*/ &YYY), _imp_ADDR(/*?*/ &XXX));
// 842
// 843 %if (handle = 0) %start
if (HANDLE != 0) goto L_0090;
// 844
// 845 %if (rtl diagnose&128 # 0) %start
if (RTLDIAGNOSE & 128 == 0) goto L_0091;
// 846 select output( 0 )
SELECTOUTPUT(0);
// 847 print string("OPENOUTPUT: filename='".filename."' was unable to open for stream(".itos(stream id,0).")")
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) 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_str_literal_ptr("OPENOUTPUT: filename='"),
(_imp_string *)/*?*/ &FILENAME);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("' was unable to open for stream("));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(STREAMID, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(")"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 848 newline
_imp_NEWLINE();
// 849 select output( old output stream )
SELECTOUTPUT(OLDOUTPUTSTREAM());
// 850 %finish
L_0091:;
// 851 %signal 9, 2, get error
_imp_signal(9, 2, GETERROR(), "");
// 852 %else
L_0090:;
// 853 streamX_handle = handle
STREAMX->HANDLE = HANDLE;
// 854 streamX_file name = file name
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 855 streamX_flags = flags
STREAMX->FLAGS = FLAGS;
// 856 %finish
// 857 %finish
L_008F:;
// 858 %end { of "open output" }
return;
} /* end of OPENOUTPUT */
// 859
// 860 !--------------------------------------------------------------------------
// 861 %external %routine open binary output( %integer stream id, %string(255) file name )
void OPENBINARYOUTPUT(int STREAMID, _imp_string255 FILENAME) {
// 862 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 863 %integer handle
int HANDLE;
// 864 %integer flags = IS OUTPUT ! IS BINARY
int FLAGS;
FLAGS = 1 | 2;
// 865 %string(4) mode = "wb"
_imp_string4 MODE;
_imp_strncpy(/*?*/ &MODE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("wb");
(void *)&tmp;
}),
/*max:*/ 4);
// 866 %string(255) xxx
_imp_string255 XXX;
// 867 %string(4) yyy
_imp_string4 YYY;
// 868
// 869 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0092;
INITIALISEIOSYSTEM();
L_0092:;
// 870
// 871 %signal 9, 9, stream id %unless (0 < stream id <= MAX OUTPUT STREAM )
{
// Double-sided test on STREAMID (Part I)
int tmp;
if (0 >= (tmp = STREAMID)) goto L_0093;
// Double-sided test on STREAMID (Part II)
if (tmp <= 10) goto L_0094;
}
L_0093:;
_imp_signal(9, 9, STREAMID, "");
L_0094:;
// 872
// 873 ! If file not open
// 874 streamX == out_streams( stream id )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[STREAMID];
// 875
// 876 %if (streamX_handle = 0) %start
if (STREAMX->HANDLE != 0) goto L_0095;
// 877 xxx = filename
_imp_strncpy(/*?*/ &XXX, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 878 yyy = mode
_imp_strncpy(/*?*/ &YYY, ({
__typeof__(_imp_string4) tmp; /*B*/
tmp = MODE;
(void *)&tmp;
}),
/*max:*/ 4);
// 879
// 880 ! Tweak xxx,yyy to be C strings
// 881 ! Why? because we are sending them to a C function expecting C strings
// 882 imptocstring( xxx )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &XXX);
// 883 imptocstring( yyy )
IMPTOCSTRING((_imp_string255 *)/*p*/ /*?*/ &YYY);
// 884
// 885 handle = openfile( addr(yyy), addr(xxx) )
HANDLE = OPENFILE(_imp_ADDR(/*?*/ &YYY), _imp_ADDR(/*?*/ &XXX));
// 886
// 887 %if (handle = 0) %start
if (HANDLE != 0) goto L_0096;
// 888
// 889 %if (rtl diagnose&128 # 0) %start
if (RTLDIAGNOSE & 128 == 0) goto L_0097;
// 890 select output( 0 )
SELECTOUTPUT(0);
// 891 print string("OPENBINARYOUTPUT: filename='".filename."' was unable to open for stream(".itos(stream id,0).")")
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) 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_str_literal_ptr("OPENBINARYOUTPUT: filename='"),
(_imp_string *)/*?*/ &FILENAME);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("' was unable to open for stream("));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = _imp_ITOS(STREAMID, 0);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(")"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 892 newline
_imp_NEWLINE();
// 893 select output( old output stream )
SELECTOUTPUT(OLDOUTPUTSTREAM());
// 894 %finish
L_0097:;
// 895 %signal 9, 2, get error
_imp_signal(9, 2, GETERROR(), "");
// 896 %else
L_0096:;
// 897 streamX_handle = handle
STREAMX->HANDLE = HANDLE;
// 898 streamX_file name = file name
_imp_strncpy(/*?*/ &STREAMX->FILENAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = FILENAME;
(void *)&tmp;
}),
/*max:*/ 255);
// 899 streamX_flags = flags
STREAMX->FLAGS = FLAGS;
// 900 %finish
// 901 %finish
L_0095:;
// 902 %end { of "open binary output" }
return;
} /* end of OPENBINARYOUTPUT */
// 903
// 904 !--------------------------------------------------------------------------
// 905 %external %routine flush output
void FLUSHOUTPUT(void) {
// 906 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 907
// 908 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_0098;
INITIALISEIOSYSTEM();
L_0098:;
// 909
// 910 ! only interrogate actual opened files (including stdout)
// 911 %signal 9, 9, out_current stream %unless (0 <= out_current stream <= MAX OUTPUT STREAM )
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 > (tmp = OUT.CURRENTSTREAM)) goto L_0099;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_009A;
}
L_0099:;
_imp_signal(9, 9, OUT.CURRENTSTREAM, "");
L_009A:;
// 912
// 913 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 914
// 915 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_009B;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_009B:;
// 916
// 917 flush( streamX_handle )
FLUSH(STREAMX->HANDLE);
// 918 %end { of "flush output" }
return;
} /* end of FLUSHOUTPUT */
// 919
// 920 !--------------------------------------------------------------------------
// 921 %external %routine print symbol( %integer c )
void PRINTSYMBOL(int C) {
// 922 %record(impstream)%name streamX
struct IMPSTREAM *STREAMX;
// 923
// 924 %if need to initialise %then initialise io system
if (!(NEEDTOINITIALISE())) goto L_009C;
INITIALISEIOSYSTEM();
L_009C:;
// 925
// 926 %signal 9, 9, out_current stream %unless (0 <= out_current stream <= MAX OUTPUT STREAM )
{
// Double-sided test on OUT.CURRENTSTREAM (Part I)
int tmp;
if (0 > (tmp = OUT.CURRENTSTREAM)) goto L_009D;
// Double-sided test on OUT.CURRENTSTREAM (Part II)
if (tmp <= 10) goto L_009E;
}
L_009D:;
_imp_signal(9, 9, OUT.CURRENTSTREAM, "");
L_009E:;
// 927
// 928 streamX == out_streams( out_current stream )
STREAMX = (struct IMPSTREAM *)/*?*/ &OUT.STREAMS[OUT.CURRENTSTREAM];
// 929
// 930 %signal 9, 5, out_current stream %if (streamX_handle = 0)
if (STREAMX->HANDLE != 0) goto L_009F;
_imp_signal(9, 5, OUT.CURRENTSTREAM, "");
L_009F:;
// 931
// 932 ! Not sure what the official IMP behaviour is for output on a closed file.
// 933 ! We choose to silently ignore it...
// 934 ! check file open before writing?
// 935 %if (streamX_handle # 0) %start
if (STREAMX->HANDLE == 0) goto L_00A0;
// 936 put char( streamX_handle, c)
PUTCHAR(STREAMX->HANDLE, C);
// 937 %if (c = nl) %then flush output
if (C != 10) goto L_00A1;
FLUSHOUTPUT();
L_00A1:;
// 938 %finish
L_00A0:;
// 939 %end { of "print symbol" }
return;
} /* end of PRINTSYMBOL */
// 940
// 941 %endoffile