#ifdef USE_PERMS_INC
const double PI = 3.141592653589793238462;
const _imp_string /*%string(1)*/ SNL = _imp_str_literal("\n");
static inline double FLOAT( double N );
static inline _imp_string /*%string(1)*/ TOSTRING( int C );
static inline int ADDR( void *P );
static inline unsigned char *BYTE( int N );
static inline unsigned char *BYTEINTEGER( int N );
static inline short *SHORT( int N );
static inline short *SHORTINTEGER( int N );
static inline int *INTEGER( int N );
static inline long long int *LONGINTEGER( int N );
static inline int *LONGLONGINTEGER( int N );
static inline int LENGTHENI( int I );
static inline float *REAL( int N );
static inline double *LONGREAL( int N );
static inline _imp_string /*%string(255)*/ *STRING( int N );
static inline void *RECORD( int N );
static inline unsigned char *LENGTH( _imp_string /*%string(255)*/ *S );
static inline unsigned char *CHARNO( _imp_string /*%string(255)*/ *S, int N );
static inline int TYPEOF( void *N );
static inline int SIZEOF( void *N );
extern double ARCSIN( double ANGLE );
extern double ARCCOS( double ANGLE );
extern double ARCTAN( double X, double Y );
extern double ARCTAN1( double ANGLE );
extern double SIN( double ANGLE );
extern double COS( double ANGLE );
extern double TAN( double ANGLE );
extern double FRACTION( double R );
extern double FRACPT( double R );
extern int IMOD( int I );
extern double MOD( double R );
extern int INT( double R );
extern int INTPT( double R );
extern long long int LINT( double R );
extern long long int LINTPT( double R );
extern int TRUNC( double R );
extern int ROUND( double R );
extern long long int IEXP( int NUM, int POWER );
extern double REXP( double NUM, double POWER );
extern double LOG( double X );
static inline int REM( int P, int Q );
extern double SQRT( double NUM );
extern int ISQRT( double NUM );
extern int MULDIV( int A, int B, int C );
extern void PROMPT( _imp_string /*%string(15)*/ S );
extern void READSYMBOL( int *P );
extern void READCH( int *P );
extern int NEXTSYMBOL( void );
extern int NEXTCH( void );
extern void SKIPSYMBOL( void );
extern void PRINTSYMBOL( unsigned char SYM );
extern void PRINTCH( unsigned char SYM );
extern void PRINTSTRING( _imp_string /*%string(255)*/ S );
extern void WRITE( int V, int P );
extern void READITEM( _imp_string /*%string(255)*/ *S );
extern void READSTRING( _imp_string /*%string(255)*/ *S );
extern void READTEXT( _imp_string /*%string(255)*/ *S, int DELIM );
extern _imp_string /*%string(255)*/ NEXTITEM( void );
extern void READLINE( _imp_string /*%string(255)*/ *S );
extern int INSTREAM( void );
extern int OUTSTREAM( void );
extern int INPUTSTREAM( void );
extern int OUTPUTSTREAM( void );
extern _imp_string /*%string(255)*/ INPUTNAME( void );
extern _imp_string /*%string(255)*/ OUTPUTNAME( void );
extern _imp_string /*%string(255)*/ INFILENAME( void );
extern _imp_string /*%string(255)*/ OUTFILENAME( void );
extern void SELECTINPUT( int N );
extern void SELECTOUTPUT( int N );
extern void OPENINPUT( int N, _imp_string /*%string(255)*/ FD );
extern void OPENOUTPUT( int N, _imp_string /*%string(255)*/ FD );
extern void OPENBINARYINPUT( int N, _imp_string /*%string(255)*/ FD );
extern void OPENBINARYOUTPUT( int N, _imp_string /*%string(255)*/ FD );
extern void DEFINEINPUT( int I, _imp_string /*%string(255)*/ SPEC );
extern void DEFINEOUTPUT( int I, _imp_string /*%string(255)*/ SPEC );
extern void ABANDONINPUT( void );
extern void ABANDONOUTPUT( void );
extern void CLOSEINPUT( void );
extern void CLOSEOUTPUT( void );
extern void RESETINPUT( void );
extern void RESETOUTPUT( void );
extern void COMPLETEINPUT( void );
extern void COMPLETEOUTPUT( void );
extern void POSITIONINPUT( int P );
extern void POSITIONOUTPUT( int P );
extern void INPUTPOSITION( void );
extern void OUTPUTPOSITION( void );
extern int /*Boolean*/ ENDOFINPUT( void );
extern void SPACE( void );
extern void SPACES( int N );
extern void NEWPAGE( void );
extern void NEWLINE( void );
extern void NEWLINES( int N );
extern void READ( void *PTR );
extern void PRINT( double R, int BEFORE, int AFTER );
extern void PRINTFLOATING( double R, int A, int B );
extern void PRINTFL( double R, int PLACES );
extern void TOUPPER( _imp_string /*%string(255)*/ *S );
extern void TOLOWER( _imp_string /*%string(255)*/ *S );
extern _imp_string /*%string(255)*/ SUBSTRING( _imp_string /*%string(255)*/ S, int FROM, int TO );
extern _imp_string /*%string(255)*/ FROMSTRING( _imp_string /*%string(255)*/ S, int FROM, int TO );
extern _imp_string /*%string(255)*/ TRIM( _imp_string /*%string(255)*/ S, int MAX );
extern _imp_string /*%string(8)*/ TIME( void );
extern _imp_string /*%string(9)*/ DATE( void );
extern int CPUTIME( void );
extern _imp_string /*%string(255)*/ CLIPARAM( void );
extern int FREESTORE( void );
extern _imp_string /*%string(255)*/ ITOS( int I, int POS );
extern int STOI( _imp_string /*%string(255)*/ S );
typedef struct EVENTFM EVENTFM; // forward declaration to allow a 'next' pointer to a struct within that struct...
struct EVENTFM {
int EVENT;
int SUBEVENT;
int EXTRA;
_imp_string /*%string(255)*/ MESSAGE;
};
extern EVENTFM EVENT( void );
extern int EVENTNO( void );
extern int SUBEVENT( void );
extern int EVENTINFO( void );
#else
#include "perms.h"
#endif // USE_PERMS_INC
#define PARM_OPT 1
#ifdef _U // Don't do unassigned checks...
#undef _U
#define _U(x) (x)
#endif
// 1 {%MAINEP ICL9CEZIMP
// 2 {%TRUSTEDPROGRAM
// 3 %BEGIN
int main(int argc, char **argv) {
__label__ _imp_endofblock;
_imp_initialise(argc, argv);
// 4 %string(127)%fn ITOS(%integer v,p)
_imp_string /*%string(127)*/ ITOS( int V, int P )
{
__label__ _imp_endofblock;
// 5 %integer vv,q,pos
int VV;
int Q;
int POS;
// 6 %byteintegerarray store(0:127)
unsigned char STORE[(127)-(0)+1];
// 7
// 8 vv = v; vv = -vv %if vv > 0
VV = V;
if (( VV ) <= ( 0 )) goto L_0002;
VV = (-(VV));
L_0002:
// 9 pos = 127
POS = 127;
// 10 %while vv <= -10 %cycle
L_0003:
if (( VV ) > ( (-(10)) )) goto L_0004;
// 11 q = vv//10
Q = ((int)(VV)) / ((int)(10));
// 12 store(pos) = q*10-vv+'0'; pos = pos-1
STORE[POS] = ((((((Q)) * ((10)))) - ((VV)))) + ((48));
POS = ((POS)) - ((1));
// 13 vv = q
VV = Q;
// 14 %repeat
goto L_0003;
L_0004:
// 15 store(pos) = '0'-vv
STORE[POS] = ((48)) - ((VV));
// 16 %if p <= 0 %start
if (( P ) > ( 0 )) goto L_0006;
// 17 p = 128+p
P = ((128)) + ((P));
// 18 %else
goto L_0007;
L_0006:
// 19 p = 128-p
P = ((128)) - ((P));
// 20 p = pos %if p > pos
if (( P ) <= ( POS )) goto L_0008;
P = POS;
L_0008:
// 21 p = p-1
P = ((P)) - ((1));
// 22 %finish
L_0007:
// 23 pos = pos-1 %and store(pos) = '-' %if v < 0
if (( V ) >= ( 0 )) goto L_0009;
POS = ((POS)) - ((1));
STORE[POS] = 45;
L_0009:
// 24 %while pos > p %and pos > 1 %cycle
L_000a:
if (( POS ) <= ( P )) goto L_000b;
if (( POS ) <= ( 1 )) goto L_000b;
// 25 pos = pos-1; store(pos) = ' '
POS = ((POS)) - ((1));
STORE[POS] = 32;
// 26 %repeat
goto L_000a;
L_000b:
// 27 pos = pos-1; store(pos) = 127-pos
POS = ((POS)) - ((1));
STORE[POS] = ((127)) - ((POS));
// 28 %result = string(addr(store(pos)))
return *STRING(ADDR( &STORE[POS]));
// 29 %end
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block ITOS at level 2
// 30
// 31 %integermap LONGINTEGER(%integer Addr)
int *LONGINTEGER( int ADDR )
{
__label__ _imp_endofblock;
// 32 %result == INTEGER(Addr)
return *INTEGER(ADDR);
// 33 %end
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block LONGINTEGER at level 2
// 34 %routine pprofile
void PPROFILE( void )
{
__label__ _imp_endofblock;
// 35 %end
return;
_imp_endofblock: ;
} // End of block PPROFILE at level 2
// 36 %routine print ch(%integer I)
void PRINTCH( int I )
{
__label__ _imp_endofblock;
// 37 print symbol(I)
PRINTSYMBOL(I);
// 38 %end
return;
_imp_endofblock: ;
} // End of block PRINTCH at level 2
// 39 %routine newpage
void NEWPAGE( void )
{
__label__ _imp_endofblock;
// 40 print ch(12)
PRINTCH(12);
// 41 %end
return;
_imp_endofblock: ;
} // End of block NEWPAGE at level 2
// 42 %integerfn IMOD(%integer I)
int IMOD( int I )
{
__label__ _imp_endofblock;
// 43 %result = |I|
return ABS(I);
// 44 %end
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block IMOD at level 2
// 45 %realfn MOD(%real R)
float MOD( float R )
{
__label__ _imp_endofblock;
// 46 %result = |R|
return ABS(R);
// 47 %end
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block MOD at level 2
// 48 %realfn FRACPT(%real r)
float FRACPT( float R )
{
__label__ _imp_endofblock;
// 49 %result = r-INTPT(r)
return ((R)) - ((INTPT(R)));
// 50 %end
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FRACPT at level 2
// 51 %CONSTINTEGER RELEASE=10
// 52 %CONSTINTEGER YES=1,NO=0
// 53 %CONSTINTEGER USE IMP=YES
// 54 %CONSTINTEGER VMEB=NO
// 55 %CONSTSTRING(9) LADATE="28 Jan 81"; ! LAST ALTERED
const _imp_string /*%string(9)*/ LADATE = _imp_str_literal("28 Jan 81");
// 56 %INTEGER I, J, K
int I;
int J;
int K;
// 57 ! PRODUCED BY OLDPS FROM NRIMPPS8 ON 16/12/80
// 58 %CONSTBYTEINTEGERARRAY CLETT(0: 500)= 1,
const unsigned char CLETT[(500)-(0)+1] = { 1, 43, 1, 45, 1, 40, 1, 41, 1, 44, 2, 201, 198, 6, 213, 206, 204, 197, 211, 211, 5, 215, 200, 201, 204, 197, 5, 213, 206, 212, 201, 204, 3, 198, 207, 210, 1, 61, 4, 210, 197, 193, 204, 7, 201, 206, 212, 197, 199, 197, 210, 8, 204, 207, 206, 199, 210, 197, 193, 204, 4, 204, 207, 206, 199, 11, 194, 217, 212, 197, 201, 206, 212, 197, 199, 197, 210, 6, 211, 212, 210, 201, 206, 199, 11, 200, 193, 204, 198, 201, 206, 212, 197, 199, 197, 210, 7, 210, 207, 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193, 208, 8, 198, 213, 206, 195, 212, 201, 207, 206, 6, 210, 197, 195, 207, 210, 196, 4, 206, 193, 205, 197, 5, 193, 210, 210, 193, 217, 9, 193, 210, 210, 193, 217, 206, 193, 205, 197, 9, 207, 198, 208, 210, 207, 199, 210, 193, 205, 6, 207, 198, 198, 201, 204, 197, 6, 207, 198, 204, 201, 211, 212, 6, 198, 207, 210, 205, 193, 212, 4, 211, 208, 197, 195, 3, 206, 207, 212, 3, 193, 206, 196, 2, 207, 210, 1, 58, 6, 206, 207, 210, 205, 193, 204, 3, 207, 215, 206, 8, 197, 216, 212, 197, 210, 206, 193, 204, 9, 197, 216, 212, 210, 201, 206, 211, 201, 195, 8, 195, 207, 206, 211, 212, 193, 206, 212, 5, 195, 207, 206, 211, 212, 5, 197, 214, 197, 206, 212, 5, 211, 212, 193, 210, 212, 9, 212, 200, 197, 206, 211, 212, 193, 210, 212, 4, 212, 200, 197, 206, 9, 197, 204, 211, 197, 211, 212, 193, 210, 212, 4, 197, 204, 211, 197, 1, 95, 6, 211, 217, 211, 212, 197, 205, 7, 196, 217, 206, 193, 205, 201, 195, 2, 42, 61, 1, 42, 4, 80, 85, 84, 95, 5, 67, 78, 79, 80, 95, 2, 204, 61, 1, 60, 1, 62, 4, 40, 196, 210, 43, 2, 196, 210, 1, 194, 3, 212, 207, 211, 3, 204, 206, 194, 3, 216, 206, 194, 2, 208, 195, 3, 195, 212, 194, 2, 45, 62, 6, 210, 197, 212, 213, 210, 206, 6, 210, 197, 211, 213, 204, 212, 7, 205, 207, 206, 201, 212, 207, 210, 4, 211, 212, 207, 208, 6, 211, 201, 199, 206, 193, 204, 4, 197, 216, 201, 212, 8, 195, 207, 206, 212, 201, 206, 213, 197, 6, 198, 201, 206, 201, 211, 200, 5, 195, 217, 195, 204, 197, 6, 210, 197, 208, 197, 193, 212, 3, 197, 206, 196, 5, 210, 197, 193, 204, 211, 5, 194, 197, 199, 201, 206, 2, 207, 206, 6, 211, 215, 201, 212, 195, 200, 4, 204, 201, 211, 212, 7, 211, 208, 197, 195, 201, 193, 204, 14, 212, 210, 213, 211, 212, 197, 196, 208, 210, 207, 199, 210, 193, 205, 6, 205, 193, 201, 206, 197, 208, 7, 195, 207, 206, 212, 210, 207, 204, 7, 201, 206, 195, 204, 213, 196, 197, };
// 59 43, 1, 45, 1, 40, 1, 41, 1, 44, 2, 201, 198, 6, 213,
// 60 206, 204, 197, 211, 211, 5, 215, 200, 201, 204, 197, 5, 213, 206,
// 61 212, 201, 204, 3, 198, 207, 210, 1, 61, 4, 210, 197, 193, 204,
// 62 7, 201, 206, 212, 197, 199, 197, 210, 8, 204, 207, 206, 199, 210,
// 63 197, 193, 204, 4, 204, 207, 206, 199, 11, 194, 217, 212, 197, 201,
// 64 206, 212, 197, 199, 197, 210, 6, 211, 212, 210, 201, 206, 199, 11,
// 65 200, 193, 204, 198, 201, 206, 212, 197, 199, 197, 210, 7, 210, 207,
// 66 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193, 208, 8, 198,
// 67 213, 206, 195, 212, 201, 207, 206, 6, 210, 197, 195, 207, 210, 196,
// 68 4, 206, 193, 205, 197, 5, 193, 210, 210, 193, 217, 9, 193, 210,
// 69 210, 193, 217, 206, 193, 205, 197, 9, 207, 198, 208, 210, 207, 199,
// 70 210, 193, 205, 6, 207, 198, 198, 201, 204, 197, 6, 207, 198, 204,
// 71 201, 211, 212, 6, 198, 207, 210, 205, 193, 212, 4, 211, 208, 197,
// 72 195, 3, 206, 207, 212, 3, 193, 206, 196, 2, 207, 210, 1, 58,
// 73 6, 206, 207, 210, 205, 193, 204, 3, 207, 215, 206, 8, 197, 216,
// 74 212, 197, 210, 206, 193, 204, 9, 197, 216, 212, 210, 201, 206, 211,
// 75 201, 195, 8, 195, 207, 206, 211, 212, 193, 206, 212, 5, 195, 207,
// 76 206, 211, 212, 5, 197, 214, 197, 206, 212, 5, 211, 212, 193, 210,
// 77 212, 9, 212, 200, 197, 206, 211, 212, 193, 210, 212, 4, 212, 200,
// 78 197, 206, 9, 197, 204, 211, 197, 211, 212, 193, 210, 212, 4, 197,
// 79 204, 211, 197, 1, 95, 6, 211, 217, 211, 212, 197, 205, 7, 196,
// 80 217, 206, 193, 205, 201, 195, 2, 42, 61, 1, 42, 4, 80, 85,
// 81 84, 95, 5, 67, 78, 79, 80, 95, 2, 204, 61, 1, 60, 1,
// 82 62, 4, 40, 196, 210, 43, 2, 196, 210, 1, 194, 3, 212, 207,
// 83 211, 3, 204, 206, 194, 3, 216, 206, 194, 2, 208, 195, 3, 195,
// 84 212, 194, 2, 45, 62, 6, 210, 197, 212, 213, 210, 206, 6, 210,
// 85 197, 211, 213, 204, 212, 7, 205, 207, 206, 201, 212, 207, 210, 4,
// 86 211, 212, 207, 208, 6, 211, 201, 199, 206, 193, 204, 4, 197, 216,
// 87 201, 212, 8, 195, 207, 206, 212, 201, 206, 213, 197, 6, 198, 201,
// 88 206, 201, 211, 200, 5, 195, 217, 195, 204, 197, 6, 210, 197, 208,
// 89 197, 193, 212, 3, 197, 206, 196, 5, 210, 197, 193, 204, 211, 5,
// 90 194, 197, 199, 201, 206, 2, 207, 206, 6, 211, 215, 201, 212, 195,
// 91 200, 4, 204, 201, 211, 212, 7, 211, 208, 197, 195, 201, 193, 204,
// 92 14, 212, 210, 213, 211, 212, 197, 196, 208, 210, 207, 199, 210, 193,
// 93 205, 6, 205, 193, 201, 206, 197, 208, 7, 195, 207, 206, 212, 210,
// 94 207, 204, 7, 201, 206, 195, 204, 213, 196, 197;
// 95
// 96
// 97
// 98
// 99 {%CONST}%ownINTEGERARRAY SYMBOL(1300: 2213)= 1307,
static int SYMBOL[(2213)-(1300)+1] = { 1307, 1303, 0, 1305, 2, 1307, 1000, 1319, 1312, 1001, 1357, 1824, 1315, 1003, 1020, 1319, 4, 1336, 6, 1329, 1323, 1001, 1014, 1325, 1003, 1329, 4, 1329, 6, 1336, 1336, 1010, 1028, 1319, 1011, 1350, 1343, 1343, 1010, 1028, 1307, 1011, 1343, 1350, 1348, 1026, 1307, 999, 1350, 1000, 1357, 1355, 1026, 1319, 999, 1357, 1000, 1365, 1363, 4, 1336, 1365, 6, 1365, 1000, 1372, 1370, 8, 1336, 999, 1372, 1000, 1377, 1375, 10, 1377, 13, 1401, 1384, 20, 1010, 1542, 1562, 1011, 1390, 26, 1010, 1542, 1562, 1011, 1401, 32, 1010, 1001, 36, 1336, 8, 1336, 8, 1336, 1011, 1408, 1406, 8, 1001, 999, 1408, 1000, 1415, 1411, 38, 1413, 43, 1415, 51, 1430, 1418, 43, 1420, 38, 1423, 60, 1408, 1425, 65, 1428, 77, 1925, 1430, 84, 1437, 1433, 96, 1437, 1031, 1415, 1437, 1444, 1440, 104, 1442, 107, 1444, 111, 1466, 1450, 1415, 1476, 1001, 1401, 1456, 120, 1466, 127, 1001, 1401, 1462, 1430, 1471, 1001, 1401, 1483, 1466, 127, 1001, 1401, 1471, 1469, 132, 1471, 1000, 1476, 1474, 127, 1476, 1000, 1483, 1479, 138, 1481, 127, 1483, 1000, 1493, 1491, 4, 1010, 1444, 1011, 1493, 6, 1493, 1000, 1502, 1500, 1030, 1010, 1444, 1011, 999, 1502, 1000, 1513, 1506, 148, 1016, 1508, 158, 1511, 165, 1018, 1513, 1016, 1518, 1516, 172, 1518, 1000, 1542, 1526, 172, 1001, 4, 1876, 1869, 6, 1535, 179, 1010, 1001, 1818, 1011, 4, 1001, 6, 1542, 1010, 1615, 1011, 4, 1001, 6, 1556, 1548, 1336, 1032, 1336, 1556, 1553, 4, 1542, 1562, 6, 1556, 184, 1542, 1562, 1560, 1037, 1336, 1562, 1000, 1573, 1567, 188, 1542, 1573, 1571, 192, 1542, 1580, 1573, 1000, 1580, 1578, 188, 1542, 999, 1580, 1000, 1587, 1585, 192, 1542, 999, 1587, 1000, 1595, 1591, 1033, 1336, 1593, 195, 1595, 1000, 1601, 1599, 179, 1008, 1601, 1015, 1606, 1604, 60, 1606, 197, 1615, 1613, 8, 1336, 195, 1336, 1606, 1615, 1000, 1624, 1620, 1476, 1001, 1401, 1624, 132, 1513, 1624, 1630, 1630, 1001, 1401, 1832, 1630, 1636, 1634, 8, 1624, 1636, 1000, 1652, 1646, 1476, 1010, 1001, 1401, 1840, 1011, 1652, 1006, 1652, 132, 1513, 1001, 1832, 1701, 1663, 1661, 8, 1010, 1001, 1401, 1840, 1011, 1652, 1663, 1000, 1674, 1666, 204, 1668, 208, 1670, 217, 1672, 227, 1674, 236, 1701, 1678, 1415, 1636, 1689, 120, 1476, 1010, 1001, 1401, 1011, 4, 1001, 6, 1006, 1701, 120, 132, 1513, 1010, 1001, 1832, 1011, 4, 1001, 6, 1006, 1711, 1709, 36, 1028, 1319, 1350, 1722, 1711, 1711, 1000, 1722, 1720, 8, 1012, 1028, 1319, 1350, 1722, 999, 1722, 1000, 1731, 1729, 4, 1028, 1319, 1350, 6, 1731, 1000, 1738, 1736, 8, 1009, 999, 1738, 1000, 1743, 1741, 242, 1743, 1000, 1749, 1747, 8, 1336, 1749, 1000, 1762, 1760, 8, 1001, 1401, 4, 1336, 195, 1336, 6, 999, 1762, 1000, 1769, 1767, 26, 1542, 1562, 1769, 1000, 1782, 1772, 1019, 1774, 1006, 1779, 1372, 1542, 1562, 1006, 1782, 1377, 1006, 1795, 1786, 248, 1034, 1789, 254, 1034, 1795, 264, 1010, 2060, 1011, 1801, 1801, 1799, 188, 2060, 1801, 1000, 1818, 1805, 269, 1034, 1813, 279, 1372, 1010, 1542, 1562, 1011, 1782, 1816, 279, 2060, 1818, 1000, 1824, 1822, 284, 1001, 1824, 1000, 1832, 1830, 284, 1001, 1357, 1824, 1832, 1000, 1840, 1840, 4, 1336, 195, 1336, 1606, 6, 1848, 1846, 36, 1028, 1319, 1350, 1848, 1000, 1858, 1852, 286, 1013, 1854, 208, 1856, 293, 1858, 1000, 1869, 1867, 1001, 36, 1336, 8, 1336, 8, 1336, 1869, 1000, 1876, 1874, 8, 1876, 999, 1876, 1000, 1916, 1882, 1415, 1476, 1001, 1401, 1889, 1415, 132, 1001, 1401, 1832, 1916, 1895, 120, 1466, 127, 1001, 1401, 1904, 120, 1010, 1001, 1401, 1011, 4, 1001, 6, 1916, 120, 132, 1010, 1001, 1401, 1832, 1916, 1011, 4, 1001, 6, 1925, 1923, 8, 1001, 1401, 1832, 999, 1925, 1000, 1932, 1930, 4, 1009, 6, 1932, 1000, 1950, 1936, 301, 1001, 1939, 304, 1001, 1942, 306, 1002, 1945, 1022, 1950, 1950, 311, 1009, 8, 1009, 1964, 1954, 1023, 1964, 1959, 1024, 317, 2003, 2008, 1964, 1025, 1005, 8, 1987, 1987, 1969, 320, 1001, 322, 1971, 2036, 1976, 4, 2036, 2025, 6, 1980, 324, 2036, 6, 1985, 4, 329, 2025, 6, 1987, 332, 2003, 1992, 320, 1001, 322, 1994, 2036, 1999, 4, 329, 2025, 6, 2003, 324, 1005, 6, 2008, 2006, 329, 2008, 1005, 2016, 2014, 8, 1005, 8, 1005, 2016, 1000, 2025, 2020, 0, 1005, 2023, 2, 1005, 2025, 1000, 2031, 2029, 0, 332, 2031, 1000, 2036, 2034, 36, 2036, 1000, 2051, 2041, 2031, 1300, 1003, 2044, 1001, 2016, 2049, 4, 2051, 2016, 6, 2051, 334, 2060, 2054, 338, 2056, 342, 2058, 346, 2060, 349, 2093, 2069, 1010, 1001, 1357, 1824, 1011, 1587, 1795, 2073, 353, 1001, 1357, 2075, 356, 2079, 363, 1033, 1336, 2082, 370, 1795, 2084, 378, 2089, 383, 1738, 1009, 1743, 2091, 390, 2093, 395, 2214, 2100, 1027, 1010, 2060, 1011, 1769, 2102, 1007, 2110, 1372, 1010, 1542, 1562, 1011, 1782, 1006, 2115, 404, 1035, 1801, 1006, 2120, 411, 1029, 1858, 1006, 2125, 417, 1036, 1762, 1006, 2130, 1377, 411, 1029, 1006, 2136, 1031, 1008, 1415, 1615, 1006, 2140, 424, 1502, 1006, 2144, 120, 1518, 1006, 2153, 1010, 1848, 1430, 1011, 1595, 1001, 1483, 1006, 2156, 1663, 1674, 2160, 428, 1601, 1006, 2164, 434, 1015, 1006, 2173, 440, 1021, 1738, 1009, 1731, 248, 1034, 1006, 2184, 443, 1001, 1401, 4, 1336, 195, 1336, 6, 1749, 1006, 2188, 450, 1006, 1017, 2193, 455, 127, 1001, 1006, 2197, 304, 1932, 1006, 2200, 463, 1006, 2204, 478, 1001, 1006, 2208, 485, 1003, 1006, 2212, 493, 1003, 1038, 2214, 1006, };
// 100 1303, 0, 1305, 2, 1307, 1000, 1319, 1312, 1001, 1357,
// 101 1824, 1315, 1003, 1020, 1319, 4, 1336, 6, 1329, 1323,
// 102 1001, 1014, 1325, 1003, 1329, 4, 1329, 6, 1336, 1336,
// 103 1010, 1028, 1319, 1011, 1350, 1343, 1343, 1010, 1028, 1307,
// 104 1011, 1343, 1350, 1348, 1026, 1307, 999, 1350, 1000, 1357,
// 105 1355, 1026, 1319, 999, 1357, 1000, 1365, 1363, 4, 1336,
// 106 1365, 6, 1365, 1000, 1372, 1370, 8, 1336, 999, 1372,
// 107 1000, 1377, 1375, 10, 1377, 13, 1401, 1384, 20, 1010,
// 108 1542, 1562, 1011, 1390, 26, 1010, 1542, 1562, 1011, 1401,
// 109 32, 1010, 1001, 36, 1336, 8, 1336, 8, 1336, 1011,
// 110 1408, 1406, 8, 1001, 999, 1408, 1000, 1415, 1411, 38,
// 111 1413, 43, 1415, 51, 1430, 1418, 43, 1420, 38, 1423,
// 112 60, 1408, 1425, 65, 1428, 77, 1925, 1430, 84, 1437,
// 113 1433, 96, 1437, 1031, 1415, 1437, 1444, 1440, 104, 1442,
// 114 107, 1444, 111, 1466, 1450, 1415, 1476, 1001, 1401, 1456,
// 115 120, 1466, 127, 1001, 1401, 1462, 1430, 1471, 1001, 1401,
// 116 1483, 1466, 127, 1001, 1401, 1471, 1469, 132, 1471, 1000,
// 117 1476, 1474, 127, 1476, 1000, 1483, 1479, 138, 1481, 127,
// 118 1483, 1000, 1493, 1491, 4, 1010, 1444, 1011, 1493, 6,
// 119 1493, 1000, 1502, 1500, 1030, 1010, 1444, 1011, 999, 1502,
// 120 1000, 1513, 1506, 148, 1016, 1508, 158, 1511, 165, 1018,
// 121 1513, 1016, 1518, 1516, 172, 1518, 1000, 1542, 1526, 172,
// 122 1001, 4, 1876, 1869, 6, 1535, 179, 1010, 1001, 1818,
// 123 1011, 4, 1001, 6, 1542, 1010, 1615, 1011, 4, 1001,
// 124 6, 1556, 1548, 1336, 1032, 1336, 1556, 1553, 4, 1542,
// 125 1562, 6, 1556, 184, 1542, 1562, 1560, 1037, 1336, 1562,
// 126 1000, 1573, 1567, 188, 1542, 1573, 1571, 192, 1542, 1580,
// 127 1573, 1000, 1580, 1578, 188, 1542, 999, 1580, 1000, 1587,
// 128 1585, 192, 1542, 999, 1587, 1000, 1595, 1591, 1033, 1336,
// 129 1593, 195, 1595, 1000, 1601, 1599, 179, 1008, 1601, 1015,
// 130 1606, 1604, 60, 1606, 197, 1615, 1613, 8, 1336, 195,
// 131 1336, 1606, 1615, 1000, 1624, 1620, 1476, 1001, 1401, 1624,
// 132 132, 1513, 1624, 1630, 1630, 1001, 1401, 1832, 1630, 1636,
// 133 1634, 8, 1624, 1636, 1000, 1652, 1646, 1476, 1010, 1001,
// 134 1401, 1840, 1011, 1652, 1006, 1652, 132, 1513, 1001, 1832,
// 135 1701, 1663, 1661, 8, 1010, 1001, 1401, 1840, 1011, 1652,
// 136 1663, 1000, 1674, 1666, 204, 1668, 208, 1670, 217, 1672,
// 137 227, 1674, 236, 1701, 1678, 1415, 1636, 1689, 120, 1476,
// 138 1010, 1001, 1401, 1011, 4, 1001, 6, 1006, 1701, 120,
// 139 132, 1513, 1010, 1001, 1832, 1011, 4, 1001, 6, 1006,
// 140 1711, 1709, 36, 1028, 1319, 1350, 1722, 1711, 1711, 1000,
// 141 1722, 1720, 8, 1012, 1028, 1319, 1350, 1722, 999, 1722,
// 142 1000, 1731, 1729, 4, 1028, 1319, 1350, 6, 1731, 1000,
// 143 1738, 1736, 8, 1009, 999, 1738, 1000, 1743, 1741, 242,
// 144 1743, 1000, 1749, 1747, 8, 1336, 1749, 1000, 1762, 1760,
// 145 8, 1001, 1401, 4, 1336, 195, 1336, 6, 999, 1762,
// 146 1000, 1769, 1767, 26, 1542, 1562, 1769, 1000, 1782, 1772,
// 147 1019, 1774, 1006, 1779, 1372, 1542, 1562, 1006, 1782, 1377,
// 148 1006, 1795, 1786, 248, 1034, 1789, 254, 1034, 1795, 264,
// 149 1010, 2060, 1011, 1801, 1801, 1799, 188, 2060, 1801, 1000,
// 150 1818, 1805, 269, 1034, 1813, 279, 1372, 1010, 1542, 1562,
// 151 1011, 1782, 1816, 279, 2060, 1818, 1000, 1824, 1822, 284,
// 152 1001, 1824, 1000, 1832, 1830, 284, 1001, 1357, 1824, 1832,
// 153 1000, 1840, 1840, 4, 1336, 195, 1336, 1606, 6, 1848,
// 154 1846, 36, 1028, 1319, 1350, 1848, 1000, 1858, 1852, 286,
// 155 1013, 1854, 208, 1856, 293, 1858, 1000, 1869, 1867, 1001,
// 156 36, 1336, 8, 1336, 8, 1336, 1869, 1000, 1876, 1874,
// 157 8, 1876, 999, 1876, 1000, 1916, 1882, 1415, 1476, 1001,
// 158 1401, 1889, 1415, 132, 1001, 1401, 1832, 1916, 1895, 120,
// 159 1466, 127, 1001, 1401, 1904, 120, 1010, 1001, 1401, 1011,
// 160 4, 1001, 6, 1916, 120, 132, 1010, 1001, 1401, 1832,
// 161 1916, 1011, 4, 1001, 6, 1925, 1923, 8, 1001, 1401,
// 162 1832, 999, 1925, 1000, 1932, 1930, 4, 1009, 6, 1932,
// 163 1000, 1950, 1936, 301, 1001, 1939, 304, 1001, 1942, 306,
// 164 1002, 1945, 1022, 1950, 1950, 311, 1009, 8, 1009, 1964,
// 165 1954, 1023, 1964, 1959, 1024, 317, 2003, 2008, 1964, 1025,
// 166 1005, 8, 1987, 1987, 1969, 320, 1001, 322, 1971, 2036,
// 167 1976, 4, 2036, 2025, 6, 1980, 324, 2036, 6, 1985,
// 168 4, 329, 2025, 6, 1987, 332, 2003, 1992, 320, 1001,
// 169 322, 1994, 2036, 1999, 4, 329, 2025, 6, 2003, 324,
// 170 1005, 6, 2008, 2006, 329, 2008, 1005, 2016, 2014, 8,
// 171 1005, 8, 1005, 2016, 1000, 2025, 2020, 0, 1005, 2023,
// 172 2, 1005, 2025, 1000, 2031, 2029, 0, 332, 2031, 1000,
// 173 2036, 2034, 36, 2036, 1000, 2051, 2041, 2031, 1300, 1003,
// 174 2044, 1001, 2016, 2049, 4, 2051, 2016, 6, 2051, 334,
// 175 2060, 2054, 338, 2056, 342, 2058, 346, 2060, 349, 2093,
// 176 2069, 1010, 1001, 1357, 1824, 1011, 1587, 1795, 2073, 353,
// 177 1001, 1357, 2075, 356, 2079, 363, 1033, 1336, 2082, 370,
// 178 1795, 2084, 378, 2089, 383, 1738, 1009, 1743, 2091, 390,
// 179 2093, 395, 2214, 2100, 1027, 1010, 2060, 1011, 1769, 2102,
// 180 1007, 2110, 1372, 1010, 1542, 1562, 1011, 1782, 1006, 2115,
// 181 404, 1035, 1801, 1006, 2120, 411, 1029, 1858, 1006, 2125,
// 182 417, 1036, 1762, 1006, 2130, 1377, 411, 1029, 1006, 2136,
// 183 1031, 1008, 1415, 1615, 1006, 2140, 424, 1502, 1006, 2144,
// 184 120, 1518, 1006, 2153, 1010, 1848, 1430, 1011, 1595, 1001,
// 185 1483, 1006, 2156, 1663, 1674, 2160, 428, 1601, 1006, 2164,
// 186 434, 1015, 1006, 2173, 440, 1021, 1738, 1009, 1731, 248,
// 187 1034, 1006, 2184, 443, 1001, 1401, 4, 1336, 195, 1336,
// 188 6, 1749, 1006, 2188, 450, 1006, 1017, 2193, 455, 127,
// 189 1001, 1006, 2197, 304, 1932, 1006, 2200, 463, 1006, 2204,
// 190 478, 1001, 1006, 2208, 485, 1003, 1006, 2212, 493, 1003,
// 191 1038, 2214, 1006;
// 192
// 193 %CONSTINTEGER SS= 2093
// 194
// 195 !
// 196 %CONST %BYTE %INTEGER %ARRAY I TO E TAB(0 : 127) = {%C
const unsigned char ITOETAB[(127)-(0)+1] = { 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 21, 64, 12, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 79, 127, 123, 91, 108, 80, 125, 77, 93, 92, 78, 107, 96, 75, 97, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 122, 94, 76, 126, 110, 111, 124, 193, 194, 195, 196, 197, 198, 199, 200, 201, 209, 210, 211, 212, 213, 214, 215, 216, 217, 226, 227, 228, 229, 230, 231, 232, 233, 74, 95, 90, 106, 109, 124, 129, 130, 131, 132, 133, 134, 135, 136, 137, 145, 146, 147, 148, 149, 150, 151, 152, 153, 162, 163, 164, 165, 166, 167, 168, 169, 192, 64, 208, 64, 64, };
// 197 16_40,16_40,16_40,16_40,16_40,16_40,16_40,16_40,
// 198 16_40,16_40,16_15,16_40,16_0C,16_40,16_40,16_40,
// 199 16_40,16_40,16_40,16_40,16_40,16_40,16_40,16_40,
// 200 16_40,16_40,16_40,16_40,16_40,16_40,16_40,16_40,
// 201 16_40,16_4F,16_7F,16_7B,16_5B,16_6C,16_50,16_7D,
// 202 16_4D,16_5D,16_5C,16_4E,16_6B,16_60,16_4B,16_61,
// 203 16_F0,16_F1,16_F2,16_F3,16_F4,16_F5,16_F6,16_F7,
// 204 16_F8,16_F9,16_7A,16_5E,16_4C,16_7E,16_6E,16_6F,
// 205 16_7C,16_C1,16_C2,16_C3,16_C4,16_C5,16_C6,16_C7,
// 206 16_C8,16_C9,16_D1,16_D2,16_D3,16_D4,16_D5,16_D6,
// 207 16_D7,16_D8,16_D9,16_E2,16_E3,16_E4,16_E5,16_E6,
// 208 16_E7,16_E8,16_E9,16_4A,16_5F,16_5A,16_6A,16_6D,
// 209 16_7C,16_81,16_82,16_83,16_84,16_85,16_86,16_87,
// 210 16_88,16_89,16_91,16_92,16_93,16_94,16_95,16_96,
// 211 16_97,16_98,16_99,16_A2,16_A3,16_A4,16_A5,16_A6,
// 212 16_A7,16_A8,16_A9,16_C0,16_40,16_D0,16_40,16_40
// 213 %CONSTINTEGERARRAY OPC(0:126)=0,
const int OPC[(126)-(0)+1] = { 0, 541737795, 541737300, 541737286, 0, 0, 0, 0, 542523724, 541284676, 1229865793, 1297040452, 1347568460, 538976330, 541740107, 1128352844, 541148226, 542327362, 1145389642, 541282370, 542329159, 541940034, 542526809, 1129335106, 541868884, 1297109842, 1129337682, 1398031188, 1163413844, 1163085144, 542070100, 541147988, 538989388, 1397510995, 1397510980, 1397510993, 538989396, 1398035784, 1398036558, 1229212741, 542329924, 542329922, 1413760323, 1229865812, 542331972, 542331970, 1398033486, 1398035270, 538976332, 541872979, 541872964, 541872977, 1381127235, 541873480, 1380011086, 541152070, 1279545932, 541869121, 1279546434, 541869122, 538987588, 538987586, 541871182, 541874254, 542393160, 1095648339, 542069331, 1313165651, 1163415617, 541150788, 538988370, 542000465, 538988619, 541675091, 1398100043, 541415504, 1129270593, 541344854, 1146242134, 1145914454, 1398228305, 1398230597, 541282387, 542397522, 541477972, 541672534, 1230128214, 1229800534, 541939276, 538987862, 1128812374, 541282125, 541477208, 542262358, 1381123158, 1380210244, 542458180, 542462786, 1431458626, 542458704, 542462792, 542265172, 542328915, 542328922, 541344068, 541348674, 1146245954, 541344592, 541348680, 541347161, 1145919812, 1128417614, 541671748, 541676354, 1230132034, 541672272, 541676360, 541674841, 1229805892, 1128547651, 542261572, 542266178, 1381126978, 542262096, 542266179, 542264665, 1380800836, };
// 214 M' JCC',M' JAT',M' JAF',0(4),
// 215 M' VAL',M' CYD',M'INCA',M'MODD',M'PRCL',M' J',M' JLK',M'CALL',
// 216 M' ADB',M' SBB',M'DEBJ',M' CPB',M' SIG',M' MYB',M' VMY',M'CPIB',
// 217 M' LCT',M'MPSR',M'CPSR',M'STCT',M'EXIT',M'ESEX',M' OUT',M' ACT',
// 218 M' SL',M'SLSS',M'SLSD',M'SLSQ',M' ST',M'STUH',M'STXN',M'IDLE',
// 219 M' SLD',M' SLB',M'TDEC',M'INCT',M' STD',M' STB',M'STLN',M'STSF',
// 220 M' L',M' LSS',M' LSD',M' LSQ',M'RRTC',M' LUH',M'RALN',M' ASF',
// 221 M'LDRL',M' LDA',M'LDTB',M' LDB',M' LD',M' LB',M' LLN',M' LXN',
// 222 M' TCH',M'ANDS',M' ORS',M'NEQS',M'EXPA',M' AND',M' OR',M' NEQ',
// 223 M' PK',M' INS',M'SUPK',M' EXP',M'COMA',M' DDV',M'DRDV',M'DMDV',
// 224 M'SWEQ',M'SWNE',M' CPS',M' TTR',M' FLT',M' IDV',M'IRDV',M'IMDV',
// 225 M' MVL',M' MV',M'CHOV',M' COM',M' FIX',M' RDV',M'RRDV',M'RDVD',
// 226 M' UAD',M' USB',M'URSB',M' UCP',M' USH',M' ROT',M' SHS',M' SHZ',
// 227 M' DAD',M' DSB',M'DRSB',M' DCP',M' DSH',M' DMY',M'DMYD',M'CBIN',
// 228 M' IAD',M' ISB',M'IRSB',M' ICP',M' ISH',M' IMY',M'IMYD',M'CDEC',
// 229 M' RAD',M' RSB',M'RRSB',M' RCP',M' RSC',M' RMY',M'RMYD';
// 230 %CONSTBYTEINTEGERARRAY ONE CASE(0 : 127) = {%C
const unsigned char ONECASE[(127)-(0)+1] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123, 124, 125, 126, 127, };
// 231 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
// 232 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,
// 233 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
// 234 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
// 235 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
// 236 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
// 237 96,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
// 238 80,81,82,83,84,85,86,87,88,89,90,123,124,125,126,127;
// 239 %CONSTINTEGERARRAY TSNAME (0:62)=16_1000(8),
const int TSNAME[(62)-(0)+1] = { 4096, 4096, 4096, 4096, 4096, 4096, 4096, 4096, 4097, 4096, 4096, 4096, 4096, 4096, 4097, 4194, 4097, 4097, 4194, 4096, 4096, 82, 81, 98, 4194, 4194, 4194, 4194, 4194, 4194, 4194, 4096, 49, 81, 4194, 4194, 49, 4096, 81, 98, 4096, 4096, 53, 4096, 4149, 49, 53, 4149, 51, 0, 4096, 49, 82, 81, 97, 114, 97, 114, 81, 98, 4177, 65, 4096, };
// 240 16_1001,16_1000(5),16_1001,16_1062,16_1001(2),16_1062,
// 241 16_1000(2),16_52,16_51,16_62,16_1062(7),
// 242 16_1000,16_31,16_51,16_1062(2),16_31,16_1000,
// 243 16_51,16_62,16_1000(2),16_35,16_1000,16_1035,
// 244 16_31,16_35,16_1035,16_33,0,16_1000,16_31,16_52,16_51,
// 245 16_61,16_72,16_61,16_72,16_51,16_62,16_1051,16_41,
// 246 16_1000;
// 247 !
// 248 %OWNINTEGERARRAY FIXED GLA(0:11)=0,
static int FIXEDGLA[(11)-(0)+1] = { 0, 1342177280, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, };
// 249 16_50000000,0(2),-1,0,0(6);
// 250 %CONSTBYTEINTEGERARRAY BYTES(0:7)=0(3),1,2,4,8,16;
const unsigned char BYTES[(7)-(0)+1] = { 0, 0, 0, 1, 2, 4, 8, 16, };
// 251 %CONSTBYTEINTEGERARRAY TRTAB(0:255)=0(48),
const unsigned char TRTAB[(255)-(0)+1] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, };
// 252 1(10),0(7),2(26),0(6),2(26),0(5),0(128)
// 253 %CONSTINTEGER MAXLEVELS=31,CONCOP=13,FIXEDGLALEN=48
// 254 %CONSTINTEGER JOBBERBIT=16_40000000; ! SET IN JOBBER MODE
// 255 %CONSTINTEGER CEBIT=1; ! SET IN COMPILER ENVIRONMENT
// 256 %CONSTINTEGER MAXDICT=16_100; ! SET FOR MAX OF EVERYTHING
// 257 !
// 258 ! THE PRINCIPAL OPCODES ARE HERE DEFINED AS THEIR MNEMONICS(AMENDED)
// 259 !
// 260 %CONSTINTEGER LB=16_7A,SLB=16_52,STB=16_5A,ADB=16_20,CPB=16_26, {%C
// 261 MYB=16_2A,SBB=16_22,CPIB=16_2E,OUT=16_3C,CPSR=16_34
// 262 %CONSTINTEGER LD=16_78,LDA=16_72,INCA=16_14,STD=16_58,LDB=16_76, {%C
// 263 LDTB=16_74,LDRL=16_70,CYD=16_12,MODD=16_16,SLD=16_50
// 264 %CONSTINTEGER STLN=16_5C,ASF=16_6E,ST=16_48,RALN=16_6C,LXN=16_7E,{%C
// 265 LLN=16_7C,LSS=16_62,SLSS=16_42,MPSR=16_32,STSF=16_5E,{%C
// 266 LUH=16_6A,STUH=16_4A,LSD=16_64,SLSD=16_44,PRCL=16_18, {%C
// 267 LSQ=16_66,SLSQ=16_46,STXN=16_4C,LCT=16_30,STCT=16_36
// 268 %CONSTINTEGER JUNC=16_1A,JLK=16_1C,CALL=16_1E,EXIT=16_38,JCC=2, {%C
// 269 JAT=4,JAF=6,DEBJ=16_24
// 270 %CONSTINTEGER IAD=16_E0,ICP=16_E6,USH=16_C8,ISB=16_E2,IRSB=16_E4,{%C
// 271 OR=16_8C,UCP=16_C6,IMY=16_EA,IMDV=16_AE,AND=16_8A, {%C
// 272 ISH=16_E8,IMYD=16_EC,IDV=16_AA
// 273 %CONSTINTEGER RAD=16_F0,RSB=16_F2,RRSB=16_F4,FLT=16_A8,RRDV=16_BC, {%C
// 274 RSC=16_F8,FIX=16_B8,RDV=16_BA,RDDV=16_BE,RMYD=16_FC, {%C
// 275 RMY=16_FA
// 276 !
// 277 %CONSTINTEGER MVL=16_B0,MV=16_B2,SWEQ=16_A0,SWNE=16_A2,CPS=16_A4
// 278 !
// 279 ! DEFINE SOME MNEMONICS FOR THE VISIBLE REGISTERS (XCEPT LNB)
// 280 !
// 281 %CONSTINTEGER ACCR=0,DR=1,LNB=2,XNB=3,PC=4,CTB=5,TOS=6,BREG=7
// 282 %CONSTBYTEINTEGERARRAY LDCODE(0:7)=0,16_78,16_7C,16_7E,0,48,0,16_7A;
const unsigned char LDCODE[(7)-(0)+1] = { 0, 120, 124, 126, 0, 48, 0, 122, };
// 283 !
// 284 %CONSTSTRING(8)MDEP="S#NDIAG"
const _imp_string /*%string(8)*/ MDEP = _imp_str_literal("S#NDIAG");
// 285 %CONSTSTRING(8)IOCPEP="S#IOCP"; ! EP FOR IOCP
const _imp_string /*%string(8)*/ IOCPEP = _imp_str_literal("S#IOCP");
// 286 %CONSTSTRING(11)AUXSTEP="ICL9CEAUXST";! DATA REF FOR INDIRECT AUX ST
const _imp_string /*%string(11)*/ AUXSTEP = _imp_str_literal("ICL9CEAUXST");
// 287 %CONSTINTEGER SNPT=16_1006; ! SPECIALNAME PTYPE
// 288 %CONSTINTEGER COMMALT=2,ENDALT=9,UNASSPAT=16_81818181,DECALT=8
// 289 !
// 290 %INTEGER DICTBASE, CONSTPTR, CONSTBTM, DFHEAD, CONSTHOLE, WKFILEAD, {%C
int DICTBASE;
int CONSTPTR;
int CONSTBTM;
int DFHEAD;
int CONSTHOLE;
int WKFILEAD;
int WKFILEK;
int DUMMYFORMAT;
int P1SIZE;
int LEVELINF;
int IOCPDISP;
int PARMBITS1;
int PARMBITS2;
int PARMLET;
// 291 WKFILEK, DUMMYFORMAT, P1SIZE, LEVELINF, IOCPDISP, PARMBITS1, {%C
// 292 PARMBITS2,PARMLET
// 293 !
// 294 %INTEGER ASL, NNAMES, ARSIZE, CABUF, PPCURR, CONSTLIMIT, OLDLINE, {%C
int ASL;
int NNAMES;
int ARSIZE;
int CABUF;
int PPCURR;
int CONSTLIMIT;
int OLDLINE;
int LINE;
int LENGTH;
int NEXTP;
int SNUM;
int RLEVEL;
int NMAX;
int USTPTR;
int PLABEL;
int LEVEL;
int CA;
int LASTNAME;
int CDCOUNT;
int ASLCURBTM;
int PARMDYNAMIC;
// 295 LINE, LENGTH, NEXTP, SNUM, RLEVEL, NMAX, USTPTR, PLABEL,{%C
// 296 LEVEL, CA, LASTNAME, CDCOUNT, ASL CUR BTM, PARMDYNAMIC
// 297 !
// 298 %INTEGER FAULTY, HIT, INHCODE, IMPS, TTOPUT, LIST, PARMDIAG, {%C
int FAULTY;
int HIT;
int INHCODE;
int IMPS;
int TTOPUT;
int LIST;
int PARMDIAG;
int WARNFLAG;
int PARMTRACE;
int PARMLINE;
int PARMOPT;
int CTYPE;
int DCOMP;
int CPRMODE;
int PARMCHK;
int PARMARR;
int ALLLONG;
int PARMDBUG;
int COMPILER;
int LASTINST;
int SMAP;
int STACK;
int AUXST;
int PARMY;
int BFFLAG;
// 299 WARNFLAG, PARMTRACE, PARMLINE, PARMOPT, CTYPE, DCOMP, {%C
// 300 CPRMODE, PARMCHK, PARMARR, ALLLONG, PARMDBUG,{%C
// 301 COMPILER, LAST INST, SMAP, STACK, AUXST, PARMY, BFFLAG
// 302 !
// 303 %INTEGER RBASE, N, FREE FORMAT, PARMPROF, EXITLAB, CONTLAB, {%C
int RBASE;
int N;
int FREEFORMAT;
int PARMPROF;
int EXITLAB;
int CONTLAB;
int Q;
int R;
int S;
int NEST;
int FNAME;
int LDPTR;
int GLACA;
int GLACABUF;
int GLACURR;
int CREFHEAD;
int SSTL;
int QMAX;
int STMTS;
int LASTAT;
int FILEADDR;
int FILEPTR;
int FILEEND;
int FILESIZE;
int LASTEND;
int BIMSTR;
int STLIMIT;
int STRLINK;
int RECTB;
int ASLWARN;
int IHEAD;
// 304 Q, R, S, NEST, FNAME, LDPTR, GLACA, GLACABUF, {%C
// 305 GLACURR, CREFHEAD, SSTL, QMAX, STMTS, LASTAT, {%C
// 306 FILE ADDR, FILE PTR, FILE END, FILE SIZE, LASTEND, {%C
// 307 BIMSTR,STLIMIT,STRLINK,RECTB,ASL WARN,IHEAD
// 308 !
// 309 %INTEGER MAX ULAB, SFLABEL
int MAXULAB;
int SFLABEL;
// 310 %LONGREAL CVALUE, IMAX, CTIME
double CVALUE;
double IMAX;
double CTIME;
// 311 %STRING(31)MAINEP
_imp_string /*%string(31)*/ MAINEP;
// 312 %RECORDFORMAT LISTF(%INTEGER S1,S2,S3,LINK)
typedef struct LISTF LISTF; // forward declaration to allow a 'next' pointer to a struct within that struct...
struct LISTF {
int S1;
int S2;
int S3;
int LINK;
};
// 313 %INTEGER LOGEPDISP,EXPEPDISP
int LOGEPDISP;
int EXPEPDISP;
// 314 !
// 315 %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER N)
extern int *COMREG( int N );
// 316 %BEGIN
{
__label__ _imp_endofblock;
// 317 FILE ADDR=COMREG(46); ! SOURCE FILE IF CLEAN
FILEADDR = *COMREG(46);
// 318 PARMBITS1=COMREG(27)
PARMBITS1 = *COMREG(27);
// 319 PARMBITS2=COMREG(28)
PARMBITS2 = *COMREG(28);
// 320 WKFILEAD=COMREG(14)
WKFILEAD = *COMREG(14);
// 321 {WKFILEK=INTEGER(WKFILEAD+8)>>10
// 322 wkfilek = 128
WKFILEK = 128;
// 323 %IF FILE ADDR<=0 %THEN FILESIZE=64000 %AND FILE ADDR=0 %ELSESTART
if (( FILEADDR ) > ( 0 )) goto L_000d;
FILESIZE = 64000;
FILEADDR = 0;
goto L_000e;
L_000d:
// 324 FILE PTR=FILE ADDR+INTEGER(FILE ADDR+4)
FILEPTR = ((FILEADDR)) + ((*INTEGER(((FILEADDR)) + ((4)))));
// 325 FILE END=FILE ADDR+INTEGER(FILE ADDR)
FILEEND = ((FILEADDR)) + ((*INTEGER(FILEADDR)));
// 326 FILE SIZE=INTEGER(FILE ADDR)
FILESIZE = *INTEGER(FILEADDR);
// 327 %FINISH
L_000e:
// 328 NNAMES=255
NNAMES = 255;
// 329 %IF FILESIZE>10000 %THEN NNAMES=511
if (( FILESIZE ) <= ( 10000 )) goto L_000f;
NNAMES = 511;
L_000f:
// 330 %IF PARMBITS1&JOBBER BIT=0 %START
if (( ((PARMBITS1)) & ((1073741824)) ) != ( 0 )) goto L_0010;
// 331 %IF FILESIZE>32000 %THEN NNAMES=1023
if (( FILESIZE ) <= ( 32000 )) goto L_0011;
NNAMES = 1023;
L_0011:
// 332 %IF FILESIZE>256*1024 %OR PARMBITS2&MAXDICT#0 %OR WKFILEK>512 %THEN NNAMES=2047
if (( FILESIZE ) > ( ((256)) * ((1024)) )) goto L_0012;
if (( ((PARMBITS2)) & ((256)) ) != ( 0 )) goto L_0012;
if (( WKFILEK ) <= ( 512 )) goto L_0013;
L_0012:
NNAMES = 2047;
L_0013:
// 333 %FINISH
L_0010:
// 334 ASL=3*NNAMES
ASL = ((3)) * ((NNAMES));
// 335 ASL=4095 %IF ASL>4095 %AND PARMBITS2&MAXDICT=0;! STAY WITHIN 128K AUXSTACK
if (( ASL ) <= ( 4095 )) goto L_0014;
if (( ((PARMBITS2)) & ((256)) ) != ( 0 )) goto L_0014;
ASL = 4095;
L_0014:
// 336 ARSIZE=WKFILEK*768-300
ARSIZE = ((((WKFILEK)) * ((768)))) - ((300));
// 337 {%END ... extra block level enables dynamic array bound declarations ...
// 338 {%BYTEINTEGERARRAYFORMAT AF(0:ARSIZE)
// 339 {%BYTEINTEGERARRAYNAME A
// 340 %byteintegerarray A(0:WKFILEK*1024)
unsigned char A[(((WKFILEK)) * ((1024)))-(0)+1];
// 341 %RECORD(LISTF)%ARRAY ASLIST(0:ASL){(LISTF)
LISTF ASLIST[(ASL)-(0)+1];
// 342 %INTEGERARRAY WORD, TAGS(0:NNAMES)
int WORD[(NNAMES)-(0)+1];
int TAGS[(NNAMES)-(0)+1];
// 343 %INTEGERARRAY DVHEADS(0:12)
int DVHEADS[(12)-(0)+1];
// 344 %INTEGERFNSPEC FROMAR4(%INTEGER PTR)
auto int FROMAR4( int PTR );
// 345 %INTEGERFNSPEC FROMAR2(%INTEGER PTR)
auto int FROMAR2( int PTR );
// 346 %ROUTINESPEC TOAR8(%INTEGER PTR, %LONGREAL VALUE)
auto void TOAR8( int PTR, double VALUE );
// 347 %ROUTINESPEC TOAR4(%INTEGER PTR, VALUE)
auto void TOAR4( int PTR, int VALUE );
// 348 %ROUTINESPEC TOAR2(%INTEGER PTR,VALUE)
auto void TOAR2( int PTR, int VALUE );
// 349 %ROUTINESPEC WARN(%INTEGER N,V)
auto void WARN( int N, int V );
// 350 %ROUTINESPEC FAULT2(%INTEGER N,VAL,IDEN)
auto void FAULT2( int N, int VAL, int IDEN );
// 351 %ROUTINESPEC FAULT(%INTEGER N, VALUE)
auto void FAULT( int N, int VALUE );
// 352 %STRING(255)%FNSPEC PRINTNAME(%INTEGER N)
auto _imp_string /*%string(255)*/ PRINTNAME( int N );
// 353 %INTEGERFNSPEC MORE SPACE
auto int MORESPACE( void );
// 354 !%INTEGERFNSPEC NEWCELL
// 355 %ROUTINESPEC INSERTATEND(%INTEGERNAME S, %INTEGER A, B, C)
auto void INSERTATEND( int *S, int A, int B, int C );
// 356 %ROUTINESPEC FROM12(%INTEGER CELL, %INTEGERNAME S1, S2)
auto void FROM12( int CELL, int *S1, int *S2 );
// 357 %ROUTINESPEC FROM123(%INTEGER CELL, %INTEGERNAME S1, S2, S3)
auto void FROM123( int CELL, int *S1, int *S2, int *S3 );
// 358 %ROUTINESPEC POP(%INTEGERNAME C, P, Q, R)
auto void POP( int *C, int *P, int *Q, int *R );
// 359 %ROUTINESPEC PUSH(%INTEGERNAME C, %INTEGER S1, S2, S3)
auto void PUSH( int *C, int S1, int S2, int S3 );
// 360 %INTEGERFNSPEC FIND(%INTEGER LAB, LIST)
auto int FIND( int LAB, int LIST );
// 361 %ROUTINESPEC MLINK(%INTEGERNAME CELL)
auto void MLINK( int *CELL );
// 362 %ROUTINESPEC REPLACE1(%INTEGER CELL, S1)
auto void REPLACE1( int CELL, int S1 );
// 363 %ROUTINESPEC REPLACE2(%INTEGER CELL, S2)
auto void REPLACE2( int CELL, int S2 );
// 364 %ROUTINESPEC REPLACE3(%INTEGER CELL,S3)
auto void REPLACE3( int CELL, int S3 );
// 365 %ROUTINESPEC REPLACE123(%INTEGER CELL,A1,A2,S3)
auto void REPLACE123( int CELL, int A1, int A2, int S3 );
// 366 %INTEGERFNSPEC FROM2(%INTEGER CELL)
auto int FROM2( int CELL );
// 367 %INTEGERFNSPEC FROM1(%INTEGER CELL)
auto int FROM1( int CELL );
// 368 %INTEGERFNSPEC FROM3(%INTEGER CELL)
auto int FROM3( int CELL );
// 369 %ROUTINESPEC BINSERT(%INTEGERNAME T,B,%INTEGER S1,S2,S3)
auto void BINSERT( int *T, int *B, int S1, int S2, int S3 );
// 370 %ROUTINESPEC CLEARLIST(%INTEGERNAME HEAD)
auto void CLEARLIST( int *HEAD );
// 371 %STRING(255)%FNSPEC MESSAGE(%INTEGER N)
auto _imp_string /*%string(255)*/ MESSAGE( int N );
// 372 %SYSTEMROUTINESPEC LPUT(%INTEGER A, B, C, D)
extern void LPUT( int A, int B, int C, int D );
// 373 %SYSTEMLONGREALFNSPEC CPUTIME
extern double CPUTIME( void );
// 374 !*DELSTART
// 375 %SYSTEMROUTINESPEC NCODE(%INTEGER START, FINISH, CA)
extern void NCODE( int START, int FINISH, int CA );
// 376 %ROUTINESPEC PRINTLIST(%INTEGER HEAD)
auto void PRINTLIST( int HEAD );
// 377 %ROUTINESPEC PRHEX(%INTEGER VALUE,PLACES)
auto void PRHEX( int VALUE, int PLACES );
// 378 %ROUTINESPEC CHECK ASL
auto void CHECKASL( void );
// 379 !*DELEND
// 380 %IF VMEB=NO %THEN %START
if (( 0 ) != ( 0 )) goto L_0015;
// 381 %SYSTEMROUTINESPEC CONSOURCE(%STRING(31)FILE,%INTEGERNAME AD)
extern void CONSOURCE( _imp_string /*%string(31)*/ FILE, int *AD );
// 382 %FINISH
L_0015:
// 383 ! START OF COMPILATION
// 384 {A==ARRAY(WKFILE AD+256*WKFILEK, AF)
// 385 %BEGIN
{
__label__ _imp_endofblock;
// 386 !***********************************************************************
// 387 !* THIS BLOCK INITIALISE THE COMPILER SCALARS AND ARRAYS *
// 388 !* WAS ORIGINALLY ROUTINE 'INITIALISE'. *
// 389 !* THE INITIALISATION OF THE CONSTANT LISTS WITH THE VALUES *
// 390 !* IN PERM MAY BE OMITTED IN BATCH OR CUT-DOWN VERSIONS. *
// 391 !***********************************************************************
// 392 %ROUTINESPEC READ LINE(%INTEGER MODE,CHAR)
auto void READLINE( int MODE, int CHAR );
// 393 %INTEGERFNSPEC COMPARE(%INTEGER P)
auto int COMPARE( int P );
// 394 %ROUTINESPEC PNAME(%INTEGER MODE)
auto void PNAME( int MODE );
// 395 %ROUTINESPEC CONST(%INTEGER MODE)
auto void CONST( int MODE );
// 396 %ROUTINESPEC TEXTTEXT(%INTEGER EBCDIC)
auto void TEXTTEXT( int EBCDIC );
// 397 %INTEGER CCSIZE,DSIZE,NEXT,ATLINE1,STARSTART
int CCSIZE;
int DSIZE;
int NEXT;
int ATLINE1;
int STARSTART;
// 398 CCSIZE=1000; DSIZE=7*NNAMES
CCSIZE = 1000;
DSIZE = ((7)) * ((NNAMES));
// 399 %INTEGERARRAY DISPLAY,SFS(0:MAXLEVELS)
int DISPLAY[(31)-(0)+1];
int SFS[(31)-(0)+1];
// 400 %BYTEINTEGERARRAY TLINE(-60:161),CC(0:CCSIZE),LETT(0:DSIZE+20)
unsigned char TLINE[(161)-((-(60)))+1];
unsigned char CC[(CCSIZE)-(0)+1];
unsigned char LETT[(((DSIZE)) + ((20)))-(0)+1];
// 401 %LONGINTEGER ATL0,ASYM0
long long int ATL0;
long long int ASYM0;
// 402 %CONSTBYTEINTEGERARRAY ILETT(0: 500)= 11,
const unsigned char ILETT[(500)-(0)+1] = { 11, 83, 69, 76, 69, 67, 84, 73, 78, 80, 85, 84, 12, 83, 69, 76, 69, 67, 84, 79, 85, 84, 80, 85, 84, 7, 78, 69, 87, 76, 73, 78, 69, 5, 83, 80, 65, 67, 69, 10, 83, 75, 73, 80, 83, 89, 77, 66, 79, 76, 10, 82, 69, 65, 68, 83, 84, 82, 73, 78, 71, 8, 78, 69, 87, 76, 73, 78, 69, 83, 6, 83, 80, 65, 67, 69, 83, 10, 78, 69, 88, 84, 83, 89, 77, 66, 79, 76, 11, 80, 82, 73, 78, 84, 83, 89, 77, 66, 79, 76, 10, 82, 69, 65, 68, 83, 89, 77, 66, 79, 76, 4, 82, 69, 65, 68, 5, 87, 82, 73, 84, 69, 7, 78, 69, 87, 80, 65, 71, 69, 4, 65, 68, 68, 82, 6, 65, 82, 67, 83, 73, 78, 3, 73, 78, 84, 5, 73, 78, 84, 80, 84, 6, 70, 82, 65, 67, 80, 84, 5, 80, 82, 73, 78, 84, 7, 80, 82, 73, 78, 84, 70, 76, 4, 82, 69, 65, 76, 7, 73, 78, 84, 69, 71, 69, 82, 3, 77, 79, 68, 6, 65, 82, 67, 67, 79, 83, 4, 83, 81, 82, 84, 3, 76, 79, 71, 3, 83, 73, 78, 3, 67, 79, 83, 3, 84, 65, 78, 3, 69, 88, 80, 11, 67, 76, 79, 83, 69, 83, 84, 82, 69, 65, 77, 11, 66, 89, 84, 69, 73, 78, 84, 69, 71, 69, 82, 8, 69, 86, 69, 78, 84, 73, 78, 70, 6, 82, 65, 68, 73, 85, 83, 6, 65, 82, 67, 84, 65, 78, 6, 76, 69, 78, 71, 84, 72, 11, 80, 82, 73, 78, 84, 83, 84, 82, 73, 78, 71, 2, 78, 76, 8, 76, 79, 78, 71, 82, 69, 65, 76, 7, 80, 82, 73, 78, 84, 67, 72, 6, 82, 69, 65, 68, 67, 72, 6, 83, 84, 82, 73, 78, 71, 8, 82, 69, 65, 68, 73, 84, 69, 77, 8, 78, 69, 88, 84, 73, 84, 69, 77, 6, 67, 72, 65, 82, 78, 79, 8, 84, 79, 83, 84, 82, 73, 78, 71, 10, 70, 82, 79, 77, 83, 84, 82, 73, 78, 71, 6, 82, 69, 67, 79, 82, 68, 5, 65, 82, 82, 65, 89, 10, 83, 69, 84, 77, 65, 82, 71, 73, 78, 83, 4, 73, 77, 79, 68, 2, 80, 73, 9, 69, 86, 69, 78, 84, 76, 73, 78, 69, 11, 76, 79, 78, 71, 73, 78, 84, 69, 71, 69, 82, 12, 76, 79, 78, 71, 76, 79, 78, 71, 82, 69, 65, 76, 9, 76, 69, 78, 71, 84, 72, 69, 78, 73, 9, 76, 69, 78, 71, 84, 72, 69, 78, 82, 8, 83, 72, 79, 82, 84, 69, 78, 73, 8, 83, 72, 79, 82, 84, 69, 78, 82, 6, 78, 69, 88, 84, 67, 72, 11, 72, 65, 76, 70, 73, 78, 84, 69, 71, 69, 82, 8, 80, 80, 82, 79, 70, 73, 76, 69, 255, };
// 403 'S','E','L','E','C','T','I','N','P','U','T', 12,'S','E','L','E',
// 404 'C','T','O','U','T','P','U','T', 7,'N','E','W','L','I','N','E',
// 405 5,'S','P','A','C','E', 10,'S','K','I','P','S','Y','M','B','O',
// 406 'L', 10,'R','E','A','D','S','T','R','I','N','G', 8,'N','E','W',
// 407 'L','I','N','E','S', 6,'S','P','A','C','E','S', 10,'N','E','X',
// 408 'T','S','Y','M','B','O','L', 11,'P','R','I','N','T','S','Y','M',
// 409 'B','O','L', 10,'R','E','A','D','S','Y','M','B','O','L', 4,'R',
// 410 'E','A','D', 5,'W','R','I','T','E', 7,'N','E','W','P','A','G',
// 411 'E', 4,'A','D','D','R', 6,'A','R','C','S','I','N', 3,'I','N',
// 412 'T', 5,'I','N','T','P','T', 6,'F','R','A','C','P','T', 5,'P',
// 413 'R','I','N','T', 7,'P','R','I','N','T','F','L', 4,'R','E','A',
// 414 'L', 7,'I','N','T','E','G','E','R', 3,'M','O','D', 6,'A','R',
// 415 'C','C','O','S', 4,'S','Q','R','T', 3,'L','O','G', 3,'S','I',
// 416 'N', 3,'C','O','S', 3,'T','A','N', 3,'E','X','P', 11,'C','L',
// 417 'O','S','E','S','T','R','E','A','M', 11,'B','Y','T','E','I','N',
// 418 'T','E','G','E','R', 8,'E','V','E','N','T','I','N','F',
// 419 6,'R','A','D','I','U','S', 6,'A','R','C','T','A','N',
// 420 6,'L','E','N','G','T','H', 11,'P','R','I','N','T','S','T','R',
// 421 'I','N','G', 2,'N','L', 8,'L','O','N','G','R','E','A','L', 7,
// 422 'P','R','I','N','T','C','H', 6,'R','E','A','D','C','H', 6,'S',
// 423 'T','R','I','N','G', 8,'R','E','A','D','I','T','E','M', 8,'N',
// 424 'E','X','T','I','T','E','M', 6,'C','H','A','R','N','O', 8,'T',
// 425 'O','S','T','R','I','N','G', 10,'F','R','O','M','S','T','R','I',
// 426 'N','G', 6,'R','E','C','O','R','D', 5,'A','R','R','A','Y', 10,
// 427 'S','E','T','M','A','R','G','I','N','S',4,'I','M','O','D',2,'P',
// 428 'I',9,'E','V','E','N','T','L','I','N','E',11,'L','O','N','G',
// 429 'I','N','T','E','G','E','R',12,'L','O','N','G','L','O','N','G',
// 430 'R','E','A','L',9,'L','E','N','G','T','H','E','N','I',
// 431 9,'L','E','N','G','T','H','E','N','R',
// 432 8,'S','H','O','R','T','E','N','I',
// 433 8,'S','H','O','R','T','E','N','R',
// 434 6,'N','E','X','T','C','H',
// 435 11,'H','A','L','F','I','N','T','E','G','E','R',
// 436 8,'P','P','R','O','F','I','L','E',255;
// 437 IMAX=(-1)>>1;PLABEL=24999
IMAX = (int)(((unsigned int)((-(1)))) >> ((1)));
PLABEL = 24999;
// 438 LETT(0)=0
LETT[0] = 0;
// 439 ATLINE1=ADDR(TLINE(1))
ATLINE1 = ADDR( &(TLINE-85)[1]);
// 440 INTEGER(ADDR(ATL0)+4)=ATLINE1-1
*INTEGER(((ADDR( &ATL0))) + ((4))) = ((ATLINE1)) - ((1));
// 441 INTEGER(ADDR(ATL0))=16_18000100
*INTEGER(ADDR( &ATL0)) = 402653440;
// 442 INTEGER(ADDR(ASYM0))=16_28000C00
*INTEGER(ADDR( &ASYM0)) = 671091712;
// 443 INTEGER(ADDR(ASYM0)+4)=ADDR(SYMBOL(1300))-4*1300
*INTEGER(((ADDR( &ASYM0))) + ((4))) = ((ADDR( &(SYMBOL-1300)[1300]))) - ((((4)) * ((1300))));
// 444 N=12;
N = 12;
// 445 MAX ULAB=NNAMES+16384; ! LARGEST VALID USER LABEL
MAXULAB = ((NNAMES)) + ((16384));
// 446 GLACURR=0; GLACA=FIXEDGLALEN; GLACABUF=GLACA
GLACURR = 0;
GLACA = 48;
GLACABUF = GLACA;
// 447 PARMOPT=1 ; PARMARR=1; LAST INST=0
PARMOPT = 1;
PARMARR = 1;
LASTINST = 0;
// 448 PARMLINE=1; PARMTRACE=1; PARMDIAG=1
PARMLINE = 1;
PARMTRACE = 1;
PARMDIAG = 1;
// 449 LIST=1; SFLABEL=20999; PARMCHK=1
LIST = 1;
SFLABEL = 20999;
PARMCHK = 1;
// 450 EXITLAB=0; CONTLAB=0
EXITLAB = 0;
CONTLAB = 0;
// 451 CABUF=0; PPCURR=0; OLDLINE=0; COMPILER=0
CABUF = 0;
PPCURR = 0;
OLDLINE = 0;
COMPILER = 0;
// 452 RLEVEL=0; NMAX=0; USTPTR=0
RLEVEL = 0;
NMAX = 0;
USTPTR = 0;
// 453 LEVEL=0; CA=0; LASTAT=0
LEVEL = 0;
CA = 0;
LASTAT = 0;
// 454 FAULTY=0; WARNFLAG=0; ALLLONG=0; INHCODE=0
FAULTY = 0;
WARNFLAG = 0;
ALLLONG = 0;
INHCODE = 0;
// 455 DCOMP=0; BFFLAG=0; CPRMODE=0
DCOMP = 0;
BFFLAG = 0;
CPRMODE = 0;
// 456 NEXT=1; LDPTR=0
NEXT = 1;
LDPTR = 0;
// 457 IOCPDISP=0; CREFHEAD=0; AUXST=0
IOCPDISP = 0;
CREFHEAD = 0;
AUXST = 0;
// 458 RBASE=10; LOGEPDISP=0; EXPEPDISP=0; STRLINK=0
RBASE = 10;
LOGEPDISP = 0;
EXPEPDISP = 0;
STRLINK = 0;
// 459 RECTB=0; IHEAD=0
RECTB = 0;
IHEAD = 0;
// 460 SSTL=0; STMTS=1; SNUM=0; LEVELINF=0
SSTL = 0;
STMTS = 1;
SNUM = 0;
LEVELINF = 0;
// 461 CDCOUNT=0
CDCOUNT = 0;
// 462 BIMSTR=0
BIMSTR = 0;
// 463 LOGEPDISP=0; EXPEPDISP=0
LOGEPDISP = 0;
EXPEPDISP = 0;
// 464 MAINEP="S#GO"; ! DEFAULT MAIN ENTRY
MAINEP = _imp_str_literal("S#GO");
// 465 DICTBASE=ADDR(LETT(0))
DICTBASE = ADDR( &LETT[0]);
// 466 !
// 467 ! OPEN OBJECT FILE HERE BEFORE MORE PAGES OF COMPILER CODE
// 468 ! ARE PAGED IN AND SUB-SYSTEM PAGES MOVE OUT
// 469 !
// 470 LPUT(0,0,0,0)
LPUT(0, 0, 0, 0);
// 471 CTIME=CPUTIME
CTIME = CPUTIME();
// 472 I=COMREG(27)
I = *COMREG(27);
// 473 STLIMIT=16_1F000
STLIMIT = 126976;
// 474 %IF I>>24&1#0 %THEN STLIMIT=COMREG(48)-4096
if (( (((int)(((unsigned int)(I)) >> ((24))))) & ((1)) ) == ( 0 )) goto L_0016;
STLIMIT = ((*COMREG(48))) - ((4096));
L_0016:
// 475 %IF I&2=2 %THEN LIST=0
if (( ((I)) & ((2)) ) != ( 2 )) goto L_0017;
LIST = 0;
L_0017:
// 476 %IF I&4=4 %THEN PARMDIAG=0
if (( ((I)) & ((4)) ) != ( 4 )) goto L_0018;
PARMDIAG = 0;
L_0018:
// 477 %IF I&16_800000#0 %THEN PARMLINE=0
if (( ((I)) & ((8388608)) ) == ( 0 )) goto L_0019;
PARMLINE = 0;
L_0019:
// 478 %IF I&16=16 %THEN PARMCHK=0
if (( ((I)) & ((16)) ) != ( 16 )) goto L_001a;
PARMCHK = 0;
L_001a:
// 479 %IF I&32=32 %THEN PARMARR=0
if (( ((I)) & ((32)) ) != ( 32 )) goto L_001b;
PARMARR = 0;
L_001b:
// 480 PARMPROF=(I>>15&1)!(I>>7&1); ! USE MAP OR PROFILE BIT PRO TEM
PARMPROF = (((((int)(((unsigned int)(I)) >> ((15))))) & ((1)))) | (((((int)(((unsigned int)(I)) >> ((7))))) & ((1))));
// 481 PARMDYNAMIC=I>>20&1
PARMDYNAMIC = (((int)(((unsigned int)(I)) >> ((20))))) & ((1));
// 482 PARMLET=I>>13&1
PARMLET = (((int)(((unsigned int)(I)) >> ((13))))) & ((1));
// 483 DCOMP=I>>14&1; ! PARM CODE OR D
DCOMP = (((int)(((unsigned int)(I)) >> ((14))))) & ((1));
// 484 PARMDBUG=I>>18&1
PARMDBUG = (((int)(((unsigned int)(I)) >> ((18))))) & ((1));
// 485 %IF I&64=64 %THEN PARMTRACE=0 %AND PARMDIAG=0
if (( ((I)) & ((64)) ) != ( 64 )) goto L_001c;
PARMTRACE = 0;
PARMDIAG = 0;
L_001c:
// 486 FREE FORMAT=I&16_80000
FREEFORMAT = ((I)) & ((524288));
// 487 STACK=I>>3&1
STACK = (((int)(((unsigned int)(I)) >> ((3))))) & ((1));
// 488 SMAP=I>>26&1; ! USE PARMZ BIT FOR DUMPING WKFILE
SMAP = (((int)(((unsigned int)(I)) >> ((26))))) & ((1));
// 489 TTOPUT=COMREG(40)
TTOPUT = *COMREG(40);
// 490 %IF I&(1<<16)#0 %THEN %START
if (( ((I)) & ((((1)) << ((16)))) ) == ( 0 )) goto L_001d;
// 491 PARMARR=0; PARMOPT=0
PARMARR = 0;
PARMOPT = 0;
// 492 PARMLINE=0; PARMCHK=0; PARMDIAG=0
PARMLINE = 0;
PARMCHK = 0;
PARMDIAG = 0;
// 493 %FINISH
L_001d:
// 494 PARMTRACE=PARMTRACE!PARMOPT; ! ALLOW NOTRACE ONLY WITH OPT
PARMTRACE = ((PARMTRACE)) | ((PARMOPT));
// 495 IMPS=I>>23&1; ! BIT SET IF IMPS REQUESTED
IMPS = (((int)(((unsigned int)(I)) >> ((23))))) & ((1));
// 496 IMPS=1; ! FOR TESTING
IMPS = 1;
// 497 NEWLINES(3); SPACES(14)
NEWLINES(3);
SPACES(14);
// 498 PRINTSTRING("ERCC. Imp")
PRINTSTRING(_imp_str_literal("ERCC. Imp"));
// 499 %IF IMPS#0 %THEN PRINTSYMBOL('s')
if (( IMPS ) == ( 0 )) goto L_001e;
PRINTSYMBOL(115);
L_001e:
// 500 PRINTSTRING(" Compiler Release")
PRINTSTRING(_imp_str_literal(" Compiler Release"));
// 501 WRITE(RELEASE,1)
WRITE(10, 1);
// 502 PRINTSTRING(" Version ".LADATE)
PRINTSTRING(_imp_strcat((&(_imp_str_literal(" Version "))), LADATE));
// 503 NEWLINES(3)
NEWLINES(3);
// 504 WRITE(NNAMES,5); WRITE(ASL,5)
WRITE(NNAMES, 5);
WRITE(ASL, 5);
// 505 NEWLINE
NEWLINE();
// 506 ASL WARN=0
ASLWARN = 0;
// 507 ASL CUR BTM=ASL-240
ASLCURBTM = ((ASL)) - ((240));
// 508 CONST LIMIT=4*ASL CUR BTM-8
CONSTLIMIT = ((((4)) * ((ASLCURBTM)))) - ((8));
// 509 %CYCLE I=ASL CUR BTM,1,ASL-1
I = ((ASLCURBTM)) - ((1));
L_001f:
if (( I ) == ( ((ASL)) - ((1)) )) goto L_0020;
I = ((I)) + ((1));
// 510 ASLIST(I+1)_LINK=I
ASLIST[((I)) + ((1))].LINK = I;
// 511 %REPEAT
goto L_001f;
L_0020:
// 512 ASLIST(ASL CUR BTM)_LINK=0
ASLIST[ASLCURBTM].LINK = 0;
// 513 ASLIST(0)_S1=-1
ASLIST[0].S1 = (-(1));
// 514 ASLIST(0)_S2=-1
ASLIST[0].S2 = (-(1));
// 515 ASLIST(0)_S3=-1
ASLIST[0].S3 = (-(1));
// 516 ASLIST(0)_LINK=0
ASLIST[0].LINK = 0;
// 517 %CYCLE I=0,1,NNAMES
I = ((0)) - ((1));
L_0022:
if (( I ) == ( NNAMES )) goto L_0023;
I = ((I)) + ((1));
// 518 WORD(I)=0; TAGS(I)=0;
WORD[I] = 0;
TAGS[I] = 0;
// 519 %REPEAT
goto L_0022;
L_0023:
// 520 %CYCLE I=0,1,12
I = ((0)) - ((1));
L_0025:
if (( I ) == ( 12 )) goto L_0026;
I = ((I)) + ((1));
// 521 DVHEADS(I)=0
DVHEADS[I] = 0;
// 522 %REPEAT
goto L_0025;
L_0026:
// 523 !
// 524 ! NOW DECLARE THE SPECIAL NAMES WHICH ARE IN ARRAY ILETT.
// 525 !
// 526 K=0; NEXT=1
K = 0;
NEXT = 1;
// 527 I=ILETT(0)
I = ILETT[0];
// 528 %WHILE I<255 %CYCLE
L_0028:
if (( I ) >= ( 255 )) goto L_0029;
// 529 %CYCLE J=I,-1,1
J = ((I)) - (((-(1))));
L_002b:
if (( J ) == ( 1 )) goto L_002c;
J = ((J)) + (((-(1))));
// 530 CC(J)=ILETT(K+J)
CC[J] = ILETT[((K)) + ((J))];
// 531 %REPEAT
goto L_002b;
L_002c:
// 532 CC(I+1)=';'
CC[((I)) + ((1))] = 59;
// 533 R=2; Q=1; PNAME(1)
R = 2;
Q = 1;
PNAME(1);
// 534 PUSH(TAGS(LASTNAME),SNPT<<16!16_8000,0,SNUM<<16)
PUSH( &TAGS[LASTNAME], ((((4102)) << ((16)))) | ((32768)), 0, ((SNUM)) << ((16)));
// 535 SNUM=SNUM+1
SNUM = ((SNUM)) + ((1));
// 536 K=K+I+1; I=ILETT(K)
K = ((((K)) + ((I)))) + ((1));
I = ILETT[K];
// 537 %REPEAT
goto L_0028;
L_0029:
// 538 !
// 539 COMREG(24)=16; ! RETURN CODE
*COMREG(24) = 16;
// 540 DUMMY FORMAT=0; ! DUMMY RECORD FORMAT
DUMMYFORMAT = 0;
// 541 DFHEAD=0
DFHEAD = 0;
// 542 PUSH(DFHEAD,0,0,0)
PUSH( &DFHEAD, 0, 0, 0);
// 543 PUSH(DUMMY FORMAT,0,0,DFHEAD); ! FOR BETTER ERROR RECOVERY
PUSH( &DUMMYFORMAT, 0, 0, DFHEAD);
// 544 LINE=0; LENGTH=0; Q=1
LINE = 0;
LENGTH = 0;
Q = 1;
// 545 R=1; LEVEL=1
R = 1;
LEVEL = 1;
// 546 %CYCLE
L_002e:
// 547 %IF Q>=LENGTH %THEN QMAX=1 %AND READ LINE(0,0)
if (( Q ) < ( LENGTH )) goto L_0031;
QMAX = 1;
READLINE(0, 0);
L_0031:
// 548 WARNFLAG=0
WARNFLAG = 0;
// 549 STARSTART=R
STARSTART = R;
// 550 R=R+3
R = ((R)) + ((3));
// 551 OLDLINE=LINE
OLDLINE = LINE;
// 552 A(R)=LINE>>8
A[R] = (int)(((unsigned int)(LINE)) >> ((8)));
// 553 A(R+1)=LINE&255
A[((R)) + ((1))] = ((LINE)) & ((255));
// 554 R=R+2
R = ((R)) + ((2));
// 555 %IF COMPARE(SS)=0 %THEN %START
if (( COMPARE(2093) ) != ( 0 )) goto L_0032;
// 556 FAULT(100,ADDR(CC(0)))
FAULT(100, ADDR( &CC[0]));
// 557 R=STARSTART
R = STARSTART;
// 558 %FINISH %ELSE %START
goto L_0033;
L_0032:
// 559 FAULT(102, 0) %IF R>ARSIZE
if (( R ) <= ( ARSIZE )) goto L_0034;
FAULT(102, 0);
L_0034:
// 560 %IF A(STARSTART+5)=COMMALT %THEN R=STARSTART %ELSE %START
if (( A[((STARSTART)) + ((5))] ) != ( 2 )) goto L_0035;
R = STARSTART;
goto L_0036;
L_0035:
// 561 I=R-STARSTART
I = ((R)) - ((STARSTART));
// 562 A(STARSTART)=I>>16
A[STARSTART] = (int)(((unsigned int)(I)) >> ((16)));
// 563 A(STARSTART+1)=I>>8&255
A[((STARSTART)) + ((1))] = (((int)(((unsigned int)(I)) >> ((8))))) & ((255));
// 564 A(STARSTART+2)=I&255
A[((STARSTART)) + ((2))] = ((I)) & ((255));
// 565 %IF A(STARSTART+5)=DECALT %AND LEVEL>1 %THEN %START
if (( A[((STARSTART)) + ((5))] ) != ( 8 )) goto L_0037;
if (( LEVEL ) <= ( 1 )) goto L_0037;
// 566 %IF SFS(LEVEL)=0 %THEN %START
if (( SFS[LEVEL] ) != ( 0 )) goto L_0038;
// 567 TO AR4(DISPLAY(LEVEL),STARSTART)
TOAR4(DISPLAY[LEVEL], STARSTART);
// 568 DISPLAY(LEVEL)=STARSTART+6
DISPLAY[LEVEL] = ((STARSTART)) + ((6));
// 569 %FINISH %ELSE A(STARSTART+6)=128;! FLAG AS UNLINKED
goto L_0039;
L_0038:
A[((STARSTART)) + ((6))] = 128;
L_0039:
// 570 %FINISH
L_0037:
// 571 !*DELSTART
// 572 %IF SMAP#0 %THEN %START
if (( SMAP ) == ( 0 )) goto L_003a;
// 573 NEWLINE; WRITE(LINE, 5)
NEWLINE();
WRITE(LINE, 5);
// 574 WRITE(STARSTART,5); NEWLINE; J=0
WRITE(STARSTART, 5);
NEWLINE();
J = 0;
// 575 %CYCLE I=STARSTART, 1, R-1
I = ((STARSTART)) - ((1));
L_003b:
if (( I ) == ( ((R)) - ((1)) )) goto L_003c;
I = ((I)) + ((1));
// 576 WRITE(A(I), 5)
WRITE(A[I], 5);
// 577 J=J+1
J = ((J)) + ((1));
// 578 %IF J>=20 %THEN NEWLINE %AND J=0
if (( J ) < ( 20 )) goto L_003e;
NEWLINE();
J = 0;
L_003e:
// 579 %REPEAT
goto L_003b;
L_003c:
// 580 NEWLINE
NEWLINE();
// 581 %FINISH
L_003a:
// 582 !*DELEND
// 583 %EXIT %IF A(STARSTART+5)=ENDALT %AND 1<=A(STARSTART+6)<=2;! ENDOF PROG OR FILE
if (( A[((STARSTART)) + ((5))] ) != ( 9 )) goto L_003f;
if (( 1 ) > ( A[((STARSTART)) + ((6))] )) goto L_003f;
if (( A[((STARSTART)) + ((6))] ) > ( 2 )) goto L_003f;
goto L_002f;
L_003f:
// 584 %IF LEVEL=0 %THEN FAULT(14, 0) %AND %EXIT
if (( LEVEL ) != ( 0 )) goto L_0040;
FAULT(14, 0);
goto L_002f;
L_0040:
// 585 %FINISH
L_0036:
// 586 %FINISH
L_0033:
// 587 %REPEAT
goto L_002e;
L_002f:
// 588 TO AR8(R,0); R=R+8
TOAR8(R, 0);
R = ((R)) + ((8));
// 589 %IF R+NEXT>ARSIZE %THEN FAULT(102,0)
if (( ((R)) + ((NEXT)) ) <= ( ARSIZE )) goto L_0041;
FAULT(102, 0);
L_0041:
// 590 P1SIZE=R
P1SIZE = R;
// 591 ! %IF USE IMP=YES %THEN %START
// 592 %CYCLE I=0,1,NEXT
I = ((0)) - ((1));
L_0042:
if (( I ) == ( NEXT )) goto L_0043;
I = ((I)) + ((1));
// 593 A(R+I)=LETT(I)
A[((R)) + ((I))] = LETT[I];
// 594 %REPEAT
goto L_0042;
L_0043:
// 595 ! %FINISH %ELSE %START
// 596 ! *LDTB_16_18000000
// 597 ! *LDB_NEXT
// 598 ! *LDA_LETT+4
// 599 ! *CYD_0
// 600 ! *LDA_A+4
// 601 ! *INCA_R
// 602 ! *MV_%L=%DR
// 603 ! %FINISH
// 604 DICTBASE=ADDR(A(R))
DICTBASE = ADDR( &A[R]);
// 605 R=R+NEXT+1
R = ((((R)) + ((NEXT)))) + ((1));
// 606 ->BEND
goto U_012b;
// 607 %ROUTINE READ LINE(%INTEGER MODE,CHAR)
void READLINE( int MODE, int CHAR )
{
__label__ _imp_endofblock;
// 608 %ROUTINESPEC GET LINE
auto void GETLINE( void );
// 609 %INTEGER DEL, LL, LP
int DEL;
int LL;
int LP;
// 610 LL=0; LP=0; Q=1
LL = 0;
LP = 0;
Q = 1;
// 611 LENGTH=0; DEL=0
LENGTH = 0;
DEL = 0;
// 612 NEXT:
U_0132:
// 613 ! %IF USE IMP=YES %THEN %START
// 614 LP=LP+1
LP = ((LP)) + ((1));
// 615 %IF LP>LL %THEN GET LINE %AND LP=1
if (( LP ) <= ( LL )) goto L_0045;
GETLINE();
LP = 1;
L_0045:
// 616 I=TLINE(LP)
I = (TLINE-85)[LP];
// 617 %IF MODE=0 %THEN %START
if (( MODE ) != ( 0 )) goto L_0046;
// 618 %IF I='%' %THEN DEL=128 %AND ->NEXT
if (( I ) != ( 37 )) goto L_0047;
DEL = 128;
goto U_0132;
L_0047:
// 619 I=ONE CASE(I)
I = ONECASE[I];
// 620 %IF 'A'<=I<='Z' %THEN I=I!DEL %ELSE %START
if (( 65 ) > ( I )) goto L_0048;
if (( I ) > ( 90 )) goto L_0048;
I = ((I)) | ((DEL));
goto L_0049;
L_0048:
// 621 DEL=0
DEL = 0;
// 622 ->NEXT %IF I=' '
if (( I ) != ( 32 )) goto L_004a;
goto U_0132;
L_004a:
// 623 %FINISH
L_0049:
// 624 LENGTH=LENGTH+1
LENGTH = ((LENGTH)) + ((1));
// 625 CC(LENGTH)=I
CC[LENGTH] = I;
// 626 %IF I='''' %OR I=34 %THEN MODE=1 %AND CHAR=I
if (( I ) == ( 39 )) goto L_002d;
if (( I ) != ( 34 )) goto L_004b;
L_002d:
MODE = 1;
CHAR = I;
L_004b:
// 627 %FINISH %ELSE %START
goto L_004c;
L_0046:
// 628 LENGTH=LENGTH+1
LENGTH = ((LENGTH)) + ((1));
// 629 CC(LENGTH)=I
CC[LENGTH] = I;
// 630 %IF I=CHAR %THEN MODE=0
if (( I ) != ( CHAR )) goto L_004d;
MODE = 0;
L_004d:
// 631 %FINISH
L_004c:
// 632 ->NEXT %UNLESS I=NL
if (( I ) == ( 10 )) goto L_004e;
goto U_0132;
L_004e:
// 633 ! %FINISH %ELSE %START
// 634 ! *LB_LP
// 635 ! *ADB_1
// 636 ! *CPB_LL
// 637 ! *JCC_12,<RLL1>
// 638 ! GET LINE
// 639 ! *LB_1
// 640 !RLL1:
// 641 ! *STB_LP
// 642 ! *LB_(ATL0+%B)
// 643 ! *LSS_MODE
// 644 ! *JAF_4,<RLL2>
// 645 ! *CPB_37; !'%'
// 646 ! *JCC_7,<RLL3>
// 647 ! *L_128
// 648 ! *ST_DEL
// 649 ! *J_<NEXT>
// 650 !RLL3:
// 651 ! *LSS_(ONE CASE+%B); ! LOWER CASE TO UPPER
// 652 ! *ICP_65; !'A'
// 653 ! *JCC_4,<RLL4>
// 654 ! *ICP_90; !'Z'
// 655 ! *JCC_2,<RLL4>
// 656 ! *OR_DEL
// 657 ! *J_<RLL5>
// 658 !RLL4:
// 659 ! *LB_0
// 660 ! *STB_DEL
// 661 ! *ICP_32; !' '
// 662 ! *JCC_8,<NEXT>
// 663 !RLL5:
// 664 ! *LB_LENGTH
// 665 ! *ADB_1
// 666 ! *STB_LENGTH
// 667 ! *ST_(CC+%B)
// 668 ! *ICP_39; !''''
// 669 ! *JCC_8,<RLL6>
// 670 ! *ICP_34; !'"'
// 671 ! *JCC_7,<RLL7>
// 672 !RLL6:
// 673 ! *ST_CHAR
// 674 ! *LB_1
// 675 ! *STB_MODE
// 676 !RLL7:
// 677 ! *ICP_10
// 678 ! *JCC_7,<NEXT>
// 679 ! *J_<RLL8>
// 680 !RLL2:
// 681 ! *LSS_%B
// 682 ! *LB_LENGTH
// 683 ! *ADB_1
// 684 ! *STB_LENGTH
// 685 ! *ST_(CC+%B)
// 686 ! *ICP_CHAR
// 687 ! *JCC_7,<RLL9>
// 688 ! *LB_0
// 689 ! *STB_MODE
// 690 !RLL9:
// 691 ! *ICP_10
// 692 ! *JCC_7,<NEXT>
// 693 !RLL8:
// 694 ! %FINISH
// 695 %IF CC(LENGTH-1)='C'+128 %THEN LENGTH=LENGTH-2 %AND ->NEXT
if (( CC[((LENGTH)) - ((1))] ) != ( ((67)) + ((128)) )) goto L_004f;
LENGTH = ((LENGTH)) - ((2));
goto U_0132;
L_004f:
// 696 FAULT(101,0) %IF LENGTH>CCSIZE
if (( LENGTH ) <= ( CCSIZE )) goto L_0050;
FAULT(101, 0);
L_0050:
// 697 %RETURN
return;
// 698 %ROUTINE GET LINE
void GETLINE( void )
{
__label__ _imp_endofblock;
// 699 %SYSTEMROUTINESPEC IOCP(%INTEGER A,B)
extern void IOCP( int A, int B );
// 700 %CONSTBYTEINTEGERARRAY ITOI(0:255)={%C
const unsigned char ITOI[(255)-(0)+1] = { 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 10, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 25, 26, 32, 32, 32, 32, 32, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 32, 26, 26, 26, 26, 26, 10, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 92, 38, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 35, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 35, 26, 26, 26, 26, 26, 94, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, };
// 701 32(10),10,32(14),25,26,32(5),
// 702 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
// 703 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
// 704 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
// 705 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
// 706 96,97,98,99,100,101,102,103,104,105,106,107,108,109,
// 707 110,111,112,113,114,115,116,117,118,119,
// 708 120,121,122,123,124,125,126,32,
// 709 26(5),10,26(10),
// 710 26(16),
// 711 26(14),92,38,
// 712 26(11),35,26(4),
// 713 26(16),
// 714 26(9),35,26(5),94,
// 715 26(32);
// 716 %INTEGER K
int K;
// 717 LL=0
LL = 0;
// 718 %IF FILE ADDR=0 %THEN %START; ! SOURCE NOT A 'CLEAN' FILE
if (( FILEADDR ) != ( 0 )) goto L_0051;
// 719 {%UNTIL K=NL} %CYCLE
L_0052:
// 720 READ SYMBOL(K)
READSYMBOL( &K);
// 721 TLINE(LL+1)=ITOI(K)
(TLINE-85)[((LL)) + ((1))] = ITOI[K];
// 722 LL=LL+1
LL = ((LL)) + ((1));
// 723 %REPEAT %UNTIL K=NL
if (( K ) == ( 10 )) goto L_0053;
goto L_0052;
L_0053:
// 724 %FINISH %ELSE %START
goto L_0055;
L_0051:
// 725 %IF FILEPTR>=FILE END %START
if (( FILEPTR ) < ( FILEEND )) goto L_0056;
// 726 %IF IHEAD#0 %THEN POP(IHEAD,FILEADDR,FILEPTR,FILEEND) %AND GETLINE %AND %RETURN
if (( IHEAD ) == ( 0 )) goto L_0057;
POP( &IHEAD, &FILEADDR, &FILEPTR, &FILEEND);
GETLINE();
return;
L_0057:
// 727 %SIGNAL %EVENT 9,1
_imp_signal(9, 1, 0, "");
// 728 %FINISH
L_0056:
// 729 ! %IF USE IMP=NO %THEN %START
// 730 ! *LDA_FILEPTR
// 731 ! *LB_FILEEND
// 732 ! *SBB_FILEPTR
// 733 ! *ADB_16_18000000
// 734 ! *LDTB_%B
// 735 ! *SWNE_%L=%DR,0,10
// 736 ! *JCC_8,<IMP>
// 737 ! *CYD_0
// 738 ! *STUH_%B
// 739 ! *IAD_1
// 740 ! *ST_%B
// 741 ! *ISB_FILEPTR
// 742 ! *ST_LL
// 743 ! *LDA_FILEPTR
// 744 ! *STB_FILEPTR
// 745 ! *LDB_LL
// 746 ! *CYD_0
// 747 ! *LDA_ATLINE1
// 748 ! *MV_%L=%DR,0,0
// 749 ! *LDA_ATLINE1; *LDTB_16_18000000
// 750 ! *LDB_LL
// 751 ! *LSS_ITOI+4; *LUH_16_180000FF
// 752 ! *TTR_%L=%DR
// 753 ! ->OLIST
// 754 ! %FINISH
// 755 IMP:
U_0136:
// 756 {%UNTIL K=NL %OR K=0} %CYCLE
L_0058:
// 757 K=BYTE INTEGER(FILEPTR); ! NEXT CHAR FROM SORCE FILE
K = *BYTEINTEGER(FILEPTR);
// 758 FILE PTR=FILE PTR+1
FILEPTR = ((FILEPTR)) + ((1));
// 759 TLINE(LL+1)=ITOI(K)
(TLINE-85)[((LL)) + ((1))] = ITOI[K];
// 760 LL=LL+1
LL = ((LL)) + ((1));
// 761 %REPEAT %UNTIL K=NL %OR K=0
if (( K ) == ( 10 )) goto L_0059;
if (( K ) == ( 0 )) goto L_0059;
goto L_0058;
L_0059:
// 762 OLIST:
U_0137:
// 763 %FINISH
L_0055:
// 764 ! %IF MODE=0 %AND LL=1 %THEN GET LINE %AND %RETURN
// 765 ! LINE=LINE+1 %UNLESS MODE=0 %AND LENGTH>0
// 766 LINE=LINE+1; ! COUNT ALL LINES
LINE = ((LINE)) + ((1));
// 767 %IF LIST#0 %THEN %START
if (( LIST ) == ( 0 )) goto L_005b;
// 768 %IF MODE=0 %AND LENGTH>0 %THEN PRINTSTRING(" C") %ELSE WRITE(LINE, 5)
if (( MODE ) != ( 0 )) goto L_005c;
if (( LENGTH ) <= ( 0 )) goto L_005c;
PRINTSTRING(_imp_str_literal(" C"));
goto L_005d;
L_005c:
WRITE(LINE, 5);
L_005d:
// 769 ! SPACES(8)
// 770 %CYCLE K=-7,1,0
K = (((-(7)))) - ((1));
L_005e:
if (( K ) == ( 0 )) goto L_005f;
K = ((K)) + ((1));
// 771 TLINE(K)=' '
(TLINE-85)[K] = 32;
// 772 %REPEAT
goto L_005e;
L_005f:
// 773 %IF MODE#0 %THEN TLINE(-7)=M'"'
if (( MODE ) == ( 0 )) goto L_0061;
(TLINE-85)[(-(7))] = 34;
L_0061:
// 774 TLINE(-8)=LL+8
(TLINE-85)[(-(8))] = ((LL)) + ((8));
// 775 IOCP(15,ADDR(TLINE(-8)))
IOCP(15, ADDR( &(TLINE-85)[(-(8))]));
// 776 %FINISH
L_005b:
// 777 %IF FREE FORMAT=0 %AND LL>73 %THEN TLINE(73)=10 %AND LL=73
if (( FREEFORMAT ) != ( 0 )) goto L_0062;
if (( LL ) <= ( 73 )) goto L_0062;
(TLINE-85)[73] = 10;
LL = 73;
L_0062:
// 778 %END
return;
_imp_endofblock: ;
} // End of block GETLINE at level 5
// 779 %END
return;
_imp_endofblock: ;
} // End of block READLINE at level 4
// 780 %INTEGERFN COMPARE(%INTEGER P)
int COMPARE( int P )
{
__label__ _imp_endofblock;
// 781 %INTEGER I, J, ITEM, RA, RL, RP, RQ, RR, RS, MARKER, SSL, ALT, PP
int I;
int J;
int ITEM;
int RA;
int RL;
int RP;
int RQ;
int RR;
int RS;
int MARKER;
int SSL;
int ALT;
int PP;
// 782 %OWNINTEGER SAVECOMP; ! FOR CHECKING DSIDED CONDS
static int SAVECOMP;
// 783 %SWITCH BIP(999:1038)
static int BIP_idx;
static const void * /*SWITCH*/ BIP[(1038)-(999)+1] = { &&BIP_999, &&BIP_1000, &&BIP_1001, &&BIP_1002, &&BIP_1003, &&BIP_1004, &&BIP_1005, &&BIP_1006, &&BIP_1007, &&BIP_1008, &&BIP_1009, &&BIP_1010, &&BIP_1011, &&BIP_1012, &&BIP_1013, &&BIP_1014, &&BIP_1015, &&BIP_1016, &&BIP_1017, &&BIP_1018, &&BIP_1019, &&BIP_1020, &&BIP_1021, &&BIP_1022, &&BIP_1023, &&BIP_1024, &&BIP_1025, &&BIP_1026, &&BIP_1027, &&BIP_1028, &&BIP_1029, &&BIP_1030, &&BIP_1031, &&BIP_1032, &&BIP_1033, &&BIP_1034, &&BIP_1035, &&BIP_1036, &&BIP_1037, &&BIP_1038, };
// 784 ! %IF USE IMP=YES %THEN %START
// 785 RP=SYMBOL(P)
RP = (SYMBOL-1300)[P];
// 786 RL=LEVEL
RL = LEVEL;
// 787 P=P+1
P = ((P)) + ((1));
// 788 PP=P; ! ROUTINE REALLY STARTS HERE
PP = P;
// 789 ! %FINISH %ELSE %START
// 790 ! *LB_P
// 791 ! *JLK_2
// 792 ! *EXIT_-64
// 793 !SUBENTRY:
// 794 ! *LSS_(ASYM0+%B)
// 795 ! *LUH_LEVEL
// 796 ! *ST_RL
// 797 ! *ADB_1
// 798 ! *STB_P
// 799 ! *STB_PP
// 800 ! %FINISH
// 801 COMM:
U_013c:
// 802 ! %IF USE IMP=YES %THEN %START
// 803 RQ=Q; ! RESET VALUES OF LINE&AR PTRS
RQ = Q;
// 804 RR=R
RR = R;
// 805 SSL=STRLINK; ! SAVE STRING LINK
SSL = STRLINK;
// 806 ALT=1; ! FIRST ALTERNATIVE TO BE TRIED
ALT = 1;
// 807 RA=SYMBOL(P); ! RA TO NEXT PHRASE ALTERNATIVE
RA = (SYMBOL-1300)[P];
// 808 RS=P
RS = P;
// 809 ! %FINISH %ELSE %START
// 810 ! *LSD_Q
// 811 ! *ST_RQ
// 812 ! *LSS_1
// 813 ! *LUH_STRLINK
// 814 ! *ST_SSL
// 815 ! *LB_P
// 816 ! *LSS_(ASYM0+%B)
// 817 ! *ST_RA
// 818 ! *STB_RS
// 819 ! %FINISH
// 820 UPR: R=R+1
U_013d:
R = ((R)) + ((1));
// 821 SUCC: ! SUCCESS ON TO NEXT ITEM
U_013e:
// 822 ! %IF USE IMP=YES %THEN %START
// 823 RS=RS+1; ! RS=NEXT ALTERNATIVE MEANS THAT
RS = ((RS)) + ((1));
// 824 ! THIS ALT HAS BEEN COMPLETED SO
// 825 ! EXIT WITH HIT=1
// 826 %IF RS=RA %THEN ->FINI
if (( RS ) != ( RA )) goto L_0063;
goto U_013f;
L_0063:
// 827 ITEM=SYMBOL(RS); ! NEXT BRICK IN THE CURRENT ALT
ITEM = (SYMBOL-1300)[RS];
// 828 %IF ITEM<999 %THEN ->LIT
if (( ITEM ) >= ( 999 )) goto L_0064;
goto U_0140;
L_0064:
// 829 ! %FINISH %ELSE %START
// 830 ! *LB_RS
// 831 ! *ADB_1
// 832 ! *CPB_RA
// 833 ! *JCC_8,<FINI>
// 834 ! *STB_RS
// 835 ! *LB_(ASYM0+%B)
// 836 ! *CPB_999
// 837 ! *JCC_4,<LIT>
// 838 ! *STB_ITEM
// 839 ! %FINISH
// 840 %IF ITEM<1300 %THEN ->BIP(ITEM)
if (( ITEM ) >= ( 1300 )) goto L_0065;
goto *(BIP-999)[ITEM]; /* Bounds=999:1038 */
L_0065:
// 841 ! BRICK IS A PHRASE TYPE
// 842 ! %IF USE IMP=YES %THEN %START
// 843 %IF COMPARE(ITEM)=0 %THEN ->FAIL
if (( COMPARE(ITEM) ) != ( 0 )) goto L_0066;
goto U_0141;
L_0066:
// 844 ! %FINISH %ELSE %START
// 845 ! *LSD_RA
// 846 ! *SLSQ_RP
// 847 ! *SLSQ_MARKER
// 848 ! *ST_%TOS
// 849 ! *LB_ITEM
// 850 ! *JLK_<SUBENTRY>
// 851 ! *ST_%B; ! RESULT=0 FOR FAIL
// 852 ! *LSQ_%TOS; *ST_MARKER
// 853 ! *LSQ_%TOS; *ST_RP
// 854 ! *LSD_%TOS; *ST_RA
// 855 ! *JAT_12,<FAIL>
// 856 ! %FINISH
// 857 ->SUCC
goto U_013e;
// 858 LIT: ! BRICK IS LITERAL
U_0140:
// 859 ! %IF USE IMP=YES %THEN %START
// 860 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 861 ->FAIL %UNLESS I=CLETT(ITEM+1)
if (( I ) == ( CLETT[((ITEM)) + ((1))] )) goto L_0067;
goto U_0141;
L_0067:
// 862 Q=Q+1
Q = ((Q)) + ((1));
// 863 K=CLETT(ITEM)+ITEM
K = ((CLETT[ITEM])) + ((ITEM));
// 864 ITEM=ITEM+2
ITEM = ((ITEM)) + ((2));
// 865 %WHILE ITEM<=K %CYCLE
L_0068:
if (( ITEM ) > ( K )) goto L_0069;
// 866 ->FAIL %UNLESS CC(Q)=CLETT(ITEM)
if (( CC[Q] ) == ( CLETT[ITEM] )) goto L_006b;
goto U_0141;
L_006b:
// 867 Q=Q+1
Q = ((Q)) + ((1));
// 868 ITEM=ITEM+1
ITEM = ((ITEM)) + ((1));
// 869 %REPEAT; ! CHECK IT WITH LITERAL DICT ENTRY
goto L_0068;
L_0069:
// 870 ! %FINISH %ELSE %START
// 871 ! *LDB_(CLETT+%B)
// 872 ! *INCA_%B
// 873 ! *INCA_1
// 874 ! *LSS_Q
// 875 ! *IAD_CC+4
// 876 ! *LUH_CC
// 877 ! *CPS_%L=%DR,0,0
// 878 ! *JCC_7,<FAIL>
// 879 ! *STUH_%B
// 880 ! *ISB_CC+4
// 881 ! *ST_Q
// 882 ! %FINISH
// 883 ->SUCC; ! MATCHED SUCCESSFULLY
goto U_013e;
// 884 FAIL: ! FAILURE - NOTE POSITION REACHD
U_0141:
// 885 ! %IF USE IMP=YES %THEN %START
// 886 %IF RA=RP %THEN ->TFAIL; ! TOTAL FAILURE NO ALT TO TRY
if (( RA ) != ( RP )) goto L_006c;
goto U_0142;
L_006c:
// 887 QMAX=Q %IF Q>QMAX
if (( Q ) <= ( QMAX )) goto L_006d;
QMAX = Q;
L_006d:
// 888 Q=RQ; ! RESET LINE AND A.R. POINTERS
Q = RQ;
// 889 R=RR+1; ! AVOID GOING VIA UPR:
R = ((RR)) + ((1));
// 890 STRLINK=SSL
STRLINK = SSL;
// 891 ALT=ALT+1; ! MOVE TO NEXT ALT OF PHRASE
ALT = ((ALT)) + ((1));
// 892 RS=RA
RS = RA;
// 893 RA=SYMBOL(RA)
RA = (SYMBOL-1300)[RA];
// 894 ! %FINISH %ELSE %START
// 895 ! *LB_RA
// 896 ! *CPB_RP
// 897 ! *JCC_8,<TFAIL>
// 898 ! *LSS_Q
// 899 ! *ICP_QMAX
// 900 ! *JCC_12,<CPL1>
// 901 ! *ST_QMAX
// 902 !CPL1: *LSD_RQ
// 903 ! *IAD_1
// 904 ! *ST_Q
// 905 ! *L_SSL
// 906 ! *STUH_STRLINK
// 907 ! *IAD_1
// 908 ! *ST_ALT
// 909 ! *STB_RS
// 910 ! *L_(ASYM0+%B)
// 911 ! *ST_RA
// 912 ! %FINISH
// 913 ->SUCC
goto U_013e;
// 914 TFAIL:
U_0142:
// 915 LEVEL=RL
LEVEL = RL;
// 916 ! %IF USE IMP=YES %THEN %START
// 917 %RESULT=0
return 0;
// 918 ! %FINISH %ELSE %START
// 919 ! *LSS_0; *J_%TOS
// 920 ! %FINISH
// 921 BIP(999): ! REPEATED PHRASE
BIP_999:
// 922 A(RR)=ALT; P=PP
A[RR] = ALT;
P = PP;
// 923 ->COMM
goto U_013c;
// 924 BIP(1000):FINI: ! NULL ALWAYS LAST & OK
BIP_1000:
U_013f:
// 925 A(RR)=ALT
A[RR] = ALT;
// 926 ! %IF USE IMP=YES %THEN %START
// 927 %RESULT=1
return 1;
// 928 ! %FINISH %ELSE %START
// 929 ! *LSS_1; *J_%TOS
// 930 ! %FINISH
// 931 BIP(1001): ! PHRASE NAME
BIP_1001:
// 932 BIP(1004): ! PHRASE OLDNAME
BIP_1004:
// 933 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 934 ->FAIL %UNLESS TRTAB(I)=2
if (( TRTAB[I] ) == ( 2 )) goto L_006e;
goto U_0141;
L_006e:
// 935 PNAME(ITEM-1004)
PNAME(((ITEM)) - ((1004)));
// 936 ->SUCC %IF HIT=1; ->FAIL
if (( HIT ) != ( 1 )) goto L_006f;
goto U_013e;
L_006f:
goto U_0141;
// 937 BIP(1002): ! PHRASE INTEGER CONSTANT
BIP_1002:
// 938 BIP(1003): ! PHRASE CONST
BIP_1003:
// 939 CONST(ITEM-1003)
CONST(((ITEM)) - ((1003)));
// 940 ->FAIL %IF HIT=0
if (( HIT ) != ( 0 )) goto L_0070;
goto U_0141;
L_0070:
// 941 ->SUCC
goto U_013e;
// 942 BIP(1005): ! PHRASE N
BIP_1005:
// 943 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 944 ->FAIL %UNLESS '0'<=I<='9'
if (( 48 ) > ( I )) goto L_006a;
if (( I ) <= ( 57 )) goto L_0071;
L_006a:
goto U_0141;
L_0071:
// 945 S=0
S = 0;
// 946 %WHILE '0'<=I<='9' %CYCLE
L_0072:
if (( 48 ) > ( I )) goto L_0073;
if (( I ) > ( 57 )) goto L_0073;
// 947 S=10*S+I&15
S = ((((10)) * ((S)))) + ((((I)) & ((15))));
// 948 Q=Q+1; I=CC(Q)
Q = ((Q)) + ((1));
I = CC[Q];
// 949 %REPEAT
goto L_0072;
L_0073:
// 950 TOAR2(R,S)
TOAR2(R, S);
// 951 R=R+2; ->SUCC
R = ((R)) + ((2));
goto U_013e;
// 952 BIP(1006): ! PHRASE S=SEPARATOR
BIP_1006:
// 953 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 954 ->SUCC %IF I=NL
if (( I ) != ( 10 )) goto L_0075;
goto U_013e;
L_0075:
// 955 ->FAIL %UNLESS I=';'
if (( I ) == ( 59 )) goto L_0076;
goto U_0141;
L_0076:
// 956 Q=Q+1; ->SUCC
Q = ((Q)) + ((1));
goto U_013e;
// 957 BIP(1007):
BIP_1007:
// 958 ! PHRASE COMMENT TEXT
// 959 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 960 J=I
J = I;
// 961 ->TX %IF I=';' %OR I=NL
if (( I ) == ( 59 )) goto L_0074;
if (( I ) != ( 10 )) goto L_0077;
L_0074:
goto U_0143;
L_0077:
// 962 ->FAIL %UNLESS I='!' %OR I='|' %OR (I='C'+128 %AND CC(Q+1)='O'+128 %AND CC(Q+2)=CC(Q+3)='M'+128 %AND CC(Q+4)='E'+128 %AND CC(Q+5)='N'+128 %AND CC(Q+6)='T'+128)
if (( I ) == ( 33 )) goto L_0078;
if (( I ) == ( 124 )) goto L_0078;
if (( I ) != ( ((67)) + ((128)) )) goto L_0079;
if (( CC[((Q)) + ((1))] ) != ( ((79)) + ((128)) )) goto L_0079;
if (( CC[((Q)) + ((2))] ) != ( CC[((Q)) + ((3))] )) goto L_0079;
if (( CC[((Q)) + ((3))] ) != ( ((77)) + ((128)) )) goto L_0079;
if (( CC[((Q)) + ((4))] ) != ( ((69)) + ((128)) )) goto L_0079;
if (( CC[((Q)) + ((5))] ) != ( ((78)) + ((128)) )) goto L_0079;
if (( CC[((Q)) + ((6))] ) == ( ((84)) + ((128)) )) goto L_0078;
L_0079:
goto U_0141;
L_0078:
// 963 Q=Q+1+6*(I>>7); J=CC(Q)
Q = ((((Q)) + ((1)))) + ((((6)) * (((int)(((unsigned int)(I)) >> ((7)))))));
J = CC[Q];
// 964 %CYCLE
L_007a:
// 965 %EXIT %IF J=NL %OR J=';'
if (( J ) == ( 10 )) goto L_0060;
if (( J ) != ( 59 )) goto L_007d;
L_0060:
goto L_007b;
L_007d:
// 966 Q=Q+1; J=CC(Q)
Q = ((Q)) + ((1));
J = CC[Q];
// 967 %REPEAT
goto L_007a;
L_007b:
// 968 TX: Q=Q+1 %IF J=';'
U_0143:
if (( J ) != ( 59 )) goto L_007e;
Q = ((Q)) + ((1));
L_007e:
// 969 ->SUCC
goto U_013e;
// 970 BIP(1008): ! PHRASE BIGHOLE
BIP_1008:
// 971 TO AR4(R,0)
TOAR4(R, 0);
// 972 R=R+4; ->SUCC
R = ((R)) + ((4));
goto U_013e;
// 973 BIP(1009): ! PHRASE N255
BIP_1009:
// 974 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 975 ->FAIL %UNLESS '0'<=I<='9'
if (( 48 ) > ( I )) goto L_007c;
if (( I ) <= ( 57 )) goto L_007f;
L_007c:
goto U_0141;
L_007f:
// 976 S=0
S = 0;
// 977 %WHILE '0'<=I<='9' %CYCLE
L_0080:
if (( 48 ) > ( I )) goto L_0081;
if (( I ) > ( 57 )) goto L_0081;
// 978 S=10*S+I&15
S = ((((10)) * ((S)))) + ((((I)) & ((15))));
// 979 Q=Q+1; I=CC(Q)
Q = ((Q)) + ((1));
I = CC[Q];
// 980 %REPEAT
goto L_0080;
L_0081:
// 981 ->FAIL %UNLESS 0<=S<=255
if (( 0 ) > ( S )) goto L_0082;
if (( S ) <= ( 255 )) goto L_0083;
L_0082:
goto U_0141;
L_0083:
// 982 A(R)=S; ->UPR
A[R] = S;
goto U_013d;
// 983 BIP(1010): ! PHRASE HOLE
BIP_1010:
// 984 MARKER=R; R=R+2; ->SUCC
MARKER = R;
R = ((R)) + ((2));
goto U_013e;
// 985 BIP(1011): ! PHRASE MARK
BIP_1011:
// 986 I=R-MARKER
I = ((R)) - ((MARKER));
// 987 A(MARKER+1)<-I
A[((MARKER)) + ((1))] = I;
// 988 A(MARKER)<-I>>8
A[MARKER] = (int)(((unsigned int)(I)) >> ((8)));
// 989 ->SUCC
goto U_013e;
// 990 BIP(1012): ! PHRASE READLINE?
BIP_1012:
// 991 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 992 %WHILE I=NL %%CYCLE
L_0084:
if (( I ) != ( 10 )) goto L_0085;
// 993 READLINE(0,0)
READLINE(0, 0);
// 994 RQ=1
RQ = 1;
// 995 I=CC(Q)
I = CC[Q];
// 996 %REPEAT
goto L_0084;
L_0085:
// 997 FAULT(102,0) %IF R>ARSIZE
if (( R ) <= ( ARSIZE )) goto L_0087;
FAULT(102, 0);
L_0087:
// 998 ->SUCC
goto U_013e;
// 999 BIP(1013): ! PHRASE CHECKIMPS
BIP_1013:
// 1000 ->FAIL %UNLESS IMPS=1; ->SUCC
if (( IMPS ) == ( 1 )) goto L_0088;
goto U_0141;
L_0088:
goto U_013e;
// 1001 BIP(1014): ! PHRASE DUMMY APP
BIP_1014:
// 1002 A(R)=2; A(R+1)=2
A[R] = 2;
A[((R)) + ((1))] = 2;
// 1003 R=R+2; ->SUCC
R = ((R)) + ((2));
goto U_013e;
// 1004 BIP(1015): ! PHRASE DOWN=NEW TEXT LEVEL
BIP_1015:
// 1005 LEVEL=LEVEL+1
LEVEL = ((LEVEL)) + ((1));
// 1006 TO AR4(R,0)
TOAR4(R, 0);
// 1007 DISPLAY(LEVEL)=R
DISPLAY[LEVEL] = R;
// 1008 SFS(LEVEL)=0
SFS[LEVEL] = 0;
// 1009 R=R+4
R = ((R)) + ((4));
// 1010 ->SUCC
goto U_013e;
// 1011 BIP(1016): ! PHRASE UP 1 TEXTUAL LEVEL
BIP_1016:
// 1012 DISPLAY(LEVEL)=0
DISPLAY[LEVEL] = 0;
// 1013 %WHILE SFS(LEVEL)#0 %CYCLE
L_0089:
if (( SFS[LEVEL] ) == ( 0 )) goto L_008a;
// 1014 POP(SFS(LEVEL),I,J,K)
POP( &SFS[LEVEL], &I, &J, &K);
// 1015 %IF I=1 %THEN FAULT2(53,K,0); ! FINISH MISSING
if (( I ) != ( 1 )) goto L_008c;
FAULT2(53, K, 0);
L_008c:
// 1016 %IF I=2 %THEN FAULT2(13,K,0); ! %REPEAT MISSING
if (( I ) != ( 2 )) goto L_008d;
FAULT2(13, K, 0);
L_008d:
// 1017 %REPEAT
goto L_0089;
L_008a:
// 1018 LEVEL=LEVEL-1
LEVEL = ((LEVEL)) - ((1));
// 1019 ->SUCC
goto U_013e;
// 1020 BIP(1017): ! PHRASE LISTON
BIP_1017:
// 1021 LIST=1; ->SUCC
LIST = 1;
goto U_013e;
// 1022 BIP(1018): ! PHRASE LISTOFF
BIP_1018:
// 1023 LIST=0; ->SUCC
LIST = 0;
goto U_013e;
// 1024 BIP(1019): ! PHRASE COLON FOR LABEL
BIP_1019:
// 1025 ->FAIL %UNLESS CC(Q-1)=':'
if (( CC[((Q)) - ((1))] ) == ( 58 )) goto L_008e;
goto U_0141;
L_008e:
// 1026 ->SUCC
goto U_013e;
// 1027 BIP(1020): ! PHRASE NOTE CONST
BIP_1020:
// 1028 %IF CTYPE=5 %THEN TOAR4(S-4,STRLINK) %AND STRLINK=S-4
if (( CTYPE ) != ( 5 )) goto L_008f;
TOAR4(((S)) - ((4)), STRLINK);
STRLINK = ((S)) - ((4));
L_008f:
// 1029 ->SUCC
goto U_013e;
// 1030 BIP(1021): ! TRACE FOR ON CONDITIONS
BIP_1021:
// 1031 PARMTRACE=1; ->SUCC
PARMTRACE = 1;
goto U_013e;
// 1032 BIP(1022): ! SET MNEMONIC
BIP_1022:
// 1033 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1034 S=M' '
S = 538976288;
// 1035 %WHILE 'A'<=I<='Z' %CYCLE
L_0090:
if (( 65 ) > ( I )) goto L_0091;
if (( I ) > ( 90 )) goto L_0091;
// 1036 S=S<<8!I; Q=Q+1; I=CC(Q)
S = ((((S)) << ((8)))) | ((I));
Q = ((Q)) + ((1));
I = CC[Q];
// 1037 %REPEAT
goto L_0090;
L_0091:
// 1038 ->FAIL %UNLESS I='_' %AND S#M' '
if (( I ) != ( 95 )) goto L_0092;
if (( S ) != ( 538976288 )) goto L_0093;
L_0092:
goto U_0141;
L_0093:
// 1039 Q=Q+1; ->SUCC
Q = ((Q)) + ((1));
goto U_013e;
// 1040 BIP(1023): ! PRIMARY FORMAT MNEMOINC
BIP_1023:
// 1041 %CYCLE I=7,1,126
I = ((7)) - ((1));
L_0094:
if (( I ) == ( 126 )) goto L_0095;
I = ((I)) + ((1));
// 1042 ->PFND %IF OPC(I)=S
if (( OPC[I] ) != ( S )) goto L_0097;
goto U_0144;
L_0097:
// 1043 %REPEAT
goto L_0094;
L_0095:
// 1044 ->FAIL
goto U_0141;
// 1045 PFND:
U_0144:
// 1046 ->FAIL %IF 8<=I>>3<=11 %AND I&7<=3
if (( 8 ) > ( (int)(((unsigned int)(I)) >> ((3))) )) goto L_0098;
if (( (int)(((unsigned int)(I)) >> ((3))) ) > ( 11 )) goto L_0098;
if (( ((I)) & ((7)) ) > ( 3 )) goto L_0098;
goto U_0141;
L_0098:
// 1047 A(R)=2*I; ->UPR
A[R] = ((2)) * ((I));
goto U_013d;
// 1048 BIP(1024): ! SECONDARY FORMAT MNEMONIC
BIP_1024:
// 1049 %CYCLE I=64,8,88
I = ((64)) - ((8));
L_0099:
if (( I ) == ( 88 )) goto L_009a;
I = ((I)) + ((8));
// 1050 %CYCLE J=0,1,3
J = ((0)) - ((1));
L_009c:
if (( J ) == ( 3 )) goto L_009d;
J = ((J)) + ((1));
// 1051 ->SFND %IF OPC(I+J)=S
if (( OPC[((I)) + ((J))] ) != ( S )) goto L_009f;
goto U_0145;
L_009f:
// 1052 %REPEAT
goto L_009c;
L_009d:
// 1053 %REPEAT
goto L_0099;
L_009a:
// 1054 ->FAIL
goto U_0141;
// 1055 SFND: A(R)=2*(I+J); ->UPR
U_0145:
A[R] = ((2)) * ((((I)) + ((J))));
goto U_013d;
// 1056 BIP(1025): ! TERTIARY FORMAT MNEMONIC
BIP_1025:
// 1057 %CYCLE I=3,-1,1
I = ((3)) - (((-(1))));
L_00a0:
if (( I ) == ( 1 )) goto L_00a1;
I = ((I)) + (((-(1))));
// 1058 %IF OPC(I)=S %THEN A(R)=2*I %AND ->UPR
if (( OPC[I] ) != ( S )) goto L_00a3;
A[R] = ((2)) * ((I));
goto U_013d;
L_00a3:
// 1059 %REPEAT; ->FAIL
goto L_00a0;
L_00a1:
goto U_0141;
// 1060 BIP(1026): ! P(OP)=+,-,&,****,**,*,!!,!,
BIP_1026:
// 1061 ! //,/,>>,<<,.,\\,\;
// 1062 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1063 ->FAIL %UNLESS 32<I<127 %AND 16_80000000>>((I-32)&31)&16_4237000A#0
if (( 32 ) >= ( I )) goto L_00a2;
if (( I ) >= ( 127 )) goto L_00a2;
if (( (((int)(((unsigned int)(-2147483648)) >> ((((((I)) - ((32)))) & ((31))))))) & ((1110900746)) ) != ( 0 )) goto L_00a4;
L_00a2:
goto U_0141;
L_00a4:
// 1064 Q=Q+1
Q = ((Q)) + ((1));
// 1065 %IF I='+' %THEN A(R)=1 %AND ->UPR
if (( I ) != ( 43 )) goto L_00a5;
A[R] = 1;
goto U_013d;
L_00a5:
// 1066 %IF I='-' %THEN A(R)=2 %AND ->UPR
if (( I ) != ( 45 )) goto L_00a6;
A[R] = 2;
goto U_013d;
L_00a6:
// 1067 %IF I='&' %THEN A(R)=3 %AND ->UPR
if (( I ) != ( 38 )) goto L_00a7;
A[R] = 3;
goto U_013d;
L_00a7:
// 1068 J=CC(Q)
J = CC[Q];
// 1069 %IF I='*' %THEN %START
if (( I ) != ( 42 )) goto L_00a8;
// 1070 %IF J#I %THEN A(R)=6 %AND ->UPR
if (( J ) == ( I )) goto L_00a9;
A[R] = 6;
goto U_013d;
L_00a9:
// 1071 %IF CC(Q+1)=I=CC(Q+2) %THEN A(R)=4 %AND Q=Q+3 %AND ->UPR
if (( CC[((Q)) + ((1))] ) != ( I )) goto L_00aa;
if (( I ) != ( CC[((Q)) + ((2))] )) goto L_00aa;
A[R] = 4;
Q = ((Q)) + ((3));
goto U_013d;
L_00aa:
// 1072 A(R)=5; Q=Q+1; ->UPR
A[R] = 5;
Q = ((Q)) + ((1));
goto U_013d;
// 1073 %FINISH
L_00a8:
// 1074 %IF I='/' %THEN %START
if (( I ) != ( 47 )) goto L_00ab;
// 1075 %IF J#I %THEN A(R)=10 %AND ->UPR
if (( J ) == ( I )) goto L_00ac;
A[R] = 10;
goto U_013d;
L_00ac:
// 1076 A(R)=9; Q=Q+1; ->UPR
A[R] = 9;
Q = ((Q)) + ((1));
goto U_013d;
// 1077 %FINISH
L_00ab:
// 1078 %IF I='!' %THEN %START
if (( I ) != ( 33 )) goto L_00ad;
// 1079 %IF J#I %THEN A(R)=8 %AND ->UPR
if (( J ) == ( I )) goto L_00ae;
A[R] = 8;
goto U_013d;
L_00ae:
// 1080 A(R)=7; Q=Q+1; ->UPR
A[R] = 7;
Q = ((Q)) + ((1));
goto U_013d;
// 1081 %FINISH
L_00ad:
// 1082 %IF I='.' %THEN A(R)=13 %AND ->UPR
if (( I ) != ( 46 )) goto L_00af;
A[R] = 13;
goto U_013d;
L_00af:
// 1083 %IF I=J='<' %THEN A(R)=12 %AND Q=Q+1 %AND ->UPR
if (( I ) != ( J )) goto L_00b0;
if (( J ) != ( 60 )) goto L_00b0;
A[R] = 12;
Q = ((Q)) + ((1));
goto U_013d;
L_00b0:
// 1084 %IF I=J='>' %THEN A(R)=11 %AND Q=Q+1 %AND ->UPR
if (( I ) != ( J )) goto L_00b1;
if (( J ) != ( 62 )) goto L_00b1;
A[R] = 11;
Q = ((Q)) + ((1));
goto U_013d;
L_00b1:
// 1085 %IF I='\' %THEN %START
if (( I ) != ( 92 )) goto L_00b2;
// 1086 %IF J#I %THEN A(R)=15 %AND ->UPR
if (( J ) == ( I )) goto L_00b3;
A[R] = 15;
goto U_013d;
L_00b3:
// 1087 Q=Q+1; A(R)=14; ->UPR
Q = ((Q)) + ((1));
A[R] = 14;
goto U_013d;
// 1088 %FINISH
L_00b2:
// 1089 ->FAIL
goto U_0141;
// 1090 BIP(1027): ! PHRASE CHECK UI
BIP_1027:
// 1091 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1092 ->SUCC %IF TRTAB(I)=2 %OR I='-'
if (( TRTAB[I] ) == ( 2 )) goto L_00b4;
if (( I ) != ( 45 )) goto L_00b5;
L_00b4:
goto U_013e;
L_00b5:
// 1093 ->SUCC %IF 16_80000000>>(I&31)&16_14043000#0
if (( (((int)(((unsigned int)(-2147483648)) >> ((((I)) & ((31))))))) & ((335818752)) ) == ( 0 )) goto L_00b6;
goto U_013e;
L_00b6:
// 1094 ->FAIL
goto U_0141;
// 1095 BIP(1028): ! P(+')=+,-,\,0
BIP_1028:
// 1096 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1097 %IF I='\' %OR I=16_7E %THEN A(R)=3 %AND Q=Q+1 %AND ->UPR
if (( I ) == ( 92 )) goto L_00b7;
if (( I ) != ( 126 )) goto L_00b8;
L_00b7:
A[R] = 3;
Q = ((Q)) + ((1));
goto U_013d;
L_00b8:
// 1098 %IF I='-' %THEN A(R)=2 %AND Q=Q+1 %AND ->UPR
if (( I ) != ( 45 )) goto L_00b9;
A[R] = 2;
Q = ((Q)) + ((1));
goto U_013d;
L_00b9:
// 1099 %IF I='+' %THEN A(R)=1 %AND Q=Q+1 %AND ->UPR
if (( I ) != ( 43 )) goto L_00ba;
A[R] = 1;
Q = ((Q)) + ((1));
goto U_013d;
L_00ba:
// 1100 A(R)=4; ->UPR
A[R] = 4;
goto U_013d;
// 1101 BIP(1029): ! PHRASE NOTE CYCLE
BIP_1029:
// 1102 TOAR4(R,0)
TOAR4(R, 0);
// 1103 PUSH(SFS(LEVEL),2,R,LINE)
PUSH( &SFS[LEVEL], 2, R, LINE);
// 1104 R=R+4
R = ((R)) + ((4));
// 1105 ->SUCC
goto U_013e;
// 1106 BIP(1030): ! P(,')=',',0
BIP_1030:
// 1107 !
// 1108 ! THIS IS VERY AWKWARD AS IT MEANS IT IS VERY TO HARD TO FIND
// 1109 ! THE END OF A PARAMETER LIST WITHOUT CHURNING. BY MAKING THIS A BIP
// 1110 ! WE CAN PEEP AHEAD FOR ')' AND FAIL HERE.
// 1111 !
// 1112 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1113 %IF I=')' %THEN ->FAIL
if (( I ) != ( 41 )) goto L_00bb;
goto U_0141;
L_00bb:
// 1114 %IF I=',' %THEN Q=Q+1
if (( I ) != ( 44 )) goto L_00bc;
Q = ((Q)) + ((1));
L_00bc:
// 1115 ->SUCC
goto U_013e;
// 1116 BIP(1031): ! PHRASE CHECKTYPE IE ENSURE
BIP_1031:
// 1117 ! FIRST LETTER IS(B,H,I,L,R,S) &
// 1118 ! 3RD LETTER IS (A,L,N,R,T)
// 1119 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1120 ->FAIL %UNLESS I>128 %AND 16_80000000>>(I&31)&16_20C83000#0 %AND 16_80000000>>(CC(Q+2)&31)&16_400A2800#0
if (( I ) <= ( 128 )) goto L_00bd;
if (( (((int)(((unsigned int)(-2147483648)) >> ((((I)) & ((31))))))) & ((549990400)) ) == ( 0 )) goto L_00bd;
if (( (((int)(((unsigned int)(-2147483648)) >> ((((CC[((Q)) + ((2))])) & ((31))))))) & ((1074407424)) ) != ( 0 )) goto L_00be;
L_00bd:
goto U_0141;
L_00be:
// 1121 ->SUCC
goto U_013e;
// 1122 BIP(1032): ! PHRASE COMP1
BIP_1032:
// 1123 BIP(1037): ! PHRASE COMP2(IS 2ND HALF OF DSIDED)
BIP_1037:
// 1124 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1125 ->FAIL %UNLESS 32<I<=92 %AND 16_80000000>>(I&31)&16_1004000E#0
if (( 32 ) >= ( I )) goto L_00bf;
if (( I ) > ( 92 )) goto L_00bf;
if (( (((int)(((unsigned int)(-2147483648)) >> ((((I)) & ((31))))))) & ((268697614)) ) != ( 0 )) goto L_00c0;
L_00bf:
goto U_0141;
L_00c0:
// 1126 ! '='=1,'>='=2,'>'=3
// 1127 ! '#' OR '\='=4,'<='=5,'<'=6
// 1128 ! 7UNUSED,'->'=8,'=='=9
// 1129 ! '##' OR '\==' =10
// 1130 %IF I='=' %THEN %START
if (( I ) != ( 61 )) goto L_00c1;
// 1131 %IF CC(Q+1)=I %THEN J=9 %AND ->JOIN1
if (( CC[((Q)) + ((1))] ) != ( I )) goto L_00c2;
J = 9;
goto U_0146;
L_00c2:
// 1132 J=1; ->JOIN
J = 1;
goto U_0147;
// 1133 %FINISH
L_00c1:
// 1134 %IF I='#' %THEN %START
if (( I ) != ( 35 )) goto L_00c3;
// 1135 %IF CC(Q+1)=I %THEN J=10 %AND ->JOIN1
if (( CC[((Q)) + ((1))] ) != ( I )) goto L_00c4;
J = 10;
goto U_0146;
L_00c4:
// 1136 J=4; ->JOIN
J = 4;
goto U_0147;
// 1137 %FINISH
L_00c3:
// 1138 %IF I='\' %AND CC(Q+1)='=' %THEN %START
if (( I ) != ( 92 )) goto L_00c5;
if (( CC[((Q)) + ((1))] ) != ( 61 )) goto L_00c5;
// 1139 Q=Q+1
Q = ((Q)) + ((1));
// 1140 %IF CC(Q+1)='=' %THEN J=10 %AND ->JOIN1
if (( CC[((Q)) + ((1))] ) != ( 61 )) goto L_00c6;
J = 10;
goto U_0146;
L_00c6:
// 1141 J=4; ->JOIN
J = 4;
goto U_0147;
// 1142 %FINISH
L_00c5:
// 1143 %IF I='>' %THEN %START
if (( I ) != ( 62 )) goto L_00c7;
// 1144 %IF CC(Q+1)='=' %THEN J=2 %AND ->JOIN1
if (( CC[((Q)) + ((1))] ) != ( 61 )) goto L_00c8;
J = 2;
goto U_0146;
L_00c8:
// 1145 J=3; ->JOIN
J = 3;
goto U_0147;
// 1146 %FINISH
L_00c7:
// 1147 %IF I='<' %THEN %START
if (( I ) != ( 60 )) goto L_00c9;
// 1148 %IF CC(Q+1)='=' %THEN J=5 %AND ->JOIN1
if (( CC[((Q)) + ((1))] ) != ( 61 )) goto L_00ca;
J = 5;
goto U_0146;
L_00ca:
// 1149 J=6; ->JOIN
J = 6;
goto U_0147;
// 1150 %FINISH
L_00c9:
// 1151 %IF I='-' %AND CC(Q+1)='>' %THEN J=8 %AND ->JOIN1
if (( I ) != ( 45 )) goto L_00cb;
if (( CC[((Q)) + ((1))] ) != ( 62 )) goto L_00cb;
J = 8;
goto U_0146;
L_00cb:
// 1152 ->FAIL
goto U_0141;
// 1153 JOIN1:Q=Q+1
U_0146:
Q = ((Q)) + ((1));
// 1154 JOIN: Q=Q+1
U_0147:
Q = ((Q)) + ((1));
// 1155 A(R)=J
A[R] = J;
// 1156 %IF ITEM=1032 %THEN SAVECOMP=J %AND ->UPR
if (( ITEM ) != ( 1032 )) goto L_00cc;
SAVECOMP = J;
goto U_013d;
L_00cc:
// 1157 ! SAVE J TO CHECK DSIDED
// 1158 %IF SAVECOMP>6 %OR J>6 %THEN Q=Q-1 %AND ->FAIL;! ILLEGAL DSIDED
if (( SAVECOMP ) > ( 6 )) goto L_00cd;
if (( J ) <= ( 6 )) goto L_00ce;
L_00cd:
Q = ((Q)) - ((1));
goto U_0141;
L_00ce:
// 1159 ->UPR; ! NB OWNS WONT WORK IF
goto U_013d;
// 1160 ! COND EXPRS ALLOWED AS THE
// 1161 ! CAN BE NESTED!
// 1162 BIP(1033): ! P(ASSOP)- ==,=,<-,->
BIP_1033:
// 1163 I=CC(Q); ! OBTAIN CURRENT CHARACTER
I = CC[Q];
// 1164 %IF I='=' %THEN %START
if (( I ) != ( 61 )) goto L_00cf;
// 1165 %IF CC(Q+1)='=' %THEN A(R)=1 %AND Q=Q+2 %AND ->UPR
if (( CC[((Q)) + ((1))] ) != ( 61 )) goto L_00d0;
A[R] = 1;
Q = ((Q)) + ((2));
goto U_013d;
L_00d0:
// 1166 A(R)=2; Q=Q+1; ->UPR
A[R] = 2;
Q = ((Q)) + ((1));
goto U_013d;
// 1167 %FINISH
L_00cf:
// 1168 %IF I='<' %AND CC(Q+1)='-' %THEN A(R)=3 %AND Q=Q+2 %AND ->UPR
if (( I ) != ( 60 )) goto L_00d1;
if (( CC[((Q)) + ((1))] ) != ( 45 )) goto L_00d1;
A[R] = 3;
Q = ((Q)) + ((2));
goto U_013d;
L_00d1:
// 1169 %IF I='-' %AND CC(Q+1)='>' %THEN A(R)=4 %AND Q=Q+2 %AND ->UPR
if (( I ) != ( 45 )) goto L_00d2;
if (( CC[((Q)) + ((1))] ) != ( 62 )) goto L_00d2;
A[R] = 4;
Q = ((Q)) + ((2));
goto U_013d;
L_00d2:
// 1170 ->FAIL
goto U_0141;
// 1171 BIP(1034): ! NOTE START
BIP_1034:
// 1172 TOAR4(R,0); ! HOLE FOR FORWARD PTR
TOAR4(R, 0);
// 1173 PUSH(SFS(LEVEL),1,R,LINE)
PUSH( &SFS[LEVEL], 1, R, LINE);
// 1174 R=R+4
R = ((R)) + ((4));
// 1175 ->SUCC
goto U_013e;
// 1176 BIP(1035): ! NOTE FINISH
BIP_1035:
// 1177 %IF SFS(LEVEL)=0 %THEN FAULT2(51,0,0) %AND ->SUCC
if (( SFS[LEVEL] ) != ( 0 )) goto L_00d3;
FAULT2(51, 0, 0);
goto U_013e;
L_00d3:
// 1178 POP(SFS(LEVEL),I,J,K)
POP( &SFS[LEVEL], &I, &J, &K);
// 1179 %IF I=2 %THEN FAULT2(59,K,0)
if (( I ) != ( 2 )) goto L_00d4;
FAULT2(59, K, 0);
L_00d4:
// 1180 TOAR4(J,STARSTART)
TOAR4(J, STARSTART);
// 1181 ->SUCC
goto U_013e;
// 1182 BIP(1036): ! NOTE REPEAT
BIP_1036:
// 1183 %IF SFS(LEVEL)=0 %THEN FAULT2(1,0,0) %AND ->SUCC
if (( SFS[LEVEL] ) != ( 0 )) goto L_00d5;
FAULT2(1, 0, 0);
goto U_013e;
L_00d5:
// 1184 POP(SFS(LEVEL),I,J,K)
POP( &SFS[LEVEL], &I, &J, &K);
// 1185 %IF I=1 %THEN FAULT2(52,K,0); ! START INSTEAD OF CYCLE
if (( I ) != ( 1 )) goto L_00d6;
FAULT2(52, K, 0);
L_00d6:
// 1186 TOAR4(J,STARSTART)
TOAR4(J, STARSTART);
// 1187 ->SUCC
goto U_013e;
// 1188 BIP(1038): ! INCLUDE "FILE"
BIP_1038:
// 1189 ->FAIL %IF VMEB=YES
if (( 0 ) != ( 1 )) goto L_00d7;
goto U_0141;
L_00d7:
// 1190 I=CC(Q)
I = CC[Q];
// 1191 ->FAIL %UNLESS I=NL %OR I=';'
if (( I ) == ( 10 )) goto L_00d8;
if (( I ) == ( 59 )) goto L_00d8;
goto U_0141;
L_00d8:
// 1192 Q=Q+1 %IF I=';'
if (( I ) != ( 59 )) goto L_00d9;
Q = ((Q)) + ((1));
L_00d9:
// 1193 ->FAIL %UNLESS CTYPE=5
if (( CTYPE ) == ( 5 )) goto L_00da;
goto U_0141;
L_00da:
// 1194 PUSH(IHEAD,FILEADDR,FILEPTR,FILEEND)
PUSH( &IHEAD, FILEADDR, FILEPTR, FILEEND);
// 1195 CONSOURCE(STRING(ADDR(A(S))),FILEADDR);! DEPARTS IF FAILS
CONSOURCE( **STRING(ADDR( &A[S])), &FILEADDR);
// 1196 FILEPTR=FILEADDR+INTEGER(FILEADDR+4)
FILEPTR = ((FILEADDR)) + ((*INTEGER(((FILEADDR)) + ((4)))));
// 1197 FILEEND=FILEADDR+INTEGER(FILEADDR)
FILEEND = ((FILEADDR)) + ((*INTEGER(FILEADDR)));
// 1198 ->SUCC
goto U_013e;
// 1199 %END; !OF ROUTINE 'COMPARE'
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block COMPARE at level 4
// 1200 %ROUTINE PNAME(%INTEGER MODE)
void PNAME( int MODE )
{
__label__ _imp_endofblock;
// 1201 !***********************************************************************
// 1202 !* MODE=0 FOR OLD NAME(ALREADY IN DICT), MODE=1 FOR NEW NAME *
// 1203 !***********************************************************************
// 1204 %CONSTINTEGERARRAY HASH(0:7)=71,47,97,79,29,37,53,59;
const int HASH[(7)-(0)+1] = { 71, 47, 97, 79, 29, 37, 53, 59, };
// 1205 %INTEGER JJ, KK, LL, FQ, FS, T, S, I
int JJ;
int KK;
int LL;
int FQ;
int FS;
int T;
int S;
int I;
// 1206 %LONGINTEGER DRDES,ACCDES
long long int DRDES;
long long int ACCDES;
// 1207 HIT=0; FQ=Q; FS=CC(Q)
HIT = 0;
FQ = Q;
FS = CC[Q];
// 1208 %RETURN %UNLESS TRTAB(FS)=2 %AND M'"'#CC(Q+1)#M''''
if (( TRTAB[FS] ) != ( 2 )) goto L_00db;
if (( 34 ) == ( CC[((Q)) + ((1))] )) goto L_00db;
if (( CC[((Q)) + ((1))] ) != ( 39 )) goto L_00dc;
L_00db:
return;
L_00dc:
// 1209 ! 1ST CHAR MUST BE LETTER
// 1210 T=1
T = 1;
// 1211 LETT(NEXT+1)=FS; JJ=71*FS
LETT[((NEXT)) + ((1))] = FS;
JJ = ((71)) * ((FS));
// 1212 ! %IF USE IMP=YES %THEN %START
// 1213 %CYCLE
L_00dd:
// 1214 Q=Q+1
Q = ((Q)) + ((1));
// 1215 I=CC(Q)
I = CC[Q];
// 1216 %EXIT %IF TRTAB(I)=0
if (( TRTAB[I] ) != ( 0 )) goto L_00e0;
goto L_00de;
L_00e0:
// 1217 JJ=JJ+HASH(T) %IF T<=7
if (( T ) > ( 7 )) goto L_00e1;
JJ = ((JJ)) + ((HASH[T]));
L_00e1:
// 1218 T=T+1
T = ((T)) + ((1));
// 1219 LETT(NEXT+T)=I
LETT[((NEXT)) + ((T))] = I;
// 1220 %REPEAT
goto L_00dd;
L_00de:
// 1221 ! %FINISH %ELSE %START
// 1222 !CYC:
// 1223 ! *LB_Q
// 1224 ! *ADB_1
// 1225 ! *STB_Q
// 1226 ! *LB_(CC+%B)
// 1227 ! *LSS_(TRTAB+%B)
// 1228 ! *JAT_4,<EXIT>
// 1229 ! *STB_I
// 1230 ! *LSS_%B; ! I TO ACC
// 1231 ! *LB_T
// 1232 ! *CPB_7
// 1233 ! *JCC_2,<SKIP>
// 1234 ! *IMY_(HASH+%B)
// 1235 ! *IAD_JJ
// 1236 ! *ST_JJ
// 1237 !SKIP:
// 1238 ! *ADB_1
// 1239 ! *STB_T
// 1240 ! *LSS_I
// 1241 ! *ADB_NEXT
// 1242 ! *ST_(LETT+%B)
// 1243 ! *J_<CYC>
// 1244 !EXIT:
// 1245 ! %FINISH
// 1246 LETT(NEXT)=T; ! INSERT LENGTH
LETT[NEXT] = T;
// 1247 S=T+1
S = ((T)) + ((1));
// 1248 FAULT(103,0) %IF NEXT+S>DSIZE;!DICTIONARY OVERFLOW
if (( ((NEXT)) + ((S)) ) <= ( DSIZE )) goto L_00e2;
FAULT(103, 0);
L_00e2:
// 1249 JJ=(JJ+113*T)&NNAMES
JJ = ((((JJ)) + ((((113)) * ((T)))))) & ((NNAMES));
// 1250 ! %IF USE IMP=YES %THEN %START
// 1251 %CYCLE KK=JJ, 1, NNAMES
KK = ((JJ)) - ((1));
L_00e3:
if (( KK ) == ( NNAMES )) goto L_00e4;
KK = ((KK)) + ((1));
// 1252 LL=WORD(KK)
LL = WORD[KK];
// 1253 ->HOLE %IF LL=0; ! NAME NOT KNOWN
if (( LL ) != ( 0 )) goto L_00e6;
goto U_0138;
L_00e6:
// 1254 ->FND %IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL)))
if (_imp_strcmp(*STRING(ADDR( &LETT[NEXT])), *STRING(ADDR( &LETT[LL]))) != 0) goto L_00e7;
goto U_0139;
L_00e7:
// 1255 %REPEAT
goto L_00e3;
L_00e4:
// 1256 %CYCLE KK=0,1,JJ
KK = ((0)) - ((1));
L_00e8:
if (( KK ) == ( JJ )) goto L_00e9;
KK = ((KK)) + ((1));
// 1257 LL=WORD(KK)
LL = WORD[KK];
// 1258 ->HOLE %IF LL=0; ! NAME NOT KNOWN
if (( LL ) != ( 0 )) goto L_00eb;
goto U_0138;
L_00eb:
// 1259 ->FND %IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL)))
if (_imp_strcmp(*STRING(ADDR( &LETT[NEXT])), *STRING(ADDR( &LETT[LL]))) != 0) goto L_00ec;
goto U_0139;
L_00ec:
// 1260 %REPEAT
goto L_00e8;
L_00e9:
// 1261 ! %FINISH %ELSE %START
// 1262 ! *LDTB_16_18000000
// 1263 ! *LDB_S
// 1264 ! *LDA_LETT+4
// 1265 ! *STD_DRDES
// 1266 ! *INCA_NEXT
// 1267 ! *STD_ACCDES
// 1268 ! *LB_JJ
// 1269 !CYC1:
// 1270 ! *STB_KK
// 1271 ! *LB_(WORD+%B)
// 1272 ! *JAT_12,<HOLE>
// 1273 ! *LSD_ACCDES
// 1274 ! *LD_DRDES
// 1275 ! *INCA_%B
// 1276 ! *CPS_%L=%DR
// 1277 ! *JCC_8,<FND>
// 1278 ! *LB_KK
// 1279 ! *CPIB_NNAMES
// 1280 ! *JCC_7,<CYC1>
// 1281 ! *LB_0
// 1282 !CYC2:
// 1283 ! *STB_KK
// 1284 ! *LB_(WORD+%B)
// 1285 ! *JAT_12,<HOLE>
// 1286 ! *LSD_ACCDES
// 1287 ! *LD_DRDES
// 1288 ! *INCA_%B
// 1289 ! *CPS_%L=%DR
// 1290 ! *JCC_8,<FND>
// 1291 ! *LB_KK
// 1292 ! *CPIB_JJ
// 1293 ! *JCC_7,<CYC2>
// 1294 ! %FINISH
// 1295 FAULT(104, 0); ! TOO MANY NAMES
FAULT(104, 0);
// 1296 HOLE: %IF MODE=0 %THEN Q=FQ %AND %RETURN
U_0138:
if (( MODE ) != ( 0 )) goto L_00ed;
Q = FQ;
return;
L_00ed:
// 1297 WORD(KK)=NEXT; NEXT=NEXT+S
WORD[KK] = NEXT;
NEXT = ((NEXT)) + ((S));
// 1298 FND: LASTAT=FQ; HIT=1; LASTNAME=KK
U_0139:
LASTAT = FQ;
HIT = 1;
LASTNAME = KK;
// 1299 A(R+1)<-LASTNAME
A[((R)) + ((1))] = LASTNAME;
// 1300 A(R)=LASTNAME>>8; R=R+2
A[R] = (int)(((unsigned int)(LASTNAME)) >> ((8)));
R = ((R)) + ((2));
// 1301 LASTEND=Q
LASTEND = Q;
// 1302 %END
return;
_imp_endofblock: ;
} // End of block PNAME at level 4
// 1303
// 1304
// 1305 %ROUTINE CONST(%INTEGER MODE)
void CONST( int MODE )
{
__label__ _imp_endofblock;
// 1306 !***********************************************************************
// 1307 !* SYNTAX CHECK AND EVALUATE ALL THE FORMS OF IMP CONSTANT *
// 1308 !* MODE=0 FOR INTEGER CONSTANTS #0 FOR ANY SORT OF CONSTANT *
// 1309 !***********************************************************************
// 1310 %INTEGER Z, DOTSEEN, EBCDIC, FS, CPREC, RR, S, T, SS
int Z;
int DOTSEEN;
int EBCDIC;
int FS;
int CPREC;
int RR;
int S;
int T;
int SS;
// 1311 {%LONG}%LONGREAL X,CVALUE,DUMMY
double X;
double CVALUE;
double DUMMY;
// 1312 %CONST{%LONG}%LONGREAL TEN=10.0 {R'41A00000000000000000000000000000'
const double TEN = 10.0;
// 1313 CPREC=5; RR=R; R=R+1
CPREC = 5;
RR = R;
R = ((R)) + ((1));
// 1314 DOTSEEN=0; HIT=0
DOTSEEN = 0;
HIT = 0;
// 1315 CVALUE=0; DUMMY=0; FS=CC(Q)
CVALUE = 0;
DUMMY = 0;
FS = CC[Q];
// 1316 S=0; ->N %IF M'0'<=FS<=M'9'
S = 0;
if (( 48 ) > ( FS )) goto L_00ee;
if (( FS ) > ( 57 )) goto L_00ee;
goto U_013a;
L_00ee:
// 1317 ->DOT %IF FS='.' %AND MODE=0 %AND '0'<=CC(Q+1)<='9'
if (( FS ) != ( 46 )) goto L_00ef;
if (( MODE ) != ( 0 )) goto L_00ef;
if (( 48 ) > ( CC[((Q)) + ((1))] )) goto L_00ef;
if (( CC[((Q)) + ((1))] ) > ( 57 )) goto L_00ef;
goto U_013b;
L_00ef:
// 1318 ! 1 DIDT MIN
// 1319 CTYPE=1; EBCDIC=0
CTYPE = 1;
EBCDIC = 0;
// 1320 ->QUOTE %IF FS=M''''
if (( FS ) != ( 39 )) goto L_00f0;
goto U_013c;
L_00f0:
// 1321 ->STR2 %IF FS=34
if (( FS ) != ( 34 )) goto L_00f1;
goto U_013d;
L_00f1:
// 1322 ->NOTQUOTE %UNLESS CC(Q+1)=M''''; Q=Q+2
if (( CC[((Q)) + ((1))] ) == ( 39 )) goto L_00f2;
goto U_013e;
L_00f2:
Q = ((Q)) + ((2));
// 1323 ->HEX %IF FS='X'
if (( FS ) != ( 88 )) goto L_00f3;
goto U_013f;
L_00f3:
// 1324 ->MULT %IF FS='M'
if (( FS ) != ( 77 )) goto L_00f4;
goto U_0140;
L_00f4:
// 1325 ->BIN %IF FS=M'B'
if (( FS ) != ( 66 )) goto L_00f5;
goto U_0141;
L_00f5:
// 1326 ->RHEX %IF FS='R' %AND MODE=0
if (( FS ) != ( 82 )) goto L_00f6;
if (( MODE ) != ( 0 )) goto L_00f6;
goto U_0142;
L_00f6:
// 1327 ->OCT %IF FS='K'
if (( FS ) != ( 75 )) goto L_00f7;
goto U_0143;
L_00f7:
// 1328 %IF FS='C' %THEN EBCDIC=1 %AND ->MULT
if (( FS ) != ( 67 )) goto L_00f8;
EBCDIC = 1;
goto U_0140;
L_00f8:
// 1329 %IF FS='D' %AND MODE=0 %THEN %START
if (( FS ) != ( 68 )) goto L_00f9;
if (( MODE ) != ( 0 )) goto L_00f9;
// 1330 CPREC=7
CPREC = 7;
// 1331 %IF M'0'<=CC(Q)<=M'9' %THEN ->N
if (( 48 ) > ( CC[Q] )) goto L_00fa;
if (( CC[Q] ) > ( 57 )) goto L_00fa;
goto U_013a;
L_00fa:
// 1332 %IF CC(Q)='.' %THEN ->DOT
if (( CC[Q] ) != ( 46 )) goto L_00fb;
goto U_013b;
L_00fb:
// 1333 %FINISH
L_00f9:
// 1334 Q=Q-2; %RETURN
Q = ((Q)) - ((2));
return;
// 1335 QUOTE: ! SINGLE CH BETWEEN QUOTES
U_013c:
// 1336 %IF CC(Q+2)=M'''' %THEN %START
if (( CC[((Q)) + ((2))] ) != ( 39 )) goto L_00fc;
// 1337 S=CC(Q+1)
S = CC[((Q)) + ((1))];
// 1338 Q=Q+3
Q = ((Q)) + ((3));
// 1339 %IF S#M'''' %THEN ->IEND
if (( S ) == ( 39 )) goto L_00fd;
goto U_0144;
L_00fd:
// 1340 %IF CC(Q)=M'''' %THEN Q=Q+1 %AND ->IEND
if (( CC[Q] ) != ( 39 )) goto L_00fe;
Q = ((Q)) + ((1));
goto U_0144;
L_00fe:
// 1341 %FINISH
L_00fc:
// 1342 %RETURN; ! NOT VALID
return;
// 1343 NOTQUOTE: ! CHECK FOR E"...."
U_013e:
// 1344 %RETURN %UNLESS FS='E' %AND CC(Q+1)=M'"'
if (( FS ) != ( 69 )) goto L_00ea;
if (( CC[((Q)) + ((1))] ) == ( 34 )) goto L_00ff;
L_00ea:
return;
L_00ff:
// 1345 EBCDIC=1; Q=Q+1
EBCDIC = 1;
Q = ((Q)) + ((1));
// 1346 STR2: ! DOUBLE QUOTED STRING
U_013d:
// 1347 A(RR)=16_35; TEXTTEXT(EBCDIC)
A[RR] = 53;
TEXTTEXT(EBCDIC);
// 1348 CTYPE=5; %RETURN
CTYPE = 5;
return;
// 1349 HEX: T=0; ! HEX CONSTANTS
U_013f:
T = 0;
// 1350 %CYCLE
L_0100:
// 1351 I=CC(Q); Q=Q+1
I = CC[Q];
Q = ((Q)) + ((1));
// 1352 %EXIT %IF I=M''''
if (( I ) != ( 39 )) goto L_0103;
goto L_0101;
L_0103:
// 1353 T=T+1
T = ((T)) + ((1));
// 1354 %RETURN %UNLESS ('0'<=I<='9' %OR 'A'<=I<='F') %AND T<17
if (( 48 ) > ( I )) goto L_0104;
if (( I ) <= ( 57 )) goto L_0105;
L_0104:
if (( 65 ) > ( I )) goto L_009e;
if (( I ) > ( 70 )) goto L_009e;
L_0105:
if (( T ) < ( 17 )) goto L_0106;
L_009e:
return;
L_0106:
// 1355 %IF T=9 %THEN SS=S %AND S=0
if (( T ) != ( 9 )) goto L_0107;
SS = S;
S = 0;
L_0107:
// 1356 S=S<<4+I&15+9*I>>6
S = ((((((S)) << ((4)))) + ((((I)) & ((15)))))) + ((((9)) * (((int)(((unsigned int)(I)) >> ((6)))))));
// 1357 %REPEAT
goto L_0100;
L_0101:
// 1358 %IF T>8 %START
if (( T ) <= ( 8 )) goto L_0108;
// 1359 Z=4*(T-8)
Z = ((4)) * ((((T)) - ((8))));
// 1360 S=S!(SS<<Z)
S = ((S)) | ((((SS)) << ((Z))));
// 1361 SS=SS>>(32-Z); CPREC=6
SS = (int)(((unsigned int)(SS)) >> ((((32)) - ((Z)))));
CPREC = 6;
// 1362 %FINISH
L_0108:
// 1363 IEND: %IF CPREC=6 %THEN TOAR4(R,SS) %AND R=R+4
U_0144:
if (( CPREC ) != ( 6 )) goto L_0109;
TOAR4(R, SS);
R = ((R)) + ((4));
L_0109:
// 1364 %IF CPREC=5 %AND 0<=S<=16_7FFF %START
if (( CPREC ) != ( 5 )) goto L_010a;
if (( 0 ) > ( S )) goto L_010a;
if (( S ) > ( 32767 )) goto L_010a;
// 1365 CPREC=4; TOAR2(R,S); R=R+2
CPREC = 4;
TOAR2(R, S);
R = ((R)) + ((2));
// 1366 %FINISH %ELSE TOAR4(R,S) %AND R=R+4
goto L_010b;
L_010a:
TOAR4(R, S);
R = ((R)) + ((4));
L_010b:
// 1367 HIT=1 %UNLESS MODE#0 %AND CPREC=6
if (( MODE ) == ( 0 )) goto L_0102;
if (( CPREC ) == ( 6 )) goto L_010c;
L_0102:
HIT = 1;
L_010c:
// 1368 A(RR)=CPREC<<4!CTYPE
A[RR] = ((((CPREC)) << ((4)))) | ((CTYPE));
// 1369 %RETURN
return;
// 1370 RHEX: ! REAL HEX CONSTANTS
U_0142:
// 1371 T=0
T = 0;
// 1372 %CYCLE
L_010d:
// 1373 I=CC(Q); Q=Q+1
I = CC[Q];
Q = ((Q)) + ((1));
// 1374 %IF T&7=0 %AND T#0 %START
if (( ((T)) & ((7)) ) != ( 0 )) goto L_0110;
if (( T ) == ( 0 )) goto L_0110;
// 1375 TOAR4(R,S); R=R+4; S=0
TOAR4(R, S);
R = ((R)) + ((4));
S = 0;
// 1376 %FINISH
L_0110:
// 1377 %EXIT %IF I=M''''; T=T+1
if (( I ) != ( 39 )) goto L_0111;
goto L_010e;
L_0111:
T = ((T)) + ((1));
// 1378 %RETURN %UNLESS '0'<=I<='9' %OR 'A'<=I<='F'
if (( 48 ) > ( I )) goto L_0112;
if (( I ) <= ( 57 )) goto L_0113;
L_0112:
if (( 65 ) > ( I )) goto L_0114;
if (( I ) <= ( 70 )) goto L_0113;
L_0114:
return;
L_0113:
// 1379 S=S<<4+I&15+9*I>>6
S = ((((((S)) << ((4)))) + ((((I)) & ((15)))))) + ((((9)) * (((int)(((unsigned int)(I)) >> ((6)))))));
// 1380 %REPEAT
goto L_010d;
L_010e:
// 1381 %RETURN %UNLESS T=8 %OR T=16 %OR T=32
if (( T ) == ( 8 )) goto L_0115;
if (( T ) == ( 16 )) goto L_0115;
if (( T ) == ( 32 )) goto L_0115;
return;
L_0115:
// 1382 %IF T=32 %THEN CPREC=7 %ELSE CPREC=4+T//8
if (( T ) != ( 32 )) goto L_0116;
CPREC = 7;
goto L_0117;
L_0116:
CPREC = ((4)) + ((((int)(T)) / ((int)(8))));
L_0117:
// 1383 A(RR)=CPREC<<4!2
A[RR] = ((((CPREC)) << ((4)))) | ((2));
// 1384 HIT=1; %RETURN
HIT = 1;
return;
// 1385 OCT: ! OCTAL CONSTANTS
U_0143:
// 1386 T=0
T = 0;
// 1387 %CYCLE
L_0118:
// 1388 I=CC(Q); Q=Q+1; T=T+1
I = CC[Q];
Q = ((Q)) + ((1));
T = ((T)) + ((1));
// 1389 %EXIT %IF I=M''''
if (( I ) != ( 39 )) goto L_011b;
goto L_0119;
L_011b:
// 1390 %RETURN %UNLESS '0'<=I<='7' %AND T<12
if (( 48 ) > ( I )) goto L_011c;
if (( I ) > ( 55 )) goto L_011c;
if (( T ) < ( 12 )) goto L_011d;
L_011c:
return;
L_011d:
// 1391 S=S<<3!(I&7)
S = ((((S)) << ((3)))) | ((((I)) & ((7))));
// 1392 %REPEAT
goto L_0118;
L_0119:
// 1393 ->IEND
goto U_0144;
// 1394 MULT: T=0; ! MULTIPLE CONSTANTS
U_0140:
T = 0;
// 1395 %CYCLE
L_011e:
// 1396 I=CC(Q); Q=Q+1; T=T+1
I = CC[Q];
Q = ((Q)) + ((1));
T = ((T)) + ((1));
// 1397 %IF I=M'''' %THEN %START
if (( I ) != ( 39 )) goto L_0121;
// 1398 %IF CC(Q)#M'''' %THEN %EXIT %ELSE Q=Q+1
if (( CC[Q] ) == ( 39 )) goto L_0122;
goto L_011f;
L_0122:
Q = ((Q)) + ((1));
// 1399 %FINISH
L_0121:
// 1400 %RETURN %IF T>=5
if (( T ) < ( 5 )) goto L_0123;
return;
L_0123:
// 1401 %IF EBCDIC#0 %THEN I=ITOETAB(I)
if (( EBCDIC ) == ( 0 )) goto L_0124;
I = ITOETAB[I];
L_0124:
// 1402 S=S<<8!I
S = ((((S)) << ((8)))) | ((I));
// 1403 %REPEAT
goto L_011e;
L_011f:
// 1404 ->IEND
goto U_0144;
// 1405 BIN: T=0; ! BINARY CONST
U_0141:
T = 0;
// 1406 %CYCLE
L_0125:
// 1407 I=CC(Q); Q=Q+1; T=T+1
I = CC[Q];
Q = ((Q)) + ((1));
T = ((T)) + ((1));
// 1408 %EXIT %IF I=M''''
if (( I ) != ( 39 )) goto L_0128;
goto L_0126;
L_0128:
// 1409 %RETURN %UNLESS '0'<=I<='1' %AND T<33
if (( 48 ) > ( I )) goto L_0129;
if (( I ) > ( 49 )) goto L_0129;
if (( T ) < ( 33 )) goto L_012a;
L_0129:
return;
L_012a:
// 1410 S=S<<1!I&1
S = ((((S)) << ((1)))) | ((((I)) & ((1))));
// 1411 %REPEAT
goto L_0125;
L_0126:
// 1412 ->IEND
goto U_0144;
// 1413 N: ! CONSTANT STARTS WITH DIGIT
U_013a:
// 1414 I=CC(Q)
I = CC[Q];
// 1415 {%UNTIL I<M'0' %OR I>M'9'} %CYCLE
L_012b:
// 1416 CVALUE=TEN*CVALUE+(I&15)
CVALUE = ((((TEN)) * ((CVALUE)))) + ((((I)) & ((15))));
// 1417 Q=Q+1; I=CC(Q); ! ONTO NEXT CHAR
Q = ((Q)) + ((1));
I = CC[Q];
// 1418 %REPEAT %UNTIL I<M'0' %OR I>M'9'
if (( I ) < ( 48 )) goto L_012c;
if (( I ) > ( 57 )) goto L_012c;
goto L_012b;
L_012c:
// 1419 ->ALPHA %UNLESS MODE=0 %AND I='.'
if (( MODE ) != ( 0 )) goto L_012d;
if (( I ) == ( 46 )) goto L_012e;
L_012d:
goto U_0145;
L_012e:
// 1420 DOT: Q=Q+1; X=TEN; I=CC(Q)
U_013b:
Q = ((Q)) + ((1));
X = TEN;
I = CC[Q];
// 1421 DOTSEEN=1; ! CONSTANT HAS DECIMAL POINT
DOTSEEN = 1;
// 1422 %WHILE M'0'<=I<=M'9' %CYCLE
L_012f:
if (( 48 ) > ( I )) goto L_0130;
if (( I ) > ( 57 )) goto L_0130;
// 1423 CVALUE=CVALUE+(I&15)/X
CVALUE = ((CVALUE)) + ((((float)(((I)) & ((15)))) / ((float)(X))));
// 1424 X=TEN*X; Q=Q+1; I=CC(Q)
X = ((TEN)) * ((X));
Q = ((Q)) + ((1));
I = CC[Q];
// 1425 %REPEAT
goto L_012f;
L_0130:
// 1426 ALPHA: ! TEST FOR EXPONENT
U_0145:
// 1427 %IF MODE=0 %AND CC(Q)='@' %THEN %START
if (( MODE ) != ( 0 )) goto L_0132;
if (( CC[Q] ) != ( 64 )) goto L_0132;
// 1428 Q=Q+1; X=CVALUE
Q = ((Q)) + ((1));
X = CVALUE;
// 1429 Z=1; I=CC(Q)
Z = 1;
I = CC[Q];
// 1430 %IF I='-' %THEN Z=-1
if (( I ) != ( 45 )) goto L_0133;
Z = (-(1));
L_0133:
// 1431 %IF I='+' %OR I='-' %THEN Q=Q+1
if (( I ) == ( 43 )) goto L_0134;
if (( I ) != ( 45 )) goto L_0135;
L_0134:
Q = ((Q)) + ((1));
L_0135:
// 1432 CONST(2)
CONST(2);
// 1433 %IF HIT=0 %THEN %RETURN
if (( HIT ) != ( 0 )) goto L_0136;
return;
L_0136:
// 1434 HIT=0
HIT = 0;
// 1435 R=RR+1
R = ((RR)) + ((1));
// 1436 %IF A(R)>>4#4 %THEN %RETURN; ! EXPONENT MUST BE HALFINTEGER
if (( (int)(((unsigned int)(A[R])) >> ((4))) ) == ( 4 )) goto L_0137;
return;
L_0137:
// 1437 S=FROM AR2(R+1)*Z
S = ((FROMAR2(((R)) + ((1))))) * ((Z));
// 1438 %IF S=-99 %THEN CVALUE=0 %ELSE %START
if (( S ) != ( (-(99)) )) goto L_0138;
CVALUE = 0;
goto L_0139;
L_0138:
// 1439 ! %IF USE IMP=NO %THEN %START
// 1440 ! *MPSR_16_8080; ! MASK OUT REAL OVERFLOW
// 1441 ! %FINISH
// 1442 %WHILE S>0 %CYCLE
L_013a:
if (( S ) <= ( 0 )) goto L_013b;
// 1443 S=S-1
S = ((S)) - ((1));
// 1444 CVALUE=CVALUE*TEN
CVALUE = ((CVALUE)) * ((TEN));
// 1445 ! %IF USE IMP=NO %THEN %START
// 1446 ! *JAT_15,<FAIL>
// 1447 ! %FINISH
// 1448 %REPEAT
goto L_013a;
L_013b:
// 1449 %WHILE S<0 %AND CVALUE#0 %CYCLE
L_013d:
if (( S ) >= ( 0 )) goto L_013e;
if (( CVALUE ) == ( 0 )) goto L_013e;
// 1450 S=S+1
S = ((S)) + ((1));
// 1451 CVALUE=CVALUE/TEN
CVALUE = ((float)(CVALUE)) / ((float)(TEN));
// 1452 %REPEAT
goto L_013d;
L_013e:
// 1453 %FINISH
L_0139:
// 1454 %FINISH
L_0132:
// 1455 ! SEE IF IT IS INTEGER
// 1456 %IF FS='D' %THEN %START
if (( FS ) != ( 68 )) goto L_0140;
// 1457 I=CC(Q)
I = CC[Q];
// 1458 %IF I='''' %THEN Q=Q+1 %ELSE %RETURN
if (( I ) != ( 39 )) goto L_0141;
Q = ((Q)) + ((1));
goto L_0142;
L_0141:
return;
L_0142:
// 1459 DOTSEEN=1; ! ENSURE NOT TAKEN AS INTEGER
DOTSEEN = 1;
// 1460 %FINISH
L_0140:
// 1461 %IF DOTSEEN=1 %OR CVALUE>IMAX %OR FRACPT(CVALUE)#0 %THEN CTYPE=2 %ELSE CTYPE=1 %AND S=INT(CVALUE)
if (( DOTSEEN ) == ( 1 )) goto L_0131;
if (( CVALUE ) > ( IMAX )) goto L_0131;
if (( FRACPT(CVALUE) ) == ( 0 )) goto L_0143;
L_0131:
CTYPE = 2;
goto L_0144;
L_0143:
CTYPE = 1;
S = INT(CVALUE);
L_0144:
// 1462 %IF CTYPE=1 %THEN ->IEND
if (( CTYPE ) != ( 1 )) goto L_0145;
goto U_0144;
L_0145:
// 1463 %IF CPREC=5 %THEN CPREC=6; ! NO 32 BIT REAL CONSTS
if (( CPREC ) != ( 5 )) goto L_0146;
CPREC = 6;
L_0146:
// 1464 %IF CPREC=6 %THEN %START
if (( CPREC ) != ( 6 )) goto L_0147;
// 1465 ! %IF USE IMP=NO %THEN %START; ! SOFTWARE ROUND IN MC CODE ONLY
// 1466 ! *LSD_CVALUE
// 1467 ! *AND_16_FF00000000000000
// 1468 ! *SLSD_CVALUE+8
// 1469 ! *AND_16_0080000000000000
// 1470 ! *LUH_%TOS
// 1471 ! *RAD_CVALUE
// 1472 ! *ST_CVALUE
// 1473 ! %FINISH
// 1474 %FINISH
L_0147:
// 1475 TOAR8(R,CVALUE); R=R+8
TOAR8(R, CVALUE);
R = ((R)) + ((8));
// 1476 %IF CPREC=7 %THEN TOAR8(R,LONGREAL(ADDR(CVALUE)+8)) %AND R=R+8
if (( CPREC ) != ( 7 )) goto L_0148;
TOAR8(R, **LONGREAL(((ADDR( &CVALUE))) + ((8))));
R = ((R)) + ((8));
L_0148:
// 1477 A(RR)=CPREC<<4+CTYPE
A[RR] = ((((CPREC)) << ((4)))) + ((CTYPE));
// 1478 HIT=1
HIT = 1;
// 1479 FAIL: %END
U_0146:
return;
_imp_endofblock: ;
} // End of block CONST at level 4
// 1480 %ROUTINE TEXTTEXT(%INTEGER EBCDIC)
void TEXTTEXT( int EBCDIC )
{
__label__ _imp_endofblock;
// 1481 !***********************************************************************
// 1482 !* PROCESSES TEXT BETWEEN DOUBLE QUOTES AND STORES IN ISO OR EBCDIC *
// 1483 !***********************************************************************
// 1484 %INTEGER J, II
int J;
int II;
// 1485 %CONSTINTEGER QU='"'
// 1486 I=CC(Q)
I = CC[Q];
// 1487 S=R+4; R=R+5; HIT=0
S = ((R)) + ((4));
R = ((R)) + ((5));
HIT = 0;
// 1488 %RETURN %UNLESS I=QU; ! FAIL UNLESS INITIAL QUOTE
if (( I ) == ( 34 )) goto L_0149;
return;
L_0149:
// 1489 Q=Q+1
Q = ((Q)) + ((1));
// 1490 %CYCLE
L_014a:
// 1491 I=CC(Q)
I = CC[Q];
// 1492 %IF EBCDIC#0 %THEN II=ITOETAB(I) %ELSE II=I
if (( EBCDIC ) == ( 0 )) goto L_014d;
II = ITOETAB[I];
goto L_014e;
L_014d:
II = I;
L_014e:
// 1493 A(R)=II; R=R+1
A[R] = II;
R = ((R)) + ((1));
// 1494 %IF I=QU %THEN %START
if (( I ) != ( 34 )) goto L_014f;
// 1495 Q=Q+1
Q = ((Q)) + ((1));
// 1496 %IF CC(Q)#QU %THEN %EXIT
if (( CC[Q] ) == ( 34 )) goto L_0150;
goto L_014b;
L_0150:
// 1497 %FINISH
L_014f:
// 1498 %IF I=10 %THEN READLINE(1,QU) %ELSE Q=Q+1
if (( I ) != ( 10 )) goto L_0151;
READLINE(1, 34);
goto L_0152;
L_0151:
Q = ((Q)) + ((1));
L_0152:
// 1499 FAULT(106,0) %IF R-S>256
if (( ((R)) - ((S)) ) <= ( 256 )) goto L_0153;
FAULT(106, 0);
L_0153:
// 1500 %REPEAT
goto L_014a;
L_014b:
// 1501 R=R-1; J=R-S-1
R = ((R)) - ((1));
J = ((((R)) - ((S)))) - ((1));
// 1502 A(S)=J; HIT=1
A[S] = J;
HIT = 1;
// 1503 %END
return;
_imp_endofblock: ;
} // End of block TEXTTEXT at level 4
// 1504 BEND:%END; ! OF BLOCK CONTAINING PASS 1
U_012b:
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_2_LEVEL_2_ at level 3
// 1505 %IF LEVEL>1 %THEN FAULT(15, 0)
if (( LEVEL ) <= ( 1 )) goto L_0154;
FAULT(15, 0);
L_0154:
// 1506 I=0
I = 0;
// 1507 NEWLINE
NEWLINE();
// 1508 %IF FAULTY=0 %THEN %START
if (( FAULTY ) != ( 0 )) goto L_0155;
// 1509 WRITE(LINE, 5)
WRITE(LINE, 5);
// 1510 PRINT STRING(" LINES ANALYSED IN")
PRINTSTRING(_imp_str_literal(" LINES ANALYSED IN"));
// 1511 WRITE(INT(1000*(CPUTIME-CTIME)),5)
WRITE(INT(((1000)) * ((((CPUTIME())) - ((CTIME))))), 5);
// 1512 PRINT STRING(" MSECS - SIZE=")
PRINTSTRING(_imp_str_literal(" MSECS - SIZE="));
// 1513 WRITE(P1SIZE, 5)
WRITE(P1SIZE, 5);
// 1514 %IF LINE>90 %AND LIST#0 %THEN NEWPAGE %ELSE NEWLINE
if (( LINE ) <= ( 90 )) goto L_0156;
if (( LIST ) == ( 0 )) goto L_0156;
NEWPAGE();
goto L_0157;
L_0156:
NEWLINE();
L_0157:
// 1515 %FINISH %ELSE %START
goto L_0158;
L_0155:
// 1516 PRINTSTRING("CODE GENERATION NOT ATTEMPTED
PRINTSTRING(_imp_str_literal("CODE GENERATION NOT ATTEMPTED\n"));
// 1517 ")
// 1518 COMREG(24)=8
*COMREG(24) = 8;
// 1519 COMREG(47)=FAULTY
*COMREG(47) = FAULTY;
// 1520 %STOP
exit(0);
// 1521 %FINISH
L_0158:
// 1522 %BEGIN
{
__label__ _imp_endofblock;
// 1523 !***********************************************************************
// 1524 !* SECOND OR CODE GENERATING PASS *
// 1525 !***********************************************************************
// 1526 %INTEGERARRAY REGISTER, GRUSE, GRAT, GRINF1, GRINF2, OLINK(0:7)
int REGISTER[(7)-(0)+1];
int GRUSE[(7)-(0)+1];
int GRAT[(7)-(0)+1];
int GRINF1[(7)-(0)+1];
int GRINF2[(7)-(0)+1];
int OLINK[(7)-(0)+1];
// 1527 %BYTEINTEGERARRAY CODE, GLABUF(0:268)
unsigned char CODE[(268)-(0)+1];
unsigned char GLABUF[(268)-(0)+1];
// 1528 %INTEGERARRAY PLABS, DESADS, PLINK(0:31)
int PLABS[(31)-(0)+1];
int DESADS[(31)-(0)+1];
int PLINK[(31)-(0)+1];
// 1529 %INTEGERARRAY SET, STACKBASE, RAL, FLAG, L, M, NMDECS, ONWORD, ONINF,{%C
int SET[(31)-(0)+1];
int STACKBASE[(31)-(0)+1];
int RAL[(31)-(0)+1];
int FLAG[(31)-(0)+1];
int L[(31)-(0)+1];
int M[(31)-(0)+1];
int NMDECS[(31)-(0)+1];
int ONWORD[(31)-(0)+1];
int ONINF[(31)-(0)+1];
int JUMP[(31)-(0)+1];
int LABEL[(31)-(0)+1];
int JROUND[(31)-(0)+1];
int DIAGINF[(31)-(0)+1];
int DISPLAY[(31)-(0)+1];
int AUXSBASE[(31)-(0)+1];
int NAMES[(31)-(0)+1];
// 1530 JUMP, LABEL, JROUND, DIAGINF, DISPLAY, {%C
// 1531 AUXSBASE, NAMES (0:MAXLEVELS)
// 1532 %INTEGERARRAY AVL WSP(0:4,0:MAXLEVELS)
int AVLWSP[(31)-(0)+1][(4)-(0)+1];
// 1533 %recordformat rcf(%integerarray val(0:12* 2047 {NNAMES})) { unfortunately we can't have a dynamically-sized array in a record. Largest possible is 2047.
typedef struct RCF RCF; // forward declaration to allow a 'next' pointer to a struct within that struct...
struct RCF {
int VAL[(24564)-(0)+1];
};
// 1534 %record (rcf) %name CTABLE
RCF *CTABLE;
// 1535 {%INTEGERARRAYFORMAT CF(0:12*NNAMES) - Imp77 doesn't support ARRAY() mapping.
// 1536 {%INTEGERARRAY(1)%NAME CTABLE
// 1537 %ROUTINESPEC CNOP(%INTEGER I, J)
auto void CNOP( int I, int J );
// 1538 %ROUTINESPEC PCLOD(%INTEGER FROM, TO)
auto void PCLOD( int FROM, int TO );
// 1539 %ROUTINESPEC PCONST(%INTEGER X)
auto void PCONST( int X );
// 1540 %ROUTINESPEC PSF1(%INTEGER OPCODE,K,N)
auto void PSF1( int OPCODE, int K, int N );
// 1541 %ROUTINESPEC PF1(%INTEGER OPCODE,KP,KPP,N)
auto void PF1( int OPCODE, int KP, int KPP, int N );
// 1542 %ROUTINESPEC PSORLF1(%INTEGER OPCODE,KP,KPP,N)
auto void PSORLF1( int OPCODE, int KP, int KPP, int N );
// 1543 %ROUTINESPEC PF2(%INTEGER OPCODE,H,Q,N,MASK,FILLER)
auto void PF2( int OPCODE, int H, int Q, int N, int MASK, int FILLER );
// 1544 %ROUTINESPEC PF3(%INTEGER OPCODE,MASK,KPPP,N)
auto void PF3( int OPCODE, int MASK, int KPPP, int N );
// 1545 %ROUTINESPEC NOTE CREF(%INTEGER CA,VAL)
auto void NOTECREF( int CA, int VAL );
// 1546 %INTEGERFNSPEC PARAM DES(%INTEGER PREC)
auto int PARAMDES( int PREC );
// 1547 %INTEGERFNSPEC MAPDES(%INTEGER PREC)
auto int MAPDES( int PREC );
// 1548 %INTEGERFNSPEC SPECIAL CONSTS(%INTEGER WHICH)
auto int SPECIALCONSTS( int WHICH );
// 1549 %ROUTINESPEC STORE CONST(%INTEGERNAME D,%INTEGER L,AD)
auto void STORECONST( int *D, int L, int AD );
// 1550 %ROUTINESPEC DUMP CONSTS
auto void DUMPCONSTS( void );
// 1551 %ROUTINESPEC PLANT(%INTEGER VALUE)
auto void PLANT( int VALUE );
// 1552 %ROUTINESPEC PLUG(%INTEGER I, J, K, BYTES)
auto void PLUG( int I, int J, int K, int BYTES );
// 1553 %ROUTINESPEC CODEOUT
auto void CODEOUT( void );
// 1554 %ROUTINESPEC PROLOGUE
auto void PROLOGUE( void );
// 1555 %ROUTINESPEC EPILOGUE
auto void EPILOGUE( void );
// 1556 %ROUTINESPEC COMPILE A STMNT
auto void COMPILEASTMNT( void );
// 1557 %ROUTINESPEC CSS(%INTEGER P)
auto void CSS( int P );
// 1558 %ROUTINESPEC LOAD DATA
auto void LOADDATA( void );
// 1559 %ROUTINESPEC ABORT
auto void ABORT( void );
// 1560 !*DELSTART
// 1561 %ROUTINESPEC PRINT USE
auto void PRINTUSE( void );
// 1562 !*DELEND
// 1563 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0159:
if (( I ) == ( 7 )) goto L_015a;
I = ((I)) + ((1));
// 1564 REGISTER(I)=0; GRUSE(I)=0; GRINF1(I)=0; GRAT(I)=0
REGISTER[I] = 0;
GRUSE[I] = 0;
GRINF1[I] = 0;
GRAT[I] = 0;
// 1565 GRINF2(I)=0
GRINF2[I] = 0;
// 1566 %REPEAT
goto L_0159;
L_015a:
// 1567 %CYCLE I=0, 1, MAXLEVELS
I = ((0)) - ((1));
L_015c:
if (( I ) == ( 31 )) goto L_015d;
I = ((I)) + ((1));
// 1568 SET(I)=0; STACKBASE(I)=0; RAL(I)=0
SET[I] = 0;
STACKBASE[I] = 0;
RAL[I] = 0;
// 1569 JUMP(I)=0; JROUND(I)=0
JUMP[I] = 0;
JROUND[I] = 0;
// 1570 LABEL(I)=0; FLAG(I)=0
LABEL[I] = 0;
FLAG[I] = 0;
// 1571 L(I)=0; M(I)=0; DIAGINF(I)=0
L[I] = 0;
M[I] = 0;
DIAGINF[I] = 0;
// 1572 DISPLAY(I)=0; ONWORD(I)=0; ONINF(I)=0
DISPLAY[I] = 0;
ONWORD[I] = 0;
ONINF[I] = 0;
// 1573 NAMES(I)=-1
NAMES[I] = (-(1));
// 1574 %CYCLE J=0,1,4
J = ((0)) - ((1));
L_015f:
if (( J ) == ( 4 )) goto L_0160;
J = ((J)) + ((1));
// 1575 AVL WSP(J,I)=0
AVLWSP/* No array bound info found for: */J[I] = 0;
// 1576 %REPEAT
goto L_015f;
L_0160:
// 1577 %REPEAT
goto L_015c;
L_015d:
// 1578 {CTABLE==ARRAY(ADDR(ASLIST(1)),CF)
// 1579 CTABLE==RECORD(ADDR(ASLIST(1)))
CTABLE = * /*(recfm)*/ RECORD(ADDR( &ASLIST[1]));
// 1580 CONST HOLE=0
CONSTHOLE = 0;
// 1581 PROLOGUE
PROLOGUE();
// 1582 LINE=0
LINE = 0;
// 1583 NEXTP=1; LEVEL=1; STMTS=0
NEXTP = 1;
LEVEL = 1;
STMTS = 0;
// 1584 RLEVEL=0; RBASE=0
RLEVEL = 0;
RBASE = 0;
// 1585 %WHILE A(NEXTP+3)!A(NEXTP+4)#0 %CYCLE
L_0162:
if (( ((A[((NEXTP)) + ((3))])) | ((A[((NEXTP)) + ((4))])) ) == ( 0 )) goto L_0163;
// 1586 COMPILE A STMNT
COMPILEASTMNT();
// 1587 %REPEAT
goto L_0162;
L_0163:
// 1588 LINE=99999
LINE = 99999;
// 1589 EPILOGUE
EPILOGUE();
// 1590 LOAD DATA
LOADDATA();
// 1591 %STOP
exit(0);
// 1592 %ROUTINE COMPILE A STMNT
void COMPILEASTMNT( void )
{
__label__ _imp_endofblock;
// 1593 %INTEGER I
int I;
// 1594 !*DELSTART
// 1595 %IF DCOMP#0 %AND CA>CABUF %THEN CODEOUT %AND PRINTUSE
if (( DCOMP ) == ( 0 )) goto L_0165;
if (( CA ) <= ( CABUF )) goto L_0165;
CODEOUT();
PRINTUSE();
L_0165:
// 1596 !*DELEND
// 1597 I=NEXTP
I = NEXTP;
// 1598 NEXTP=NEXTP+A(NEXTP)<<16+A(NEXTP+1)<<8+A(NEXTP+2)
NEXTP = ((((((NEXTP)) + ((((A[NEXTP])) << ((16)))))) + ((((A[((NEXTP)) + ((1))])) << ((8)))))) + ((A[((NEXTP)) + ((2))]));
// 1599 LINE=A(I+3)<<8+A(I+4)
LINE = ((((A[((I)) + ((3))])) << ((8)))) + ((A[((I)) + ((4))]));
// 1600 STMTS=STMTS+1
STMTS = ((STMTS)) + ((1));
// 1601 CSS(I+5)
CSS(((I)) + ((5)));
// 1602 ! CHECK ASL %IF LINE&7=0
// 1603 %END
return;
_imp_endofblock: ;
} // End of block COMPILEASTMNT at level 4
// 1604 %ROUTINE LOAD DATA
void LOADDATA( void )
{
__label__ _imp_endofblock;
// 1605 !***********************************************************************
// 1606 !* PASS INFORMATION TO LPUT TO ENABLE IT TO GENERATE THE *
// 1607 !* LOADER DATA AND COMPLETE THE PROGRAM FILE. *
// 1608 !***********************************************************************
// 1609 %INTEGER LANGFLAG,PARMS
int LANGFLAG;
int PARMS;
// 1610 GLACA=(GLACA+7)&(-8)
GLACA = ((((GLACA)) + ((7)))) & (((-(8))));
// 1611 USTPTR=(USTPTR+7)&(-8)
USTPTR = ((((USTPTR)) + ((7)))) & (((-(8))));
// 1612 CODE OUT
CODEOUT();
// 1613 CNOP(0, 8)
CNOP(0, 8);
// 1614 DUMP CONSTS
DUMPCONSTS();
// 1615 %IF PARMTRACE=0 %THEN LANGFLAG=6 %ELSE LANGFLAG=1
if (( PARMTRACE ) != ( 0 )) goto L_0166;
LANGFLAG = 6;
goto L_0167;
L_0166:
LANGFLAG = 1;
L_0167:
// 1616 LANGFLAG=LANGFLAG<<24
LANGFLAG = ((LANGFLAG)) << ((24));
// 1617 PARMS=(PARMDIAG<<1!PARMLINE)<<1!PARMTRACE
PARMS = ((((((((PARMDIAG)) << ((1)))) | ((PARMLINE)))) << ((1)))) | ((PARMTRACE));
// 1618 FIXED GLA(4)=LANGFLAG!1<<16!(CPRMODE&1)<<8!PARMS;! LANG RLSE & MAINPROG
FIXEDGLA[4] = ((((((LANGFLAG)) | ((((1)) << ((16)))))) | ((((((CPRMODE)) & ((1)))) << ((8)))))) | ((PARMS));
// 1619 I=GLACA-GLACABUF
I = ((GLACA)) - ((GLACABUF));
// 1620 %IF INHCODE=0 %THEN %START
if (( INHCODE ) != ( 0 )) goto L_0168;
// 1621 LPUT(2, I, GLACABUF, ADDR(GLABUF(0))) %UNLESS I=0
if (( I ) == ( 0 )) goto L_0169;
LPUT(2, I, GLACABUF, ADDR( &GLABUF[0]));
L_0169:
// 1622 ! BACK OF GLAP
// 1623 LPUT(2, FIXEDGLALEN, 0, ADDR(FIXED GLA(0)));! FRONT OF GLAP
LPUT(2, 48, 0, ADDR( &FIXEDGLA[0]));
// 1624 LPUT(19,2,8,5); ! RELOCATE GLA ST ADDRESS
LPUT(19, 2, 8, 5);
// 1625 LPUT(19,2,12,4); ! RELOCATE CODE ST ADDRESS
LPUT(19, 2, 12, 4);
// 1626 I=16_E2E2E2E2
I = -488447262;
// 1627 LPUT(4, 4, SSTL, ADDR(I))
LPUT(4, 4, SSTL, ADDR( &I));
// 1628 !
// 1629 %FINISH
L_0168:
// 1630 SSTL=(SSTL+11)&(-8)
SSTL = ((((SSTL)) + ((11)))) & (((-(8))));
// 1631 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\nCODE"));
// 1632 CODE")
// 1633 WRITE(CA, 6); PRINTSTRING(" BYTES GLAP")
WRITE(CA, 6);
PRINTSTRING(_imp_str_literal(" BYTES GLAP"));
// 1634 WRITE(GLACA, 3); PRINTSTRING("+")
WRITE(GLACA, 3);
PRINTSTRING(_imp_str_literal("+"));
// 1635 WRITE(USTPTR, 1); PRINTSTRING(" BYTES DIAG TABLES")
WRITE(USTPTR, 1);
PRINTSTRING(_imp_str_literal(" BYTES DIAG TABLES"));
// 1636 WRITE(SSTL, 3); PRINTSTRING(" BYTES
WRITE(SSTL, 3);
PRINTSTRING(_imp_str_literal(" BYTES\nTOTAL"));
// 1637 TOTAL")
// 1638 REGISTER(0)=CA; REGISTER(1)=GLACA
REGISTER[0] = CA;
REGISTER[1] = GLACA;
// 1639 REGISTER(2)=0
REGISTER[2] = 0;
// 1640 REGISTER(3)=SSTL
REGISTER[3] = SSTL;
// 1641 REGISTER(4)=USTPTR
REGISTER[4] = USTPTR;
// 1642 K=CA+GLACA+SSTL+USTPTR; REGISTER(5)=K
K = ((((((CA)) + ((GLACA)))) + ((SSTL)))) + ((USTPTR));
REGISTER[5] = K;
// 1643 WRITE(K, 5); PRINTSTRING(" BYTES")
WRITE(K, 5);
PRINTSTRING(_imp_str_literal(" BYTES"));
// 1644 NEWLINE; PRINT CH(13); ! MARKER FOR COMP TO PRINT
NEWLINE();
PRINTCH(13);
// 1645 !SUMMARY
// 1646 %IF FAULTY=0 %THEN %START
if (( FAULTY ) != ( 0 )) goto L_016a;
// 1647 WRITE(STMTS, 7); PRINTSTRING(" STATEMENTS COMPILED IN")
WRITE(STMTS, 7);
PRINTSTRING(_imp_str_literal(" STATEMENTS COMPILED IN"));
// 1648 WRITE(INT(1000*(CPUTIME-CTIME)),5)
WRITE(INT(((1000)) * ((((CPUTIME())) - ((CTIME))))), 5);
// 1649 PRINTSTRING(" MSECS")
PRINTSTRING(_imp_str_literal(" MSECS"));
// 1650 COMREG(47)=STMTS; ! NO OF STMTS FOR COMPER
*COMREG(47) = STMTS;
// 1651 %FINISH %ELSE %START
goto L_016b;
L_016a:
// 1652 PRINTSTRING("PROGRAM CONTAINS"); WRITE(FAULTY, 2)
PRINTSTRING(_imp_str_literal("PROGRAM CONTAINS"));
WRITE(FAULTY, 2);
// 1653 PRINTSTRING(" FAULT"); PRINTSYMBOL('S') %IF FAULTY>1
PRINTSTRING(_imp_str_literal(" FAULT"));
if (( FAULTY ) <= ( 1 )) goto L_016c;
PRINTSYMBOL(83);
L_016c:
// 1654 COMREG(47)=FAULTY; ! NO OF FAULTS FOR COMPER
*COMREG(47) = FAULTY;
// 1655 %FINISH
L_016b:
// 1656 NEWLINES(2)
NEWLINES(2);
// 1657 NEWLINE
NEWLINE();
// 1658 I=0; I=8 %IF FAULTY#0
I = 0;
if (( FAULTY ) == ( 0 )) goto L_016d;
I = 8;
L_016d:
// 1659 COMREG(24)=I
*COMREG(24) = I;
// 1660 %IF INHCODE=0 %THEN LPUT(7, 24, 0, ADDR(REGISTER(0)))
if (( INHCODE ) != ( 0 )) goto L_016e;
LPUT(7, 24, 0, ADDR( ®ISTER[0]));
L_016e:
// 1661 ! SUMMARY INFO..REGISTER AS BUF
// 1662 PPROFILE
PPROFILE();
// 1663 %STOP
exit(0);
// 1664 %END
return;
_imp_endofblock: ;
} // End of block LOADDATA at level 4
// 1665 !
// 1666 !***********************************************************************
// 1667 !* IMP CODE PLANTING ROUTINES *
// 1668 !* CODE AND GLAP ARE PUT INTO THE BUFFERS 'CODE,GLABUF(0:268)' *
// 1669 !* BY A NUMBER OF TRIVIAL ROUTINES.LPUT IS CALLED TO ADD THE *
// 1670 !* BUFFER TO THE OUTPUT FILE. THE BUFFERS ARE BASICALLY 0:255 *
// 1671 !* WITH A 12-BYTE MARGIN TO MINIMISE THE NUMBER OF TESTS FOR *
// 1672 !* THE BUFFER FULL CONDITION *
// 1673 !* *
// 1674 !* PPCURR(GLACURR) IS THE BUFFER POINTER *
// 1675 !* CA(GLACA) IS THE RELATIVE ADDRESS OF THE NEXT BYTE *
// 1676 !* CABUF(GLACABUF) IS CA(GLACA) FOR START OF BUFFER *
// 1677 !***********************************************************************
// 1678 !*DELSTART
// 1679 %ROUTINE RECODE(%INTEGER S,F,AD)
void RECODE( int S, int F, int AD )
{
__label__ _imp_endofblock;
// 1680 %IF S#F %START
if (( S ) == ( F )) goto L_016f;
// 1681 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\nCODE FOR LINE"));
// 1682 CODE FOR LINE"); WRITE(LINE,5)
WRITE(LINE, 5);
// 1683 NCODE(S,F,AD)
NCODE(S, F, AD);
// 1684 %FINISH
L_016f:
// 1685 %END
return;
_imp_endofblock: ;
} // End of block RECODE at level 4
// 1686 !*DELEND
// 1687 %ROUTINE CODEOUT
void CODEOUT( void )
{
__label__ _imp_endofblock;
// 1688 %IF PPCURR>0 %THEN %START
if (( PPCURR ) <= ( 0 )) goto L_0170;
// 1689 !*DELSTART
// 1690 RECODE(ADDR(CODE(0)), ADDR(CODE(PPCURR)), CABUF) %IF DCOMP#0
if (( DCOMP ) == ( 0 )) goto L_0171;
RECODE(ADDR( &CODE[0]), ADDR( &CODE[PPCURR]), CABUF);
L_0171:
// 1691 !*DELEND
// 1692 LPUT(1, PPCURR, CABUF, ADDR(CODE(0))) %IF INHCODE=0
if (( INHCODE ) != ( 0 )) goto L_0172;
LPUT(1, PPCURR, CABUF, ADDR( &CODE[0]));
L_0172:
// 1693 PPCURR=0; CABUF=CA
PPCURR = 0;
CABUF = CA;
// 1694 %FINISH
L_0170:
// 1695 %END
return;
_imp_endofblock: ;
} // End of block CODEOUT at level 4
// 1696 %ROUTINE PLANT(%INTEGER HALFWORD)
void PLANT( int HALFWORD )
{
__label__ _imp_endofblock;
// 1697 !***********************************************************************
// 1698 !* ADD A HALF WORD OF BINARY TO THE BUFFER *
// 1699 !***********************************************************************
// 1700 ! %IF USE IMP=YES %THEN %START
// 1701 CODE(PPCURR)<-HALFWORD>>8
CODE[PPCURR] = (int)(((unsigned int)(HALFWORD)) >> ((8)));
// 1702 CODE(PPCURR+1)<-HALFWORD
CODE[((PPCURR)) + ((1))] = HALFWORD;
// 1703 PPCURR=PPCURR+2
PPCURR = ((PPCURR)) + ((2));
// 1704 ! %FINISH %ELSE %START
// 1705 ! *LDA_CODE+4
// 1706 ! *LDTB_16_58000002
// 1707 ! *LB_PPCURR
// 1708 ! *LSS_HALFWORD
// 1709 ! *ST_(%DR+%B)
// 1710 ! *ADB_2
// 1711 ! *STB_PPCURR
// 1712 ! %FINISH
// 1713 CA=CA+2
CA = ((CA)) + ((2));
// 1714 CODEOUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_0173;
CODEOUT();
L_0173:
// 1715 %END
return;
_imp_endofblock: ;
} // End of block PLANT at level 4
// 1716 %ROUTINE PCONST(%INTEGER WORD)
void PCONST( int WORD )
{
__label__ _imp_endofblock;
// 1717 !***********************************************************************
// 1718 !* ADD A WORD OF BINARY TO THE BUFFER *
// 1719 !***********************************************************************
// 1720 %INTEGER I
int I;
// 1721 ! %IF USE IMP=YES %THEN %START
// 1722 %CYCLE I=24,-8,0
I = ((24)) - (((-(8))));
L_0174:
if (( I ) == ( 0 )) goto L_0175;
I = ((I)) + (((-(8))));
// 1723 CODE(PPCURR)=WORD>>I&255
CODE[PPCURR] = (((int)(((unsigned int)(WORD)) >> ((I))))) & ((255));
// 1724 PPCURR=PPCURR+1
PPCURR = ((PPCURR)) + ((1));
// 1725 %REPEAT
goto L_0174;
L_0175:
// 1726 ! %FINISH %ELSE %START
// 1727 ! *LDA_CODE+4
// 1728 ! *LDTB_16_58000004
// 1729 ! *LSS_WORD
// 1730 ! *LB_PPCURR
// 1731 ! *ST_(%DR+%B)
// 1732 ! *ADB_4
// 1733 ! *STB_PPCURR
// 1734 ! %FINISH
// 1735 CA=CA+4
CA = ((CA)) + ((4));
// 1736 CODE OUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_0177;
CODEOUT();
L_0177:
// 1737 %END
return;
_imp_endofblock: ;
} // End of block PCONST at level 4
// 1738 %ROUTINE PSF1(%INTEGER OPCODE,K,N)
void PSF1( int OPCODE, int K, int N )
{
__label__ _imp_endofblock;
// 1739 !***********************************************************************
// 1740 !* PLANT THE HALFWORD FORMS OF PRIMARY FORMAT NR INSTRNS *
// 1741 !* IF N IS TOO LARGE FOR THE SHORT FORM PF1 IS CALLED TO PLANT *
// 1742 !* THE CORRESPONDING LONG FORM *
// 1743 !***********************************************************************
// 1744 %INTEGER KPP
int KPP;
// 1745 ! ABORT %UNLESS 0<=K<=2 %AND OPCODE&1=0
// 1746 %IF (K=0 %AND -64<=N<=63) %OR (K#0 %AND 0<=N<=511) %START
if (( K ) != ( 0 )) goto L_0178;
if (( (-(64)) ) > ( N )) goto L_0178;
if (( N ) <= ( 63 )) goto L_0176;
L_0178:
if (( K ) == ( 0 )) goto L_0179;
if (( 0 ) > ( N )) goto L_0179;
if (( N ) > ( 511 )) goto L_0179;
L_0176:
// 1747 %IF K#0 %THEN N=N//4
if (( K ) == ( 0 )) goto L_017a;
N = ((int)(N)) / ((int)(4));
L_017a:
// 1748 ! %IF USE IMP=YES %THEN %START
// 1749 CODE(PPCURR)=OPCODE!K>>1
CODE[PPCURR] = ((OPCODE)) | (((int)(((unsigned int)(K)) >> ((1)))));
// 1750 CODE(PPCURR+1)=(K&1)<<7!N&127
CODE[((PPCURR)) + ((1))] = ((((((K)) & ((1)))) << ((7)))) | ((((N)) & ((127))));
// 1751 PPCURR=PPCURR+2
PPCURR = ((PPCURR)) + ((2));
// 1752 ! %FINISH %ELSE %START
// 1753 ! *LSS_OPCODE
// 1754 ! *USH_1
// 1755 ! *OR_K
// 1756 ! *USH_7
// 1757 ! *SLSS_N
// 1758 ! *AND_127
// 1759 ! *LB_PPCURR
// 1760 ! *OR_%TOS
// 1761 ! *LDA_CODE+4
// 1762 ! *LDTB_16_58000002
// 1763 ! *ST_(%DR+%B)
// 1764 ! *ADB_2
// 1765 ! *STB_PPCURR
// 1766 ! %FINISH
// 1767 CA=CA+2
CA = ((CA)) + ((2));
// 1768 CODEOUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_017b;
CODEOUT();
L_017b:
// 1769 %FINISH %ELSE %START
goto L_017c;
L_0179:
// 1770 %IF K=0 %THEN KPP=0 %ELSE KPP=2
if (( K ) != ( 0 )) goto L_017d;
KPP = 0;
goto L_017e;
L_017d:
KPP = 2;
L_017e:
// 1771 PF1(OPCODE,K>>1<<1,KPP,N)
PF1(OPCODE, (((int)(((unsigned int)(K)) >> ((1))))) << ((1)), KPP, N);
// 1772 %FINISH
L_017c:
// 1773 %END
return;
_imp_endofblock: ;
} // End of block PSF1 at level 4
// 1774 %ROUTINE PF1(%INTEGER OPCODE,KP,KPP,N)
void PF1( int OPCODE, int KP, int KPP, int N )
{
__label__ _imp_endofblock;
// 1775 !***********************************************************************
// 1776 !* PLANT THE NORMAL FORMS OF PRIMARY FORMAT INSTRNS(IE THOSE *
// 1777 !* WHICH DO NOT DEPEND ON THE SIZE OF N) *
// 1778 !***********************************************************************
// 1779 %INTEGER INC
int INC;
// 1780 ! ABORT %UNLESS 0<=KP<=3 %AND 0<=KPP<=7 %AND OPCODE&1=0
// 1781 INC=2
INC = 2;
// 1782 %IF KPP=PC %THEN %START
if (( KPP ) != ( 4 )) goto L_017f;
// 1783 %IF N<0 %THEN N=N&16_7FFFFFFF %AND NOTE CREF(CA,N)
if (( N ) >= ( 0 )) goto L_0180;
N = ((N)) & ((2147483647));
NOTECREF(CA, N);
L_0180:
// 1784 N=(N-CA)//2
N = ((int)(((N)) - ((CA)))) / ((int)(2));
// 1785 %FINISH
L_017f:
// 1786 %IF (1<<KPP)&B'101100'#0 %THEN N=N//4
if (( ((((1)) << ((KPP)))) & ((44)) ) == ( 0 )) goto L_0181;
N = ((int)(N)) / ((int)(4));
L_0181:
// 1787 ! %IF USE IMP=YES %THEN %START
// 1788 CODE(PPCURR)=OPCODE!1
CODE[PPCURR] = ((OPCODE)) | ((1));
// 1789 CODE(PPCURR+1)=16_80!KP<<5!KPP<<2!(N>>16&3)
CODE[((PPCURR)) + ((1))] = ((((((128)) | ((((KP)) << ((5)))))) | ((((KPP)) << ((2)))))) | (((((int)(((unsigned int)(N)) >> ((16))))) & ((3))));
// 1790 CODE(PPCURR+2)=N>>8&255
CODE[((PPCURR)) + ((2))] = (((int)(((unsigned int)(N)) >> ((8))))) & ((255));
// 1791 CODE(PPCURR+3)=N&255
CODE[((PPCURR)) + ((3))] = ((N)) & ((255));
// 1792 ! %FINISH %ELSE %START
// 1793 ! *LSS_OPCODE
// 1794 ! *USH_1
// 1795 ! *OR_3
// 1796 ! *USH_2
// 1797 ! *OR_KP
// 1798 ! *USH_3
// 1799 ! *OR_KPP
// 1800 ! *USH_18
// 1801 ! *SLSS_N
// 1802 ! *AND_16_3FFFF
// 1803 ! *OR_%TOS
// 1804 ! *LDTB_16_58000004
// 1805 ! *LDA_CODE+4
// 1806 ! *LB_PPCURR
// 1807 ! *ST_(%DR+%B)
// 1808 ! %FINISH
// 1809 %IF KPP<=5 %THEN INC=4
if (( KPP ) > ( 5 )) goto L_0182;
INC = 4;
L_0182:
// 1810 PPCURR=PPCURR+INC
PPCURR = ((PPCURR)) + ((INC));
// 1811 CA=CA+INC
CA = ((CA)) + ((INC));
// 1812 CODEOUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_0183;
CODEOUT();
L_0183:
// 1813 %END
return;
_imp_endofblock: ;
} // End of block PF1 at level 4
// 1814 %ROUTINE PSORLF1(%INTEGER OPCODE,KP,KPP,N)
void PSORLF1( int OPCODE, int KP, int KPP, int N )
{
__label__ _imp_endofblock;
// 1815 !***********************************************************************
// 1816 !* AS PF1 BUT CUT VALID FORMS TO SHORT FORM *
// 1817 !***********************************************************************
// 1818 %INTEGER INC
int INC;
// 1819 INC=2
INC = 2;
// 1820 %IF (KPP=0=KP %AND -64<=N<=63) %OR (KPP=LNB %AND KP&1=0 %AND 0<=N<=511) %START
if (( KPP ) != ( 0 )) goto L_0184;
if (( 0 ) != ( KP )) goto L_0184;
if (( (-(64)) ) > ( N )) goto L_0184;
if (( N ) <= ( 63 )) goto L_0185;
L_0184:
if (( KPP ) != ( 2 )) goto L_0186;
if (( ((KP)) & ((1)) ) != ( 0 )) goto L_0186;
if (( 0 ) > ( N )) goto L_0186;
if (( N ) > ( 511 )) goto L_0186;
L_0185:
// 1821 %IF KPP=LNB %THEN KP=1+KP>>1
if (( KPP ) != ( 2 )) goto L_0187;
KP = ((1)) + (((int)(((unsigned int)(KP)) >> ((1)))));
L_0187:
// 1822 %IF KP#0 %THEN N=N//4
if (( KP ) == ( 0 )) goto L_0188;
N = ((int)(N)) / ((int)(4));
L_0188:
// 1823 ! %IF USE IMP=YES %THEN %START
// 1824 CODE(PPCURR)=OPCODE!KP>>1
CODE[PPCURR] = ((OPCODE)) | (((int)(((unsigned int)(KP)) >> ((1)))));
// 1825 CODE(PPCURR+1)=(KP&1)<<7!(N&127)
CODE[((PPCURR)) + ((1))] = ((((((KP)) & ((1)))) << ((7)))) | ((((N)) & ((127))));
// 1826 ! %FINISH %ELSE %START
// 1827 ! *LSS_OPCODE
// 1828 ! *USH_1
// 1829 ! *OR_KP
// 1830 ! *USH_7
// 1831 ! *SLSS_N
// 1832 ! *AND_127
// 1833 ! *LB_PPCURR
// 1834 ! *OR_%TOS
// 1835 ! *LDA_CODE+4
// 1836 ! *LDTB_16_58000002
// 1837 ! *ST_(%DR+%B)
// 1838 ! %FINISH
// 1839 %FINISH %ELSE %START
goto L_0189;
L_0186:
// 1840 %IF KPP=PC %THEN %START
if (( KPP ) != ( 4 )) goto L_018a;
// 1841 %IF N<0 %THEN N=N&16_7FFFFFFF %AND NOTE CREF(CA,N)
if (( N ) >= ( 0 )) goto L_018b;
N = ((N)) & ((2147483647));
NOTECREF(CA, N);
L_018b:
// 1842 N=(N-CA)//2
N = ((int)(((N)) - ((CA)))) / ((int)(2));
// 1843 %FINISH
L_018a:
// 1844 %IF (1<<KPP)&B'101100'#0 %THEN N=N//4
if (( ((((1)) << ((KPP)))) & ((44)) ) == ( 0 )) goto L_018c;
N = ((int)(N)) / ((int)(4));
L_018c:
// 1845 ! %IF USE IMP=YES %THEN %START
// 1846 CODE(PPCURR)=OPCODE!1
CODE[PPCURR] = ((OPCODE)) | ((1));
// 1847 CODE(PPCURR+1)=((4!KP)<<3!KPP)<<2!(N>>16&3)
CODE[((PPCURR)) + ((1))] = ((((((((((4)) | ((KP)))) << ((3)))) | ((KPP)))) << ((2)))) | (((((int)(((unsigned int)(N)) >> ((16))))) & ((3))));
// 1848 CODE(PPCURR+2)=N>>8&255
CODE[((PPCURR)) + ((2))] = (((int)(((unsigned int)(N)) >> ((8))))) & ((255));
// 1849 CODE(PPCURR+3)=N&255
CODE[((PPCURR)) + ((3))] = ((N)) & ((255));
// 1850 ! %FINISH %ELSE %START
// 1851 ! *LSS_OPCODE
// 1852 ! *USH_1
// 1853 ! *OR_3
// 1854 ! *USH_2
// 1855 ! *OR_KP
// 1856 ! *USH_3
// 1857 ! *OR_KPP
// 1858 ! *USH_18
// 1859 ! *SLSS_N
// 1860 ! *AND_16_3FFFF
// 1861 ! *OR_%TOS
// 1862 ! *LDTB_16_58000004
// 1863 ! *LDA_CODE+4
// 1864 ! *LB_PPCURR
// 1865 ! *ST_(%DR+%B)
// 1866 ! %FINISH
// 1867 %IF KPP<=5 %THEN INC=4
if (( KPP ) > ( 5 )) goto L_018d;
INC = 4;
L_018d:
// 1868 %FINISH
L_0189:
// 1869 CA=CA+INC; PPCURR=PPCURR+INC
CA = ((CA)) + ((INC));
PPCURR = ((PPCURR)) + ((INC));
// 1870 CODEOUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_018e;
CODEOUT();
L_018e:
// 1871 %END
return;
_imp_endofblock: ;
} // End of block PSORLF1 at level 4
// 1872 %ROUTINE PF2(%INTEGER OPCODE,H,Q,N,MASK,FILLER)
void PF2( int OPCODE, int H, int Q, int N, int MASK, int FILLER )
{
__label__ _imp_endofblock;
// 1873 !***********************************************************************
// 1874 !* PLANT SECONDARY(STORE TO STORE) FORMAT INSTRNS *
// 1875 !* THESE MAY BE 16 OR 32 BIT DEPENDING ON Q *
// 1876 !***********************************************************************
// 1877 ! ABORT %UNLESS 0<=H<=1 %AND 0<=Q<=1 %AND 0<=N<=127 %AND OPCODE&1=0
// 1878 PLANT(OPCODE<<8!H<<8!Q<<7!N)
PLANT(((((((((OPCODE)) << ((8)))) | ((((H)) << ((8)))))) | ((((Q)) << ((7)))))) | ((N)));
// 1879 %IF Q#0 %THEN PLANT(MASK<<8!FILLER)
if (( Q ) == ( 0 )) goto L_018f;
PLANT(((((MASK)) << ((8)))) | ((FILLER)));
L_018f:
// 1880 %END
return;
_imp_endofblock: ;
} // End of block PF2 at level 4
// 1881 %ROUTINE PF3(%INTEGER OPCODE,MASK,KPPP,N)
void PF3( int OPCODE, int MASK, int KPPP, int N )
{
__label__ _imp_endofblock;
// 1882 !***********************************************************************
// 1883 !* PLANT THE TERTIARY(JUMP) FORMAT INSTRUCTIONS *
// 1884 !***********************************************************************
// 1885 ! ABORT %UNLESS 0<=MASK<=15 %AND 0<=KPPP<=7 %AND OPCODE&1=0
// 1886 %IF KPPP=PC %THEN %START
if (( KPPP ) != ( 4 )) goto L_0190;
// 1887 %IF N<0 %THEN N=N&16_7FFFFFFF %AND NOTE CREF(CA,N)
if (( N ) >= ( 0 )) goto L_0191;
N = ((N)) & ((2147483647));
NOTECREF(CA, N);
L_0191:
// 1888 N=(N-CA)//2
N = ((int)(((N)) - ((CA)))) / ((int)(2));
// 1889 %FINISH
L_0190:
// 1890 CODE(PPCURR)=OPCODE!MASK>>3&1
CODE[PPCURR] = ((OPCODE)) | (((((int)(((unsigned int)(MASK)) >> ((3))))) & ((1))));
// 1891 CODE(PPCURR+1)=(MASK&7)<<5!KPPP<<2!(N>>16&3)
CODE[((PPCURR)) + ((1))] = ((((((((MASK)) & ((7)))) << ((5)))) | ((((KPPP)) << ((2)))))) | (((((int)(((unsigned int)(N)) >> ((16))))) & ((3))));
// 1892 PPCURR=PPCURR+2
PPCURR = ((PPCURR)) + ((2));
// 1893 CA=CA+2
CA = ((CA)) + ((2));
// 1894 %IF KPPP<=5 %THEN %START
if (( KPPP ) > ( 5 )) goto L_0192;
// 1895 CODE(PPCURR)=N>>8&255
CODE[PPCURR] = (((int)(((unsigned int)(N)) >> ((8))))) & ((255));
// 1896 CODE(PPCURR+1)=N&255
CODE[((PPCURR)) + ((1))] = ((N)) & ((255));
// 1897 PPCURR=PPCURR+2; CA=CA+2
PPCURR = ((PPCURR)) + ((2));
CA = ((CA)) + ((2));
// 1898 %FINISH
L_0192:
// 1899 CODEOUT %IF PPCURR>=256
if (( PPCURR ) < ( 256 )) goto L_0193;
CODEOUT();
L_0193:
// 1900 %END
return;
_imp_endofblock: ;
} // End of block PF3 at level 4
// 1901 %ROUTINE NOTE CREF(%INTEGER CA,N)
void NOTECREF( int CA, int N )
{
__label__ _imp_endofblock;
// 1902 !***********************************************************************
// 1903 !* NOTE THAT A (PC+N) INSTRUCTION HAS N RELATIVE TO CONST TABLE *
// 1904 !* NOT REATIVE TO CODE. REMEMBER THE ADDRESS OF THE INSTRUCTION *
// 1905 !* SO THAT AN LPUT(18) CORRECTION CAN BE MADE AT END OF COMPILATION *
// 1906 !***********************************************************************
// 1907 %RECORD(LISTF)%NAME CELL {(LISTF)
LISTF *CELL;
// 1908 CELL==ASLIST(CREFHEAD)
CELL = (&(ASLIST[CREFHEAD]));
// 1909 %IF CREFHEAD=0 %OR CELL_S3#0 %THEN PUSH(CREFHEAD,CA,0,0) %AND %RETURN
if (( CREFHEAD ) == ( 0 )) goto L_0194;
if (( CELL->S3 ) == ( 0 )) goto L_0195;
L_0194:
PUSH( &CREFHEAD, CA, 0, 0);
return;
L_0195:
// 1910 %IF CELL_S2=0 %THEN CELL_S2=CA %ELSE CELL_S3=CA
if (( CELL->S2 ) != ( 0 )) goto L_0196;
CELL->S2 = CA;
goto L_0197;
L_0196:
CELL->S3 = CA;
L_0197:
// 1911 %END
return;
_imp_endofblock: ;
} // End of block NOTECREF at level 4
// 1912 %ROUTINE PCLOD(%INTEGER FROM, TO)
void PCLOD( int FROM, int TO )
{
__label__ _imp_endofblock;
// 1913 !***********************************************************************
// 1914 !* PLANT A SERIES OF INTRUNS FROM ARRAY FIXED CODE *
// 1915 !***********************************************************************
// 1916 %INTEGER I
int I;
// 1917 !%CONSTINTEGERARRAY FIXED CODE(0:127)
// 1918 ! %CYCLE I=FROM, 1, TO
// 1919 ! PCONST(FIXED CODE(I))
// 1920 ! %REPEAT
// 1921 %END
return;
_imp_endofblock: ;
} // End of block PCLOD at level 4
// 1922 %ROUTINE CNOP(%INTEGER I, J)
void CNOP( int I, int J )
{
__label__ _imp_endofblock;
// 1923 PSF1(JUNC,0,1) %WHILE CA&(J-1)#I
L_0198:
if (( ((CA)) & ((((J)) - ((1)))) ) == ( I )) goto L_0199;
PSF1(26, 0, 1);
goto L_0198;
L_0199:
// 1924 %END
return;
_imp_endofblock: ;
} // End of block CNOP at level 4
// 1925 %ROUTINE PGLA(%INTEGER BDRY, L, INF ADR)
void PGLA( int BDRY, int L, int INFADR )
{
__label__ _imp_endofblock;
// 1926 %INTEGER I, J
int I;
int J;
// 1927 J=GLACA; GLACA=(J+BDRY-1)&(-BDRY)
J = GLACA;
GLACA = ((((((J)) + ((BDRY)))) - ((1)))) & (((-(BDRY))));
// 1928 GLACURR=GLACURR+GLACA-J; ! COMPLETE THE ROUNDING
GLACURR = ((((GLACURR)) + ((GLACA)))) - ((J));
// 1929 %IF L+GLACURR>256 %THEN %START
if (( ((L)) + ((GLACURR)) ) <= ( 256 )) goto L_019b;
// 1930 %IF INHCODE=0 %THEN LPUT(2, GLACURR, GLACABUF, ADDR(GLABUF(0)))
if (( INHCODE ) != ( 0 )) goto L_019c;
LPUT(2, GLACURR, GLACABUF, ADDR( &GLABUF[0]));
L_019c:
// 1931 GLACURR=0; GLACABUF=GLACA
GLACURR = 0;
GLACABUF = GLACA;
// 1932 %FINISH
L_019b:
// 1933 %CYCLE I=0,1,L-1
I = ((0)) - ((1));
L_019d:
if (( I ) == ( ((L)) - ((1)) )) goto L_019e;
I = ((I)) + ((1));
// 1934 GLABUF(GLACURR+I)=BYTE INTEGER(I+INF ADR)
GLABUF[((GLACURR)) + ((I))] = *BYTEINTEGER(((I)) + ((INFADR)));
// 1935 %REPEAT
goto L_019d;
L_019e:
// 1936 GLACA=GLACA+L; GLACURR=GLACURR+L
GLACA = ((GLACA)) + ((L));
GLACURR = ((GLACURR)) + ((L));
// 1937 %END
return;
_imp_endofblock: ;
} // End of block PGLA at level 4
// 1938 %ROUTINE PLUG(%INTEGER AREA, AT, VALUE, BYTES)
void PLUG( int AREA, int AT, int VALUE, int BYTES )
{
__label__ _imp_endofblock;
// 1939 !***********************************************************************
// 1940 !* WRITE UP TO ONE WORD INTO OBJECT FILE OUT OF SEQUENCE *
// 1941 !***********************************************************************
// 1942 %INTEGERNAME WCABUF
int *WCABUF;
// 1943 %INTEGER I, RELAD, BUFAD
int I;
int RELAD;
int BUFAD;
// 1944 WCABUF==CABUF; BUFAD=ADDR(CODE(0))
WCABUF = (&(CABUF));
BUFAD = ADDR( &CODE[0]);
// 1945 %IF AREA=2 %THEN WCABUF==GLACABUF %AND BUFAD=ADDR(GLABUF(0))
if (( AREA ) != ( 2 )) goto L_01a0;
WCABUF = (&(GLACABUF));
BUFAD = ADDR( &GLABUF[0]);
L_01a0:
// 1946 RELAD=AT-WCABUF
RELAD = ((AT)) - ((WCABUF));
// 1947 %IF 0<=RELAD<=256 %AND AREA<=3 %THEN %START
if (( 0 ) > ( RELAD )) goto L_01a1;
if (( RELAD ) > ( 256 )) goto L_01a1;
if (( AREA ) > ( 3 )) goto L_01a1;
// 1948 %CYCLE I=0,1,BYTES-1
I = ((0)) - ((1));
L_01a2:
if (( I ) == ( ((BYTES)) - ((1)) )) goto L_01a3;
I = ((I)) + ((1));
// 1949 BYTEINTEGER(RELAD+BUFAD+I)<-VALUE>>((BYTES-1-I)<<3)
*BYTEINTEGER(((((RELAD)) + ((BUFAD)))) + ((I))) = (int)(((unsigned int)(VALUE)) >> ((((((((BYTES)) - ((1)))) - ((I)))) << ((3)))));
// 1950 %REPEAT
goto L_01a2;
L_01a3:
// 1951 %FINISH %ELSE %START
goto L_01a5;
L_01a1:
// 1952 %IF RELAD=-2 %THEN CODEOUT
if (( RELAD ) != ( (-(2)) )) goto L_01a6;
CODEOUT();
L_01a6:
// 1953 %IF INHCODE=0 %THEN LPUT(AREA,BYTES,AT,ADDR(VALUE)+4-BYTES)
if (( INHCODE ) != ( 0 )) goto L_01a7;
LPUT(AREA, BYTES, AT, ((((ADDR( &VALUE))) + ((4)))) - ((BYTES)));
L_01a7:
// 1954 !*DELSTART
// 1955 NCODE(ADDR(VALUE)+4-BYTES,ADDR(VALUE)+4,AT) %IF DCOMP=1=AREA
if (( DCOMP ) != ( 1 )) goto L_01a8;
if (( 1 ) != ( AREA )) goto L_01a8;
NCODE(((((ADDR( &VALUE))) + ((4)))) - ((BYTES)), ((ADDR( &VALUE))) + ((4)), AT);
L_01a8:
// 1956 !*DELEND
// 1957 %FINISH
L_01a5:
// 1958 %END
return;
_imp_endofblock: ;
} // End of block PLUG at level 4
// 1959
// 1960 %INTEGERFN PARAM DES(%INTEGER PREC)
int PARAMDES( int PREC )
{
__label__ _imp_endofblock;
// 1961 !***********************************************************************
// 1962 !* SET UP BNDED L=1 DESRIPTOR FOR PASSING VARIABLE BY REFERENCE *
// 1963 !* ONLY THE TOP HALF IS SET UP *
// 1964 !***********************************************************************
// 1965 %INTEGER K,DES
int K;
int DES;
// 1966 K=DESADS(PREC)
K = DESADS[PREC];
// 1967 %RESULT=K %UNLESS K=0
if (( K ) == ( 0 )) goto L_01a9;
return K;
L_01a9:
// 1968 %IF PREC=4 %THEN DES=16_58000002 %ELSE DES=PREC<<27!1
if (( PREC ) != ( 4 )) goto L_01aa;
DES = 1476395010;
goto L_01ab;
L_01aa:
DES = ((((PREC)) << ((27)))) | ((1));
L_01ab:
// 1969 STORE CONST (K,4,ADDR(DES))
STORECONST( &K, 4, ADDR( &DES));
// 1970 DESADS(PREC)=K
DESADS[PREC] = K;
// 1971 %RESULT=K
return K;
// 1972 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block PARAMDES at level 4
// 1973 %INTEGERFN MAPDES(%INTEGER PREC)
int MAPDES( int PREC )
{
__label__ _imp_endofblock;
// 1974 !***********************************************************************
// 1975 !* SET UP 8BIT ZERO ADDRESS UNSCALED BCI DESCRTR FOR MAPPING *
// 1976 !***********************************************************************
// 1977 %INTEGER K,DES0,DES1
int K;
int DES0;
int DES1;
// 1978 K=DESADS(PREC+8)
K = DESADS[((PREC)) + ((8))];
// 1979 %RESULT=K %UNLESS K=0
if (( K ) == ( 0 )) goto L_01ac;
return K;
L_01ac:
// 1980 %IF PREC=4 %THEN DES0=16_58000002 %ELSE DES0=16_03000000!PREC<<27
if (( PREC ) != ( 4 )) goto L_01ad;
DES0 = 1476395010;
goto L_01ae;
L_01ad:
DES0 = ((50331648)) | ((((PREC)) << ((27))));
L_01ae:
// 1981 DES1=0; STORE CONST(K,8,ADDR(DES0))
DES1 = 0;
STORECONST( &K, 8, ADDR( &DES0));
// 1982 DESADS(PREC+8)=K
DESADS[((PREC)) + ((8))] = K;
// 1983 %RESULT=K
return K;
// 1984 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block MAPDES at level 4
// 1985 %INTEGERFN SPECIAL CONSTS(%INTEGER WHICH)
int SPECIALCONSTS( int WHICH )
{
__label__ _imp_endofblock;
// 1986 !***********************************************************************
// 1987 !* PUTS CERTAIN SPECIAL CONSTANTS INTO THE CONSTANT TABLE ON *
// 1988 !* DEMAND AND REMEMBERS THEIR POSN TO AVOID SEARCHONG *
// 1989 !***********************************************************************
// 1990 {%CONST}%ownINTEGERARRAY SCS(0:5) = 16_40800000,0,
static int SCS[(5)-(0)+1] = { 1082130432, 0, 1091567616, 0, 1, 0, };
// 1991 16_41100000,0,
// 1992 1,0;
// 1993 %INTEGER K
int K;
// 1994 K=DESADS(WHICH+16)
K = DESADS[((WHICH)) + ((16))];
// 1995 %RESULT=K %UNLESS K=0
if (( K ) == ( 0 )) goto L_01af;
return K;
L_01af:
// 1996 STORE CONST(K,8,ADDR(SCS(2*WHICH)))
STORECONST( &K, 8, ADDR( &SCS[((2)) * ((WHICH))]));
// 1997 DESADS(WHICH+16)=K
DESADS[((WHICH)) + ((16))] = K;
// 1998 %RESULT=K
return K;
// 1999 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block SPECIALCONSTS at level 4
// 2000 %ROUTINE STORE CONST(%INTEGERNAME D, %INTEGER L, AD)
void STORECONST( int *D, int L, int AD )
{
__label__ _imp_endofblock;
// 2001 !***********************************************************************
// 2002 !* PUT THE CONSTANT VAL OF LENGTH 'L' INTO THE CONSTANT TABLE *
// 2003 !* A CHECK IS MADE TO SEE IF THE CONSTANT HAS ALREADY *
// 2004 !* BEEN INSERTED IN WHICH CASE THE OLD COPY IS REUSED *
// 2005 !***********************************************************************
// 2006 %INTEGER I, J, K, C1, C2, C3, C4, LP
int I;
int J;
int K;
int C1;
int C2;
int C3;
int C4;
int LP;
// 2007 LP=L//4; C2=0; C3=0; C4=0
LP = ((int)(L)) / ((int)(4));
C2 = 0;
C3 = 0;
C4 = 0;
// 2008 %CYCLE I=0,1,L-1
I = ((0)) - ((1));
L_01b0:
if (( I ) == ( ((L)) - ((1)) )) goto L_01b1;
I = ((I)) + ((1));
// 2009 BYTEINTEGER(ADDR(C1)+I)=BYTEINTEGER(AD+I)
*BYTEINTEGER(((ADDR( &C1))) + ((I))) = *BYTEINTEGER(((AD)) + ((I)));
// 2010 %REPEAT
goto L_01b0;
L_01b1:
// 2011 %IF PARMOPT#0 %THEN ->SKIP
if (( PARMOPT ) == ( 0 )) goto L_01b3;
goto U_015c;
L_01b3:
// 2012 K=CONST BTM; ! AFTER STRINGS IN CTABLE
K = CONSTBTM;
// 2013 %IF L=4 %THEN %START
if (( L ) != ( 4 )) goto L_01b4;
// 2014 ! %IF USE IMP=YES %THEN %START
// 2015 %WHILE K<CONST PTR %CYCLE
L_01b5:
if (( K ) >= ( CONSTPTR )) goto L_01b6;
// 2016 %IF CTABLE_val(K)=C1 %AND CONSTHOLE#K %THEN D=4*K!16_80000000 %AND %RETURN
if (( /* No array bound info found for: */CTABLE->VAL[K] ) != ( C1 )) goto L_01b8;
if (( CONSTHOLE ) == ( K )) goto L_01b8;
D = ((((4)) * ((K)))) | ((-2147483648));
return;
L_01b8:
// 2017 K=K+1
K = ((K)) + ((1));
// 2018 %REPEAT
goto L_01b5;
L_01b6:
// 2019 ! %FINISH %ELSE %START
// 2020 ! *LD_CTABLE
// 2021 ! *LB_K
// 2022 ! *SBB_1
// 2023 ! *LSS_C1
// 2024 !AGN1:
// 2025 ! *ADB_1
// 2026 ! *CPB_CONSTPTR
// 2027 ! *JCC_10,<SKIP>
// 2028 ! *ICP_(%DR+%B)
// 2029 ! *JCC_7,<AGN1>
// 2030 ! *CPB_CONSTHOLE
// 2031 ! *JCC_8,<AGN1>
// 2032 ! *LSS_%B
// 2033 ! *IMY_4
// 2034 ! *OR_16_80000000
// 2035 ! *ST_(D)
// 2036 ! *EXIT_-64
// 2037 ! %FINISH
// 2038 %FINISH %ELSE %START
goto L_01b9;
L_01b4:
// 2039 J=CONSTPTR-LP
J = ((CONSTPTR)) - ((LP));
// 2040 %WHILE K<=J %CYCLE
L_01ba:
if (( K ) > ( J )) goto L_01bb;
// 2041 %IF CTABLE_val(K)=C1 %AND CTABLE_val(K+1)=C2 %AND (CONSTHOLE<K %OR CONSTHOLE>=K+LP) %START
if (( /* No array bound info found for: */CTABLE->VAL[K] ) != ( C1 )) goto L_01bd;
if (( /* No array bound info found for: */CTABLE->VAL[((K)) + ((1))] ) != ( C2 )) goto L_01bd;
if (( CONSTHOLE ) < ( K )) goto L_013f;
if (( CONSTHOLE ) < ( ((K)) + ((LP)) )) goto L_01bd;
L_013f:
// 2042 %IF L=8 %OR (CTABLE_val(K+2)=C3 %AND CTABLE_val(K+3)=C4) %THEN D=4*K!16_80000000 %AND %RETURN
if (( L ) == ( 8 )) goto L_01be;
if (( /* No array bound info found for: */CTABLE->VAL[((K)) + ((2))] ) != ( C3 )) goto L_01bf;
if (( /* No array bound info found for: */CTABLE->VAL[((K)) + ((3))] ) != ( C4 )) goto L_01bf;
L_01be:
D = ((((4)) * ((K)))) | ((-2147483648));
return;
L_01bf:
// 2043 %FINISH
L_01bd:
// 2044 K=K+2
K = ((K)) + ((2));
// 2045 %REPEAT
goto L_01ba;
L_01bb:
// 2046 %FINISH
L_01b9:
// 2047 SKIP:
U_015c:
// 2048 %IF L=4 %AND CONSTHOLE#0 %START
if (( L ) != ( 4 )) goto L_01c0;
if (( CONSTHOLE ) == ( 0 )) goto L_01c0;
// 2049 CTABLE_val(CONSTHOLE)=C1
/* No array bound info found for: */CTABLE->VAL[CONSTHOLE] = C1;
// 2050 D=4*CONSTHOLE!16_80000000
D = ((((4)) * ((CONSTHOLE)))) | ((-2147483648));
// 2051 CONSTHOLE=0
CONSTHOLE = 0;
// 2052 %RETURN
return;
// 2053 %FINISH
L_01c0:
// 2054 %IF L>4 %AND CONST PTR&1#0 %THEN CONSTHOLE=CONST PTR %AND CONSTPTR=CONST PTR+1
if (( L ) <= ( 4 )) goto L_01c1;
if (( ((CONSTPTR)) & ((1)) ) == ( 0 )) goto L_01c1;
CONSTHOLE = CONSTPTR;
CONSTPTR = ((CONSTPTR)) + ((1));
L_01c1:
// 2055 D=4*CONST PTR!16_80000000
D = ((((4)) * ((CONSTPTR)))) | ((-2147483648));
// 2056 CTABLE_val(CONSTPTR)=C1
/* No array bound info found for: */CTABLE->VAL[CONSTPTR] = C1;
// 2057 CTABLE_val(CONSTPTR+1)=C2
/* No array bound info found for: */CTABLE->VAL[((CONSTPTR)) + ((1))] = C2;
// 2058 %IF L=16 %THEN CTABLE_val(CONSTPTR+2)=C3 %AND CTABLE_val(CONSTPTR+3)=C4
if (( L ) != ( 16 )) goto L_01c2;
/* No array bound info found for: */CTABLE->VAL[((CONSTPTR)) + ((2))] = C3;
/* No array bound info found for: */CTABLE->VAL[((CONSTPTR)) + ((3))] = C4;
L_01c2:
// 2059 CONST PTR=CONST PTR+LP
CONSTPTR = ((CONSTPTR)) + ((LP));
// 2060 %IF CONST PTR>CONST LIMIT %THEN FAULT(107,0)
if (( CONSTPTR ) <= ( CONSTLIMIT )) goto L_01c3;
FAULT(107, 0);
L_01c3:
// 2061 %END
return;
_imp_endofblock: ;
} // End of block STORECONST at level 4
// 2062 %ROUTINE GET ENV(%INTEGERNAME HEAD)
void GETENV( int *HEAD )
{
__label__ _imp_endofblock;
// 2063 !***********************************************************************
// 2064 !* SAVE A COPY OF THE REGISTER STATE FOR FUTURE REFERENCE *
// 2065 !***********************************************************************
// 2066 %INTEGER I, USE
int I;
int USE;
// 2067 %CYCLE I=0, 1, 7
I = ((0)) - ((1));
L_01c4:
if (( I ) == ( 7 )) goto L_01c5;
I = ((I)) + ((1));
// 2068 USE=GRUSE(I)&16_FF; ! MAIN USE ONLY
USE = ((GRUSE[I])) & ((255));
// 2069 PUSH(HEAD, GRINF1(I), GRAT(I), I<<8!USE) %IF USE#0
if (( USE ) == ( 0 )) goto L_01c7;
PUSH(HEAD, GRINF1[I], GRAT[I], ((((I)) << ((8)))) | ((USE)));
L_01c7:
// 2070 %REPEAT
goto L_01c4;
L_01c5:
// 2071 %END
return;
_imp_endofblock: ;
} // End of block GETENV at level 4
// 2072 %ROUTINE RESTORE(%INTEGER HEAD)
void RESTORE( int HEAD )
{
__label__ _imp_endofblock;
// 2073 !***********************************************************************
// 2074 !* RESET THE REGISTERS TO ENVIRONMENT IN LIST HEADED BY 'HEAD' *
// 2075 !***********************************************************************
// 2076 %INTEGER I, R, USE, INF, AT
int I;
int R;
int USE;
int INF;
int AT;
// 2077 %CYCLE I=0, 1, 7
I = ((0)) - ((1));
L_01c8:
if (( I ) == ( 7 )) goto L_01c9;
I = ((I)) + ((1));
// 2078 %IF REGISTER(I)>=0 %THEN GRUSE(I)=0 %AND GRINF1(I)=0
if (( REGISTER[I] ) < ( 0 )) goto L_01cb;
GRUSE[I] = 0;
GRINF1[I] = 0;
L_01cb:
// 2079 %REPEAT
goto L_01c8;
L_01c9:
// 2080 %WHILE HEAD#0 %CYCLE
L_01cc:
if (( HEAD ) == ( 0 )) goto L_01cd;
// 2081 POP(HEAD, INF, AT, I)
POP( &HEAD, &INF, &AT, &I);
// 2082 R=I>>8; USE=I&255
R = (int)(((unsigned int)(I)) >> ((8)));
USE = ((I)) & ((255));
// 2083 %IF REGISTER(R)>=0 %THEN GRUSE(R)=USE %AND GRINF1(R)=INF
if (( REGISTER[R] ) < ( 0 )) goto L_01cf;
GRUSE[R] = USE;
GRINF1[R] = INF;
L_01cf:
// 2084 GRAT(R)=AT
GRAT[R] = AT;
// 2085 %REPEAT
goto L_01cc;
L_01cd:
// 2086 %END
return;
_imp_endofblock: ;
} // End of block RESTORE at level 4
// 2087 %ROUTINE RELOCATE(%INTEGER GLARAD,VALUE,AREA)
void RELOCATE( int GLARAD, int VALUE, int AREA )
{
__label__ _imp_endofblock;
// 2088 !***********************************************************************
// 2089 !* PLANTS A WORD IN THE GLA (IF GLARAD<0) AND ARRANGES TO *
// 2090 !* RELOCATE IT RELATIVE TO AN AREA(CODE=1,GLA=2,CST=4,GST=5 *
// 2091 !* IF THE RELOCATION IS RELATIVE TO SYMBOL TABLES THE WORD *
// 2092 !* CAN NOT BE RELOCATED TILL SIZE OF THE CODE(OR GLA) IS KNOWN *
// 2093 !***********************************************************************
// 2094 %IF GLARAD<0 %THEN PGLA(4,4,ADDR(VALUE)) %AND GLARAD=GLACA-4
if (( GLARAD ) >= ( 0 )) goto L_01d0;
PGLA(4, 4, ADDR( &VALUE));
GLARAD = ((GLACA)) - ((4));
L_01d0:
// 2095 LPUT(19,2,GLARAD,AREA)
LPUT(19, 2, GLARAD, AREA);
// 2096 %END
return;
_imp_endofblock: ;
} // End of block RELOCATE at level 4
// 2097 %ROUTINE GXREF(%STRING(31) NAME,%INTEGER MODE,XTRA,AT)
void GXREF( _imp_string /*%string(31)*/ NAME, int MODE, int XTRA, int AT )
{
__label__ _imp_endofblock;
// 2098 !***********************************************************************
// 2099 !* ASK LPUT TO ARRANGE FOR A DOUBLE WORD AT 'AT' IN THE GLA *
// 2100 !* TO CONTAIN A DESCRIPTOR FOR NAME 'NAME'. *
// 2101 !* MODE=0 STATIC CODE XREF *
// 2102 !* MODE=1 DYNAMIC CODE XREF *
// 2103 !* MODE=2 DATA XREF XTRA=MINIMIUM LENGTH *
// 2104 !***********************************************************************
// 2105 %INTEGER LPUTNO
int LPUTNO;
// 2106 %IF MODE=2 %THEN LPUTNO=15 %ELSE LPUTNO=MODE+12
if (( MODE ) != ( 2 )) goto L_01d1;
LPUTNO = 15;
goto L_01d2;
L_01d1:
LPUTNO = ((MODE)) + ((12));
L_01d2:
// 2107 LPUT(LPUTNO,XTRA,AT,ADDR(NAME))
LPUT(LPUTNO, XTRA, AT, ADDR( &NAME));
// 2108 %END
return;
_imp_endofblock: ;
} // End of block GXREF at level 4
// 2109 %ROUTINE CXREF(%STRING(255) NAME,%INTEGER MODE,XTRA,%INTEGERNAME AT)
void CXREF( _imp_string /*%string(255)*/ NAME, int MODE, int XTRA, int *AT )
{
__label__ _imp_endofblock;
// 2110 !***********************************************************************
// 2111 !* CREATE A ZEROED AREA IN THE GLA AND CALL GXREF TO GET *
// 2112 !* IT FILLED AT LOAD TIME WITH INFORMATION ON AN EXTERNAL OBJECT *
// 2113 !* PARAMETERS ARE AS FOR GXREF. *
// 2114 !***********************************************************************
// 2115 %INTEGER Z1,Z2
int Z1;
int Z2;
// 2116 Z1=0; Z2=0
Z1 = 0;
Z2 = 0;
// 2117 PGLA(8,8,ADDR(Z1)); ! 2 ZERO WORDS
PGLA(8, 8, ADDR( &Z1));
// 2118 AT=GLACA-8
AT = ((GLACA)) - ((8));
// 2119 GXREF(NAME,MODE,XTRA,AT)
GXREF(NAME, MODE, XTRA, *AT);
// 2120 %END
return;
_imp_endofblock: ;
} // End of block CXREF at level 4
// 2121 %ROUTINE CODEDES(%INTEGERNAME AT)
void CODEDES( int *AT )
{
__label__ _imp_endofblock;
// 2122 !***********************************************************************
// 2123 !* PUT A CODE DESCRIPTOR INTO THE PLT FOR USE BY DEFINE EP *
// 2124 !***********************************************************************
// 2125 %INTEGER DESC1,DESC2
int DESC1;
int DESC2;
// 2126 DESC1=16_E1000000; DESC2=0
DESC1 = -520093696;
DESC2 = 0;
// 2127 %IF CDCOUNT=0 %THEN FIXED GLA(0)=DESC1 %AND AT=0 %ELSE PGLA(8,8,ADDR(DESC1)) %AND AT=GLACA-8
if (( CDCOUNT ) != ( 0 )) goto L_01d3;
FIXEDGLA[0] = DESC1;
AT = 0;
goto L_01d4;
L_01d3:
PGLA(8, 8, ADDR( &DESC1));
AT = ((GLACA)) - ((8));
L_01d4:
// 2128 CDCOUNT=CDCOUNT+1
CDCOUNT = ((CDCOUNT)) + ((1));
// 2129 %END
return;
_imp_endofblock: ;
} // End of block CODEDES at level 4
// 2130 %ROUTINE DEFINE EP(%STRING(255)NAME, %INTEGER ADR,AT,MAIN)
void DEFINEEP( _imp_string /*%string(255)*/ NAME, int ADR, int AT, int MAIN )
{
__label__ _imp_endofblock;
// 2131 !***********************************************************************
// 2132 !* AN EP CONSISTS OF A CODE DESCRIPTOR IN THE GLA(PLT) OF *
// 2133 !* FILE CONTAINING THE EP. LPUT IS TOLD ABOUT THIS AND THE LOADER*
// 2134 !* ARRANGES TO PUT A DESCRIPTOR-DESCRIPTOR TO THE CODE-DESC *
// 2135 !* IN THE GLA OF ANY FILE REFERENCES THIS EP. THIS FIRST WORD *
// 2136 !* OF ICLS PLT IS THE MAIN EP AND WE MIMIC THIS AS FAR AS POSS *
// 2137 !***********************************************************************
// 2138 %IF AT=0 %THEN FIXED GLA(1)=ADR %ELSE PLUG(2,AT+4,ADR,4)
if (( AT ) != ( 0 )) goto L_01d5;
FIXEDGLA[1] = ADR;
goto L_01d6;
L_01d5:
PLUG(2, ((AT)) + ((4)), ADR, 4);
L_01d6:
// 2139 RELOCATE(AT+4,ADR,1)
RELOCATE(((AT)) + ((4)), ADR, 1);
// 2140 LPUT(11,MAIN<<31!2,AT,ADDR(NAME)) %IF NAME#""
if (_imp_strcmp(NAME, _imp_str_literal("")) == 0) goto L_01d7;
LPUT(11, ((((MAIN)) << ((31)))) | ((2)), AT, ADDR( &NAME));
L_01d7:
// 2141 %END
return;
_imp_endofblock: ;
} // End of block DEFINEEP at level 4
// 2142 %ROUTINE PROLOGUE
void PROLOGUE( void )
{
__label__ _imp_endofblock;
// 2143 !***********************************************************************
// 2144 !* GENERATES THE SUBROUTINE THAT ALWAYS ARE REQUIRED ONTO THE *
// 2145 !* FRONT OF THE OBJECT PROGRAM WHERE THEY ARE DIRECTLY ADDRESABLE*
// 2146 !***********************************************************************
// 2147 %INTEGERFNSPEC STRINGIN(%INTEGER POS)
auto int STRINGIN( int POS );
// 2148 %ROUTINESPEC ERR EXIT(%INTEGER A, B, C)
auto void ERREXIT( int A, int B, int C );
// 2149 %INTEGER I, K, L, STCA
int I;
int K;
int L;
int STCA;
// 2150 I=16_C2C2C2C2
I = -1027423550;
// 2151 LPUT(4,4,0,ADDR(I))
LPUT(4, 4, 0, ADDR( &I));
// 2152 SSTL=4
SSTL = 4;
// 2153 %CYCLE I=0, 1, 31
I = ((0)) - ((1));
L_01d8:
if (( I ) == ( 31 )) goto L_01d9;
I = ((I)) + ((1));
// 2154 PLABS(I)=0; PLINK(I)=0
PLABS[I] = 0;
PLINK[I] = 0;
// 2155 DESADS(I)=0
DESADS[I] = 0;
// 2156 %REPEAT
goto L_01d8;
L_01d9:
// 2157 !
// 2158 ! GENERATE THE FIXED-FLOAT CONSTANTS THAT MAY BE NEEDED
// 2159 !
// 2160 PLABS(1)=CA
PLABS[1] = CA;
// 2161 %CYCLE I=0, 1, 1
I = ((0)) - ((1));
L_01db:
if (( I ) == ( 1 )) goto L_01dc;
I = ((I)) + ((1));
// 2162 PCONST(UNASSPAT)
PCONST(-2122219135);
// 2163 %REPEAT
goto L_01db;
L_01dc:
// 2164 !
// 2165 ! GENERATE THE RUN TIME ERROR ROUTINE :-
// 2166 ! MDIAGS FOR NR IS %ROUTINE MDIAGS(%INT PC,LNB,ERROR,XTRA)
// 2167 ! PC IS A DUMMY (SEG FIELD ONLY USED) EXCEPT AFTER CONTINGENCY
// 2168 ! ON ENTRY TO THIS SUBROUTINE ERROR & XTRA ARE IN ACC AS 64 BIT INTEGER
// 2169 ! ENTRY HAS BEEN BY JLK SO RETURN ADDRESS STACKED
// 2170 !
// 2171 !RTF PRCL 4 TO PLANT PARAMS
// 2172 ! JLK +1 STACK DUMMY PC
// 2173 ! STLN TOS LNB AS SECOND PARAMETER
// 2174 ! ST TOS ERROR NO AS THIRD PARAM
// 2175 ! LXN (LNB+4) POINTER TO GLA
// 2176 ! RALN 9 TO STORED LNB
// 2177 ! CALL ((XNB+10)) VIA XREF=DESCRIPTOR-DESCRIPTOR
// 2178 ! J TOS BACK AFTER A MONITOR
// 2179 !
// 2180 PLABS(2)=CA
PLABS[2] = CA;
// 2181 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 2182 PSF1(JLK,0,1)
PSF1(28, 0, 1);
// 2183 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 2184 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 2185 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 2186 PSF1(RALN,0,9)
PSF1(108, 0, 9);
// 2187 PF1(CALL,2,XNB,40)
PF1(30, 2, 3, 40);
// 2188 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 2189 !
// 2190 ! SUBROUTINE TO CALL DEBUG ROUTINE(S#IMPMON) LINE NO IN ACC
// 2191 !
// 2192 ! PRCL 4
// 2193 ! ST TOS
// 2194 ! LXN (LNB+4)
// 2195 ! RALN 6
// 2196 ! CALL ((XNB+IMPMONEPDISP))
// 2197 ! JUNC TOS
// 2198 !
// 2199 %IF PARMDBUG#0 %THEN %START
if (( PARMDBUG ) == ( 0 )) goto L_01de;
// 2200 PLABS(3)=CA
PLABS[3] = CA;
// 2201 CXREF("S#IMPMON",PARMDYNAMIC,2,K)
CXREF(_imp_str_literal("S#IMPMON"), PARMDYNAMIC, 2, &K);
// 2202 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 2203 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 2204 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 2205 PSF1(RALN,0,6)
PSF1(108, 0, 6);
// 2206 PF1(CALL,2,XNB,K)
PF1(30, 2, 3, K);
// 2207 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 2208 %FINISH
L_01de:
// 2209 !
// 2210 ! SUBROUTINE TO ADVANCE STACK FRONT BY B WORDS AND FILL WITH UNASSIGNED
// 2211 !
// 2212 ! JAT 12,*+13 B IS ZERO
// 2213 ! LSS TOS
// 2214 ! STSF TOS
// 2215 ! LDTB STRING DECRIPTOR SET UP DESCRIPTOR FOR MVL
// 2216 ! LDA TOS
// 2217 ! ASF B ADVANCE BY B WORDS
// 2218 ! MYB 4 CHANGE B TO BYTES
// 2219 ! LDB B AND MOVE TO BOUND FIELD
// 2220 ! MVL L=DR AND FILL WITH X80S
// 2221 ! ST TOS
// 2222 ! J TOS RETURN
// 2223 !
// 2224 %IF PARMCHK=1 %THEN %START; ! ONLY REQUIRED WITH CHKING
if (( PARMCHK ) != ( 1 )) goto L_01df;
// 2225 CNOP(0,4); K=CA
CNOP(0, 4);
K = CA;
// 2226 PCONST(16_58000000)
PCONST(1476395008);
// 2227 PLABS(4)=CA
PLABS[4] = CA;
// 2228 PF3(JAT,12,0,13)
PF3(4, 12, 0, 13);
// 2229 PF1(LSS,0,TOS,0)
PF1(98, 0, 6, 0);
// 2230 PF1(STSF,0,TOS,0)
PF1(94, 0, 6, 0);
// 2231 PF1(LDTB,0,PC,K)
PF1(116, 0, 4, K);
// 2232 PF1(LDA,0,TOS,0)
PF1(114, 0, 6, 0);
// 2233 PF1(ASF,0,BREG,0)
PF1(110, 0, 7, 0);
// 2234 PSF1(MYB,0,4)
PSF1(42, 0, 4);
// 2235 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 2236 PF2(MVL,1,1,0,0,UNASSPAT&255)
PF2(176, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 2237 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 2238 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 2239 %FINISH
L_01df:
// 2240 !
// 2241 ! SOME ERROR ROUTINES
// 2242 !
// 2243 ERR EXIT(5, 16_801, 0) %IF PARMOPT#0; ! UNASSIGNED VARIABLE
if (( PARMOPT ) == ( 0 )) goto L_01e0;
ERREXIT(5, 2049, 0);
L_01e0:
// 2244 ERR EXIT(6, 16_504, 0); ! SWITCH LABEL UNSET
ERREXIT(6, 1284, 0);
// 2245 ERR EXIT(7, 16_505, 1); ! ILLEGEAL EXPONENTIATION
ERREXIT(7, 1285, 1);
// 2246 ERR EXIT(8,16_201, 0) %IF PARMOPT#0; ! EXCESS BLOCKS
if (( PARMOPT ) == ( 0 )) goto L_01e1;
ERREXIT(8, 513, 0);
L_01e1:
// 2247 ERR EXIT(9, 16_601, 0); ! CAPACITY EXCEEDED
ERREXIT(9, 1537, 0);
// 2248 ERR EXIT(10,21, 0) ; ! NO RESULT
ERREXIT(10, 21, 0);
// 2249 ERR EXIT(11,16_501, 0) %IF PARMOPT#0; ! CYCLE NOT VALID
if (( PARMOPT ) == ( 0 )) goto L_01e2;
ERREXIT(11, 1281, 0);
L_01e2:
// 2250 ERR EXIT(12,16_701,0); ! RES FAILS
ERREXIT(12, 1793, 0);
// 2251 ERR EXIT(13,36,0) %IF PARMOPT#0; ! WRONG NO OF PARAMS
if (( PARMOPT ) == ( 0 )) goto L_01e3;
ERREXIT(13, 36, 0);
L_01e3:
// 2252 !
// 2253 ! PUT THE STRINGS ONTO THE FRONT OF CONSTANT AREA
// 2254 !
// 2255 CTABLE_val(0)=16_18000001
/* No array bound info found for: */CTABLE->VAL[0] = 402653185;
// 2256 CTABLE_val(1)=4
/* No array bound info found for: */CTABLE->VAL[1] = 4;
// 2257 STCA=8; L=ADDR(CTABLE_val(0))
STCA = 8;
L = ADDR( &/* No array bound info found for: */CTABLE->VAL[0]);
// 2258 CONST PTR=2; ! IN CASE NO STRINGS
CONSTPTR = 2;
// 2259 %WHILE STRLINK#0 %CYCLE
L_01e4:
if (( STRLINK ) == ( 0 )) goto L_01e5;
// 2260 I=STRLINK; STRLINK=FROM AR4(I)
I = STRLINK;
STRLINK = FROMAR4(I);
// 2261 TO AR4(I,STRINGIN(I+4)); ! CHANGE LINK TO STRING ADDR
TOAR4(I, STRINGIN(((I)) + ((4))));
// 2262 %REPEAT
goto L_01e4;
L_01e5:
// 2263 STRLINK=16_80000000
STRLINK = -2147483648;
// 2264 CONST BTM=CONST PTR
CONSTBTM = CONSTPTR;
// 2265 %IF PARMOPT#0 %THEN CTABLE_val(CONST PTR)=M'IDIA' %AND CONST PTR=CONST PTR+1
if (( PARMOPT ) == ( 0 )) goto L_01e7;
/* No array bound info found for: */CTABLE->VAL[CONSTPTR] = 1229211969;
CONSTPTR = ((CONSTPTR)) + ((1));
L_01e7:
// 2266 GXREF(MDEP,PARMDYNAMIC,2,40)
GXREF(MDEP, PARMDYNAMIC, 2, 40);
// 2267 %IF PARMPROF#0 %THEN %START; ! ALLOCATE PROFILE COUNT AREA
if (( PARMPROF ) == ( 0 )) goto L_01e8;
// 2268 I=16_38000001+LINE
I = ((939524097)) + ((LINE));
// 2269 K=8
K = 8;
// 2270 PARMPROF=GLACA
PARMPROF = GLACA;
// 2271 PGLA(4,8,ADDR(I))
PGLA(4, 8, ADDR( &I));
// 2272 K=0
K = 0;
// 2273 %CYCLE I=0,1,LINE
I = ((0)) - ((1));
L_01e9:
if (( I ) == ( LINE )) goto L_01ea;
I = ((I)) + ((1));
// 2274 PGLA(4,4,ADDR(K))
PGLA(4, 4, ADDR( &K));
// 2275 %REPEAT
goto L_01e9;
L_01ea:
// 2276 LINE=0
LINE = 0;
// 2277 %FINISH
L_01e8:
// 2278 LEVEL=1
LEVEL = 1;
// 2279 %CYCLE I=0,1,31
I = ((0)) - ((1));
L_01ec:
if (( I ) == ( 31 )) goto L_01ed;
I = ((I)) + ((1));
// 2280 %IF PLINK(I)#0 %THEN CLEAR LIST(PLINK(I))
if (( PLINK[I] ) == ( 0 )) goto L_01ef;
CLEARLIST( &PLINK[I]);
L_01ef:
// 2281 %REPEAT
goto L_01ec;
L_01ed:
// 2282 %RETURN
return;
// 2283 %INTEGERFN STRINGIN(%INTEGER POS)
int STRINGIN( int POS )
{
__label__ _imp_endofblock;
// 2284 !***********************************************************************
// 2285 !* PUT A STRING INTO THE CONSTANT AREA CHECKING FOR DUPLICATES *
// 2286 !***********************************************************************
// 2287 %INTEGER J,K,IND,HD
int J;
int K;
int IND;
int HD;
// 2288 %RECORD(LISTF)%NAME CELL{(LISTF)
LISTF *CELL;
// 2289 K=A(POS)
K = A[POS];
// 2290 %IF K=0 %THEN %RESULT=0
if (( K ) != ( 0 )) goto L_01f0;
return 0;
L_01f0:
// 2291 IND=K&31; HD=PLINK(IND)
IND = ((K)) & ((31));
HD = PLINK[IND];
// 2292 %WHILE HD#0 %CYCLE
L_01f1:
if (( HD ) == ( 0 )) goto L_01f2;
// 2293 CELL==ASLIST(HD)
CELL = (&(ASLIST[HD]));
// 2294 %IF CELL_S1=K %AND STRING(L+CELL_S2)=STRING(ADDR(A(POS))) %THEN %RESULT=CELL_S2-4
if (( CELL->S1 ) != ( K )) goto L_01f4;
if (_imp_strcmp(*STRING(((L)) + ((CELL->S2))), *STRING(ADDR( &A[POS]))) != 0) goto L_01f4;
return ((CELL->S2)) - ((4));
L_01f4:
// 2295 HD=CELL_LINK
HD = CELL->LINK;
// 2296 %REPEAT
goto L_01f1;
L_01f2:
// 2297 HD=STCA
HD = STCA;
// 2298 BYTEINTEGER(L+STCA)=K; STCA=STCA+1
*BYTEINTEGER(((L)) + ((STCA))) = K;
STCA = ((STCA)) + ((1));
// 2299 %CYCLE J=POS+1,1,POS+K
J = ((((POS)) + ((1)))) - ((1));
L_01f5:
if (( J ) == ( ((POS)) + ((K)) )) goto L_01f6;
J = ((J)) + ((1));
// 2300 BYTE INTEGER(L+STCA)=A(J)
*BYTEINTEGER(((L)) + ((STCA))) = A[J];
// 2301 STCA=STCA+1
STCA = ((STCA)) + ((1));
// 2302 %REPEAT
goto L_01f5;
L_01f6:
// 2303 CONST PTR=((STCA+7)&(-8))>>2
CONSTPTR = (int)(((unsigned int)(((((STCA)) + ((7)))) & (((-(8)))))) >> ((2)));
// 2304 PUSH(PLINK(IND),K,HD,0)
PUSH( &PLINK[IND], K, HD, 0);
// 2305 %RESULT=HD-4
return ((HD)) - ((4));
// 2306 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block STRINGIN at level 5
// 2307 %ROUTINE ERR EXIT(%INTEGER LAB, ERRNO, MODE)
void ERREXIT( int LAB, int ERRNO, int MODE )
{
__label__ _imp_endofblock;
// 2308 !***********************************************************************
// 2309 !* MODE=0 FOR DUMMY(ZERO) XTRA - MODE=1 XTRA IN BREG *
// 2310 !***********************************************************************
// 2311 PLABS(LAB)=CA
PLABS[LAB] = CA;
// 2312 %IF MODE=0 %THEN PSF1(LSS,0,0) %ELSE PF1(LSS,0,BREG,0)
if (( MODE ) != ( 0 )) goto L_01f8;
PSF1(98, 0, 0);
goto L_01f9;
L_01f8:
PF1(98, 0, 7, 0);
L_01f9:
// 2313 PSF1(LUH,0,ERRNO)
PSF1(106, 0, ERRNO);
// 2314 PSF1(JLK,0,(PLABS(2)-CA)//2)
PSF1(28, 0, ((int)(((PLABS[2])) - ((CA)))) / ((int)(2)));
// 2315 %END
return;
_imp_endofblock: ;
} // End of block ERREXIT at level 5
// 2316 %END
return;
_imp_endofblock: ;
} // End of block PROLOGUE at level 4
// 2317 %ROUTINE CSS(%INTEGER P)
void CSS( int P )
{
__label__ _imp_endofblock;
// 2318 %ROUTINESPEC MERGE INFO
auto void MERGEINFO( void );
// 2319 %ROUTINESPEC REDUCE ENV(%INTEGERNAME HEAD)
auto void REDUCEENV( int *HEAD );
// 2320 %ROUTINESPEC ENTER JUMP(%INTEGER MASK,STAD,FLAG)
auto void ENTERJUMP( int MASK, int STAD, int FLAG );
// 2321 %INTEGERFNSPEC ENTER LAB(%INTEGER M,FLAG)
auto int ENTERLAB( int M, int FLAG );
// 2322 %ROUTINESPEC REMOVE LAB(%INTEGER LAB)
auto void REMOVELAB( int LAB );
// 2323 %ROUTINESPEC CEND(%INTEGER KKK)
auto void CEND( int KKK );
// 2324 %INTEGERFNSPEC CCOND(%INTEGER CTO,A,B)
auto int CCOND( int CTO, int A, int B );
// 2325 %ROUTINESPEC CHECK STOF
auto void CHECKSTOF( void );
// 2326 %INTEGERFNSPEC REVERSE(%INTEGER MASK)
auto int REVERSE( int MASK );
// 2327 %ROUTINESPEC SET LINE
auto void SETLINE( void );
// 2328 %INTEGERFNSPEC SET XORYNB(%INTEGER WHICH,RLEVEL)
auto int SETXORYNB( int WHICH, int RLEVEL );
// 2329 %INTEGERFNSPEC XORYNB(%INTEGER USE,INF)
auto int XORYNB( int USE, int INF );
// 2330 %ROUTINESPEC GET IN ACC(%INTEGER ACC,SIZE,AC,AREA,DISP)
auto void GETINACC( int ACC, int SIZE, int AC, int AREA, int DISP );
// 2331 %INTEGERFNSPEC AREA CODE
auto int AREACODE( void );
// 2332 %INTEGERFNSPEC AREA CODE2(%INTEGER BS)
auto int AREACODE2( int BS );
// 2333 %ROUTINESPEC CUI(%INTEGER CODE)
auto void CUI( int CODE );
// 2334 %ROUTINESPEC ASSIGN(%INTEGER A,B)
auto void ASSIGN( int A, int B );
// 2335 %ROUTINESPEC CSTART(%INTEGER CCRES,MODE)
auto void CSTART( int CCRES, int MODE );
// 2336 %ROUTINESPEC CCYCBODY(%INTEGER UA,ELAB,CLAB)
auto void CCYCBODY( int UA, int ELAB, int CLAB );
// 2337 %ROUTINESPEC CLOOP(%INTEGER ALT,MARKC,MARKUI)
auto void CLOOP( int ALT, int MARKC, int MARKUI );
// 2338 %ROUTINESPEC CIFTHEN(%INTEGER MARKIU,MARKC,MARKUI,MARKE,MARKR,SKIP)
auto void CIFTHEN( int MARKIU, int MARKC, int MARKUI, int MARKE, int MARKR, int SKIP );
// 2339 %ROUTINESPEC CREATE AH(%INTEGER MODE)
auto void CREATEAH( int MODE );
// 2340 %ROUTINESPEC TORP(%INTEGERNAME HEAD,BOT,NOPS)
auto void TORP( int *HEAD, int *BOT, int *NOPS );
// 2341 %INTEGERFNSPEC INTEXP(%INTEGERNAME VALUE)
auto int INTEXP( int *VALUE );
// 2342 %INTEGERFNSPEC CONSTEXP(%INTEGER PRECTYPE)
auto int CONSTEXP( int PRECTYPE );
// 2343 %ROUTINESPEC CSEXP(%INTEGER REG,MODE)
auto void CSEXP( int REG, int MODE );
// 2344 %ROUTINESPEC CSTREXP(%INTEGER A,B)
auto void CSTREXP( int A, int B );
// 2345 %ROUTINESPEC CRES(%INTEGER LAB)
auto void CRES( int LAB );
// 2346 %ROUTINESPEC EXPOP(%INTEGER A,B,C,D)
auto void EXPOP( int A, int B, int C, int D );
// 2347 %ROUTINESPEC TEST APP(%INTEGERNAME NUM)
auto void TESTAPP( int *NUM );
// 2348 %ROUTINESPEC SKIP EXP
auto void SKIPEXP( void );
// 2349 %ROUTINESPEC SKIP APP
auto void SKIPAPP( void );
// 2350 %ROUTINESPEC NO APP
auto void NOAPP( void );
// 2351 %INTEGERFNSPEC DOPE VECTOR(%INTEGER A,B,MODE,ID,%INTEGERNAME C,D)
auto int DOPEVECTOR( int A, int B, int MODE, int ID, int *C, int *D );
// 2352 %ROUTINESPEC DECLARE ARRAYS(%INTEGER A,B)
auto void DECLAREARRAYS( int A, int B );
// 2353 %ROUTINESPEC DECLARE SCALARS(%INTEGER A,B)
auto void DECLARESCALARS( int A, int B );
// 2354 %ROUTINESPEC MAKE DECS(%INTEGER Q)
auto void MAKEDECS( int Q );
// 2355 %ROUTINESPEC SAVE AUX STACK
auto void SAVEAUXSTACK( void );
// 2356 %ROUTINESPEC RESET AUX STACK
auto void RESETAUXSTACK( void );
// 2357 %ROUTINESPEC CRSPEC(%INTEGER M)
auto void CRSPEC( int M );
// 2358 %ROUTINESPEC CFPLIST(%INTEGERNAME A,B)
auto void CFPLIST( int *A, int *B );
// 2359 %ROUTINESPEC CFPDEL
auto void CFPDEL( void );
// 2360 %ROUTINESPEC CLT
auto void CLT( void );
// 2361 %ROUTINESPEC CQN(%INTEGER P)
auto void CQN( int P );
// 2362 %ROUTINESPEC GET WSP(%INTEGERNAME PLACE,%INTEGER SIZE)
auto void GETWSP( int *PLACE, int SIZE );
// 2363 %ROUTINESPEC RETURN WSP(%INTEGER PLACE,SIZE)
auto void RETURNWSP( int PLACE, int SIZE );
// 2364 %INTEGERFNSPEC TSEXP(%INTEGERNAME VALUE)
auto int TSEXP( int *VALUE );
// 2365 %ROUTINESPEC CRCALL(%INTEGER RTNAME)
auto void CRCALL( int RTNAME );
// 2366 %ROUTINESPEC NAMEOP(%INTEGER Z,REG,SIZE,NAMEP)
auto void NAMEOP( int Z, int REG, int SIZE, int NAMEP );
// 2367 %ROUTINESPEC CNAME(%INTEGER Z,REG)
auto void CNAME( int Z, int REG );
// 2368 %ROUTINESPEC CANAME(%INTEGER Z,BS,DP)
auto void CANAME( int Z, int BS, int DP );
// 2369 %ROUTINESPEC CSNAME(%INTEGER Z,REG)
auto void CSNAME( int Z, int REG );
// 2370 %ROUTINESPEC TEST ASS(%INTEGER REG,TYPE,SIZE)
auto void TESTASS( int REG, int TYPE, int SIZE );
// 2371 %ROUTINESPEC COPY TAG(%INTEGER KK)
auto void COPYTAG( int KK );
// 2372 %ROUTINESPEC REDUCE TAG
auto void REDUCETAG( void );
// 2373 %ROUTINESPEC REPLACE TAG (%INTEGER KK)
auto void REPLACETAG( int KK );
// 2374 %ROUTINESPEC RT JUMP(%INTEGER CODE,%INTEGERNAME L)
auto void RTJUMP( int CODE, int *L );
// 2375 %ROUTINESPEC STORE TAG(%INTEGER KK,SLINK)
auto void STORETAG( int KK, int SLINK );
// 2376 %ROUTINESPEC UNPACK
auto void UNPACK( void );
// 2377 %ROUTINESPEC PACK(%INTEGERNAME PTYPE)
auto void PACK( int *PTYPE );
// 2378 %ROUTINESPEC DIAG POINTER(%INTEGER LEVEL)
auto void DIAGPOINTER( int LEVEL );
// 2379 %ROUTINESPEC RDISPLAY(%INTEGER KK)
auto void RDISPLAY( int KK );
// 2380 %ROUTINESPEC RHEAD(%INTEGER KK)
auto void RHEAD( int KK );
// 2381 %ROUTINESPEC ODD ALIGN
auto void ODDALIGN( void );
// 2382 %INTEGERFNSPEC PTR OFFSET(%INTEGER RLEV)
auto int PTROFFSET( int RLEV );
// 2383 %ROUTINESPEC PPJ(%INTEGER MASK,N)
auto void PPJ( int MASK, int N );
// 2384 %ROUTINESPEC CRFORMAT(%INTEGERNAME OPHEAD)
auto void CRFORMAT( int *OPHEAD );
// 2385 %INTEGERFNSPEC DISPLACEMENT(%INTEGER LINK)
auto int DISPLACEMENT( int LINK );
// 2386 %INTEGERFNSPEC COPY RECORD TAG(%INTEGERNAME SUBS)
auto int COPYRECORDTAG( int *SUBS );
// 2387 %ROUTINESPEC SAVE IRS
auto void SAVEIRS( void );
// 2388 %ROUTINESPEC COPY DR
auto void COPYDR( void );
// 2389 %ROUTINESPEC BOOT OUT(%INTEGER REG)
auto void BOOTOUT( int REG );
// 2390 %ROUTINESPEC CHANGE RD(%INTEGER REG)
auto void CHANGERD( int REG );
// 2391 %ROUTINESPEC FORGET(%INTEGER REG)
auto void FORGET( int REG );
// 2392 %ROUTINESPEC REMEMBER
auto void REMEMBER( void );
// 2393 %ROUTINESPEC NOTE ASSMENT(%INTEGER REG,ASSOP,VAR)
auto void NOTEASSMENT( int REG, int ASSOP, int VAR );
// 2394 %SWITCH SW(1:24)
static int SW_idx;
static const void * /*SWITCH*/ SW[(24)-(1)+1] = { &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, &&SW_6, &&SW_7, &&SW_8, &&SW_9, &&SW_10, &&SW_11, &&SW_12, &&SW_13, &&SW_14, &&SW_15, &&SW_16, &&SW_17, &&SW_18, &&SW_19, &&SW_20, &&SW_21, &&SW_22, &&SW_23, &&SW_24, };
// 2395 %RECORDFORMAT RD(%BYTEINTEGER UPTYPE,PTYPE,XB,FLAG,{%C
typedef struct RD RD; // forward declaration to allow a 'next' pointer to a struct within that struct...
struct RD {
unsigned char UPTYPE;
unsigned char PTYPE;
unsigned char XB;
unsigned char FLAG;
int D;
int XTRA;
};
// 2396 %INTEGER D,XTRA)
// 2397 %INTEGER SNDISP,ACC,K,KFORM,STNAME,MIDCELL
int SNDISP;
int ACC;
int K;
int KFORM;
int STNAME;
int MIDCELL;
// 2398 %INTEGER TCELL,NUMMOD,JJ,JJJ,KK,QQ,MARKER,REPORTUI,XDISP,MASK, {%C
int TCELL;
int NUMMOD;
int JJ;
int JJJ;
int KK;
int QQ;
int MARKER;
int REPORTUI;
int XDISP;
int MASK;
int BASE;
int AREA;
int ACCESS;
int DISP;
int EXTRN;
int CURRINST;
int VALUE;
int STRINGL;
int PTYPE;
int I;
int J;
int OLDI;
int USEBITS;
int TWSPHEAD;
int KKK;
int STRFNRES;
int MARKIU;
int MARKUI;
int MARKC;
int MARKE;
int MARKR;
// 2399 BASE,AREA,ACCESS,DISP,EXTRN, CURR INST,VALUE,STRINGL, {%C
// 2400 PTYPE,I,J,OLDI,USEBITS,TWSPHEAD,KKK,STRFNRES, {%C
// 2401 MARKIU,MARKUI,MARKC,MARKE,MARKR
// 2402 %INTEGER LITL,ROUT,NAM,ARR,PREC,TYPE
int LITL;
int ROUT;
int NAM;
int ARR;
int PREC;
int TYPE;
// 2403 %RECORD (RD) EXPOPND{(RD); ! RESULT RECORD FOR EXPOP
RD EXPOPND;
// 2404 CURR INST=0
CURRINST = 0;
// 2405 TWSPHEAD=0
TWSPHEAD = 0;
// 2406 %INTEGERARRAY SGRUSE,SGRINF(0:7)
int SGRUSE[(7)-(0)+1];
int SGRINF[(7)-(0)+1];
// 2407 ->SW(A(P))
goto *(SW-1)[A[P]]; /* Bounds=1:24 */
// 2408 SW(23): ! INCLUDE SOMETHING
SW_23:
// 2409 SW(24): ! REDUNDANT SEP
SW_24:
// 2410 SW(2): ! <CMARK> <COMMENT TEXT>
SW_2:
// 2411 CSSEXIT: LAST INST=CURR INST
U_01d5:
LASTINST = CURRINST;
// 2412 %WHILE TWSPHEAD#0 %CYCLE
L_01fa:
if (( TWSPHEAD ) == ( 0 )) goto L_01fb;
// 2413 POP(TWSPHEAD,JJ,KK,QQ)
POP( &TWSPHEAD, &JJ, &KK, &QQ);
// 2414 RETURN WSP(JJ,KK)
RETURNWSP(JJ, KK);
// 2415 %REPEAT
goto L_01fa;
L_01fb:
// 2416 %RETURN
return;
// 2417 SW(1): !(UI)(S)
SW_1:
// 2418 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_01fd;
FAULT(57, 0);
L_01fd:
// 2419 MARKER=P+1+A(P+1)<<8+A(P+2)
MARKER = ((((((P)) + ((1)))) + ((((A[((P)) + ((1))])) << ((8)))))) + ((A[((P)) + ((2))]));
// 2420 P=P+3
P = ((P)) + ((3));
// 2421 ->LABFND %IF A(MARKER)=1
if (( A[MARKER] ) != ( 1 )) goto L_01fe;
goto U_01d6;
L_01fe:
// 2422 %IF A(MARKER)=2 %THEN SET LINE %AND CUI(0) %AND ->CSSEXIT
if (( A[MARKER] ) != ( 2 )) goto L_01ff;
SETLINE();
CUI(0);
goto U_01d5;
L_01ff:
// 2423 MARKE=0; MARKR=0
MARKE = 0;
MARKR = 0;
// 2424 MARKUI=P; MARKIU=MARKER+1
MARKUI = P;
MARKIU = ((MARKER)) + ((1));
// 2425 MARKC=MARKIU+1
MARKC = ((MARKIU)) + ((1));
// 2426 %IF A(MARKER)=3 %THEN CIFTHEN(MARKIU,MARKC,MARKUI,0,0,NO) %AND ->CSSEXIT
if (( A[MARKER] ) != ( 3 )) goto L_0200;
CIFTHEN(MARKIU, MARKC, MARKUI, 0, 0, 0);
goto U_01d5;
L_0200:
// 2427 CLOOP(A(MARKIU),MARKC+2,MARKUI)
CLOOP(A[MARKIU], ((MARKC)) + ((2)), MARKUI);
// 2428 ->CSSEXIT
goto U_01d5;
// 2429 LABFND: ->SWITCH %UNLESS A(P)=1 %AND A(P+5)=2; ! 1ST OF UI AND NO APP
U_01d6:
if (( A[P] ) != ( 1 )) goto L_01fc;
if (( A[((P)) + ((5))] ) == ( 2 )) goto L_0201;
L_01fc:
goto U_01d7;
L_0201:
// 2430 ->SWITCH %UNLESS A(P+6)=2 %AND A(P+7)=2;! NO ENAMSE OR ASSNMNT
if (( A[((P)) + ((6))] ) != ( 2 )) goto L_0202;
if (( A[((P)) + ((7))] ) == ( 2 )) goto L_0203;
L_0202:
goto U_01d7;
L_0203:
// 2431 JJ=ENTER LAB(FROM AR2(P+3),0); ->CSSEXIT
JJ = ENTERLAB(FROMAR2(((P)) + ((3))), 0);
goto U_01d5;
// 2432 SW(5): ! %CYCLE
SW_5:
// 2433 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_0204;
FAULT(57, 0);
L_0204:
// 2434 %IF A(P+5)=2 %THEN %START; ! OPEN CYCLE
if (( A[((P)) + ((5))] ) != ( 2 )) goto L_0205;
// 2435 CLOOP(0,P+1,0)
CLOOP(0, ((P)) + ((1)), 0);
// 2436 %FINISH %ELSE %START
goto L_0206;
L_0205:
// 2437 CLOOP(6,P+6,P+1)
CLOOP(6, ((P)) + ((6)), ((P)) + ((1)));
// 2438 %FINISH
L_0206:
// 2439 ->CSSEXIT
goto U_01d5;
// 2440 !
// 2441 SW(6): ! REPEAT
SW_6:
// 2442 ->CSSEXIT
goto U_01d5;
// 2443 SW(22): ! '%CONTROL' (CONST)
SW_22:
// 2444 J=FROM AR4(P+2)
J = FROMAR4(((P)) + ((2)));
// 2445 CODEOUT
CODEOUT();
// 2446 DCOMP=J>>28; ->CSSEXIT
DCOMP = (int)(((unsigned int)(J)) >> ((28)));
goto U_01d5;
// 2447 !
// 2448 SW(3): ! (%IU)(COND)%THEN(UI)(ELSE')
SW_3:
// 2449 MARKIU=P+1; MARKC=MARKIU+3
MARKIU = ((P)) + ((1));
MARKC = ((MARKIU)) + ((3));
// 2450 MARKR=P+2+A(P+2)<<8+A(P+3); ! ! FROMAR2(P+2)
MARKR = ((((((P)) + ((2)))) + ((((A[((P)) + ((2))])) << ((8)))))) + ((A[((P)) + ((3))]));
// 2451 MARKE=0
MARKE = 0;
// 2452 %IF A(MARKR)=3 %THEN %START
if (( A[MARKR] ) != ( 3 )) goto L_0207;
// 2453 MARKE=MARKR+1+FROMAR2(MARKR+1)
MARKE = ((((MARKR)) + ((1)))) + ((FROMAR2(((MARKR)) + ((1)))));
// 2454 MARKUI=MARKR+3
MARKUI = ((MARKR)) + ((3));
// 2455 %FINISH
L_0207:
// 2456 CIFTHEN(MARKIU,MARKC,MARKUI,MARKE,MARKR,NO)
CIFTHEN(MARKIU, MARKC, MARKUI, MARKE, MARKR, 0);
// 2457 ->CSSEXIT
goto U_01d5;
// 2458 SW(4):
SW_4:
// 2459 ! '%FINISH(ELSE')(S)
// 2460 ->CSSEXIT
goto U_01d5;
// 2461 SWITCH: %BEGIN; ! SWITCH LABEL
U_01d7:
{
__label__ _imp_endofblock;
// 2462 %INTEGER HEAD,BASEPT,NAPS,FNAME
int HEAD;
int BASEPT;
int NAPS;
int FNAME;
// 2463 %INTEGERARRAY BITS(0:2)
int BITS[(2)-(0)+1];
// 2464 FORGET(-1)
FORGET((-(1)));
// 2465 FNAME=FROM AR2(P+3)
FNAME = FROMAR2(((P)) + ((3)));
// 2466 %UNLESS A(P)=1 %AND A(P+5)=1 %THEN FAULT2(5,0,FNAME) %AND ->BEND
if (( A[P] ) != ( 1 )) goto L_0208;
if (( A[((P)) + ((5))] ) == ( 1 )) goto L_0209;
L_0208:
FAULT2(5, 0, FNAME);
goto U_01dd;
L_0209:
// 2467 ! 1ST OF UI + APP
// 2468 P=P+3; TEST APP(NAPS)
P = ((P)) + ((3));
TESTAPP( &NAPS);
// 2469 P=P+6
P = ((P)) + ((6));
// 2470 %UNLESS INTEXP(JJ)=0 %THEN FAULT2(41,0,0) %AND ->BEND
if (( INTEXP( &JJ) ) == ( 0 )) goto L_020a;
FAULT2(41, 0, 0);
goto U_01dd;
L_020a:
// 2471 ! UNLESS EXPRESSION EVALUATES AND
// 2472 %UNLESS NAPS=1 %THEN FAULT2(21,NAPS-1,FNAME) %AND ->BEND
if (( NAPS ) == ( 1 )) goto L_020b;
FAULT2(21, ((NAPS)) - ((1)), FNAME);
goto U_01dd;
L_020b:
// 2473 ! NO REST OF APP
// 2474 %UNLESS A(P+1)=2=A(P+2) %THEN FAULT2(5,0,FNAME) %AND ->BEND
if (( A[((P)) + ((1))] ) != ( 2 )) goto L_020c;
if (( 2 ) == ( A[((P)) + ((2))] )) goto L_020d;
L_020c:
FAULT2(5, 0, FNAME);
goto U_01dd;
L_020d:
// 2475 ! NO ENAME OR REST OF ASSIGMENT
// 2476 COPY TAG(FNAME)
COPYTAG(FNAME);
// 2477 HEAD=K
HEAD = K;
// 2478 %IF OLDI#LEVEL %OR TYPE#6 %THEN FAULT(4,FNAME) %AND ->BEND
if (( OLDI ) != ( LEVEL )) goto L_020e;
if (( TYPE ) == ( 6 )) goto L_020f;
L_020e:
FAULT(4, FNAME);
goto U_01dd;
L_020f:
// 2479 FROM123(HEAD,BASEPT,KKK,KK); ! EXTRACT TABLE ADDR,LB & UB
FROM123(HEAD, &BASEPT, &KKK, &KK);
// 2480 MLINK(HEAD); ! K POINTS TO BIT LIST
MLINK( &HEAD);
// 2481 ->INBD %IF KKK<=JJ<=KK
if (( KKK ) > ( JJ )) goto L_0210;
if (( JJ ) > ( KK )) goto L_0210;
goto U_01de;
L_0210:
// 2482 FAULT2(50,JJ,FNAME); ->BEND
FAULT2(50, JJ, FNAME);
goto U_01dd;
// 2483 INBD: Q=JJ-KKK
U_01de:
Q = ((JJ)) - ((KKK));
// 2484 %WHILE Q>=96 %%CYCLE
L_0211:
if (( Q ) < ( 96 )) goto L_0212;
// 2485 MLINK(HEAD)
MLINK( &HEAD);
// 2486 Q=Q-96
Q = ((Q)) - ((96));
// 2487 %REPEAT
goto L_0211;
L_0212:
// 2488 !
// 2489 ! ASLIST(HEAD) IS THE START OF 96 BIT ENTRY IN THE BIT LIST
// 2490 ! CHECK BIT NO Q TO SEE IF LABEL ALREADY SET AND THEN SET BIT Q
// 2491 !
// 2492 FROM123(HEAD,BITS(0),BITS(1),BITS(2))
FROM123(HEAD, &BITS[0], &BITS[1], &BITS[2]);
// 2493 QQ=Q>>5; ! RIGHT WORD
QQ = (int)(((unsigned int)(Q)) >> ((5)));
// 2494 Q=Q&31; JJJ=1<<Q; ! BIT IN WORD
Q = ((Q)) & ((31));
JJJ = ((1)) << ((Q));
// 2495 FAULT2(6,JJ,FNAME) %UNLESS BITS(QQ)&JJJ=0
if (( ((BITS[QQ])) & ((JJJ)) ) == ( 0 )) goto L_0214;
FAULT2(6, JJ, FNAME);
L_0214:
// 2496 BITS(QQ)=BITS(QQ)!JJJ
BITS[QQ] = ((BITS[QQ])) | ((JJJ));
// 2497 REPLACE123(HEAD,BITS(0),BITS(1),BITS(2))
REPLACE123(HEAD, BITS[0], BITS[1], BITS[2]);
// 2498 !
// 2499 ! OPTIMISED (ARR=2) SWITCHES BASEPT POINTS TO THE
// 2500 ! ZEROETH NOT THE FIRST ELEMENT
// 2501 !
// 2502 %IF ARR=2 %THEN KKK=0; ! RESET LB IF DESC TO ELEMNT 0
if (( ARR ) != ( 2 )) goto L_0215;
KKK = 0;
L_0215:
// 2503 QQ=BASEPT+(JJ-KKK)*4; ! REL POSITION OF LABEL
QQ = ((BASEPT)) + ((((((JJ)) - ((KKK)))) * ((4))));
// 2504 PLUG(2,QQ,CA,4); ! OVERWRITE THE WORD IN TABLE
PLUG(2, QQ, CA, 4);
// 2505 ! RELOCATION(BY HD OF CODE) INTACT
// 2506 BEND: %END; ->CSSEXIT
U_01dd:
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_4_LEVEL_4_ at level 5
goto U_01d5;
// 2507 SW(7): ! (%WU)(SC)(COND)(RESTOFWU)
SW_7:
// 2508 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_0216;
FAULT(57, 0);
L_0216:
// 2509 MARKIU=P+1; ! TO WHILE/UNTIL
MARKIU = ((P)) + ((1));
// 2510 MARKC=MARKIU+3; ! TO (SC)(COND)
MARKC = ((MARKIU)) + ((3));
// 2511 CLOOP(A(MARKIU)+3,MARKC,MARKIU+1+FROMAR2(MARKIU+1))
CLOOP(((A[MARKIU])) + ((3)), MARKC, ((((MARKIU)) + ((1)))) + ((FROMAR2(((MARKIU)) + ((1))))));
// 2512 ->CSSEXIT
goto U_01d5;
// 2513 !
// 2514 SW(8): ! SIMPLE DECLN
SW_8:
// 2515 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_0217;
FAULT(57, 0);
L_0217:
// 2516 FAULT(40,0) %IF NMDECS(LEVEL)&1#0
if (( ((NMDECS[LEVEL])) & ((1)) ) == ( 0 )) goto L_0218;
FAULT(40, 0);
L_0218:
// 2517 QQ=P; P=P+5;CLT;ROUT=0; LITL=0
QQ = P;
P = ((P)) + ((5));
CLT();
ROUT = 0;
LITL = 0;
// 2518 %IF A(P)#1 %THEN %START; ! ARRAY DECLARATIONS
if (( A[P] ) == ( 1 )) goto L_0219;
// 2519 FAULT(70,0) %IF TYPE=5 %AND ACC=0
if (( TYPE ) != ( 5 )) goto L_021a;
if (( ACC ) != ( 0 )) goto L_021a;
FAULT(70, 0);
L_021a:
// 2520 NAM=0
NAM = 0;
// 2521 SET LINE
SETLINE();
// 2522 QQ=2-A(P+1); P=P+2; ! QQ=1 FOR ARRAYFORMATS
QQ = ((2)) - ((A[((P)) + ((1))]));
P = ((P)) + ((2));
// 2523 DECLARE ARRAYS(QQ,0)
DECLAREARRAYS(QQ, 0);
// 2524 %FINISH %ELSE %START
goto L_021b;
L_0219:
// 2525 %IF A(QQ+1)=128 %THEN %START;! NOT LINKED&SHUFFLED
if (( A[((QQ)) + ((1))] ) != ( 128 )) goto L_021c;
// 2526 CQN(P+1); P=P+2
CQN(((P)) + ((1)));
P = ((P)) + ((2));
// 2527 DECLARE SCALARS(1,0)
DECLARESCALARS(1, 0);
// 2528 %FINISH
L_021c:
// 2529 %FINISH
L_021b:
// 2530 ->CSSEXIT
goto U_01d5;
// 2531 !
// 2532 SW(9): ! %END
SW_9:
// 2533 %BEGIN
{
__label__ _imp_endofblock;
// 2534 %SWITCH S(1:5)
static int S_idx;
static const void * /*SWITCH*/ S[(5)-(1)+1] = { &&S_1, &&S_2, &&S_3, &&S_4, &&S_5, };
// 2535 -> S(A(P+1))
goto *(S-1)[A[((P)) + ((1))]]; /* Bounds=1:5 */
// 2536 S(1): ! ENDOFPROGRAM
S_1:
// 2537 S(2): ! ENDOFFILE
S_2:
// 2538 %IF CPRMODE=0 %THEN CPRMODE=2
if (( CPRMODE ) != ( 0 )) goto L_021d;
CPRMODE = 2;
L_021d:
// 2539 FAULT(15,0) %UNLESS LEVEL+CPRMODE=3
if (( ((LEVEL)) + ((CPRMODE)) ) == ( 3 )) goto L_021e;
FAULT(15, 0);
L_021e:
// 2540 FAULT(56,0) %UNLESS A(P+1)=CPRMODE
if (( A[((P)) + ((1))] ) == ( CPRMODE )) goto L_021f;
FAULT(56, 0);
L_021f:
// 2541 CEND(CPRMODE)
CEND(CPRMODE);
// 2542 ->BEND
goto U_01d9;
// 2543 S(3): ! ENDOFLIST
S_3:
// 2544 LIST=0;
LIST = 0;
// 2545 ->BEND
goto U_01d9;
// 2546 S(4): ! END
S_4:
// 2547 CEND(FLAG(LEVEL))
CEND(FLAG[LEVEL]);
// 2548 BEND: %END
U_01d9:
goto _imp_endofblock;
S_5:
fprintf(stderr, "%%SWITCH LABEL NOT SET - S(%d): at line %s:%d", S_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,S_idx,_imp_current_line,"SWITCH LABEL NOT SET - S";*/
_imp_endofblock: ;
} // End of block _BLOCK_5_LEVEL_4_ at level 5
// 2549 ->CSSEXIT
goto U_01d5;
// 2550 !
// 2551 SW(11):
SW_11:
// 2552 %BEGIN
{
__label__ _imp_endofblock;
// 2553 %INTEGER MARKER1,KK,KKK
int MARKER1;
int KK;
int KKK;
// 2554 %STRING(34)XNAME
_imp_string /*%string(34)*/ XNAME;
// 2555 P=P+1; MARKER1=FROM AR2(P)+P; ! (SEX)(RT)(SPEC')(NAME)(FPP)
P = ((P)) + ((1));
MARKER1 = ((FROMAR2(P))) + ((P));
// 2556 AGN: Q=P; KK=FROM AR2(MARKER1+5); ! KK ON NAME
U_01dc:
Q = P;
KK = FROMAR2(((MARKER1)) + ((5)));
// 2557 EXTRN=A(P+2)
EXTRN = A[((P)) + ((2))];
// 2558 LITL=EXTRN&3
LITL = ((EXTRN)) & ((3));
// 2559 %IF A(MARKER1)=1 %THEN %START;! P<%SPEC'>='%SPEC'
if (( A[MARKER1] ) != ( 1 )) goto L_0220;
// 2560 P=P+3; CRSPEC(1-EXTRN>>2);! 0 FOR ROUTINESPEC
P = ((P)) + ((3));
CRSPEC(((1)) - (((int)(((unsigned int)(EXTRN)) >> ((2))))));
// 2561 ! 1 FOR EXTERNAL (ETC) SPEC
// 2562 ->BEND
goto U_01dd;
// 2563 %FINISH
L_0220:
// 2564 COPY TAG(KK)
COPYTAG(KK);
// 2565 %IF OLDI=LEVEL %THEN %START
if (( OLDI ) != ( LEVEL )) goto L_0221;
// 2566 %IF CPRMODE=0 %THEN CPRMODE=2;! FLAG AS FILE OF ROUTINES
if (( CPRMODE ) != ( 0 )) goto L_0222;
CPRMODE = 2;
L_0222:
// 2567 !
// 2568 %IF (CPRMODE=2 %AND LEVEL=1) %START
if (( CPRMODE ) != ( 2 )) goto L_0223;
if (( LEVEL ) != ( 1 )) goto L_0223;
// 2569 %IF EXTRN=3 %THEN EXTRN=2
if (( EXTRN ) != ( 3 )) goto L_0224;
EXTRN = 2;
L_0224:
// 2570 XNAME<-STRING(DICTBASE+WORD(KK))
XNAME = *STRING(((DICTBASE)) + ((WORD[KK])));
// 2571 %IF EXTRN=1 %THEN XNAME<-"S#".XNAME
if (( EXTRN ) != ( 1 )) goto L_0225;
XNAME = _imp_strcat((&(_imp_str_literal("S#"))), XNAME);
L_0225:
// 2572 %IF EXTRN=4 %THEN XNAME=""
if (( EXTRN ) != ( 4 )) goto L_0226;
XNAME = _imp_str_literal("");
L_0226:
// 2573 JJ=MIDCELL; ! CODE DESCRIPTOR REL ADDR
JJ = MIDCELL;
// 2574 %IF EXTRN#4 %THEN USEBITS=2
if (( EXTRN ) == ( 4 )) goto L_0227;
USEBITS = 2;
L_0227:
// 2575 DEFINE EP(XNAME,CA,JJ,0)
DEFINEEP(XNAME, CA, JJ, 0);
// 2576 %IF JJ#0 %THEN PSF1(INCA,0,-JJ)
if (( JJ ) == ( 0 )) goto L_0228;
PSF1(20, 0, (-(JJ)));
L_0228:
// 2577 %FINISH %ELSE %START; ! EXTERNALS IN PRGM OR WRNG LEVEL
goto L_0229;
L_0223:
// 2578 FAULT(55,KK) %UNLESS EXTRN=4; EXTRN=4
if (( EXTRN ) == ( 4 )) goto L_022a;
FAULT(55, KK);
L_022a:
EXTRN = 4;
// 2579 %FINISH
L_0229:
// 2580 %IF A(P+3)=1 %THEN KKK=LITL<<14!16_1000 %ELSE %START
if (( A[((P)) + ((3))] ) != ( 1 )) goto L_022b;
KKK = ((((LITL)) << ((14)))) | ((4096));
goto L_022c;
L_022b:
// 2581 ROUT=1; P=P+4; ! FIGURE OUT PTYPE FOR FNS&MAPS
ROUT = 1;
P = ((P)) + ((4));
// 2582 CLT; ARR=0; NAM=0
CLT();
ARR = 0;
NAM = 0;
// 2583 %IF A(P)=2 %THEN NAM=2; ! SET NAME ARRAY BIT FOR MAPS
if (( A[P] ) != ( 2 )) goto L_022d;
NAM = 2;
L_022d:
// 2584 PACK(KKK); ! AND STORE PTYPE IN KKK
PACK( &KKK);
// 2585 %FINISH
L_022c:
// 2586 %FINISH
L_0221:
// 2587 %UNLESS OLDI=LEVEL %AND J=15 %AND PTYPE=KKK %START
if (( OLDI ) != ( LEVEL )) goto L_0213;
if (( J ) != ( 15 )) goto L_0213;
if (( PTYPE ) == ( KKK )) goto L_022e;
L_0213:
// 2588 P=Q+3; CRSPEC(0); P=Q; ->AGN
P = ((Q)) + ((3));
CRSPEC(0);
P = Q;
goto U_01dc;
// 2589 %FINISH
L_022e:
// 2590 PTYPE=PTYPE!(EXTRN&3)<<14; ! DEAL WITH %ROUTINESPEC FOLLOWED
PTYPE = ((PTYPE)) | ((((((EXTRN)) & ((3)))) << ((14))));
// 2591 ! BY %EXTERNALROUTINE
// 2592 %BEGIN
{
__label__ _imp_endofblock;
// 2593 %INTEGER PTR,PTYPEP,CNT,PP
int PTR;
int PTYPEP;
int CNT;
int PP;
// 2594 J=0; REPLACE TAG(KK);! BODY GIVEN SO UPDATE TAGS INFO
J = 0;
REPLACETAG(KK);
// 2595 JJ=K; PLABEL=PLABEL-1
JJ = K;
PLABEL = ((PLABEL)) - ((1));
// 2596 %UNLESS COMPILER=1 %OR (CPRMODE=2 %AND LEVEL=1) %START
if (( COMPILER ) == ( 1 )) goto L_022f;
if (( CPRMODE ) != ( 2 )) goto L_0230;
if (( LEVEL ) == ( 1 )) goto L_022f;
L_0230:
// 2597 %IF JROUND(LEVEL+1)=0 %START; ! NOT JUMP OUTSTANDING
if (( JROUND[((LEVEL)) + ((1))] ) != ( 0 )) goto L_0231;
// 2598 JROUND(LEVEL+1)=PLABEL
JROUND[((LEVEL)) + ((1))] = PLABEL;
// 2599 ENTER JUMP(15,PLABEL,0)
ENTERJUMP(15, PLABEL, 0);
// 2600 %FINISH
L_0231:
// 2601 %FINISH
L_022f:
// 2602 PTYPEP=PTYPE
PTYPEP = PTYPE;
// 2603 P=MARKER1+7
P = ((MARKER1)) + ((7));
// 2604 RHEAD(KK)
RHEAD(KK);
// 2605 N=20; CNT=1
N = 20;
CNT = 1;
// 2606 %WHILE A(P)=1 %CYCLE; ! WHILE SOME (MORE) FP PART
L_0232:
if (( A[P] ) != ( 1 )) goto L_0233;
// 2607 PP=P+1+FROMAR2(P+1)
PP = ((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))));
// 2608 P=P+3
P = ((P)) + ((3));
// 2609 CFPDEL
CFPDEL();
// 2610 PTR=P
PTR = P;
// 2611 {%UNTIL A(PTR-1)=2} %CYCLE; ! CYCLE DOWN NAMELIST
L_0235:
// 2612 %IF JJ#0 %THEN %START
if (( JJ ) == ( 0 )) goto L_0238;
// 2613 FROM12(JJ,J,JJJ); ! EXTRACT PTYPE XTRA INFO
FROM12(JJ, &J, &JJJ);
// 2614 %UNLESS J>>16=PTYPE %AND(PTYPE#5 %OR JJJ>>16=ACC) %THEN FAULT2(9,CNT,KK)
if (( (int)(((unsigned int)(J)) >> ((16))) ) != ( PTYPE )) goto L_0239;
if (( PTYPE ) != ( 5 )) goto L_023a;
if (( (int)(((unsigned int)(JJJ)) >> ((16))) ) == ( ACC )) goto L_023a;
L_0239:
FAULT2(9, CNT, KK);
L_023a:
// 2615 %FINISH %ELSE FAULT2(8,0,KK);! MORE FPS THAN IN SPEC
goto L_023b;
L_0238:
FAULT2(8, 0, KK);
L_023b:
// 2616 PTR=PTR+3
PTR = ((PTR)) + ((3));
// 2617 CNT=CNT+1
CNT = ((CNT)) + ((1));
// 2618 MLINK(JJ)
MLINK( &JJ);
// 2619 %REPEAT %UNTIL A(PTR-1)=2
if (( A[((PTR)) - ((1))] ) == ( 2 )) goto L_0236;
goto L_0235;
L_0236:
// 2620 DECLARE SCALARS(0,0)
DECLARESCALARS(0, 0);
// 2621 P=PP
P = PP;
// 2622 %REPEAT; ! UNTIL NO MORE FP-PART
goto L_0232;
L_0233:
// 2623 N=(N+3)&(-4); ! TO WORD BOUNDARY AFTER ALL SYSTEM
N = ((((N)) + ((3)))) & (((-(4))));
// 2624 ! STANDARD PARAMETERS HAVE BEEN DECLARED
// 2625 FAULT2(10,0,KK) %UNLESS JJ=0
if (( JJ ) == ( 0 )) goto L_023c;
FAULT2(10, 0, KK);
L_023c:
// 2626 PTYPE=PTYPEP
PTYPE = PTYPEP;
// 2627 %IF PTYPE&16_F0F=5 %THEN N=N+8;! STR FNS RESULT PARAM IS STACKED
if (( ((PTYPE)) & ((3855)) ) != ( 5 )) goto L_023d;
N = ((N)) + ((8));
L_023d:
// 2628 ! AS XTRA PARM JUST BEFORE DISPLAY
// 2629 RDISPLAY(KK)
RDISPLAY(KK);
// 2630 MAKE DECS(MARKER1+1)
MAKEDECS(((MARKER1)) + ((1)));
// 2631 %END
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_7_LEVEL_5_ at level 6
// 2632 BEND: %END; ->CSSEXIT
U_01dd:
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_6_LEVEL_4_ at level 5
goto U_01d5;
// 2633 !
// 2634 SW(13): !REALS(LN)
SW_13:
// 2635 FAULT(58,0) %UNLESS CPRMODE=0
if (( CPRMODE ) == ( 0 )) goto L_023e;
FAULT(58, 0);
L_023e:
// 2636 ALL LONG=A(P+1)&1;->CSSEXIT
ALLLONG = ((A[((P)) + ((1))])) & ((1));
goto U_01d5;
// 2637 !
// 2638 SW(14): !%BEGIN
SW_14:
// 2639 %BEGIN
{
__label__ _imp_endofblock;
// 2640 PTYPE=0
PTYPE = 0;
// 2641 %IF LEVEL=1 %AND RLEVEL=0 %AND CPRMODE=0 %START
if (( LEVEL ) != ( 1 )) goto L_023f;
if (( RLEVEL ) != ( 0 )) goto L_023f;
if (( CPRMODE ) != ( 0 )) goto L_023f;
// 2642 CODE DES(JJ)
CODEDES( &JJ);
// 2643 DEFINE EP(MAINEP, CA, JJ, 1)
DEFINEEP(MAINEP, CA, JJ, 1);
// 2644 RLEVEL=1; RBASE=1
RLEVEL = 1;
RBASE = 1;
// 2645 L(1)=0; M(1)=0; DIAGINF(1)=0; AUXSBASE(1)=0
L[1] = 0;
M[1] = 0;
DIAGINF[1] = 0;
AUXSBASE[1] = 0;
// 2646 CPRMODE=1
CPRMODE = 1;
// 2647 N=24; NMAX=N
N = 24;
NMAX = N;
// 2648 FORGET(-1)
FORGET((-(1)));
// 2649 DIAG POINTER(LEVEL+1)
DIAGPOINTER(((LEVEL)) + ((1)));
// 2650 !
// 2651 ! THE CODE PLANTED IS AS FOLLOWS:-
// 2652 ! STD (LNB+3) SAVE DESCRIPTOG TO GLA(PLT)
// 2653 ! LXN (LNB+4) TO GLA(PLT)
// 2654 ! STLN (XNB+5) SAVE LNB FOR STOP SEQUENCE
// 2655 ! ASF 1 FOR REPORT WORD
// 2656 !
// 2657 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 2658 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 2659 PF1(STLN,0,XNB,20)
PF1(92, 0, 3, 20);
// 2660 ! PSF1(ASF,0,1)
// 2661 !
// 2662 ! THE NEXT 8 INSTRUCTIONS ARE REQUIRED TO SET SF 6 WORDS IN FRONT OF LNB
// 2663 ! AN ASF 1 WORKS AS WELL EXCEPT FOR K-STAND ALONE WHEN THERE MAY BE
// 2664 ! A USELESS REDUNDANT DESCRIPTOR ON THE STACK
// 2665 !
// 2666 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 2667 PF1(LSS,0,TOS,0)
PF1(98, 0, 6, 0);
// 2668 PSF1(IAD,0,24)
PSF1(224, 0, 24);
// 2669 PF1(STSF,0,TOS,0)
PF1(94, 0, 6, 0);
// 2670 PF1(ISB,0,TOS,0)
PF1(226, 0, 6, 0);
// 2671 PSF1(ISH,0,-2)
PSF1(232, 0, (-(2)));
// 2672 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 2673 PF1(ASF,0,BREG,0)
PF1(110, 0, 7, 0);
// 2674 !
// 2675 !
// 2676 ! SET THE PROGRAM MASK TO MASK OUT UNDERFLOW AND ALLOW ALL OTHER INTS
// 2677 !
// 2678 ! MPSR 16_40C0
// 2679 !
// 2680 PF1(MPSR,0,0,16_40C0)
PF1(50, 0, 0, 16576);
// 2681 PTYPE=1
PTYPE = 1;
// 2682 %FINISH %ELSE SET LINE; ! SO 'ENTERED FROM LINE' IS OK
goto L_0240;
L_023f:
SETLINE();
L_0240:
// 2683 RHEAD(-1)
RHEAD((-(1)));
// 2684 RDISPLAY(-1)
RDISPLAY((-(1)));
// 2685 MAKE DECS(P+1)
MAKEDECS(((P)) + ((1)));
// 2686 %END
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_8_LEVEL_4_ at level 5
// 2687 ->CSSEXIT
goto U_01d5;
// 2688 !
// 2689 SW(15):
SW_15:
// 2690 ! '%ON'(EVENT')(N)(NLIST)'%START'
// 2691 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_0241;
FAULT(57, 0);
L_0241:
// 2692 FAULT(40,0) %IF NMDECS(LEVEL)&1#0
if (( ((NMDECS[LEVEL])) & ((1)) ) == ( 0 )) goto L_0242;
FAULT(40, 0);
L_0242:
// 2693 NMDECS(LEVEL)=NMDECS(LEVEL)!16_11;! NO MORE DECS AND IN ONCOND
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((17));
// 2694 %IF STACK=0 %THEN %START
if (( STACK ) != ( 0 )) goto L_0243;
// 2695 SAVE AUX STACK
SAVEAUXSTACK();
// 2696 DISP=AUXSBASE(LEVEL)
DISP = AUXSBASE[LEVEL];
// 2697 PSF1(LSS,2,DISP); ! SAVE TOP OF AUX STACK
PSF1(98, 2, DISP);
// 2698 PSF1(ST,1,DISP+12)
PSF1(72, 1, ((DISP)) + ((12)));
// 2699 %FINISH
L_0243:
// 2700 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 2701 PSF1(CPSR,1,N+8)
PSF1(52, 1, ((N)) + ((8)));
// 2702 PLABEL=PLABEL-1
PLABEL = ((PLABEL)) - ((1));
// 2703 JJJ=PLABEL
JJJ = PLABEL;
// 2704 ENTER JUMP(15,JJJ,B'10'); ! JUMP ROUND ON BODY
ENTERJUMP(15, JJJ, 2);
// 2705 !
// 2706 P=P+2; JJ=0; ! SET UP A BITMASK IN JJ
P = ((P)) + ((2));
JJ = 0;
// 2707 {%UNTIL A(P-1)=2} %CYCLE; ! UNTIL NO MORE NLIST
L_0244:
// 2708 KK=A(P)
KK = A[P];
// 2709 FAULT2(26,KK,0) %UNLESS 1<=KK<=14
if (( 1 ) > ( KK )) goto L_0237;
if (( KK ) <= ( 14 )) goto L_0247;
L_0237:
FAULT2(26, KK, 0);
L_0247:
// 2710 JJ=JJ!1<<(KK-1)
JJ = ((JJ)) | ((((1)) << ((((KK)) - ((1))))));
// 2711 P=P+2
P = ((P)) + ((2));
// 2712 %REPEAT %UNTIL A(P-1)=2
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_0245;
goto L_0244;
L_0245:
// 2713 KK=CA; PGLA(4,4,ADDR(CA))
KK = CA;
PGLA(4, 4, ADDR( &CA));
// 2714 RELOCATE(GLACA-4,KK,1); ! ENTRY ADDRESS IN PLT
RELOCATE(((GLACA)) - ((4)), KK, 1);
// 2715 ONWORD(LEVEL)=JJ<<18!(GLACA-4)
ONWORD[LEVEL] = ((((JJ)) << ((18)))) | ((((GLACA)) - ((4))));
// 2716 FORGET(-1)
FORGET((-(1)));
// 2717 PSF1(ST,1,N); ! STORE EVENT,SUBEVENT&LINE
PSF1(72, 1, N);
// 2718 PSF1(MPSR,1,N+8)
PSF1(50, 1, ((N)) + ((8)));
// 2719 ONINF(LEVEL)=N; N=N+12
ONINF[LEVEL] = N;
N = ((N)) + ((12));
// 2720 %IF STACK=0 %THEN %START
if (( STACK ) != ( 0 )) goto L_0248;
// 2721 PSF1(LSS,1,DISP+12); ! RESET AUX STACK TOP
PSF1(98, 1, ((DISP)) + ((12)));
// 2722 PSF1(ST,2,DISP)
PSF1(72, 2, DISP);
// 2723 %FINISH
L_0248:
// 2724 CSTART(0,3)
CSTART(0, 3);
// 2725 NMDECS(LEVEL)=NMDECS(LEVEL)!!16_10;! NOT IN ONCOND
NMDECS[LEVEL] = ((NMDECS[LEVEL])) ^ ((16));
// 2726 JJ=ENTER LAB(JJJ,B'111'); ! REPLACE ENVIRONMENT
JJ = ENTERLAB(JJJ, 7);
// 2727 ->CSSEXIT
goto U_01d5;
// 2728 SW(16):
SW_16:
// 2729 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_0249;
FAULT(57, 0);
L_0249:
// 2730 %BEGIN; ! %SWITCH (SWITCH LIST)
{
__label__ _imp_endofblock;
// 2731 %INTEGER Q,RANGE,KKK,KK,LB,PP,D0,D1,OPHEAD,V,ARRP,R
int Q;
int RANGE;
int KKK;
int KK;
int LB;
int PP;
int D0;
int D1;
int OPHEAD;
int V;
int ARRP;
int R;
// 2732 Q=P
Q = P;
// 2733 ARRP=1
ARRP = 1;
// 2734 %IF PARMOPT=0 %THEN ARRP=2
if (( PARMOPT ) != ( 0 )) goto L_024a;
ARRP = 2;
L_024a:
// 2735 {%UNTIL A(Q)=2} %CYCLE; ! UNTIL NO'REST OF SW LIST'
L_024b:
// 2736 P=P+3
P = ((P)) + ((3));
// 2737 P=P+3 %WHILE A(P)=1
L_024e:
if (( A[P] ) != ( 1 )) goto L_024f;
P = ((P)) + ((3));
goto L_024e;
L_024f:
// 2738 P=P+4; ! TO P(+')
P = ((P)) + ((4));
// 2739 KKK=INTEXP(LB); ! EXTRACT LOWER BOUND
KKK = INTEXP( &LB);
// 2740 P=P+3
P = ((P)) + ((3));
// 2741 KKK=KKK!INTEXP(KK); ! EXTRACT UPPER BOUND
KKK = ((KKK)) | ((INTEXP( &KK)));
// 2742 RANGE=(KK-LB+1)
RANGE = ((((KK)) - ((LB)))) + ((1));
// 2743 %IF RANGE<=0 %OR KKK#0 %START
if (( RANGE ) <= ( 0 )) goto L_0250;
if (( KKK ) == ( 0 )) goto L_0251;
L_0250:
// 2744 FAULT2(38,1-RANGE,FROMAR2(Q+1))
FAULT2(38, ((1)) - ((RANGE)), FROMAR2(((Q)) + ((1))));
// 2745 LB=0; KK=10; RANGE=11
LB = 0;
KK = 10;
RANGE = 11;
// 2746 %FINISH
L_0251:
// 2747 %IF GLACA+8-4*LB<0 %THEN ARRP=1;! ZEROETH ELEMENT OFF FRONT
if (( ((((GLACA)) + ((8)))) - ((((4)) * ((LB)))) ) >= ( 0 )) goto L_0252;
ARRP = 1;
L_0252:
// 2748 PTYPE=16_56+ARRP<<8; ! WORD LABEL ARRAY
PTYPE = ((86)) + ((((ARRP)) << ((8))));
// 2749 PP=P; P=Q+1
PP = P;
P = ((Q)) + ((1));
// 2750 {%UNTIL A(P-1)=2} %CYCLE; ! DOWN NAMELIST
L_0253:
// 2751 K=FROM AR2(P)
K = FROMAR2(P);
// 2752 P=P+3
P = ((P)) + ((3));
// 2753 OPHEAD=0; R=LB
OPHEAD = 0;
R = LB;
// 2754 !
// 2755 ! SET UP A BIT LIST (96 BITS PER CELL) TO CHECK FOR SWITCH LABELS
// 2756 ! SET TWICE
// 2757 !
// 2758 {%UNTIL R>KK} %CYCLE
L_0256:
// 2759 PUSH(OPHEAD,0,0,0)
PUSH( &OPHEAD, 0, 0, 0);
// 2760 R=R+96
R = ((R)) + ((96));
// 2761 %REPEAT %UNTIL R>KK
if (( R ) > ( KK )) goto L_0257;
goto L_0256;
L_0257:
// 2762 !
// 2763 ! FOR CHECKING MODE USE A BOUNDED WORD DESCRIPTOR AND WORD SIZE
// 2764 ! ENTRIES PRESET TO "SW LABEL NOT SET". OPTIMISING USE BCI WORD
// 2765 ! ARRAYS WITH BASE SET TO ZEROETH ELEMENT
// 2766
// 2767 D1=(GLACA+15)&(-8); ! FIRST TABLE ENTRY
D1 = ((((GLACA)) + ((15)))) & (((-(8))));
// 2768 D0=16_28000000!RANGE; ! SCALED WORD DES
D0 = ((671088640)) | ((RANGE));
// 2769 %IF ARRP=2 %THEN %START
if (( ARRP ) != ( 2 )) goto L_0259;
// 2770 D0=D0!16_01000000 %UNLESS LB=0;! SET BCI BIT
if (( LB ) == ( 0 )) goto L_025a;
D0 = ((D0)) | ((16777216));
L_025a:
// 2771 D1=D1-4*LB
D1 = ((D1)) - ((((4)) * ((LB))));
// 2772 %FINISH
L_0259:
// 2773 PGLA(8,8,ADDR(D0))
PGLA(8, 8, ADDR( &D0));
// 2774 SNDISP=GLACA>>2-2; ! WORD PLT DISP
SNDISP = (((int)(((unsigned int)(GLACA)) >> ((2))))) - ((2));
// 2775 RELOCATE(GLACA-4,D1,2); ! RELOCATE RELATIVE TO GLA
RELOCATE(((GLACA)) - ((4)), D1, 2);
// 2776 PUSH(OPHEAD,D1,LB,KK)
PUSH( &OPHEAD, D1, LB, KK);
// 2777 KFORM=0; ACC=4
KFORM = 0;
ACC = 4;
// 2778 J=1; STORE TAG(K,OPHEAD)
J = 1;
STORETAG(K, OPHEAD);
// 2779 !
// 2780 !THE TABLE WILL CONSIST OF RELATIVE DISPLACEMENTS FROM THE TABLE HEAD
// 2781 ! TO THE LABEL POSN. SET ALL TO GO TO PLAB(6) INITIALLY
// 2782 !
// 2783 V=PLABS(6)
V = PLABS[6];
// 2784 %CYCLE KKK=LB,1,KK
KKK = ((LB)) - ((1));
L_025b:
if (( KKK ) == ( KK )) goto L_025c;
KKK = ((KKK)) + ((1));
// 2785 RELOCATE(-1,V,1); ! PLABS(6) RELOCATED BY HD OF CODE
RELOCATE((-(1)), V, 1);
// 2786 %REPEAT
goto L_025b;
L_025c:
// 2787 %REPEAT %UNTIL A(P-1)=2; ! FOR ANY MORE NAMES IN NAMELIST
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_0254;
goto L_0253;
L_0254:
// 2788 Q=PP; P=Q
Q = PP;
P = Q;
// 2789 %REPEAT %UNTIL A(Q)=2; ! UNTIL A(Q)=2
if (( A[Q] ) == ( 2 )) goto L_024c;
goto L_024b;
L_024c:
// 2790 %END;->CSSEXIT
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_9_LEVEL_4_ at level 5
goto U_01d5;
// 2791 !
// 2792 SW(17): LIST=1; ->CSSEXIT
SW_17:
LIST = 1;
goto U_01d5;
// 2793 !
// 2794 SW(12): ! '%OWN' (TYPE)(OWNDEC)
SW_12:
// 2795 %BEGIN
{
__label__ _imp_endofblock;
// 2796 !***********************************************************************
// 2797 !* INITIALISED DECLARATION GO INTO THE GLA OR GLA SYMBOL TABLES *
// 2798 !* EXCEPT FOR CONST ARRAYS WHICH GO INTO THE CODE SYMBOL TABLES *
// 2799 !* STRINGS AND ARRAYS HAVE A HEADER IN THE GLA. LPUT ARRANGES *
// 2800 !* FOR THE LOADER TO RELOCATE THE HEADERS. *
// 2801 !* EXTERNALS ARE IDENTICAL WITH OWN BUT ALSO HAVE A DATA EP DEFN *
// 2802 !* IN THE LOAD DATA SO THEY CAN BE FOUND AT LOAD TIME *
// 2803 !* EXTRINSICS HAVE A DATA REFERENCE AND A DUMMY HEADER IN THE GLA *
// 2804 !* THE LOADER USES THE FORMER TO RELOCATE THE LATTER. *
// 2805 !***********************************************************************
// 2806 %ROUTINESPEC CLEAR(%INTEGER L)
auto void CLEAR( int L );
// 2807 %ROUTINESPEC STAG(%INTEGER J,DATALEN)
auto void STAG( int J, int DATALEN );
// 2808 %ROUTINESPEC XTRACT CONST(%INTEGER CONTYPE,CONPREC)
auto void XTRACTCONST( int CONTYPE, int CONPREC );
// 2809 %ROUTINESPEC INIT SPACE(%INTEGER A,B)
auto void INITSPACE( int A, int B );
// 2810 %INTEGER LENGTH,BP,PP,SIGN,CBASE,MODE,UICONST,ICONST,TAGDISP,EPTYPE, {%C
int LENGTH;
int BP;
int PP;
int SIGN;
int CBASE;
int MODE;
int UICONST;
int ICONST;
int TAGDISP;
int EPTYPE;
int EPDISP;
int AH1;
int AH2;
int AH3;
int AH4;
int AD;
int FNAM;
int FINF;
int SPOINT;
int CONSTSFOUND;
int CPREC;
int EXTRN;
int NNAMES;
int MARK;
int LPUTP;
int MARKER1;
int LB;
int CTYPE;
int CONSTP;
int FORMAT;
int PTSIZE;
int DIMEN;
int SACC;
int TYPEP;
// 2811 EPDISP,AH1,AH2,AH3,AH4,AD,FNAM,FINF,SPOINT,CONSTSFOUND,CPREC,{%C
// 2812 EXTRN,NNAMES,MARK,LPUTP,MARKER1,LB,CTYPE,CONSTP,FORMAT, {%C
// 2813 PTSIZE,DIMEN,SACC,TYPEP
// 2814 %LONGREAL RCONST,LRCONST
double RCONST;
double LRCONST;
// 2815 %OWNLONGREAL ZERO=0
static double ZERO = 0;
// 2816 %STRING(255) SCONST,NAMTXT
_imp_string /*%string(255)*/ SCONST;
_imp_string /*%string(255)*/ NAMTXT;
// 2817 %INTEGERNAME STPTR
int *STPTR;
// 2818 LPUTP=5; STPTR==USTPTR; ! NORMAL CASE GLA SYMBOLTABLES
LPUTP = 5;
STPTR = (&(USTPTR));
// 2819 ! FAULT(40,0) %IF NMDECS&1#0
// 2820 EXTRN=A(P+1)
EXTRN = A[((P)) + ((1))];
// 2821 %IF EXTRN>=4 %THEN EXTRN=0; ! CONST & CONSTANT->0
if (( EXTRN ) < ( 4 )) goto L_025e;
EXTRN = 0;
L_025e:
// 2822 LITL=EXTRN
LITL = EXTRN;
// 2823 %IF LITL<=1 %THEN LITL=LITL!!1
if (( LITL ) > ( 1 )) goto L_025f;
LITL = ((LITL)) ^ ((1));
L_025f:
// 2824 KFORM=0; SNDISP=0
KFORM = 0;
SNDISP = 0;
// 2825 CONSTS FOUND=0
CONSTSFOUND = 0;
// 2826 %IF EXTRN=0 %THEN LPUTP=4 %AND STPTR==SSTL
if (( EXTRN ) != ( 0 )) goto L_0260;
LPUTP = 4;
STPTR = (&(SSTL));
L_0260:
// 2827 P=P+3; CBASE=0
P = ((P)) + ((3));
CBASE = 0;
// 2828 MODE=A(P-1); ! MODE =1 FOR NORMAL OWNS
MODE = A[((P)) - ((1))];
// 2829 ->RECORD %IF MODE>1; ! MODE =2 FOR OWN RECORDS
if (( MODE ) <= ( 1 )) goto L_0261;
goto U_0204;
L_0261:
// 2830 CLT; ! MODE =3 FOR OWN RECORD ARRAYS
CLT();
// 2831 %IF A(P)=1 %THEN CQN(P+1) %ELSE ARR=1 %AND NAM=0
if (( A[P] ) != ( 1 )) goto L_0262;
CQN(((P)) + ((1)));
goto L_0263;
L_0262:
ARR = 1;
NAM = 0;
L_0263:
// 2832 %IF TYPE=5 %AND ACC=0=NAM %THEN FAULT(70,0) %AND ACC=2
if (( TYPE ) != ( 5 )) goto L_0264;
if (( ACC ) != ( 0 )) goto L_0264;
if (( 0 ) != ( NAM )) goto L_0264;
FAULT(70, 0);
ACC = 2;
L_0264:
// 2833 ROUT=0; PACK(PTYPE)
ROUT = 0;
PACK( &PTYPE);
// 2834 -> NON SCALAR %IF ARR#0 %AND NAM=0
if (( ARR ) == ( 0 )) goto L_0265;
if (( NAM ) != ( 0 )) goto L_0265;
goto U_0205;
L_0265:
// 2835 P=P+1
P = ((P)) + ((1));
// 2836 {%UNTIL A(MARK)=2} %CYCLE; ! UNTIL <RESTOFOWNDEC> NULL
L_0266:
// 2837 MARK= P+1+FROM AR2(P+1)
MARK = ((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))));
// 2838 NNAMES=1
NNAMES = 1;
// 2839 PP=P+3; P=PP+2; ! PP ON FIRST NAME'
PP = ((P)) + ((3));
P = ((PP)) + ((2));
// 2840 %WHILE A(P)=1 %%CYCLE
L_0269:
if (( A[P] ) != ( 1 )) goto L_026a;
// 2841 NNAMES=NNAMES+1
NNAMES = ((NNAMES)) + ((1));
// 2842 P=P+3
P = ((P)) + ((3));
// 2843 %REPEAT
goto L_0269;
L_026a:
// 2844 P=P+1; ! P ON CONST'
P = ((P)) + ((1));
// 2845 !
// 2846 ! OBTAIN THE INITIAL CONSTANT,ITS TYPE(CTYPE) AND SIGN(SIGN)
// 2847 !
// 2848 ICONST=0; UICONST=0
ICONST = 0;
UICONST = 0;
// 2849 RCONST=0; LRCONST=0; SCONST=""
RCONST = 0;
LRCONST = 0;
SCONST = _imp_str_literal("");
// 2850 SIGN=3; CTYPE=TYPE; CONSTSFOUND=0; CPREC=PREC
SIGN = 3;
CTYPE = TYPE;
CONSTSFOUND = 0;
CPREC = PREC;
// 2851 %IF NAM#0 %THEN CTYPE=1 %AND CPREC=5
if (( NAM ) == ( 0 )) goto L_026c;
CTYPE = 1;
CPREC = 5;
L_026c:
// 2852 !
// 2853 %IF A(P)=1 %THEN %START; ! CONSTANT GIVEN
if (( A[P] ) != ( 1 )) goto L_026d;
// 2854 P=P+1
P = ((P)) + ((1));
// 2855 XTRACT CONST(CTYPE,CPREC)
XTRACTCONST(CTYPE, CPREC);
// 2856 %FINISH
L_026d:
// 2857 !
// 2858 {%UNTIL NNAMES=0} %CYCLE; ! DOWN <NAMELIST>
L_026e:
// 2859 J=0; K=FROM AR2(PP)
J = 0;
K = FROMAR2(PP);
// 2860 NAMTXT=STRING(DICTBASE+WORD(K))
NAMTXT = *STRING(((DICTBASE)) + ((WORD[K])));
// 2861 %IF NAM#0 %THEN %START; ! OWNNAMES AND ARRAYNAMES
if (( NAM ) == ( 0 )) goto L_0271;
// 2862 %IF EXTRN=3 %THEN FAULT2(46,0,K);! NO EXTRINSIC NAMES
if (( EXTRN ) != ( 3 )) goto L_0272;
FAULT2(46, 0, K);
L_0272:
// 2863 UICONST=16_FFFF!PREC<<27
UICONST = ((65535)) | ((((PREC)) << ((27))));
// 2864 PGLA(8,ACC,ADDR(UICONST))
PGLA(8, ACC, ADDR( &UICONST));
// 2865 TAGDISP=GLACA-ACC; EPDISP=TAGDISP
TAGDISP = ((GLACA)) - ((ACC));
EPDISP = TAGDISP;
// 2866 %FINISH %ELSE %START
goto L_0273;
L_0271:
// 2867 %IF TYPE=5 %THEN %START; ! STRING
if (( TYPE ) != ( 5 )) goto L_0274;
// 2868 QQ=STPTR; AD=ADDR(SCONST)
QQ = STPTR;
AD = ADDR( &SCONST);
// 2869 %IF EXTRN=3 %THEN %START; ! EXTRINSIC STRINGS
if (( EXTRN ) != ( 3 )) goto L_0275;
// 2870 AH3=0; AH2=PREC<<27!ACC; ! DUMMY STRING HEADER
AH3 = 0;
AH2 = ((((PREC)) << ((27)))) | ((ACC));
// 2871 %FINISH %ELSE %START
goto L_0276;
L_0275:
// 2872 LPUT(LPUTP,ACC,QQ,AD) %IF INHCODE=0;! O/P STRING
if (( INHCODE ) != ( 0 )) goto L_0277;
LPUT(LPUTP, ACC, QQ, AD);
L_0277:
// 2873 STPTR=(STPTR+ACC+3)&(-4)
STPTR = ((((((STPTR)) + ((ACC)))) + ((3)))) & (((-(4))));
// 2874 AH3=QQ; AH2=3<<27!ACC
AH3 = QQ;
AH2 = ((((3)) << ((27)))) | ((ACC));
// 2875 %FINISH
L_0276:
// 2876 PGLA(8,8,ADDR(AH2))
PGLA(8, 8, ADDR( &AH2));
// 2877 TAGDISP=GLACA-8
TAGDISP = ((GLACA)) - ((8));
// 2878 %IF EXTRN=3 %THEN GXREF(NAMTXT,2,2<<24!ACC,TAGDISP+4) %ELSE RELOCATE(TAGDISP+4,AH3,LPUTP)
if (( EXTRN ) != ( 3 )) goto L_0278;
GXREF(NAMTXT, 2, ((((2)) << ((24)))) | ((ACC)), ((TAGDISP)) + ((4)));
goto L_0279;
L_0278:
RELOCATE(((TAGDISP)) + ((4)), AH3, LPUTP);
L_0279:
// 2879 EPTYPE=5; EPDISP=QQ; ! DATA IN GLA SYMBOL TABLES
EPTYPE = 5;
EPDISP = QQ;
// 2880 %FINISH %ELSE %START; ! INTEGER & REAL
goto L_027a;
L_0274:
// 2881 %IF EXTRN=3 %THEN %START; ! EXTRINSICS
if (( EXTRN ) != ( 3 )) goto L_027b;
// 2882 PTYPE=PTYPE!1<<10; ! EXTRINSICS VIA PTR
PTYPE = ((PTYPE)) | ((((1)) << ((10))));
// 2883 AH2=PREC<<27; AH3=0
AH2 = ((PREC)) << ((27));
AH3 = 0;
// 2884 PGLA(8,8,ADDR(AH2))
PGLA(8, 8, ADDR( &AH2));
// 2885 TAGDISP=GLACA-8
TAGDISP = ((GLACA)) - ((8));
// 2886 GXREF(NAMTXT,2,2<<24!ACC,TAGDISP+4)
GXREF(NAMTXT, 2, ((((2)) << ((24)))) | ((ACC)), ((TAGDISP)) + ((4)));
// 2887 %FINISH %ELSE %START; ! OWN,EXTERNAL&CONST
goto L_027c;
L_027b:
// 2888 %IF TYPE=2 %THEN %START
if (( TYPE ) != ( 2 )) goto L_027d;
// 2889 AD=ADDR(RCONST)
AD = ADDR( &RCONST);
// 2890 %FINISH %ELSE %START; ! INTEGER VARIABLES
goto L_027e;
L_027d:
// 2891 AD=ADDR(ICONST)+4-ACC
AD = ((((ADDR( &ICONST))) + ((4)))) - ((ACC));
// 2892 %FINISH
L_027e:
// 2893 %IF EXTRN#0 %THEN PGLA(ACC,ACC,AD); ! PUT CONSTANT INTO GLA
if (( EXTRN ) == ( 0 )) goto L_027f;
PGLA(ACC, ACC, AD);
L_027f:
// 2894 TAGDISP=GLACA-ACC; ! OFFSET OF VAR FOR TAGS
TAGDISP = ((GLACA)) - ((ACC));
// 2895 EPDISP=TAGDISP; ! AND FOR ENTRY DEFN
EPDISP = TAGDISP;
// 2896 EPTYPE=2; ! DATA IN ADRESSABLE GLA
EPTYPE = 2;
// 2897 %FINISH
L_027c:
// 2898 %FINISH
L_027a:
// 2899 %FINISH
L_0273:
// 2900 STAG(TAGDISP,ACC)
STAG(TAGDISP, ACC);
// 2901 %IF EXTRN=0=NAM %START; ! CONST = LITERAL
if (( EXTRN ) != ( 0 )) goto L_0280;
if (( 0 ) != ( NAM )) goto L_0280;
// 2902 REPLACE2(TAGS(K),INTEGER(AD&(-4)));! BYTES!
REPLACE2(TAGS[K], **INTEGER(((AD)) & (((-(4))))));
// 2903 %IF PREC=6 %THEN REPLACE3(TAGS(K),INTEGER(AD+4))
if (( PREC ) != ( 6 )) goto L_0281;
REPLACE3(TAGS[K], **INTEGER(((AD)) + ((4))));
L_0281:
// 2904 %IF PREC=7 %THEN REPLACE3(TAGS(K),CONSTP)
if (( PREC ) != ( 7 )) goto L_0282;
REPLACE3(TAGS[K], CONSTP);
L_0282:
// 2905 %FINISH
L_0280:
// 2906 PP=PP+3
PP = ((PP)) + ((3));
// 2907 NNAMES=NNAMES-1
NNAMES = ((NNAMES)) - ((1));
// 2908 %REPEAT %UNTIL NNAMES=0; ! DOWN <NAMELIST>
if (( NNAMES ) == ( 0 )) goto L_026f;
goto L_026e;
L_026f:
// 2909 P=MARK
P = MARK;
// 2910 %REPEAT %UNTIL A(MARK)=2; ! UNTIL <RESTOFOWNDEC> NULL
if (( A[MARK] ) == ( 2 )) goto L_0267;
goto L_0266;
L_0267:
// 2911 ->BEND
goto U_0206;
// 2912 RECORD: ! <XOWN>'%RECORD'<NAMELIST>
U_0204:
// 2913 !***********************************************************************
// 2914 !* NO INITIALISATION OF OWN RECORDS ALLOWED SO THEY ARE ALL *
// 2915 !* CLEARED TO ZERO. *
// 2916 !***********************************************************************
// 2917 MARKER1=P+1+FROM AR2(P+1); ! TO FORMAT NAME
MARKER1 = ((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))));
// 2918 FNAM=FROM AR2(MARKER1)
FNAM = FROMAR2(MARKER1);
// 2919 COPYTAG(FNAM)
COPYTAG(FNAM);
// 2920 FINF=TCELL
FINF = TCELL;
// 2921 %IF PTYPE#4 %THEN FAULT(62,FNAM) %AND ->BEND
if (( PTYPE ) == ( 4 )) goto L_0283;
FAULT(62, FNAM);
goto U_0206;
L_0283:
// 2922 PTYPE=16_133!LITL<<14
PTYPE = ((307)) | ((((LITL)) << ((14))));
// 2923 KFORM=FINF; UNPACK
KFORM = FINF;
UNPACK();
// 2924 %IF MODE=3 %THEN FORMAT=2-A(P) %AND P=P+2 %AND ->RECIN
if (( MODE ) != ( 3 )) goto L_0284;
FORMAT = ((2)) - ((A[P]));
P = ((P)) + ((2));
goto U_0207;
L_0284:
// 2925 P=P+1; BP=ACC; ! SIZE OF RECORD FROM FORMAT
P = ((P)) + ((1));
BP = ACC;
// 2926 PTYPE=16_33; J=0
PTYPE = 51;
J = 0;
// 2927 %IF A(P-1)#3 %THEN CQN(P-1) %AND PACK(PTYPE)
if (( A[((P)) - ((1))] ) == ( 3 )) goto L_0285;
CQN(((P)) - ((1)));
PACK( &PTYPE);
L_0285:
// 2928 P=P+1; PTSIZE=ACC; ! SIZE OF HOLE FOR POINTER
P = ((P)) + ((1));
PTSIZE = ACC;
// 2929 {%UNTIL A(P)=2} %CYCLE
L_0286:
// 2930 P=P+1; K=FROM AR2(P)
P = ((P)) + ((1));
K = FROMAR2(P);
// 2931 NAMTXT=STRING(DICTBASE+WORD(K))
NAMTXT = *STRING(((DICTBASE)) + ((WORD[K])));
// 2932 %IF NAM#0 %THEN %START; ! OWNNAMES AND ARRAYNAMES
if (( NAM ) == ( 0 )) goto L_0289;
// 2933 %IF EXTRN=3 %THEN FAULT2(46,0,K);! NO EXTRINSIC NAMES
if (( EXTRN ) != ( 3 )) goto L_028a;
FAULT2(46, 0, K);
L_028a:
// 2934 UICONST=16_FFFF!PREC<<27
UICONST = ((65535)) | ((((PREC)) << ((27))));
// 2935 PGLA(8,PTSIZE,ADDR(UICONST))
PGLA(8, PTSIZE, ADDR( &UICONST));
// 2936 EPTYPE=2
EPTYPE = 2;
// 2937 TAGDISP=GLACA-PTSIZE; EPDISP=TAGDISP
TAGDISP = ((GLACA)) - ((PTSIZE));
EPDISP = TAGDISP;
// 2938 %FINISH %ELSE %START
goto L_028b;
L_0289:
// 2939 %IF EXTRN=3 %THEN %START; ! EXTRINISIC
if (( EXTRN ) != ( 3 )) goto L_028c;
// 2940 PTYPE=PTYPE!16_400; ! FORCE NAM=1 (IE VIA POINTER)
PTYPE = ((PTYPE)) | ((1024));
// 2941 AH2=16_18000000+BP
AH2 = ((402653184)) + ((BP));
// 2942 AH3=0
AH3 = 0;
// 2943 PGLA(8,8,ADDR(AH2))
PGLA(8, 8, ADDR( &AH2));
// 2944 TAGDISP=GLACA-8
TAGDISP = ((GLACA)) - ((8));
// 2945 GXREF(NAMTXT,2,2<<24!BP,TAGDISP+4); ! RELOCATE BY EXTERNAL
GXREF(NAMTXT, 2, ((((2)) << ((24)))) | ((BP)), ((TAGDISP)) + ((4)));
// 2946 %FINISH %ELSE %START
goto L_028d;
L_028c:
// 2947 EPDISP=(GLACA+15)&(-8)
EPDISP = ((((GLACA)) + ((15)))) & (((-(8))));
// 2948 AH3=EPDISP
AH3 = EPDISP;
// 2949 AH2=16_18000000+BP; ! TOP WORD OFDESRCIPTOR
AH2 = ((402653184)) + ((BP));
// 2950 PGLA(8,4,ADDR(AH2)); ! ADDED 18MAR76 TO FIX BUG
PGLA(8, 4, ADDR( &AH2));
// 2951 RELOCATE(-1,AH3,2); ! PUT DISP INTO GLA
RELOCATE((-(1)), AH3, 2);
// 2952 TAGDISP=EPDISP; ! AND RELOCATE REL APPROPIATE AREA
TAGDISP = EPDISP;
// 2953 EPTYPE=2; ! DATA IN GLA TABLES
EPTYPE = 2;
// 2954 I=0; ICONST=0
I = 0;
ICONST = 0;
// 2955 %WHILE I<BP %CYCLE
L_028e:
if (( I ) >= ( BP )) goto L_028f;
// 2956 PGLA(4,4,ADDR(ICONST))
PGLA(4, 4, ADDR( &ICONST));
// 2957 I=I+4
I = ((I)) + ((4));
// 2958 %REPEAT
goto L_028e;
L_028f:
// 2959 %FINISH
L_028d:
// 2960 %FINISH
L_028b:
// 2961 ACC=BP; ! ACC TO SIZE OF RECORD
ACC = BP;
// 2962 STAG(TAGDISP,BP)
STAG(TAGDISP, BP);
// 2963 P=P+2
P = ((P)) + ((2));
// 2964 %REPEAT %UNTIL A(P)=2
if (( A[P] ) == ( 2 )) goto L_0287;
goto L_0286;
L_0287:
// 2965 ->BEND
goto U_0206;
// 2966 NONSCALAR: ! OWN AND OWNRECORD ARRAYS
U_0205:
// 2967 !***********************************************************************
// 2968 !* OWN ARRAYS CAN BE INITIALISED BUT ONLY ONE ARRAY CAN BE *
// 2969 !* DECLARED IN A STATEMENT.(THANK HEAVENS!) *
// 2970 !* OWN RECORD ARRAYS ARE CLEARED TO ZERO *
// 2971 !***********************************************************************
// 2972 P=P+1
P = ((P)) + ((1));
// 2973 FORMAT=2-A(P)
FORMAT = ((2)) - ((A[P]));
// 2974 RECIN: PP=P+1; P=P+3; NNAMES=1
U_0207:
PP = ((P)) + ((1));
P = ((P)) + ((3));
NNAMES = 1;
// 2975 K=FROM AR2(PP)
K = FROMAR2(PP);
// 2976 NAMTXT=STRING(DICTBASE+WORD(K))
NAMTXT = *STRING(((DICTBASE)) + ((WORD[K])));
// 2977 %IF TYPE>=3 %THEN BP=ACC %ELSE BP=BYTES(PREC)
if (( TYPE ) < ( 3 )) goto L_0291;
BP = ACC;
goto L_0292;
L_0291:
BP = BYTES[PREC];
L_0292:
// 2978 SACC=ACC; TYPEP=PTYPE
SACC = ACC;
TYPEP = PTYPE;
// 2979 AH4=12+DOPE VECTOR(TYPE,BP,0,K,QQ,LB)
AH4 = ((12)) + ((DOPEVECTOR(TYPE, BP, 0, K, &QQ, &LB)));
// 2980 SNDISP=AH4-12; ! DV DISP (+TOP BIT FLAG)
SNDISP = ((AH4)) - ((12));
// 2981 %IF SNDISP=-1 %THEN SNDISP=0; ! BUM DOPE VECTOR
if (( SNDISP ) != ( (-(1)) )) goto L_0293;
SNDISP = 0;
L_0293:
// 2982 SNDISP=(SNDISP&16_3FFFF)>>2; ! AS WORD DISPLACEMENT
SNDISP = (int)(((unsigned int)(((SNDISP)) & ((262143)))) >> ((2)));
// 2983 DIMEN=J; ! SAVE NO OF DIMENESIONS
DIMEN = J;
// 2984 ACC=SACC; PTYPE=TYPEP; UNPACK
ACC = SACC;
PTYPE = TYPEP;
UNPACK();
// 2985 %IF LB=0 %AND J=1 %AND TYPE<=3 %THEN ARR=2 %AND PACK (PTYPE)
if (( LB ) != ( 0 )) goto L_0294;
if (( J ) != ( 1 )) goto L_0294;
if (( TYPE ) > ( 3 )) goto L_0294;
ARR = 2;
PACK( &PTYPE);
L_0294:
// 2986 LENGTH=QQ//BP; ! NO OF ELEMENTS
LENGTH = ((int)(QQ)) / ((int)(BP));
// 2987 SPOINT=STPTR
SPOINT = STPTR;
// 2988 %IF MODE#3 %AND FORMAT=0 %THEN %START; ! NOT A RECORD ARRAY
if (( MODE ) == ( 3 )) goto L_0295;
if (( FORMAT ) != ( 0 )) goto L_0295;
// 2989 %IF A(P)=1 %THEN P=P+1 %AND INIT SPACE(QQ,LENGTH)
if (( A[P] ) != ( 1 )) goto L_0296;
P = ((P)) + ((1));
INITSPACE(QQ, LENGTH);
L_0296:
// 2990 %FINISH
L_0295:
// 2991 %IF CONSTS FOUND=0 %THEN %START;! NO CONSTANTS GIVEN
if (( CONSTSFOUND ) != ( 0 )) goto L_0297;
// 2992 ! SO CLEAR AN AREA TO ZERO
// 2993 CONSTS FOUND=LENGTH
CONSTSFOUND = LENGTH;
// 2994 CLEAR(QQ) %UNLESS LENGTH<1 %OR EXTRN=3 %OR FORMAT#0
if (( LENGTH ) < ( 1 )) goto L_0298;
if (( EXTRN ) == ( 3 )) goto L_0298;
if (( FORMAT ) != ( 0 )) goto L_0298;
CLEAR(QQ);
L_0298:
// 2995 %FINISH %ELSE %START
goto L_0299;
L_0297:
// 2996 FAULT2(49,0,K) %IF EXTRN=3 %OR FORMAT#0
if (( EXTRN ) == ( 3 )) goto L_0270;
if (( FORMAT ) == ( 0 )) goto L_029a;
L_0270:
FAULT2(49, 0, K);
L_029a:
// 2997 %FINISH
L_0299:
// 2998 %IF EXTRN=3 %THEN EPDISP=0 %ELSE EPDISP=SPOINT
if (( EXTRN ) != ( 3 )) goto L_029b;
EPDISP = 0;
goto L_029c;
L_029b:
EPDISP = SPOINT;
L_029c:
// 2999 !
// 3000 ! OUTPUT AN ARRAYHEAD INTO THE GLA RELATIVE TO THE START OF THE SYMBOL-
// 3001 ! TABLES IN WHICH THE ARRAY RESIDES.
// 3002 !
// 3003 J=DIMEN; ! RESET DIMENSIONS AFTER INITTING
J = DIMEN;
// 3004 %IF TYPE<=2 %THEN AH1=PREC<<27!LENGTH %ELSE AH1=3<<27!1<<25!QQ
if (( TYPE ) > ( 2 )) goto L_029d;
AH1 = ((((PREC)) << ((27)))) | ((LENGTH));
goto L_029e;
L_029d:
AH1 = ((((((3)) << ((27)))) | ((((1)) << ((25)))))) | ((QQ));
L_029e:
// 3005 AH1=AH1!(1-PARMARR)<<24; ! SET BCI IF BASE TO BE SHIFTED
AH1 = ((AH1)) | ((((((1)) - ((PARMARR)))) << ((24))));
// 3006 %IF PREC=4 %THEN AH1=16_58000002
if (( PREC ) != ( 4 )) goto L_029f;
AH1 = 1476395010;
L_029f:
// 3007 AH2=EPDISP
AH2 = EPDISP;
// 3008 AH3=5<<27!3*J; ! DV DESPTR = WORD CHKD
AH3 = ((((5)) << ((27)))) | ((((3)) * ((J))));
// 3009 %IF TYPE<=3 %AND PARMARR=0=FORMAT %AND PARMCHK=0 %AND J=1 %THEN AH2=AH2-BP*LB
if (( TYPE ) > ( 3 )) goto L_02a0;
if (( PARMARR ) != ( 0 )) goto L_02a0;
if (( 0 ) != ( FORMAT )) goto L_02a0;
if (( PARMCHK ) != ( 0 )) goto L_02a0;
if (( J ) != ( 1 )) goto L_02a0;
AH2 = ((AH2)) - ((((BP)) * ((LB))));
L_02a0:
// 3010 PGLA(8,16,ADDR(AH1))
PGLA(8, 16, ADDR( &AH1));
// 3011 TAGDISP=GLACA-16
TAGDISP = ((GLACA)) - ((16));
// 3012 %IF EXTRN=3 %THEN %START; ! EXTRINSIC ARRAYS
if (( EXTRN ) != ( 3 )) goto L_02a1;
// 3013 GXREF(NAMTXT,2,2<<24!QQ,TAGDISP+4); ! RELOCATE ADDR(A(FIRST))
GXREF(NAMTXT, 2, ((((2)) << ((24)))) | ((QQ)), ((TAGDISP)) + ((4)));
// 3014 %FINISH %ELSE %START
goto L_02a2;
L_02a1:
// 3015 RELOCATE(TAGDISP+4,AH2,LPUTP);! RELOCATE ADDR(A(FIRST))
RELOCATE(((TAGDISP)) + ((4)), AH2, LPUTP);
// 3016 %FINISH
L_02a2:
// 3017 RELOCATE(TAGDISP+12,AH4,1); ! RELOCATE DV POINTER
RELOCATE(((TAGDISP)) + ((12)), AH4, 1);
// 3018 AH4=(AH4<<1>>3)!16_80000000
AH4 = (((int)(((unsigned int)(((AH4)) << ((1)))) >> ((3))))) | ((-2147483648));
// 3019 NOTE CREF(AH4!(TAGDISP+12)>>2<<16,(AH4&16_FFFF)<<2)
NOTECREF(((AH4)) | (((((int)(((unsigned int)(((TAGDISP)) + ((12)))) >> ((2))))) << ((16)))), ((((AH4)) & ((65535)))) << ((2)));
// 3020 EPTYPE=5; ! DATA IN GLA SYMBOL TABLES
EPTYPE = 5;
// 3021 STAG(TAGDISP,QQ)
STAG(TAGDISP, QQ);
// 3022 -> BEND
goto U_0206;
// 3023 %ROUTINE INIT SPACE(%INTEGER SIZE,NELS)
void INITSPACE( int SIZE, int NELS )
{
__label__ _imp_endofblock;
// 3024 !***********************************************************************
// 3025 !* P IS TO FIRST ENTRY FOR CONSTLIST *
// 3026 !* MAP SPACE ONTO WORKFILE END TO GIVE SANE ERROR MESSAGE IF *
// 3027 !* THERE WAS NOT ENOUGH SPACE *
// 3028 !***********************************************************************
// 3029 %INTEGER RF,I,K,ELSIZE,AD,SPP,LENGTH,SAVER,WSIZE,WRIT
int RF;
int I;
int K;
int ELSIZE;
int AD;
int SPP;
int LENGTH;
int SAVER;
int WSIZE;
int WRIT;
// 3030 {%BYTEINTEGERARRAYNAME SP
// 3031
// 3032 %IF SIZE>4096 %THEN WSIZE=4096 %ELSE WSIZE=SIZE
if (( SIZE ) <= ( 4096 )) goto L_02a3;
WSIZE = 4096;
goto L_02a4;
L_02a3:
WSIZE = SIZE;
L_02a4:
// 3033 {%BYTEINTEGERARRAYFORMAT SPF(0:WSIZE+256)
// 3034 SAVER=R; R=R+WSIZE+256
SAVER = R;
R = ((((R)) + ((WSIZE)))) + ((256));
// 3035 %IF R>ARSIZE %THEN FAULT(102,0)
if (( R ) <= ( ARSIZE )) goto L_02a5;
FAULT(102, 0);
L_02a5:
// 3036 %byteintegerarray SP(0:WSIZE+256)
unsigned char SP[(((WSIZE)) + ((256)))-(0)+1];
// 3037 {SP==ARRAY(ADDR(A(SAVER)),SPF)
// 3038 %IF TYPE=1 %THEN AD=ADDR(ICONST)+4-ACC
if (( TYPE ) != ( 1 )) goto L_02a6;
AD = ((((ADDR( &ICONST))) + ((4)))) - ((ACC));
L_02a6:
// 3039 %IF TYPE=2 %THEN AD=ADDR(RCONST)
if (( TYPE ) != ( 2 )) goto L_02a7;
AD = ADDR( &RCONST);
L_02a7:
// 3040 %IF TYPE=5 %THEN AD=ADDR(SCONST)
if (( TYPE ) != ( 5 )) goto L_02a8;
AD = ADDR( &SCONST);
L_02a8:
// 3041 SPP=0; WRIT=0
SPP = 0;
WRIT = 0;
// 3042 ELSIZE=SIZE//NELS
ELSIZE = ((int)(SIZE)) / ((int)(NELS));
// 3043 {%UNTIL A(P-1)=2} %CYCLE
L_02a9:
// 3044 XTRACT CONST(TYPE,PREC)
XTRACTCONST(TYPE, PREC);
// 3045 %IF A(P)=1 %START; ! REPITITION FACTOR
if (( A[P] ) != ( 1 )) goto L_02ac;
// 3046 P=P+1
P = ((P)) + ((1));
// 3047 %IF INTEXP(RF)#0 %THEN FAULT(44,CONSTS FOUND) %AND RF=1
if (( INTEXP( &RF) ) == ( 0 )) goto L_02ad;
FAULT(44, CONSTSFOUND);
RF = 1;
L_02ad:
// 3048 P=P+1
P = ((P)) + ((1));
// 3049 %FINISH %ELSE RF=1 %AND P=P+2
goto L_02ae;
L_02ac:
RF = 1;
P = ((P)) + ((2));
L_02ae:
// 3050 FAULT(44,CONSTS FOUND) %IF RF<=0
if (( RF ) > ( 0 )) goto L_02af;
FAULT(44, CONSTSFOUND);
L_02af:
// 3051 %CYCLE I=RF,-1,1
I = ((RF)) - (((-(1))));
L_02b0:
if (( I ) == ( 1 )) goto L_02b1;
I = ((I)) + (((-(1))));
// 3052 %CYCLE K=0,1,ELSIZE-1
K = ((0)) - ((1));
L_02b3:
if (( K ) == ( ((ELSIZE)) - ((1)) )) goto L_02b4;
K = ((K)) + ((1));
// 3053 %IF CONSTS FOUND<=NELS %THEN SP(SPP)=BYTE INTEGER(AD+K) %AND SPP=SPP+1
if (( CONSTSFOUND ) > ( NELS )) goto L_02b6;
SP[SPP] = *BYTEINTEGER(((AD)) + ((K)));
SPP = ((SPP)) + ((1));
L_02b6:
// 3054 %REPEAT
goto L_02b3;
L_02b4:
// 3055 CONSTS FOUND=CONSTS FOUND+1
CONSTSFOUND = ((CONSTSFOUND)) + ((1));
// 3056 %IF SPP>=4096 %START; ! EMPTY BUFFER
if (( SPP ) < ( 4096 )) goto L_02b7;
// 3057 LPUT(LPUTP,SPP,STPTR+WRIT,ADDR(SP(0))) %IF INHCODE=0
if (( INHCODE ) != ( 0 )) goto L_02b8;
LPUT(LPUTP, SPP, ((STPTR)) + ((WRIT)), ADDR( &SP[0]));
L_02b8:
// 3058 WRIT=WRIT+SPP
WRIT = ((WRIT)) + ((SPP));
// 3059 SPP=0
SPP = 0;
// 3060 %FINISH
L_02b7:
// 3061 %REPEAT
goto L_02b0;
L_02b1:
// 3062 %REPEAT %UNTIL A(P-1)=2; ! UNTIL P<ROCL>=%NULL
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_02aa;
goto L_02a9;
L_02aa:
// 3063 %IF CONSTS FOUND#NELS %THEN FAULT(45,CONSTS FOUND)
if (( CONSTSFOUND ) == ( NELS )) goto L_02b9;
FAULT(45, CONSTSFOUND);
L_02b9:
// 3064 STPTR=(STPTR+3)&(-4)
STPTR = ((((STPTR)) + ((3)))) & (((-(4))));
// 3065 LENGTH=(SIZE+3)&(-4)
LENGTH = ((((SIZE)) + ((3)))) & (((-(4))));
// 3066 LPUT(LPUTP,LENGTH-WRIT,STPTR+WRIT,ADDR(SP(0))) %IF INHCODE=0
if (( INHCODE ) != ( 0 )) goto L_02ba;
LPUT(LPUTP, ((LENGTH)) - ((WRIT)), ((STPTR)) + ((WRIT)), ADDR( &SP[0]));
L_02ba:
// 3067 STPTR=STPTR+LENGTH
STPTR = ((STPTR)) + ((LENGTH));
// 3068 R=SAVER
R = SAVER;
// 3069 %END
return;
_imp_endofblock: ;
} // End of block INITSPACE at level 6
// 3070 %ROUTINE CLEAR(%INTEGER LENGTH)
void CLEAR( int LENGTH )
{
__label__ _imp_endofblock;
// 3071 STPTR=(STPTR+3)&(-4)
STPTR = ((((STPTR)) + ((3)))) & (((-(4))));
// 3072 LENGTH=(LENGTH+3)&(-4)
LENGTH = ((((LENGTH)) + ((3)))) & (((-(4))));
// 3073 LPUT(LPUTP,LENGTH,STPTR,0)%IF INHCODE=0
if (( INHCODE ) != ( 0 )) goto L_02bb;
LPUT(LPUTP, LENGTH, *STPTR, 0);
L_02bb:
// 3074 STPTR=STPTR+LENGTH
STPTR = ((STPTR)) + ((LENGTH));
// 3075 %END
return;
_imp_endofblock: ;
} // End of block CLEAR at level 6
// 3076 %ROUTINE STAG(%INTEGER J,DATALEN)
void STAG( int J, int DATALEN )
{
__label__ _imp_endofblock;
// 3077 %IF EXTRN=2 %THEN LPUT(14,EPTYPE<<24!DATALEN,EPDISP,ADDR(NAMTXT))
if (( EXTRN ) != ( 2 )) goto L_02bc;
LPUT(14, ((((EPTYPE)) << ((24)))) | ((DATALEN)), EPDISP, ADDR( &NAMTXT));
L_02bc:
// 3078 RBASE=CBASE
RBASE = CBASE;
// 3079 STORE TAG(K,J)
STORETAG(K, J);
// 3080 RBASE=RLEVEL
RBASE = RLEVEL;
// 3081 %END
return;
_imp_endofblock: ;
} // End of block STAG at level 6
// 3082 %ROUTINE XTRACT CONST(%INTEGER CONTYPE,CONPREC)
void XTRACTCONST( int CONTYPE, int CONPREC )
{
__label__ _imp_endofblock;
// 3083 !***********************************************************************
// 3084 !* P POINTS TO P<+'> OF <+'><OPERNAD><RESTOFEXPR> AND IS UPDATED*
// 3085 !* THE CONST IS CONVERTED TO REQUIRED FORM AND IF INTEGER *
// 3086 !* IS LEFT IN ICONST, IF REAL IN RCONST AND IF STRING IN SCONST *
// 3087 !***********************************************************************
// 3088 %INTEGER LENGTH,STYPE,SPREC,SACC,CPREC,MODE,I
int LENGTH;
int STYPE;
int SPREC;
int SACC;
int CPREC;
int MODE;
int I;
// 3089 STYPE=PTYPE; SACC=ACC;! MAY BE CHANGED IF CONST IS EXPR
STYPE = PTYPE;
SACC = ACC;
// 3090 %IF CONTYPE=5 %THEN %START
if (( CONTYPE ) != ( 5 )) goto L_02bd;
// 3091 CTYPE=5
CTYPE = 5;
// 3092 %IF A(P)=4 %AND A(P+1)=2 %AND A(P+2)=16_35 %AND A(P+A(P+7)+8)=2 %START
if (( A[P] ) != ( 4 )) goto L_02be;
if (( A[((P)) + ((1))] ) != ( 2 )) goto L_02be;
if (( A[((P)) + ((2))] ) != ( 53 )) goto L_02be;
if (( A[((((P)) + ((A[((P)) + ((7))])))) + ((8))] ) != ( 2 )) goto L_02be;
// 3093 SCONST=STRING(ADDR(A(P+7)))
SCONST = *STRING(ADDR( &A[((P)) + ((7))]));
// 3094 LENGTH=A(P+7)
LENGTH = A[((P)) + ((7))];
// 3095 P=P+A(P+7)+9
P = ((((P)) + ((A[((P)) + ((7))])))) + ((9));
// 3096 %FINISH %ELSE %START
goto L_02bf;
L_02be:
// 3097 FAULT(44,CONSTS FOUND); SCONST=""
FAULT(44, CONSTSFOUND);
SCONST = _imp_str_literal("");
// 3098 LENGTH=0; P=P-3; SKIP EXP
LENGTH = 0;
P = ((P)) - ((3));
SKIPEXP();
// 3099 %FINISH
L_02bf:
// 3100 %FINISH %ELSE %START
goto L_02c0;
L_02bd:
// 3101 MODE=CONPREC<<4!CONTYPE
MODE = ((((CONPREC)) << ((4)))) | ((CONTYPE));
// 3102 %IF CONPREC<5 %THEN MODE=CONTYPE!16_50
if (( CONPREC ) >= ( 5 )) goto L_02c1;
MODE = ((CONTYPE)) | ((80));
L_02c1:
// 3103 CONSTP=CONSTEXP(MODE)
CONSTP = CONSTEXP(MODE);
// 3104 %IF CONSTP=0 %THEN FAULT(41,0) %AND CONSTP=ADDR(ZERO);! CANT EVALUATE EXPT
if (( CONSTP ) != ( 0 )) goto L_02c2;
FAULT(41, 0);
CONSTP = ADDR( &ZERO);
L_02c2:
// 3105 CTYPE=TYPE; CPREC=PREC
CTYPE = TYPE;
CPREC = PREC;
// 3106 %IF CTYPE=1 %THEN %START
if (( CTYPE ) != ( 1 )) goto L_02c3;
// 3107 ICONST=INTEGER(CONSTP)
ICONST = *INTEGER(CONSTP);
// 3108 %IF CONPREC=6 %THEN UICONST=ICONST %AND ICONST=INTEGER(CONSTP+4)
if (( CONPREC ) != ( 6 )) goto L_02c4;
UICONST = ICONST;
ICONST = *INTEGER(((CONSTP)) + ((4)));
L_02c4:
// 3109 %FINISH %ELSE %START
goto L_02c5;
L_02c3:
// 3110 RCONST=LONGREAL(CONSTP)
RCONST = *LONGREAL(CONSTP);
// 3111 %IF CONPREC=7 %THEN %START;! LONGLONGS UNALIGNED IN AR
if (( CONPREC ) != ( 7 )) goto L_02c6;
// 3112 %CYCLE I=0,1,15
I = ((0)) - ((1));
L_02c7:
if (( I ) == ( 15 )) goto L_02c8;
I = ((I)) + ((1));
// 3113 BYTEINTEGER(ADDR(RCONST)+I)=BYTEINTEGER(CONSTP+I)
*BYTEINTEGER(((ADDR( &RCONST))) + ((I))) = *BYTEINTEGER(((CONSTP)) + ((I)));
// 3114 %REPEAT
goto L_02c7;
L_02c8:
// 3115 %FINISH
L_02c6:
// 3116 %FINISH
L_02c5:
// 3117 %FINISH
L_02c0:
// 3118 PTYPE=STYPE; UNPACK; ACC=SACC
PTYPE = STYPE;
UNPACK();
ACC = SACC;
// 3119 !
// 3120 ! FAULT ANY OBVIOUS ERRORS IE:-
// 3121 ! CONSTANT FOR EXTRINSIC OR INCOMPATIBLE TYPE OR STRING TOO LONG
// 3122 !
// 3123 %IF EXTRN=3 %OR (CTYPE=5 %AND LENGTH>=ACC) %OR (CONTYPE=1 %AND ((CONPREC=3 %AND ICONST>255) %OR (CONPREC=4 %AND ICONST>16_FFFF))) %THEN FAULT(44,CONSTS FOUND)
if (( EXTRN ) == ( 3 )) goto L_02ab;
if (( CTYPE ) != ( 5 )) goto L_02ca;
if (( LENGTH ) >= ( ACC )) goto L_02ab;
L_02ca:
if (( CONTYPE ) != ( 1 )) goto L_02cb;
if (( CONPREC ) != ( 3 )) goto L_02cc;
if (( ICONST ) > ( 255 )) goto L_02ab;
L_02cc:
if (( CONPREC ) != ( 4 )) goto L_02cb;
if (( ICONST ) <= ( 65535 )) goto L_02cb;
L_02ab:
FAULT(44, CONSTSFOUND);
L_02cb:
// 3124 %END
return;
_imp_endofblock: ;
} // End of block XTRACTCONST at level 6
// 3125 BEND: %END; ->CSSEXIT
U_0206:
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_10_LEVEL_4_ at level 5
goto U_01d5;
// 3126 SW(18):
SW_18:
// 3127 ABORT
ABORT();
// 3128 SW(10):
SW_10:
// 3129 %BEGIN; ! %RECORD (RDECLN)
{
__label__ _imp_endofblock;
// 3130 !***********************************************************************
// 3131 !* RECORDS ARE ALLOCATED AT COMPILE TIME WHEN POSSIBLE *
// 3132 !* SEE CRFORMAT FOR ACTION ON RECORD FORMAT DECLARATIONS *
// 3133 !***********************************************************************
// 3134 %INTEGER MODE,RECL,ALLOC,FNAM,FINF,NAME,OPHEAD
int MODE;
int RECL;
int ALLOC;
int FNAM;
int FINF;
int NAME;
int OPHEAD;
// 3135 P=P+1; MODE=A(P); SNDISP=0
P = ((P)) + ((1));
MODE = A[P];
SNDISP = 0;
// 3136 %IF MODE=1 %THEN %START; ! DEAL WITH FORMAT
if (( MODE ) != ( 1 )) goto L_02cd;
// 3137 NAME=FROM AR2(P+1); P=P+3
NAME = FROMAR2(((P)) + ((1)));
P = ((P)) + ((3));
// 3138 CRFORMAT(OPHEAD); K=NAME
CRFORMAT( &OPHEAD);
K = NAME;
// 3139 PTYPE=4; J=0
PTYPE = 4;
J = 0;
// 3140 KFORM=OPHEAD
KFORM = OPHEAD;
// 3141 STORE TAG(K,OPHEAD)
STORETAG(K, OPHEAD);
// 3142 ->BEND
goto U_01df;
// 3143 %FINISH
L_02cd:
// 3144 P=P+1; MARKER=P+FROM AR2(P)
P = ((P)) + ((1));
MARKER = ((P)) + ((FROMAR2(P)));
// 3145 FNAM=FROM AR2(MARKER); ! FORMAT NAME
FNAM = FROMAR2(MARKER);
// 3146 COPY TAG(FNAM)
COPYTAG(FNAM);
// 3147 FINF=TCELL
FINF = TCELL;
// 3148 %IF TYPE#4 %THEN %START
if (( TYPE ) == ( 4 )) goto L_02ce;
// 3149 FINF=DUMMY FORMAT
FINF = DUMMYFORMAT;
// 3150 ACC=4; FAULT(62,FNAM)
ACC = 4;
FAULT(62, FNAM);
// 3151 %FINISH
L_02ce:
// 3152 RECL=ACC
RECL = ACC;
// 3153 %IF MODE=2%THEN %START; ! '%RECORDSPEC'
if (( MODE ) != ( 2 )) goto L_02cf;
// 3154 COPY TAG(FROM AR2(P+2))
COPYTAG(FROMAR2(((P)) + ((2))));
// 3155 %IF A(P+4)=1 %AND TYPE=4 %START;! SPEC FOR FORMAT ELEMENT
if (( A[((P)) + ((4))] ) != ( 1 )) goto L_02d0;
if (( TYPE ) != ( 4 )) goto L_02d0;
// 3156 P=P+5
P = ((P)) + ((5));
// 3157 Q=DISPLACEMENT(TCELL)
Q = DISPLACEMENT(TCELL);
// 3158 UNPACK
UNPACK();
// 3159 %FINISH
L_02d0:
// 3160 %IF TYPE=3 %AND NAM=1 %AND FROM3(TCELL)&16_FFFF=0 %START
if (( TYPE ) != ( 3 )) goto L_02d1;
if (( NAM ) != ( 1 )) goto L_02d1;
if (( ((FROM3(TCELL))) & ((65535)) ) != ( 0 )) goto L_02d1;
// 3161 REPLACE3(TCELL,FINF!K<<16)
REPLACE3(TCELL, ((FINF)) | ((((K)) << ((16)))));
// 3162 REPLACE2(TCELL,SNDISP<<16!RECL)
REPLACE2(TCELL, ((((SNDISP)) << ((16)))) | ((RECL)));
// 3163 %FINISH %ELSE FAULT(63,0)
goto L_02d2;
L_02d1:
FAULT(63, 0);
L_02d2:
// 3164 %FINISH %ELSE %START; ! RECORD DECLARATION
goto L_02d3;
L_02cf:
// 3165 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_02d4;
FAULT(57, 0);
L_02d4:
// 3166 FAULT(40,0) %IF NMDECS(LEVEL)&1#0
if (( ((NMDECS[LEVEL])) & ((1)) ) == ( 0 )) goto L_02d5;
FAULT(40, 0);
L_02d5:
// 3167 TYPE=3; PREC=3; ROUT=0
TYPE = 3;
PREC = 3;
ROUT = 0;
// 3168 %IF A(P+2)=1 %THEN %START; ! SIMPLE RECORD AND RECORDNAMES
if (( A[((P)) + ((2))] ) != ( 1 )) goto L_02d6;
// 3169 ALLOC=ACC; CQN(P+3)
ALLOC = ACC;
CQN(((P)) + ((3)));
// 3170 ACC=ALLOC; P=P+4
ACC = ALLOC;
P = ((P)) + ((4));
// 3171 DECLARE SCALARS(1,FINF)
DECLARESCALARS(1, FINF);
// 3172 %FINISH %ELSE %START; ! ARRAYS OF RECORDS
goto L_02d7;
L_02d6:
// 3173 NAM=0
NAM = 0;
// 3174 Q=2-A(P+3); P=P+4; ! Q=1 FOR ARRAY FORMAT
Q = ((2)) - ((A[((P)) + ((3))]));
P = ((P)) + ((4));
// 3175 SET LINE
SETLINE();
// 3176 DECLARE ARRAYS(Q,FINF)
DECLAREARRAYS(Q, FINF);
// 3177 %FINISH
L_02d7:
// 3178 %FINISH
L_02d3:
// 3179 BEND: %END;->CSSEXIT
U_01df:
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_11_LEVEL_4_ at level 5
goto U_01d5;
// 3180 !
// 3181 SW(19):
SW_19:
// 3182 ! '*' (UCI) (S)
// 3183 FAULT(57,0) %UNLESS LEVEL>=2
if (( LEVEL ) >= ( 2 )) goto L_02d8;
FAULT(57, 0);
L_02d8:
// 3184 %BEGIN
{
__label__ _imp_endofblock;
// 3185 %ROUTINESPEC CIND
auto void CIND( void );
// 3186 %INTEGER FNAME,ALT,OPCODE,FORM,H,Q,MASK,FILLER
int FNAME;
int ALT;
int OPCODE;
int FORM;
int H;
int Q;
int MASK;
int FILLER;
// 3187 %SWITCH SW(1:5),F(1:3),POP(1:6),TOP(1:4)
static int SW_idx;
static const void * /*SWITCH*/ SW[(5)-(1)+1] = { &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, };
static int F_idx;
static const void * /*SWITCH*/ F[(3)-(1)+1] = { &&F_1, &&F_2, &&F_3, };
static int POP_idx;
static const void * /*SWITCH*/ POP[(6)-(1)+1] = { &&POP_1, &&POP_2, &&POP_3, &&POP_4, &&POP_5, &&POP_6, };
static int TOP_idx;
static const void * /*SWITCH*/ TOP[(4)-(1)+1] = { &&TOP_1, &&TOP_2, &&TOP_3, &&TOP_4, };
// 3188 ALT=A(P+1); P=P+2
ALT = A[((P)) + ((1))];
P = ((P)) + ((2));
// 3189 OPCODE=CALL
OPCODE = 30;
// 3190 ->SW(ALT)
goto *(SW-1)[ALT]; /* Bounds=1:5 */
// 3191 SW(1):SW(2):
SW_1:
SW_2:
// 3192 FNAME=FROM AR2(P)
FNAME = FROMAR2(P);
// 3193 COPY TAG(FNAME)
COPYTAG(FNAME);
// 3194 FAULT(33,FNAME) %UNLESS ROUT=NAM=0 %AND ARR=0 %AND PREC>4 %AND I=RBASE %AND TYPE#7
if (( ROUT ) != ( NAM )) goto L_02d9;
if (( NAM ) != ( 0 )) goto L_02d9;
if (( ARR ) != ( 0 )) goto L_02d9;
if (( PREC ) <= ( 4 )) goto L_02d9;
if (( I ) != ( RBASE )) goto L_02d9;
if (( TYPE ) != ( 7 )) goto L_02da;
L_02d9:
FAULT(33, FNAME);
L_02da:
// 3195 %IF ALT=1 %THEN PSF1(ST,1,K) %ELSE GET IN ACC(ACCR,BYTES(PREC)>>2,0,LNB,K)
if (( ALT ) != ( 1 )) goto L_02db;
PSF1(72, 1, K);
goto L_02dc;
L_02db:
GETINACC(0, (int)(((unsigned int)(BYTES[PREC])) >> ((2))), 0, 2, K);
L_02dc:
// 3196 ->EXIT
goto U_01e5;
// 3197 SW(3): ! PUT (HEX HALFWORD)
SW_3:
// 3198 TYPE=A(P)
TYPE = A[P];
// 3199 PREC=TYPE>>4; TYPE=TYPE&7
PREC = (int)(((unsigned int)(TYPE)) >> ((4)));
TYPE = ((TYPE)) & ((7));
// 3200 FAULT(32,0) %UNLESS TYPE=1 %AND PREC<6
if (( TYPE ) != ( 1 )) goto L_02dd;
if (( PREC ) < ( 6 )) goto L_02de;
L_02dd:
FAULT(32, 0);
L_02de:
// 3201 %IF PREC=5 %THEN P=P+2
if (( PREC ) != ( 5 )) goto L_02df;
P = ((P)) + ((2));
L_02df:
// 3202 PLANT(FROM AR2(P+1))
PLANT(FROMAR2(((P)) + ((1))));
// 3203 ->EXIT
goto U_01e5;
// 3204 SW(5): ! CNOP
SW_5:
// 3205 CNOP(A(P),A(P+1))
CNOP(A[P], A[((P)) + ((1))]);
// 3206 ->EXIT
goto U_01e5;
// 3207 SW(4): ! ASSEMBLER
SW_4:
// 3208 FORM=A(P); ! FORM=PRIMARY,SECONDARY OR 3RY
FORM = A[P];
// 3209 OPCODE=A(P+1)
OPCODE = A[((P)) + ((1))];
// 3210 P=P+2; ->F(FORM)
P = ((P)) + ((2));
goto *(F-1)[FORM]; /* Bounds=1:3 */
// 3211 F(1): ! ALL PRIMARY FORMAT INSTRUCTIONS
F_1:
// 3212 ALT=A(P); P=P+1
ALT = A[P];
P = ((P)) + ((1));
// 3213 ->POP(ALT)
goto *(POP-1)[ALT]; /* Bounds=1:6 */
// 3214 POP(1): ! LABELNAME
POP_1:
// 3215 FNAME=FROM AR2(P); P=P+2
FNAME = FROMAR2(P);
P = ((P)) + ((2));
// 3216 ENTER JUMP(OPCODE<<24!3<<23,FNAME,0)
ENTERJUMP(((((OPCODE)) << ((24)))) | ((((3)) << ((23)))), FNAME, 0);
// 3217 ->EXIT
goto U_01e5;
// 3218 POP(2): ! DIRECT SYMBOLIC
POP_2:
// 3219 CIND
CIND();
// 3220 POPI: PSORLF1(OPCODE,ACCESS,AREA,DISP)
U_01e6:
PSORLF1(OPCODE, ACCESS, AREA, DISP);
// 3221 ->EXIT
goto U_01e5;
// 3222 POP(3): ! INDIRECT SYMBOLIC
POP_3:
// 3223 CIND
CIND();
// 3224 ACCESS=4-A(P); P=P+1
ACCESS = ((4)) - ((A[P]));
P = ((P)) + ((1));
// 3225 ->POPI
goto U_01e6;
// 3226 POP(4): ! DR SYMBOLICALLY MODIFIED
POP_4:
// 3227 CIND; ACCESS=1; ->POPI
CIND();
ACCESS = 1;
goto U_01e6;
// 3228 POP(5): ! (DR) & (DR+B)
POP_5:
// 3229 ACCESS=4-A(P); AREA=7
ACCESS = ((4)) - ((A[P]));
AREA = 7;
// 3230 DISP=0; P=P+1
DISP = 0;
P = ((P)) + ((1));
// 3231 ->POPI
goto U_01e6;
// 3232 POP(6): ! B
POP_6:
// 3233 ACCESS=0
ACCESS = 0;
// 3234 AREA=7; DISP=0; ->POPI
AREA = 7;
DISP = 0;
goto U_01e6;
// 3235 F(2): ! SECONDARY (STORE-TO STORE)FORMAT
F_2:
// 3236 MASK=0; FILLER=0; Q=0; FNAME=0
MASK = 0;
FILLER = 0;
Q = 0;
FNAME = 0;
// 3237 H=2-A(P)
H = ((2)) - ((A[P]));
// 3238 %IF H=0 %THEN FNAME=FROM AR2(P+1)-1 %AND P=P+2
if (( H ) != ( 0 )) goto L_02e0;
FNAME = ((FROMAR2(((P)) + ((1))))) - ((1));
P = ((P)) + ((2));
L_02e0:
// 3239 FAULT(32,0) %UNLESS 0<=FNAME<=127
if (( 0 ) > ( FNAME )) goto L_02e1;
if (( FNAME ) <= ( 127 )) goto L_02e2;
L_02e1:
FAULT(32, 0);
L_02e2:
// 3240 ALT=A(P+1); P=P+2
ALT = A[((P)) + ((1))];
P = ((P)) + ((2));
// 3241 %IF ALT=1 %THEN %START
if (( ALT ) != ( 1 )) goto L_02e3;
// 3242 Q=1
Q = 1;
// 3243 MASK=FROM AR2(P)
MASK = FROMAR2(P);
// 3244 FILLER=FROM AR2(P+2)
FILLER = FROMAR2(((P)) + ((2)));
// 3245 P=P+4
P = ((P)) + ((4));
// 3246 FAULT(32,0) %UNLESS 0<=MASK!FILLER<=255
if (( 0 ) > ( ((MASK)) | ((FILLER)) )) goto L_02b2;
if (( ((MASK)) | ((FILLER)) ) <= ( 255 )) goto L_02e4;
L_02b2:
FAULT(32, 0);
L_02e4:
// 3247 %FINISH
L_02e3:
// 3248 PF2(OPCODE,H,Q,FNAME,MASK,FILLER)
PF2(OPCODE, H, Q, FNAME, MASK, FILLER);
// 3249 ->EXIT
goto U_01e5;
// 3250 F(3): ! TERTIARY FORMAT
F_3:
// 3251 MASK=FROM AR2(P)
MASK = FROMAR2(P);
// 3252 ALT=A(P+2)
ALT = A[((P)) + ((2))];
// 3253 FAULT(32,0) %UNLESS 0<=MASK<=15
if (( 0 ) > ( MASK )) goto L_02e5;
if (( MASK ) <= ( 15 )) goto L_02e6;
L_02e5:
FAULT(32, 0);
L_02e6:
// 3254 P=P+3; ->TOP(ALT)
P = ((P)) + ((3));
goto *(TOP-1)[ALT]; /* Bounds=1:4 */
// 3255 TOP(1): ! LABEL
TOP_1:
// 3256 FNAME=FROM AR2(P); P=P+2
FNAME = FROMAR2(P);
P = ((P)) + ((2));
// 3257 ENTER JUMP(OPCODE<<24!MASK<<21,FNAME,0)
ENTERJUMP(((((OPCODE)) << ((24)))) | ((((MASK)) << ((21)))), FNAME, 0);
// 3258 ->EXIT
goto U_01e5;
// 3259 TOP(2): ! SYMBOLIC OPERAND
TOP_2:
// 3260 CIND
CIND();
// 3261 FAULT(32,0) %IF AREA>=6
if (( AREA ) < ( 6 )) goto L_02e7;
FAULT(32, 0);
L_02e7:
// 3262 %IF AREA=LNB %OR AREA=XNB %OR AREA=CTB %THEN DISP=DISP//4
if (( AREA ) == ( 2 )) goto L_02e8;
if (( AREA ) == ( 3 )) goto L_02e8;
if (( AREA ) != ( 5 )) goto L_02e9;
L_02e8:
DISP = ((int)(DISP)) / ((int)(4));
L_02e9:
// 3263 TOPI: PF3(OPCODE,MASK,AREA,DISP)
U_01e7:
PF3(OPCODE, MASK, AREA, DISP);
// 3264 ->EXIT
goto U_01e5;
// 3265 TOP(3): ! (DR) & (DR+B)
TOP_3:
// 3266 DISP=0; AREA=8-A(P)
DISP = 0;
AREA = ((8)) - ((A[P]));
// 3267 P=P+1; ->TOPI
P = ((P)) + ((1));
goto U_01e7;
// 3268 TOP(4): ! (DR+N)
TOP_4:
// 3269 DISP=FROM AR2(P); P=P+2
DISP = FROMAR2(P);
P = ((P)) + ((2));
// 3270 AREA=1; ->TOPI
AREA = 1;
goto U_01e7;
// 3271 %ROUTINE CIND
void CIND( void )
{
__label__ _imp_endofblock;
// 3272 !***********************************************************************
// 3273 !* COMPILE A SYMBOLIC OPERAND BY SETTING ACCESS,AREA &DISP *
// 3274 !***********************************************************************
// 3275 %INTEGER ALT,AFN,FN0,FN1,FN2,FN3,JJ,D,CTYPE,CPREC
int ALT;
int AFN;
int FN0;
int FN1;
int FN2;
int FN3;
int JJ;
int D;
int CTYPE;
int CPREC;
// 3276 %SWITCH SW(1:4)
static int SW_idx;
static const void * /*SWITCH*/ SW[(4)-(1)+1] = { &&SW_1, &&SW_2, &&SW_3, &&SW_4, };
// 3277 AFN=ADDR(FN0)
AFN = ADDR( &FN0);
// 3278 ALT=A(P); ACCESS=0
ALT = A[P];
ACCESS = 0;
// 3279 P=P+1; ->SW(ALT)
P = ((P)) + ((1));
goto *(SW-1)[ALT]; /* Bounds=1:4 */
// 3280 SW(1): ! (=')(PLUS')(ICONST)
SW_1:
// 3281 P=P+1; ! PAST (=')
P = ((P)) + ((1));
// 3282 D=A(P); CTYPE=A(P+1)
D = A[P];
CTYPE = A[((P)) + ((1))];
// 3283 CPREC=CTYPE>>4; CTYPE=CTYPE&7
CPREC = (int)(((unsigned int)(CTYPE)) >> ((4)));
CTYPE = ((CTYPE)) & ((7));
// 3284 %IF CPREC=4 %THEN FN0=FROM AR2(P+2) %ELSE %START
if (( CPREC ) != ( 4 )) goto L_02ea;
FN0 = FROMAR2(((P)) + ((2)));
goto L_02eb;
L_02ea:
// 3285 %CYCLE JJ=0,1,BYTES(CPREC)-1
JJ = ((0)) - ((1));
L_02ec:
if (( JJ ) == ( ((BYTES[CPREC])) - ((1)) )) goto L_02ed;
JJ = ((JJ)) + ((1));
// 3286 BYTEINTEGER(AFN+JJ)=A(P+JJ+2)
*BYTEINTEGER(((AFN)) + ((JJ))) = A[((((P)) + ((JJ)))) + ((2))];
// 3287 %REPEAT
goto L_02ec;
L_02ed:
// 3288 %FINISH
L_02eb:
// 3289 P=P+2+BYTES(CPREC)
P = ((((P)) + ((2)))) + ((BYTES[CPREC]));
// 3290 %IF D=2 %THEN %START
if (( D ) != ( 2 )) goto L_02ef;
// 3291 %IF CTYPE=2 %THEN FN0=FN0!!16_80000000 %ELSE %START
if (( CTYPE ) != ( 2 )) goto L_02f0;
FN0 = ((FN0)) ^ ((-2147483648));
goto L_02f1;
L_02f0:
// 3292 %IF CPREC=6 %THEN LONGINTEGER(AFN)=-LONGINTEGER(AFN) %ELSE FN0=-FN0
if (( CPREC ) != ( 6 )) goto L_02f2;
*LONGINTEGER(AFN) = (-(*LONGINTEGER(AFN)));
goto L_02f3;
L_02f2:
FN0 = (-(FN0));
L_02f3:
// 3293 %FINISH
L_02f1:
// 3294 %FINISH
L_02ef:
// 3295 CNST: ->LIT %UNLESS CTYPE=1 %AND CPREC<=5 %AND 16_FFFE0000<=FN0<=16_1FFFF
U_01f3:
if (( CTYPE ) != ( 1 )) goto L_02f4;
if (( CPREC ) > ( 5 )) goto L_02f4;
if (( -131072 ) > ( FN0 )) goto L_02f4;
if (( FN0 ) <= ( 131071 )) goto L_02f5;
L_02f4:
goto U_01f4;
L_02f5:
// 3296 AREA=0; DISP=FN0
AREA = 0;
DISP = FN0;
// 3297 %RETURN
return;
// 3298 LIT: FAULT(32,0) %UNLESS 1<=CTYPE<=2 %AND 5<=CPREC<=7
U_01f4:
if (( 1 ) > ( CTYPE )) goto L_02f6;
if (( CTYPE ) > ( 2 )) goto L_02f6;
if (( 5 ) > ( CPREC )) goto L_02f6;
if (( CPREC ) <= ( 7 )) goto L_02f7;
L_02f6:
FAULT(32, 0);
L_02f7:
// 3299 STORE CONST(DISP,BYTES(CPREC),AFN)
STORECONST( &DISP, BYTES[CPREC], AFN);
// 3300 AREA=PC; ACCESS=0
AREA = 4;
ACCESS = 0;
// 3301 %RETURN
return;
// 3302 SW(2): ! (NAME)(OPTINC)
SW_2:
// 3303 FN0=FROM AR2(P); P=P+2
FN0 = FROMAR2(P);
P = ((P)) + ((2));
// 3304 COPY TAG(FN0)
COPYTAG(FN0);
// 3305 %IF (LITL=1 %AND ARR=0) %START
if (( LITL ) != ( 1 )) goto L_02f8;
if (( ARR ) != ( 0 )) goto L_02f8;
// 3306 CTYPE=TYPE; CPREC=PREC
CTYPE = TYPE;
CPREC = PREC;
// 3307 ALT=TAGS(FN0)
ALT = TAGS[FN0];
// 3308 FROM123(ALT,D,FN0,FN1)
FROM123(ALT, &D, &FN0, &FN1);
// 3309 %IF CPREC=7 %THEN AFN=FN1
if (( CPREC ) != ( 7 )) goto L_02f9;
AFN = FN1;
L_02f9:
// 3310 ->CNST
goto U_01f3;
// 3311 %FINISH
L_02f8:
// 3312 %IF TYPE>=6 %OR TYPE=4 %OR (ROUT=1 %AND NAM=0) %THEN FAULT(33,FN0) %AND %RETURN
if (( TYPE ) >= ( 6 )) goto L_02fa;
if (( TYPE ) == ( 4 )) goto L_02fa;
if (( ROUT ) != ( 1 )) goto L_02fb;
if (( NAM ) != ( 0 )) goto L_02fb;
L_02fa:
FAULT(33, FN0);
return;
L_02fb:
// 3313 %IF ROUT=1 %THEN K=FROM1(K)
if (( ROUT ) != ( 1 )) goto L_02fc;
K = FROM1(K);
L_02fc:
// 3314 AREA=LNB
AREA = 2;
// 3315 %IF I#RBASE %THEN AREA=SET XORYNB(XNB,I)
if (( I ) == ( RBASE )) goto L_02fd;
AREA = SETXORYNB(3, I);
L_02fd:
// 3316 ALT=A(P); D=FROM AR2(P+1)
ALT = A[P];
D = FROMAR2(((P)) + ((1)));
// 3317 %IF ALT=1 %THEN K=K+D
if (( ALT ) != ( 1 )) goto L_02fe;
K = ((K)) + ((D));
L_02fe:
// 3318 %IF ALT=2 %THEN K=K-D
if (( ALT ) != ( 2 )) goto L_02ff;
K = ((K)) - ((D));
L_02ff:
// 3319 P=P+1; P=P+2 %IF ALT<=2
P = ((P)) + ((1));
if (( ALT ) > ( 2 )) goto L_0300;
P = ((P)) + ((2));
L_0300:
// 3320 DISP=K; %RETURN
DISP = K;
return;
// 3321 SW(3): ! '('(REG)(OPTINC)')'
SW_3:
// 3322 AREA=A(P)+1; ALT=A(P+1); P=P+2
AREA = ((A[P])) + ((1));
ALT = A[((P)) + ((1))];
P = ((P)) + ((2));
// 3323 DISP=0
DISP = 0;
// 3324 D=FROM AR2(P)
D = FROMAR2(P);
// 3325 %IF ALT=1 %THEN DISP=D
if (( ALT ) != ( 1 )) goto L_0301;
DISP = D;
L_0301:
// 3326 %IF ALT=2 %THEN FAULT(32,0)
if (( ALT ) != ( 2 )) goto L_0302;
FAULT(32, 0);
L_0302:
// 3327 %IF AREA=PC %THEN DISP=CA+2*DISP %ELSE DISP=4*DISP
if (( AREA ) != ( 4 )) goto L_0303;
DISP = ((CA)) + ((((2)) * ((DISP))));
goto L_0304;
L_0303:
DISP = ((4)) * ((DISP));
L_0304:
// 3328 P=P+2 %UNLESS ALT=3
if (( ALT ) == ( 3 )) goto L_0305;
P = ((P)) + ((2));
L_0305:
// 3329 %RETURN
return;
// 3330 SW(4): ! '%TOS'
SW_4:
// 3331 AREA=6; DISP=0
AREA = 6;
DISP = 0;
// 3332 %END
return;
_imp_endofblock: ;
} // End of block CIND at level 6
// 3333 EXIT: GRUSE(ACCR)=0
U_01e5:
GRUSE[0] = 0;
// 3334 GRUSE(DR)=0
GRUSE[1] = 0;
// 3335 GRUSE(BREG)=0
GRUSE[7] = 0;
// 3336 GRUSE(XNB)=0 %IF OPCODE=CALL %OR OPCODE=LXN %OR OPCODE=JLK %OR OPCODE=OUT
if (( OPCODE ) == ( 30 )) goto L_0306;
if (( OPCODE ) == ( 126 )) goto L_0306;
if (( OPCODE ) == ( 28 )) goto L_0306;
if (( OPCODE ) != ( 60 )) goto L_0307;
L_0306:
GRUSE[3] = 0;
L_0307:
// 3337 GRUSE(CTB)=0 %IF OPCODE=CALL %OR OPCODE=LCT %OR OPCODE=JLK %OR OPCODE=OUT
if (( OPCODE ) == ( 30 )) goto L_0308;
if (( OPCODE ) == ( 48 )) goto L_0308;
if (( OPCODE ) == ( 28 )) goto L_0308;
if (( OPCODE ) != ( 60 )) goto L_0309;
L_0308:
GRUSE[5] = 0;
L_0309:
// 3338 %END
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_12_LEVEL_4_ at level 5
// 3339 ->CSSEXIT
goto U_01d5;
// 3340 SW(20):
SW_20:
// 3341 ! '%TRUSTEDPROGRAM'
// 3342 COMPILER=1 %IF PARMARR=0 %AND PARMCHK=0; ->CSSEXIT
if (( PARMARR ) != ( 0 )) goto L_030a;
if (( PARMCHK ) != ( 0 )) goto L_030a;
COMPILER = 1;
L_030a:
goto U_01d5;
// 3343 SW(21): ! '%MAINEP'(NAME)
SW_21:
// 3344 KK=FROM AR2(P+1)
KK = FROMAR2(((P)) + ((1)));
// 3345 FAULT(58,0) %UNLESS CPRMODE=0
if (( CPRMODE ) == ( 0 )) goto L_030b;
FAULT(58, 0);
L_030b:
// 3346 MAINEP<-STRING(DICTBASE+WORD(KK))
MAINEP = *STRING(((DICTBASE)) + ((WORD[KK])));
// 3347 ->CSSEXIT
goto U_01d5;
// 3348 %ROUTINE CRFORMAT(%INTEGERNAME OPHEAD)
void CRFORMAT( int *OPHEAD )
{
__label__ _imp_endofblock;
// 3349 !***********************************************************************
// 3350 !* CONVERTS A RECORDFORMAT STATEMENT TO A LIST HEADED BY OPHEAD *
// 3351 !* FORMAT OF AN ENTRY. *
// 3352 !* S1=SUBNAME<<20!PTYPE<<4!J *
// 3353 !* S2,S3=4 16 BIT DISPLACEMENTS D2,ACC,D1,KFORM *
// 3354 !* NORMALLY D1=RECORD RELATIVE DISPLACEMENT AND ACC=LMAX(STRINGS)*
// 3355 !* FOR ARRAYS D2=FIRST ELEMENT DISPLACEMENT AND D1=DISPLACEMENT *
// 3356 !* OF RECORD RELATIVE ARRAYHEAD IN THE GLA *
// 3357 !* KFORM IS ONLY USED FOR RECORDS AND POINTS TO THE FORMAT *
// 3358 !* ON EXIT ACC HAS THE RECORD SIZE ROUNDED UP TO THE BOUNDARY *
// 3359 !* REQUIRED BY ITS LARGEST COMPONENT *
// 3360 !***********************************************************************
// 3361 %INTEGER D1,D2,NLIST,FORM,RL,MRL,UNSCAL,SC,DESC,FN,INC,Q,R,A0,A1,A2,DV,RFD,LB,OB,TYPEP,SACC
int D1;
int D2;
int NLIST;
int FORM;
int RL;
int MRL;
int UNSCAL;
int SC;
int DESC;
int FN;
int INC;
int Q;
int R;
int A0;
int A1;
int A2;
int DV;
int RFD;
int LB;
int OB;
int TYPEP;
int SACC;
// 3362 %SWITCH RFEL(1:5)
static int RFEL_idx;
static const void * /*SWITCH*/ RFEL[(5)-(1)+1] = { &&RFEL_1, &&RFEL_2, &&RFEL_3, &&RFEL_4, &&RFEL_5, };
// 3363 %ROUTINESPEC SN(%INTEGER Q)
auto void SN( int Q );
// 3364 %ROUTINESPEC ROUND
auto void ROUND( void );
// 3365 NLIST=0; OPHEAD=0; FORM=0; ACC=0; OB=0
NLIST = 0;
OPHEAD = 0;
FORM = 0;
ACC = 0;
OB = 0;
// 3366 MRL=0; INC=0; ! INC COUNTS DOWN RECORD
MRL = 0;
INC = 0;
// 3367 NEXT: ROUT=0; LITL=0; NAM=0; RFD=A(P)
U_01f2:
ROUT = 0;
LITL = 0;
NAM = 0;
RFD = A[P];
// 3368 %IF RFD<=2 %THEN P=P+1 %AND CLT
if (( RFD ) > ( 2 )) goto L_030c;
P = ((P)) + ((1));
CLT();
L_030c:
// 3369 ->RFEL(RFD)
goto *(RFEL-1)[RFD]; /* Bounds=1:5 */
// 3370 RFEL(1): ! (TYPE) (QNAME')(NAMELIST)
RFEL_1:
// 3371 CQN(P); P=P+1
CQN(P);
P = ((P)) + ((1));
// 3372 PACK(PTYPE); D2=0
PACK( &PTYPE);
D2 = 0;
// 3373 RL=3
RL = 3;
// 3374 %IF NAM=0 %AND 3<=PREC<=4 %THEN RL=PREC-3
if (( NAM ) != ( 0 )) goto L_030d;
if (( 3 ) > ( PREC )) goto L_030d;
if (( PREC ) > ( 4 )) goto L_030d;
RL = ((PREC)) - ((3));
L_030d:
// 3375 AGN: ROUND ; J=0
U_01f3:
ROUND();
J = 0;
// 3376 {%UNTIL A(P-1)=2} %CYCLE
L_030e:
// 3377 D1=INC; SN(P)
D1 = INC;
SN(P);
// 3378 P=P+3; INC=INC+ACC
P = ((P)) + ((3));
INC = ((INC)) + ((ACC));
// 3379 %REPEAT %UNTIL A(P-1)=2
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_030f;
goto L_030e;
L_030f:
// 3380 P=P+RFD>>2<<1; ! EXTRA 2 FOR RECORDS TO SKIP FORMAT
P = ((P)) + (((((int)(((unsigned int)(RFD)) >> ((2))))) << ((1))));
// 3381 TRY END: -> END %IF A(P)=2
U_01f4:
if (( A[P] ) != ( 2 )) goto L_0311;
goto U_01f5;
L_0311:
// 3382 P=P+1; -> NEXT
P = ((P)) + ((1));
goto U_01f2;
// 3383 RFEL(2):RFEL2: ! (TYPE)%ARRAY(NAMELIST)(BPAIR)
RFEL_2:
U_01f6:
// 3384 Q=P; ARR=1; PACK(PTYPE)
Q = P;
ARR = 1;
PACK( &PTYPE);
// 3385 %IF TYPE<=2 %THEN UNSCAL=0 %AND SC=PREC %ELSE UNSCAL=1 %AND SC=3
if (( TYPE ) > ( 2 )) goto L_0312;
UNSCAL = 0;
SC = PREC;
goto L_0313;
L_0312:
UNSCAL = 1;
SC = 3;
L_0313:
// 3386 %IF PREC=4 %THEN DESC=16_58000002 %ELSE DESC=SC<<27!UNSCAL<<25!(1-PARMARR)<<24
if (( PREC ) != ( 4 )) goto L_0314;
DESC = 1476395010;
goto L_0315;
L_0314:
DESC = ((((((SC)) << ((27)))) | ((((UNSCAL)) << ((25)))))) | ((((((1)) - ((PARMARR)))) << ((24))));
L_0315:
// 3387 {%UNTIL A(P-1)=2} %CYCLE; ! UNTIL <RESTOFARRAYLIST> NULL
L_0316:
// 3388 P=P+3 %UNTIL A(P-1)=2
L_0319:
P = ((P)) + ((3));
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_031a;
goto L_0319;
L_031a:
// 3389
// 3390 TYPEP=PTYPE; SACC=ACC
TYPEP = PTYPE;
SACC = ACC;
// 3391 DV=DOPE VECTOR(TYPE,ACC,0,FROMAR2(Q),R,LB)+12
DV = ((DOPEVECTOR(TYPE, ACC, 0, FROMAR2(Q), &R, &LB))) + ((12));
// 3392 ! DOPE VECTOR INTO SHAREABLE S.T.
// 3393 ACC=SACC; PTYPE=TYPEP; UNPACK
ACC = SACC;
PTYPE = TYPEP;
UNPACK();
// 3394 %IF TYPE=5 %OR (TYPE=1 %AND PREC=3) %THEN RL=0 %ELSE RL=3
if (( TYPE ) == ( 5 )) goto L_031b;
if (( TYPE ) != ( 1 )) goto L_031c;
if (( PREC ) != ( 3 )) goto L_031c;
L_031b:
RL = 0;
goto L_031d;
L_031c:
RL = 3;
L_031d:
// 3395 ROUND
ROUND();
// 3396 {%UNTIL A(Q-1)=2} %CYCLE; ! HEAD INTO GLA FOR EACH ARRAY
L_031e:
// 3397 A0=R; %IF UNSCAL=0 %THEN A0=A0//ACC
A0 = R;
if (( UNSCAL ) != ( 0 )) goto L_0321;
A0 = ((int)(A0)) / ((int)(ACC));
L_0321:
// 3398 %IF PREC=4 %THEN A0=0; ! STRING DESCRIPTORS !
if (( PREC ) != ( 4 )) goto L_0322;
A0 = 0;
L_0322:
// 3399 A0=A0!DESC; A1=INC
A0 = ((A0)) | ((DESC));
A1 = INC;
// 3400 %IF TYPE<=3 %AND PARMARR=0=PARMCHK %AND J=1 %THEN A1=A1-LB*ACC
if (( TYPE ) > ( 3 )) goto L_0323;
if (( PARMARR ) != ( 0 )) goto L_0323;
if (( 0 ) != ( PARMCHK )) goto L_0323;
if (( J ) != ( 1 )) goto L_0323;
A1 = ((A1)) - ((((LB)) * ((ACC))));
L_0323:
// 3401 A2=5<<27!3*J
A2 = ((((5)) << ((27)))) | ((((3)) * ((J))));
// 3402 PGLA(4,16,ADDR(A0))
PGLA(4, 16, ADDR( &A0));
// 3403 D1=GLACA-16
D1 = ((GLACA)) - ((16));
// 3404 RELOCATE(D1+12,DV,1); ! RELOCATE DV POINTER
RELOCATE(((D1)) + ((12)), DV, 1);
// 3405 NOTE CREF(16_80000000!(DV<<1>>3)!(D1+12)>>2<<16, (DV&16_FFFF)<<2)
NOTECREF(((((-2147483648)) | (((int)(((unsigned int)(((DV)) << ((1)))) >> ((3))))))) | (((((int)(((unsigned int)(((D1)) + ((12)))) >> ((2))))) << ((16)))), ((((DV)) & ((65535)))) << ((2)));
// 3406 D2=INC
D2 = INC;
// 3407 SN(Q); INC=INC+R
SN(Q);
INC = ((INC)) + ((R));
// 3408 Q=Q+3
Q = ((Q)) + ((3));
// 3409 %REPEAT %UNTIL A(Q-1)=2; ! HEAD INTO GLA FOR EACH ARRAY
if (( A[((Q)) - ((1))] ) == ( 2 )) goto L_031f;
goto L_031e;
L_031f:
// 3410 P=P+1; Q=P
P = ((P)) + ((1));
Q = P;
// 3411 %REPEAT %UNTIL A(P-1)=2
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_0317;
goto L_0316;
L_0317:
// 3412 P=P+2 %IF RFD=5
if (( RFD ) != ( 5 )) goto L_0324;
P = ((P)) + ((2));
L_0324:
// 3413 -> TRY END
goto U_01f4;
// 3414 RFEL(3): ! %RECORD (%ARRAY) %NAME
RFEL_3:
// 3415 TYPE=3; PREC=3; NAM=1
TYPE = 3;
PREC = 3;
NAM = 1;
// 3416 ARR=2-A(P+1); P=P+2
ARR = ((2)) - ((A[((P)) + ((1))]));
P = ((P)) + ((2));
// 3417 PACK(PTYPE); D2=0
PACK( &PTYPE);
D2 = 0;
// 3418 RL=3; ACC=8+8*ARR
RL = 3;
ACC = ((8)) + ((((8)) * ((ARR))));
// 3419 FORM=0
FORM = 0;
// 3420 ->AGN
goto U_01f3;
// 3421 RFEL(4): ! RECORDS IN RECORDS
RFEL_4:
// 3422 RFEL(5): ! RECORDARRAYS IN RECORDS
RFEL_5:
// 3423 Q=P+FROM AR2(P+1)+1
Q = ((((P)) + ((FROMAR2(((P)) + ((1))))))) + ((1));
// 3424 FN=FROM AR2(Q)
FN = FROMAR2(Q);
// 3425 COPY TAG(FN); ! COPY FORMAT TAG & SET ACC
COPYTAG(FN);
// 3426 FAULT(62,FN) %UNLESS PTYPE=4
if (( PTYPE ) == ( 4 )) goto L_0325;
FAULT(62, FN);
L_0325:
// 3427 TYPE=3; PREC=3; FORM=TCELL
TYPE = 3;
PREC = 3;
FORM = TCELL;
// 3428 %IF RFD=4 %THEN %START
if (( RFD ) != ( 4 )) goto L_0326;
// 3429 PTYPE=16_33; P=P+3; D2=0
PTYPE = 51;
P = ((P)) + ((3));
D2 = 0;
// 3430 RL=3; ->AGN
RL = 3;
goto U_01f3;
// 3431 %FINISH
L_0326:
// 3432 P=P+3; ->RFEL2
P = ((P)) + ((3));
goto U_01f6;
// 3433 END: ! FINISH OFF
U_01f5:
// 3434 RL=MRL; ROUND
RL = MRL;
ROUND();
// 3435 ACC=INC; ! SIZE ROUNDED APPROPRIATELY
ACC = INC;
// 3436 FAULT(98,0) %UNLESS INC<=16_7FFF
if (( INC ) <= ( 32767 )) goto L_0327;
FAULT(98, 0);
L_0327:
// 3437 CLEAR LIST(NLIST)
CLEARLIST( &NLIST);
// 3438 %RETURN
return;
// 3439 %ROUTINE SN(%INTEGER Q)
void SN( int Q )
{
__label__ _imp_endofblock;
// 3440 !***********************************************************************
// 3441 !* CHECK THE SUBNAME HAS NOT BEEN USED BEFORE IN THIS FORMAT *
// 3442 !* AND ENTER IT WITH ITS DESCRIPTORS INTO THE LIST. *
// 3443 !***********************************************************************
// 3444 FNAME=FROM AR2(Q)
FNAME = FROMAR2(Q);
// 3445 FAULT2(61,0,FNAME) %UNLESS FIND(FNAME,NLIST)=-1
if (( FIND(FNAME, NLIST) ) == ( (-(1)) )) goto L_0328;
FAULT2(61, 0, FNAME);
L_0328:
// 3446 BINSERT(OPHEAD,OB,FNAME<<20!PTYPE<<4!J,D2<<16!ACC,D1<<16!FORM)
BINSERT(OPHEAD, &OB, ((((((FNAME)) << ((20)))) | ((((PTYPE)) << ((4)))))) | ((J)), ((((D2)) << ((16)))) | ((ACC)), ((((D1)) << ((16)))) | ((FORM)));
// 3447 PUSH(NLIST,0,FNAME,0)
PUSH( &NLIST, 0, FNAME, 0);
// 3448 %END
return;
_imp_endofblock: ;
} // End of block SN at level 6
// 3449 %ROUTINE ROUND
void ROUND( void )
{
__label__ _imp_endofblock;
// 3450 MRL=RL %IF RL>MRL
if (( RL ) <= ( MRL )) goto L_0329;
MRL = RL;
L_0329:
// 3451 INC=INC+1 %WHILE INC&RL#0
L_032a:
if (( ((INC)) & ((RL)) ) == ( 0 )) goto L_032b;
INC = ((INC)) + ((1));
goto L_032a;
L_032b:
// 3452 %END
return;
_imp_endofblock: ;
} // End of block ROUND at level 6
// 3453 %END; ! OF ROUTINE CRFORMAT
return;
_imp_endofblock: ;
} // End of block CRFORMAT at level 5
// 3454 %INTEGERFN DISPLACEMENT(%INTEGER LINK)
int DISPLACEMENT( int LINK )
{
__label__ _imp_endofblock;
// 3455 !***********************************************************************
// 3456 !* SEARCH A FORMAT LIST FOR A SUBNAME *
// 3457 !* A(P) HAS ENAME--LINK IS HEAD OF RFORMAT LIST. RESULT IS DISP *
// 3458 !* FROM START OF RECORD *
// 3459 !***********************************************************************
// 3460 %RECORD(LISTF)%NAME FCELL,PCELL,LCELL{(LISTF)
LISTF *FCELL;
LISTF *PCELL;
LISTF *LCELL;
// 3461 %INTEGER RR,II,ENAME,CELL
int RR;
int II;
int ENAME;
int CELL;
// 3462 ENAME=A(P)<<8+A(P+1); CELL=0
ENAME = ((((A[P])) << ((8)))) + ((A[((P)) + ((1))]));
CELL = 0;
// 3463 %IF LINK#0 %THEN %START; ! CHK RECORDSPEC NOT OMITTED
if (( LINK ) == ( 0 )) goto L_032d;
// 3464 FCELL==ASLIST(LINK); ! ONTO FORMAT TAG CELL
FCELL = (&(ASLIST[LINK]));
// 3465 LINK=FCELL_S3&16_7FFF; ! LINK TO SIDE CHAIN
LINK = ((FCELL->S3)) & ((32767));
// 3466 CELL=LINK; II=-1; ACC=-1
CELL = LINK;
II = (-(1));
ACC = (-(1));
// 3467 %WHILE LINK>0 %CYCLE
L_032e:
if (( LINK ) <= ( 0 )) goto L_032f;
// 3468 LCELL==ASLIST(LINK)
LCELL = (&(ASLIST[LINK]));
// 3469 %IF LCELL_S1>>20=ENAME %START; ! RIGHT SUBNAME LOCATED
if (( (int)(((unsigned int)(LCELL->S1)) >> ((20))) ) != ( ENAME )) goto L_0331;
// 3470 TCELL=LINK
TCELL = LINK;
// 3471 RR=LCELL_S1
RR = LCELL->S1;
// 3472 SNDISP=LCELL_S2
SNDISP = LCELL->S2;
// 3473 K=LCELL_S3
K = LCELL->S3;
// 3474 J=RR&15; PTYPE=RR>>4&16_FFFF
J = ((RR)) & ((15));
PTYPE = (((int)(((unsigned int)(RR)) >> ((4))))) & ((65535));
// 3475 ACC=SNDISP&16_FFFF; SNDISP=SNDISP&16_FFFF0000//16_10000
ACC = ((SNDISP)) & ((65535));
SNDISP = ((int)(((SNDISP)) & ((-65536)))) / ((int)(65536));
// 3476 KFORM=K&16_FFFF; K=K>>16
KFORM = ((K)) & ((65535));
K = (int)(((unsigned int)(K)) >> ((16)));
// 3477 %IF LINK#CELL %START; ! NOT TOP CELL OF FORMAT
if (( LINK ) == ( CELL )) goto L_0332;
// 3478 PCELL_LINK=LCELL_LINK
PCELL->LINK = LCELL->LINK;
// 3479 LCELL_LINK=CELL
LCELL->LINK = CELL;
// 3480 FCELL_S3=FCELL_S3&16_FFFF0000!LINK
FCELL->S3 = ((((FCELL->S3)) & ((-65536)))) | ((LINK));
// 3481 %FINISH; ! ARRANGING LIST WITH THIS SUBNAME
L_0332:
// 3482 ! AT THE TOP
// 3483 %RESULT=K
return K;
// 3484 %FINISH
L_0331:
// 3485 PCELL==LCELL
PCELL = LCELL;
// 3486 LINK=LCELL_LINK
LINK = LCELL->LINK;
// 3487 %REPEAT
goto L_032e;
L_032f:
// 3488 %FINISH
L_032d:
// 3489 FAULT(65,ENAME)
FAULT(65, ENAME);
// 3490 %IF CELL>0 %THEN PUSH(ASLIST(CELL)_LINK,ENAME<<20!7<<4,0,0)
if (( CELL ) <= ( 0 )) goto L_0333;
PUSH( &ASLIST[CELL].LINK, ((((ENAME)) << ((20)))) | ((((7)) << ((4)))), 0, 0);
L_0333:
// 3491 PTYPE=7; TCELL=0
PTYPE = 7;
TCELL = 0;
// 3492 %RESULT=-1
return (-(1));
// 3493 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block DISPLACEMENT at level 5
// 3494 %INTEGERFN COPY RECORD TAG(%INTEGERNAME SUBS)
int COPYRECORDTAG( int *SUBS )
{
__label__ _imp_endofblock;
// 3495 !***********************************************************************
// 3496 !* PRODUCE PTYPE ETC FOR A COMPOUND NAME BY CHAINING DOWN ONE *
// 3497 !* ONE OR MORE RECORD FORMAT LISTS. ON EXIT RESULT =0 IF NO *
// 3498 !* SUBNAME FOUND OR SUBNAME IS OF TYPE RECORD WITH NO FURTHER *
// 3499 !* SUBNAME ATTACHED. RESULT#0 IF BONE-FIDE SUBNAME LOCATED *
// 3500 !* ON ENTRY KFORM HAS POINTER TO THE (FIRST ) FORMAT LIST AND *
// 3501 !* P POINTS TO THE A.R. ENTRY FOR (FIRST) ENAME *
// 3502 !***********************************************************************
// 3503 %INTEGER Q,FNAME
int Q;
int FNAME;
// 3504 SUBS=0
SUBS = 0;
// 3505 {%UNTIL TYPE#3} %CYCLE
L_0334:
// 3506 FNAME=KFORM
FNAME = KFORM;
// 3507 P=P+2; SKIP APP
P = ((P)) + ((2));
SKIPAPP();
// 3508 %RESULT=0 %IF A(P)=2 %OR FNAME<=0;! NO (FURTHER) ENAME
if (( A[P] ) == ( 2 )) goto L_0330;
if (( FNAME ) > ( 0 )) goto L_0337;
L_0330:
return 0;
L_0337:
// 3509 SUBS=SUBS+1
SUBS = ((SUBS)) + ((1));
// 3510 P=P+1; Q=DISPLACEMENT (FNAME)
P = ((P)) + ((1));
Q = DISPLACEMENT(FNAME);
// 3511 UNPACK
UNPACK();
// 3512 %REPEAT %UNTIL TYPE#3
if (( TYPE ) != ( 3 )) goto L_0335;
goto L_0334;
L_0335:
// 3513 %RESULT=Q+1; ! GIVES 0 IF SUBNAME NOT KNOWN
return ((Q)) + ((1));
// 3514 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block COPYRECORDTAG at level 5
// 3515 %ROUTINE CRNAME(%INTEGER Z,REG,MODE,BS,AR,DP,%INTEGERNAME NAMEP)
void CRNAME( int Z, int REG, int MODE, int BS, int AR, int DP, int *NAMEP )
{
__label__ _imp_endofblock;
// 3516 !***********************************************************************
// 3517 !* DEAL WITH RECORD ELEMENT NAMES.Z AS FOR CNAME.CLINK=TAGS(RN) *
// 3518 !* MODE=ACCESS FOR RECORD(NOT THE ELEMENT!) *
// 3519 !* ON EXIT BASE,AREA & DISP POINT TO REQUIRED ELEMENT *
// 3520 !* RECURSIVE CALL IS NEEDED TO DEAL WITH RECORDS IN RECORDS *
// 3521 !* DEPTH SHEWS RECURSIVE LEVELS- NEEDED TO AVOID MIS SETTING *
// 3522 !* REGISTER IN USE IF RECORDNAME IN RECORD HAS THE SAME NAME AS *
// 3523 !* A GENUINE RECORD NAME. *
// 3524 !***********************************************************************
// 3525 %INTEGER DEPTH,FNAME
int DEPTH;
int FNAME;
// 3526 %ROUTINESPEC CENAME(%INTEGER MODE,FNAME,BS,AR,DP,XD)
auto void CENAME( int MODE, int FNAME, int BS, int AR, int DP, int XD );
// 3527 DEPTH=0
DEPTH = 0;
// 3528 FNAME=KFORM; ! POINTER TO FORMAT
FNAME = KFORM;
// 3529 %IF ARR=0 %OR (Z=6 %AND A(P+2)=2) %START;! SIMPLE RECORD
if (( ARR ) == ( 0 )) goto L_0336;
if (( Z ) != ( 6 )) goto L_0338;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0338;
L_0336:
// 3530 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0339;
P = ((P)) + ((3));
goto L_033a;
L_0339:
NOAPP();
L_033a:
// 3531 CENAME(MODE,FNAME,BS,AR,DP,0)
CENAME(MODE, FNAME, BS, AR, DP, 0);
// 3532 %FINISH %ELSE %START
goto L_033b;
L_0338:
// 3533 CANAME(ARR,BS,DP)
CANAME(ARR, BS, DP);
// 3534 CENAME(ACCESS,FNAME,BASE,AREA,DISP,0)
CENAME(ACCESS, FNAME, BASE, AREA, DISP, 0);
// 3535 %FINISH; %RETURN
L_033b:
return;
// 3536 !
// 3537 %ROUTINE CENAME(%INTEGER MODE,FNAME,BS,AR,DP,XD)
void CENAME( int MODE, int FNAME, int BS, int AR, int DP, int XD )
{
__label__ _imp_endofblock;
// 3538 !***********************************************************************
// 3539 !* FINDS OUT ABOUT SUBNAME AND ACTS ACCORDINGLY.MOSTLY ACTION *
// 3540 !* CONSISTS OF UPPING XD BY OFFSET OF THE SUBNAME BUT IS VERY *
// 3541 !* HAIRY FOR RECORDS IN RECORDS ETC *
// 3542 !* MODE IS ACCESS FOR THE RECORD *
// 3543 !***********************************************************************
// 3544 %ROUTINESPEC FETCH RAD
auto void FETCHRAD( void );
// 3545 %ROUTINESPEC LOCALISE(%INTEGER SIZE)
auto void LOCALISE( int SIZE );
// 3546 %INTEGER Q,QQ,D,C,W
int Q;
int QQ;
int D;
int C;
int W;
// 3547 DEPTH=DEPTH+1
DEPTH = ((DEPTH)) + ((1));
// 3548 %IF A(P)=2 %THEN %START; ! ENAME MISSING
if (( A[P] ) != ( 2 )) goto L_033c;
// 3549 ACCESS=MODE; AREA=AR; XDISP=XD
ACCESS = MODE;
AREA = AR;
XDISP = XD;
// 3550 BASE=BS; DISP=DP; ! FOR POINTER
BASE = BS;
DISP = DP;
// 3551 %IF Z<14 %THEN %START; ! NOT A RECORD OPERATION
if (( Z ) >= ( 14 )) goto L_033d;
// 3552 %UNLESS 3<=Z<=4 %OR Z=6 %START; ! ADDR(RECORD)
if (( 3 ) > ( Z )) goto L_02b5;
if (( Z ) <= ( 4 )) goto L_033e;
L_02b5:
if (( Z ) == ( 6 )) goto L_033e;
// 3553 FAULT(64,0); BASE=RBASE; AREA=-1
FAULT(64, 0);
BASE = RBASE;
AREA = (-(1));
// 3554 DISP=0; ACCESS=0; PTYPE=1; UNPACK
DISP = 0;
ACCESS = 0;
PTYPE = 1;
UNPACK();
// 3555 %FINISH
L_033e:
// 3556 %FINISH
L_033d:
// 3557 %RETURN
return;
// 3558 %FINISH
L_033c:
// 3559 P=P+1; ! FIND OUT ABOUT SUBNAME
P = ((P)) + ((1));
// 3560 Q=DISPLACEMENT(FNAME); ! TCELL POINTS TO CELL HOLDING
Q = DISPLACEMENT(FNAME);
// 3561 UNPACK; ! INFO ABOUT THE SUBNAME
UNPACK();
// 3562 %IF Q=-1=ACC %OR PTYPE=7 %START; ! WRONG SUBNAME(HAS BEEN FAULTED)
if (( Q ) != ( (-(1)) )) goto L_033f;
if (( (-(1)) ) == ( ACC )) goto L_0340;
L_033f:
if (( PTYPE ) != ( 7 )) goto L_0341;
L_0340:
// 3563 P=P+2; SKIP APP; P=P-3
P = ((P)) + ((2));
SKIPAPP();
P = ((P)) - ((3));
// 3564 ACCESS=0; BASE=RBASE; DISP=0; AREA=-1
ACCESS = 0;
BASE = RBASE;
DISP = 0;
AREA = (-(1));
// 3565 %RETURN
return;
// 3566 %FINISH
L_0341:
// 3567 NAMEP=(A(P)<<8!A(P+1))<<16!NAMEP; ! NAMEP=-1 UNALTERED !
NAMEP = ((((((((A[P])) << ((8)))) | ((A[((P)) + ((1))])))) << ((16)))) | ((NAMEP));
// 3568 ->AE %IF ARR=1; ! ARRAYS INCLUDING RECORDARRAYS
if (( ARR ) != ( 1 )) goto L_0342;
goto U_01f0;
L_0342:
// 3569 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0343;
P = ((P)) + ((3));
goto L_0344;
L_0343:
NOAPP();
L_0344:
// 3570 %IF TYPE<=2 %OR TYPE=5 %OR (TYPE=3 %AND A(P)=2 %AND (3<=Z<=4 %OR Z=6)) %START
if (( TYPE ) <= ( 2 )) goto L_0345;
if (( TYPE ) == ( 5 )) goto L_0345;
if (( TYPE ) != ( 3 )) goto L_0346;
if (( A[P] ) != ( 2 )) goto L_0346;
if (( 3 ) > ( Z )) goto L_0347;
if (( Z ) <= ( 4 )) goto L_0345;
L_0347:
if (( Z ) != ( 6 )) goto L_0346;
L_0345:
// 3571 ACCESS=MODE+4+4*NAM; BASE=BS;
ACCESS = ((((MODE)) + ((4)))) + ((((4)) * ((NAM))));
BASE = BS;
// 3572 AREA=AR; DISP=DP; XDISP=XD+Q
AREA = AR;
DISP = DP;
XDISP = ((XD)) + ((Q));
// 3573 %RETURN
return;
// 3574 %FINISH
L_0346:
// 3575 !
// 3576 ! NOW CODING BECOMES HAIRY:- STILL LEFT ARE
// 3577 ! A) RECORDS IN RECORDS Q POINTS TO SECONDARY RECORD
// 3578 ! B) RECORDNAMES IN RECORDS Q HAS OFF-SET OF A POINTER
// 3579 ! C) RECORDARRAYNAMES IN RECORDS Q HAS OFF-SET A HEADER IN RECORD
// 3580 ! D) RECORDARRAYS IN RECORDS NOT YET ALLOWED
// 3581 ! Q WOULD HAVE OFF-SET OF A RECORD RELATIVE HEADER IN THE GLA
// 3582 !
// 3583 XD=XD+Q
XD = ((XD)) + ((Q));
// 3584 NAMEP=-1
NAMEP = (-(1));
// 3585 %IF NAM=1 %THEN %START
if (( NAM ) != ( 1 )) goto L_0348;
// 3586 %IF MODE=0 %START
if (( MODE ) != ( 0 )) goto L_0349;
// 3587 DP=DP+XD; XD=0; MODE=2
DP = ((DP)) + ((XD));
XD = 0;
MODE = 2;
// 3588 %FINISH %ELSE %START
goto L_034a;
L_0349:
// 3589 LOCALISE(8); ! PICK UP RECNAME DESCR &STCK
LOCALISE(8);
// 3590 AR=AREA; DP=DISP; BS=BASE
AR = AREA;
DP = DISP;
BS = BASE;
// 3591 %FINISH
L_034a:
// 3592 %FINISH
L_0348:
// 3593 CENAME(MODE,KFORM,BS,AR,DP,XD)
CENAME(MODE, KFORM, BS, AR, DP, XD);
// 3594 %RETURN
return;
// 3595 AE: ! ARRAYS AND ARRAYNAMES AS ELEMEN
U_01f0:
// 3596 FROM123(TCELL,Q,SNDISP,K)
FROM123(TCELL, &Q, &SNDISP, &K);
// 3597 ACC=SNDISP&16_FFFF; SNDISP=SNDISP&16_FFFF0000//16_10000
ACC = ((SNDISP)) & ((65535));
SNDISP = ((int)(((SNDISP)) & ((-65536)))) / ((int)(65536));
// 3598 KFORM=K&16_FFFF; K=K>>16
KFORM = ((K)) & ((65535));
K = (int)(((unsigned int)(K)) >> ((16)));
// 3599 C=ACC; D=SNDISP; Q=K; QQ=KFORM
C = ACC;
D = SNDISP;
Q = K;
QQ = KFORM;
// 3600 %IF (Z=6 %OR Z=12) %AND A(P+2)=2 %START;! 'GET ARRAYHEAD' CALL
if (( Z ) == ( 6 )) goto L_034b;
if (( Z ) != ( 12 )) goto L_034c;
L_034b:
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_034c;
// 3601 P=P+3
P = ((P)) + ((3));
// 3602 %IF NAM=1 %THEN %START
if (( NAM ) != ( 1 )) goto L_034d;
// 3603 ACCESS=MODE+8; BASE=BS
ACCESS = ((MODE)) + ((8));
BASE = BS;
// 3604 AREA=AR; DISP=DP; XDISP=XD+Q
AREA = AR;
DISP = DP;
XDISP = ((XD)) + ((Q));
// 3605 %RETURN
return;
// 3606 %FINISH
L_034d:
// 3607 !
// 3608 ! PASSING AN ARRAY IN A RECORD BY NAME MUST CONSTRUCT PROPER ARRAYHEAD
// 3609 ! FROM THE RECORD RELATIVE ONE AT Q(GLA)
// 3610 !
// 3611 NAMEP=-1
NAMEP = (-(1));
// 3612 FETCH RAD
FETCHRAD();
// 3613 AREA=-1; DISP=Q
AREA = (-(1));
DISP = Q;
// 3614 BASE=0; ACCESS=0;
BASE = 0;
ACCESS = 0;
// 3615 CREATE AH(1)
CREATEAH(1);
// 3616 %FINISH %ELSE %START; ! ARRAY ELEMENTS IN RECORDS
goto L_034e;
L_034c:
// 3617 NAMEP=-1
NAMEP = (-(1));
// 3618 %IF NAM=1 %THEN %START; ! ARRAYNAMES-FULLHEAD IN RECORD
if (( NAM ) != ( 1 )) goto L_034f;
// 3619 XD=XD+Q
XD = ((XD)) + ((Q));
// 3620 LOCALISE(16); ! MOVE HEAD UNDER LNB
LOCALISE(16);
// 3621 CANAME(3,BASE,DISP); ! ARRAY MODE SETS DISP,AREA&BASE
CANAME(3, BASE, DISP);
// 3622 %FINISH %ELSE %START; ! ARRAY RELATIVE HEAD IN GLA
goto L_0350;
L_034f:
// 3623 %IF MODE=0 %OR MODE=2 %%START
if (( MODE ) == ( 0 )) goto L_0351;
if (( MODE ) != ( 2 )) goto L_0352;
L_0351:
// 3624 %IF MODE=0 %THEN W=DP-4 %ELSE W=DP+4
if (( MODE ) != ( 0 )) goto L_0353;
W = ((DP)) - ((4));
goto L_0354;
L_0353:
W = ((DP)) + ((4));
L_0354:
// 3625 %FINISH %ELSE %START
goto L_0355;
L_0352:
// 3626 FETCH RAD; ! RECORD ADDR TO ACC
FETCHRAD();
// 3627 GET WSP(W,1)
GETWSP( &W, 1);
// 3628 PSF1(ST,1,W); XD=0
PSF1(72, 1, W);
XD = 0;
// 3629 BS=RBASE
BS = RBASE;
// 3630 %FINISH
L_0355:
// 3631 CANAME(3,0,Q); ! RECORD REL ARRAY ACCESS
CANAME(3, 0, Q);
// 3632 ! CAN RETURN ACCESS=1 OR 3 ONLY
// 3633 %IF PARMARR=0=PARMCHK %AND ACCESS=3 %AND (PREC=3 %OR TYPE>=3) %START
if (( PARMARR ) != ( 0 )) goto L_0356;
if (( 0 ) != ( PARMCHK )) goto L_0356;
if (( ACCESS ) != ( 3 )) goto L_0356;
if (( PREC ) == ( 3 )) goto L_0357;
if (( TYPE ) < ( 3 )) goto L_0356;
L_0357:
// 3634 PSORLF1(ADB,0,AREA CODE2(BS),W)
PSORLF1(32, 0, AREACODE2(BS), W);
// 3635 PSF1(ADB,0,XD) %UNLESS XD=0
if (( XD ) == ( 0 )) goto L_0358;
PSF1(32, 0, XD);
L_0358:
// 3636 GRUSE(BREG)=0
GRUSE[7] = 0;
// 3637 %FINISH %ELSE %START
goto L_0359;
L_0356:
// 3638 GET IN ACC(DR,2,0,AREA CODE,Q)
GETINACC(1, 2, 0, AREACODE(), Q);
// 3639 PSORLF1(INCA,0,AREA CODE2(BS),W)
PSORLF1(20, 0, AREACODE2(BS), W);
// 3640 %IF ACCESS=1 %THEN ACCESS=2 %AND AREA=7 %AND XD=XD+NUMMOD*BYTES(PREC)
if (( ACCESS ) != ( 1 )) goto L_035a;
ACCESS = 2;
AREA = 7;
XD = ((XD)) + ((((NUMMOD)) * ((BYTES[PREC]))));
L_035a:
// 3641 PSF1(INCA,0,XD) %UNLESS XD=0
if (( XD ) == ( 0 )) goto L_035b;
PSF1(20, 0, XD);
L_035b:
// 3642 FORGET (DR)
FORGET(1);
// 3643 AREA=7; DISP=0; ! AND ACCESS = 2 OR 3 ONLY
AREA = 7;
DISP = 0;
// 3644 %IF TYPE=3 %AND A(P)=1 %START; ! WILL BE A FURTHER CALL
if (( TYPE ) != ( 3 )) goto L_035c;
if (( A[P] ) != ( 1 )) goto L_035c;
// 3645 ! ON ROUTINE CENAME
// 3646 GET WSP(DISP,2)
GETWSP( &DISP, 2);
// 3647 PSF1(STD,1,DISP)
PSF1(88, 1, DISP);
// 3648 AREA=LNB; BASE=RBASE
AREA = 2;
BASE = RBASE;
// 3649 %FINISH
L_035c:
// 3650 %FINISH
L_0359:
// 3651 %FINISH
L_0350:
// 3652 %IF TYPE=3 %THEN CENAME(ACCESS,QQ,BASE,AREA,DISP,0)
if (( TYPE ) != ( 3 )) goto L_035d;
CENAME(ACCESS, QQ, BASE, AREA, DISP, 0);
L_035d:
// 3653 %FINISH
L_034e:
// 3654 %RETURN
return;
// 3655 %ROUTINE FETCH RAD
void FETCHRAD( void )
{
__label__ _imp_endofblock;
// 3656 !***********************************************************************
// 3657 !* SET ACC TO 32 BIT ADDRESS OF RECORD. *
// 3658 !***********************************************************************
// 3659 ACCESS=MODE+4
ACCESS = ((MODE)) + ((4));
// 3660 AREA=AR; BASE=BS
AREA = AR;
BASE = BS;
// 3661 DISP=DP; XDISP=XD
DISP = DP;
XDISP = XD;
// 3662 NAMEOP(4,ACCR,4,-1)
NAMEOP(4, 0, 4, (-(1)));
// 3663 %END
return;
_imp_endofblock: ;
} // End of block FETCHRAD at level 7
// 3664 %ROUTINE LOCALISE(%INTEGER SIZE)
void LOCALISE( int SIZE )
{
__label__ _imp_endofblock;
// 3665 !***********************************************************************
// 3666 !* REMOVES A DESCRIPTOR OR ARRAYHEAD FROM A RECORD AND STORES *
// 3667 !* IT IN A TEMPORARY UNDER LNB. *
// 3668 !***********************************************************************
// 3669 %INTEGER HOLE
int HOLE;
// 3670 ACCESS=MODE+4
ACCESS = ((MODE)) + ((4));
// 3671 AREA=AR; BASE=BS; DISP=DP
AREA = AR;
BASE = BS;
DISP = DP;
// 3672 XDISP=XD
XDISP = XD;
// 3673 NAMEOP(2,ACCR,SIZE,-1)
NAMEOP(2, 0, SIZE, (-(1)));
// 3674 GET WSP(HOLE,SIZE>>2)
GETWSP( &HOLE, (int)(((unsigned int)(SIZE)) >> ((2))));
// 3675 PSF1(ST,1,HOLE)
PSF1(72, 1, HOLE);
// 3676 MODE=2; AREA=LNB
MODE = 2;
AREA = 2;
// 3677 BASE=RBASE; DISP=HOLE; XD=0
BASE = RBASE;
DISP = HOLE;
XD = 0;
// 3678 %END; ! OF ROUTINE LOCALISE
return;
_imp_endofblock: ;
} // End of block LOCALISE at level 7
// 3679 %END; ! OF ROUTINE CENAME
return;
_imp_endofblock: ;
} // End of block CENAME at level 6
// 3680 %END; ! OF ROUTINE CRNAME
return;
_imp_endofblock: ;
} // End of block CRNAME at level 5
// 3681 %ROUTINE CSTREXP(%INTEGER MODE,REG)
void CSTREXP( int MODE, int REG )
{
__label__ _imp_endofblock;
// 3682 !***********************************************************************
// 3683 !* PLANT IN-LINE CODE FOR CONCATENATION. A WORK AREA UNDER *
// 3684 !* BASE REGISTER COVER IS USUALLY REQUIRED. THE CURRENT LENGTH *
// 3685 !* OF STRING IN THE WORK AREA IS KEPT IN A REGISTER (BREG) *
// 3686 !* WHICH IS PROTECTED THROUGH THE NORMAL INTERMEDIATE-RESULT *
// 3687 !* MECHANISMS. *
// 3688 !* ON ENTRY:- *
// 3689 !* MODE=0 NORMAL. WK AREA NOT USED FOR ONE OPERAND EXPSSNS *
// 3690 !* MODE=1 STRING MUST GO TO WORK AREA *
// 3691 !* (AND TO COME) *
// 3692 !* MODE=3 CONCATENATE INTO LHS OF =ASSNMNT (E.G. A=B.C) *
// 3693 !* MODE=4 OPTIMISE S=S.T BY NOT COPYING S *
// 3694 !* 2**4 BIT OF MODE IS SET IF WK-AREA NOT TO BE FREED ON EXIT *
// 3695 !* ON EXIT:- *
// 3696 !* BASE,DISP & INDEX DEFINE RESULT *
// 3697 !* VALUE#0 %IF RESULT IN A WORK AREA(CCOND MUST KNOW) *
// 3698 !* STRINGL SET IF STRING LENGTH KNOWN. STRFNRES DEFINES LENREG *
// 3699 !***********************************************************************
// 3700 %INTEGER PP,WKAREA,DOTS,REXP,ERR,CLEN,KEEPWA,FNAM
int PP;
int WKAREA;
int DOTS;
int REXP;
int ERR;
int CLEN;
int KEEPWA;
int FNAM;
// 3701 %INTEGERFNSPEC STROP(%INTEGER REG)
auto int STROP( int REG );
// 3702 KEEPWA=MODE&16; MODE=MODE&15
KEEPWA = ((MODE)) & ((16));
MODE = ((MODE)) & ((15));
// 3703 PP=P; STRINGL=0; FNAM=0; WKAREA=0
PP = P;
STRINGL = 0;
FNAM = 0;
WKAREA = 0;
// 3704 REXP=2-A(P+1+FROM AR2(P+1)); ! =0 %IF ONE OPERAND EXP
REXP = ((2)) - ((A[((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))))]));
// 3705 -> NORMAL %UNLESS A(P+3)=4 %AND REXP=0 %AND MODE=0
if (( A[((P)) + ((3))] ) != ( 4 )) goto L_035e;
if (( REXP ) != ( 0 )) goto L_035e;
if (( MODE ) == ( 0 )) goto L_035f;
L_035e:
goto U_01e4;
L_035f:
// 3706 -> SIMPLE %IF A(P+4)=2
if (( A[((P)) + ((4))] ) != ( 2 )) goto L_0360;
goto U_01e5;
L_0360:
// 3707 -> NORMAL %UNLESS A(P+4)=1
if (( A[((P)) + ((4))] ) == ( 1 )) goto L_0361;
goto U_01e4;
L_0361:
// 3708 ! COPY TAG(FROM AR2(P+5))
// 3709 ! %IF PTYPE=SNPT %THEN PTYPE=TSNAME(K)
// 3710 ! -> NORMAL %UNLESS ROUT=0 ; ! BEWARE OF MAP=FN
// 3711 ! -> NORMAL %IF PARMARR=1 %AND(ARR#0 %OR A(P+7)=1)
// 3712 SIMPLE: P=P+4
U_01e5:
P = ((P)) + ((4));
// 3713 ERR=STROP(REG)
ERR = STROP(REG);
// 3714 -> ERROR %UNLESS ERR=0
if (( ERR ) == ( 0 )) goto L_0362;
goto U_01e6;
L_0362:
// 3715 VALUE=WKAREA
VALUE = WKAREA;
// 3716 P=P+1; STRFNRES=0
P = ((P)) + ((1));
STRFNRES = 0;
// 3717 %RETURN
return;
// 3718 ERROR: FAULT2(ERR,0,FNAM)
U_01e6:
FAULT2(ERR, 0, FNAM);
// 3719 BASE=RBASE; DISP=0
BASE = RBASE;
DISP = 0;
// 3720 VALUE=0; ACCESS=0
VALUE = 0;
ACCESS = 0;
// 3721 P=PP; SKIP EXP
P = PP;
SKIPEXP();
// 3722 %RETURN
return;
// 3723 NORMAL: CLEN=0; P=P+3; ! LENGTH OF CONSTANT PART
U_01e4:
CLEN = 0;
P = ((P)) + ((3));
// 3724 ERR=72; ->ERROR %UNLESS A(P)=4
ERR = 72;
if (( A[P] ) == ( 4 )) goto L_0363;
goto U_01e6;
L_0363:
// 3725 P=P+1
P = ((P)) + ((1));
// 3726 GET WSP(WKAREA,268); ! GET NEXT OPERAND
GETWSP( &WKAREA, 268);
// 3727 DOTS=0; ! NO OPERATORS YET
DOTS = 0;
// 3728 NEXT: STRINGL=0
U_01e7:
STRINGL = 0;
// 3729 ERR=STROP(DR); ! GET NEXT OPERAND
ERR = STROP(1);
// 3730 -> ERROR %UNLESS ERR=0
if (( ERR ) == ( 0 )) goto L_0364;
goto U_01e6;
L_0364:
// 3731 %IF REGISTER(ACCR)#0 %THEN BOOT OUT(ACCR)
if (( REGISTER[0] ) == ( 0 )) goto L_0365;
BOOTOUT(0);
L_0365:
// 3732 PSF1(LB,0,WKAREA); ! BYTE DISP FROM LNB
PSF1(122, 0, WKAREA);
// 3733 PPJ(0,19+DOTS); ! TO SUBROUTINE 19 OR 20
PPJ(0, ((19)) + ((DOTS)));
// 3734 %IF A(P)=2 %THEN -> TIDY; ! NO MORE OPERATIONS
if (( A[P] ) != ( 2 )) goto L_0366;
goto U_01e8;
L_0366:
// 3735 ERR=72; -> ERROR %UNLESS A(P+1)=CONCOP; ! CONCATENATE
ERR = 72;
if (( A[((P)) + ((1))] ) == ( 13 )) goto L_0367;
goto U_01e6;
L_0367:
// 3736 DOTS=DOTS!1
DOTS = ((DOTS)) | ((1));
// 3737 P=P+2; -> NEXT
P = ((P)) + ((2));
goto U_01e7;
// 3738 TIDY: ! FINISH OFF
U_01e8:
// 3739 VALUE=WKAREA
VALUE = WKAREA;
// 3740 P=P+1; ! PAST REST OF EXPRN
P = ((P)) + ((1));
// 3741 RETURN WSP(WKAREA,268) %IF KEEPWA=0
if (( KEEPWA ) != ( 0 )) goto L_0368;
RETURNWSP(WKAREA, 268);
L_0368:
// 3742 STRINGL=0
STRINGL = 0;
// 3743 %RETURN
return;
// 3744 %INTEGERFN STROP(%INTEGER REG)
int STROP( int REG )
{
__label__ _imp_endofblock;
// 3745 !***********************************************************************
// 3746 !* DEALS WITH OPERAND FOR CONCATENATION. RETURN RESULT=0 FOR *
// 3747 !* VALID OPERAND OTHERWISE AN ERROR NUMBER. *
// 3748 !***********************************************************************
// 3749 %INTEGER CTYPE,VAL,MODE
int CTYPE;
int VAL;
int MODE;
// 3750 MODE=A(P); ! ALTERNATIVE OF OPERAND
MODE = A[P];
// 3751 %RESULT=75 %IF MODE>2
if (( MODE ) <= ( 2 )) goto L_0369;
return 75;
L_0369:
// 3752 %IF MODE#1 %THEN %START
if (( MODE ) == ( 1 )) goto L_036a;
// 3753 CTYPE=A(P+1); ! GET CONST TYPE & LOSE AMCK FLAGS
CTYPE = A[((P)) + ((1))];
// 3754 %IF CTYPE=16_35 %THEN %START
if (( CTYPE ) != ( 53 )) goto L_036b;
// 3755 STRINGL=A(P+6)
STRINGL = A[((P)) + ((6))];
// 3756 DISP=FROM AR4(P+2)
DISP = FROMAR4(((P)) + ((2)));
// 3757 P=P+STRINGL+7
P = ((((P)) + ((STRINGL)))) + ((7));
// 3758 %FINISH %ELSE %RESULT=71
goto L_036c;
L_036b:
return 71;
L_036c:
// 3759 PF1(LDRL,0,PC,STRLINK)
PF1(112, 0, 4, STRLINK);
// 3760 PSF1(INCA,0,DISP) %IF DISP#0
if (( DISP ) == ( 0 )) goto L_036d;
PSF1(20, 0, DISP);
L_036d:
// 3761 %IF STRINGL#1 %THEN %START
if (( STRINGL ) == ( 1 )) goto L_036e;
// 3762 %IF STRINGL<=63 %THEN PSF1(LDB,0,STRINGL) %ELSE PF1(LDB,2,7,0);! ((DR))
if (( STRINGL ) > ( 63 )) goto L_036f;
PSF1(118, 0, STRINGL);
goto L_0370;
L_036f:
PF1(118, 2, 7, 0);
L_0370:
// 3763 %FINISH
L_036e:
// 3764 GRUSE(DR)=0
GRUSE[1] = 0;
// 3765 %IF REG=ACCR %THEN COPY DR
if (( REG ) != ( 0 )) goto L_0371;
COPYDR();
L_0371:
// 3766 %FINISH %ELSE %START
goto L_0372;
L_036a:
// 3767 P=P+1; ! MUST CHECK FIRST
P = ((P)) + ((1));
// 3768 REDUCE TAG; ! SINCE CNAME ONLY LOADS STRINGS
REDUCETAG();
// 3769 ! AND LONGINTS TO DR!
// 3770 %IF 5#TYPE#7 %THEN FNAM=FROMAR2(P) %AND %RESULT=71
if (( 5 ) == ( TYPE )) goto L_0373;
if (( TYPE ) == ( 7 )) goto L_0373;
FNAM = FROMAR2(P);
return 71;
L_0373:
// 3771 CNAME(2,REG)
CNAME(2, REG);
// 3772 STRINGL=0
STRINGL = 0;
// 3773 %IF ROUT#0 %AND NAM<=1 %START;! WAS FUNCTION NOT MAP
if (( ROUT ) == ( 0 )) goto L_0374;
if (( NAM ) > ( 1 )) goto L_0374;
// 3774 %IF WKAREA=0 %AND KEEPWA#0 %THEN WKAREA=STRFNRES %ELSE RETURN WSP(STRFNRES,268)
if (( WKAREA ) != ( 0 )) goto L_0375;
if (( KEEPWA ) == ( 0 )) goto L_0375;
WKAREA = STRFNRES;
goto L_0376;
L_0375:
RETURNWSP(STRFNRES, 268);
L_0376:
// 3775 %FINISH
L_0374:
// 3776 %FINISH
L_0372:
// 3777 %RESULT=0
return 0;
// 3778 %END; ! OF INTEGERFN STROP
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block STROP at level 6
// 3779 %END; ! OF ROUTINE CSTREXP
return;
_imp_endofblock: ;
} // End of block CSTREXP at level 5
// 3780 %ROUTINE CRES (%INTEGER LAB)
void CRES( int LAB )
{
__label__ _imp_endofblock;
// 3781 !**********************************************************************
// 3782 !* COMPILES A RESOLUTION E.G A->B.(C).D.(E).F AND JUMPS TO LAB *
// 3783 !* ON FAILURE. (LAB=0 FOR UNCONDITIONAL RESOLUTION TO PERM ON *
// 3784 !* FAILURE ). *
// 3785 !* THE METHOD IS TO CALL A SUBROUTINE PASSING 3 PARAMS:- *
// 3786 !* P1 POINTS TO LHS(A) *
// 3787 !* P2 STRING TO CONTAIN FRAGMENT (PASSED BY NAME) *
// 3788 !* P3 THE EXPRESSION PASSED AS DESCRIPTOR *
// 3789 !* SUBROUTINE TRIES TO PERFORM THE RESOLUTION AND SETS THE *
// 3790 !* CONDITION CODE =8 IF IT SUCCEEDS. *
// 3791 !* *
// 3792 !* ON ENTRY LHS IS DEFINED BY DESCRIPTOR REG. *
// 3793 !* P POINTS TO P(+') OF RHS DEFINED AS (+')(OPERAND)(RESTOFEXP) *
// 3794 !* *
// 3795 !$ THE ROUTINE IS COMPACT BUT DIFFICULT TO FOLLOW (OR ALTER) *
// 3796 !* THE TIME IN PERM IS LARGE SO IT IS NOT WORTHWHILE TO PERSUE *
// 3797 !* CODE EFFICIENCY TOO INDUSTRIOUSLY . *
// 3798 !**********************************************************************
// 3799 %INTEGER P1,P2,SEXPRN,W,LAST,ERR,FNAM
int P1;
int P2;
int SEXPRN;
int W;
int LAST;
int ERR;
int FNAM;
// 3800 %RECORD (RD) R{(RD)
RD R;
// 3801 LAST=0; FNAM=0; ! =1 WHEN END OF EXPRNSN FOUND
LAST = 0;
FNAM = 0;
// 3802 SEXPRN=0; ! RESOLUTION(BRKTD) EXPRESSNS
SEXPRN = 0;
// 3803 ERR=74; ! NORMAL CRES FAULT
ERR = 74;
// 3804 PSF1(INCA,0,1); ! TO FIRST CHAR
PSF1(20, 0, 1);
// 3805 P1=P; P=P+3
P1 = P;
P = ((P)) + ((3));
// 3806 ->RES %IF A(P)=4; ! LHS MUST BE A STRING
if (( A[P] ) != ( 4 )) goto L_0377;
goto U_01e2;
L_0377:
// 3807 ! BUT THIS CHECKED BEFORE CALL
// 3808 ERR=72
ERR = 72;
// 3809 ERROR: FAULT2(ERR,0,FNAM)
U_01e3:
FAULT2(ERR, 0, FNAM);
// 3810 P=P1; SKIP EXP; %RETURN
P = P1;
SKIPEXP();
return;
// 3811 RES: P=P+1; ! TO P(OPERAND)
U_01e2:
P = ((P)) + ((1));
// 3812 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 3813 %IF SEXPRN=0 %THEN W=STD %ELSE W=ST
if (( SEXPRN ) != ( 0 )) goto L_0378;
W = 88;
goto L_0379;
L_0378:
W = 72;
L_0379:
// 3814 PF1(W,0,TOS,0)
PF1(W, 0, 6, 0);
// 3815 %IF A(P)=3 %THEN PSF1(LSD,0,0) %AND GRUSE(ACCR)=0 %ELSE %START;! B OMITTED
if (( A[P] ) != ( 3 )) goto L_037a;
PSF1(100, 0, 0);
GRUSE[0] = 0;
goto L_037b;
L_037a:
// 3816 ->ERROR %UNLESS A(P)=1; ! P(OPERAND)=NAME
if (( A[P] ) == ( 1 )) goto L_037c;
goto U_01e3;
L_037c:
// 3817 P=P+1; P2=P
P = ((P)) + ((1));
P2 = P;
// 3818 CNAME(3,ACCR)
CNAME(3, 0);
// 3819 %IF TYPE#5 %THEN ERR=71 %AND FNAM=FROMAR2(P2) %AND ->ERROR
if (( TYPE ) == ( 5 )) goto L_037d;
ERR = 71;
FNAM = FROMAR2(P2);
goto U_01e3;
L_037d:
// 3820 %IF A(P+1)#CONCOP %THEN ERR=72 %AND ->ERROR
if (( A[((P)) + ((1))] ) == ( 13 )) goto L_037e;
ERR = 72;
goto U_01e3;
L_037e:
// 3821 P=P+2
P = ((P)) + ((2));
// 3822 %FINISH
L_037b:
// 3823 PF1(ST,0,TOS,0); ! B (OR DUMMY) TO P2
PF1(72, 0, 6, 0);
// 3824 ->ERROR %UNLESS A(P)=3; ! P(OPERAND)='('(EXPR)')'
if (( A[P] ) == ( 3 )) goto L_037f;
goto U_01e3;
L_037f:
// 3825 SEXPRN=SEXPRN+1; P=P+1
SEXPRN = ((SEXPRN)) + ((1));
P = ((P)) + ((1));
// 3826 CSTREXP(0,DR); ! TO REGISTER DR
CSTREXP(0, 1);
// 3827 !
// 3828 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 3829 PSF1(RALN,0,11)
PSF1(108, 0, 11);
// 3830 PPJ(-1,16)
PPJ((-(1)), 16);
// 3831 ! DEAL WITH CC#8 IE RESLN FAILED
// 3832 %IF LAB#0 %THEN ENTER JUMP(7,LAB,B'11') %ELSE PPJ(7,12)
if (( LAB ) == ( 0 )) goto L_0380;
ENTERJUMP(7, LAB, 3);
goto L_0381;
L_0380:
PPJ(7, 12);
L_0381:
// 3833 !
// 3834 -> END %IF A(P)=2
if (( A[P] ) != ( 2 )) goto L_0382;
goto U_01e4;
L_0382:
// 3835 %IF A(P+1)#CONCOP %THEN ERR=72 %AND ->ERROR
if (( A[((P)) + ((1))] ) == ( 13 )) goto L_0383;
ERR = 72;
goto U_01e3;
L_0383:
// 3836 ->ERROR %UNLESS A(P+2)=1
if (( A[((P)) + ((2))] ) == ( 1 )) goto L_0384;
goto U_01e3;
L_0384:
// 3837 P2=P+1; P=P2+1
P2 = ((P)) + ((1));
P = ((P2)) + ((1));
// 3838 P=P+3 %AND SKIP APP %UNTIL A(P)=2
L_0385:
P = ((P)) + ((3));
SKIPAPP();
if (( A[P] ) == ( 2 )) goto L_0386;
goto L_0385;
L_0386:
// 3839 %IF A(P+1)=1 %THEN P=P2 %AND ->RES
if (( A[((P)) + ((1))] ) != ( 1 )) goto L_0388;
P = P2;
goto U_01e2;
L_0388:
// 3840 P1=P+1
P1 = ((P)) + ((1));
// 3841 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 3842 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 3843 R_PTYPE=1; R_XB=ACCR
R.PTYPE = 1;
R.XB = 0;
// 3844 R_FLAG=9
R.FLAG = 9;
// 3845 P=P2+2; CNAME(1,DR)
P = ((P2)) + ((2));
CNAME(1, 1);
// 3846 %IF R_FLAG#9 %THEN PF1(LSD,0,TOS,0)
if (( R.FLAG ) == ( 9 )) goto L_0389;
PF1(100, 0, 6, 0);
L_0389:
// 3847 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 3848 PF1(STUH,0,BREG,0)
PF1(74, 0, 7, 0);
// 3849 PF1(LUH,0,BREG,0)
PF1(106, 0, 7, 0);
// 3850 PF2(MVL,0,0,0,0,0)
PF2(176, 0, 0, 0, 0, 0);
// 3851 %IF ROUT#0 %OR NAM#0 %THEN PPJ(0,18);! ASSNMNT CHECK (Q.V)
if (( ROUT ) != ( 0 )) goto L_0387;
if (( NAM ) == ( 0 )) goto L_038a;
L_0387:
PPJ(0, 18);
L_038a:
// 3852 PF2(MV,1,1,0,0,UNASSPAT&255)
PF2(178, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 3853 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 3854 %IF PARMARR=1 %START
if (( PARMARR ) != ( 1 )) goto L_038b;
// 3855 PSF1(USH,0,8)
PSF1(200, 0, 8);
// 3856 PSF1(USH,0,-40)
PSF1(200, 0, (-(40)));
// 3857 PPJ(36,9)
PPJ(36, 9);
// 3858 %FINISH
L_038b:
// 3859 P=P1
P = P1;
// 3860 END:
U_01e4:
// 3861 P=P+1
P = ((P)) + ((1));
// 3862 %END
return;
_imp_endofblock: ;
} // End of block CRES at level 5
// 3863 %ROUTINE SAVE AUX STACK
void SAVEAUXSTACK( void )
{
__label__ _imp_endofblock;
// 3864 !***********************************************************************
// 3865 !* COPY AUX STACK DESCRPTR & POINTER INTO CURRENT STACK FRAME *
// 3866 !* FIVE WORDS ARE USED FOR THIS PURPOSE:- *
// 3867 !* 1&2 HOLD AUX STACK DESCRIPTOR *
// 3868 !* 3 HOLDS VALUE AT BLK ENTRY FOR USE AT EXIT *
// 3869 !* 4 HOLDS STACKTOP VALUE AFTER ALL ARRAY DECLNS(FOR %ONS) *
// 3870 !* 5 HOLD STACKLIMIT FOR CHECKING AT ARRAY DECLARATIONS *
// 3871 !* THE LATTER IS OMITTED INPARM=OPT *
// 3872 !***********************************************************************
// 3873 %INTEGER XYNB, DR0, DR1
int XYNB;
int DR0;
int DR1;
// 3874 %IF AUXST=0 %THEN %START; ! FIRST REF PUT REF IN PLT
if (( AUXST ) != ( 0 )) goto L_038c;
// 3875 DR0=16_30000001; DR1=0
DR0 = 805306369;
DR1 = 0;
// 3876 PGLA(8,8,ADDR(DR0))
PGLA(8, 8, ADDR( &DR0));
// 3877 AUXST=GLACA-8
AUXST = ((GLACA)) - ((8));
// 3878 GXREF(AUXSTEP,2,16_02000008,AUXST+4)
GXREF(AUXSTEP, 2, 33554440, ((AUXST)) + ((4)));
// 3879 %FINISH
L_038c:
// 3880 %IF AUXSBASE(LEVEL)=0 %START
if (( AUXSBASE[LEVEL] ) != ( 0 )) goto L_038d;
// 3881 XYNB=SET XORYNB(-1,-1)
XYNB = SETXORYNB((-(1)), (-(1)));
// 3882 PF1(LD,2,XYNB,AUXST)
PF1(120, 2, XYNB, AUXST);
// 3883 %IF PARMOPT#0 %THEN %START
if (( PARMOPT ) == ( 0 )) goto L_038e;
// 3884 PF1(LSS,1,0,2); ! PICK UP STACKTOP
PF1(98, 1, 0, 2);
// 3885 PSF1(ST,1,N+16)
PSF1(72, 1, ((N)) + ((16)));
// 3886 %FINISH
L_038e:
// 3887 PF1(LSS,2,7,0)
PF1(98, 2, 7, 0);
// 3888 PSF1(STD,1,N)
PSF1(88, 1, N);
// 3889 PSF1(ST,1,N+8)
PSF1(72, 1, ((N)) + ((8)));
// 3890 AUXSBASE(LEVEL)=N; N=N+16
AUXSBASE[LEVEL] = N;
N = ((N)) + ((16));
// 3891 %IF PARMOPT#0 %THEN N=N+4
if (( PARMOPT ) == ( 0 )) goto L_038f;
N = ((N)) + ((4));
L_038f:
// 3892 GRUSE(DR)=0; GRUSE(ACCR)=11; GRINF1(ACCR)=0
GRUSE[1] = 0;
GRUSE[0] = 11;
GRINF1[0] = 0;
// 3893 %FINISH
L_038d:
// 3894 %END
return;
_imp_endofblock: ;
} // End of block SAVEAUXSTACK at level 5
// 3895 %ROUTINE RESET AUX STACK
void RESETAUXSTACK( void )
{
__label__ _imp_endofblock;
// 3896 !***********************************************************************
// 3897 !* IF ANY ARRAYS HAVE BEEN PUT ON THE AUXSTACK THEN UNDECLARE *
// 3898 !***********************************************************************
// 3899 %IF AUXSBASE(LEVEL)#0 %START
if (( AUXSBASE[LEVEL] ) == ( 0 )) goto L_0390;
// 3900 PSF1(LB,1,AUXSBASE(LEVEL)+8)
PSF1(122, 1, ((AUXSBASE[LEVEL])) + ((8)));
// 3901 PSF1(STB,2,AUXSBASE(LEVEL))
PSF1(90, 2, AUXSBASE[LEVEL]);
// 3902 GRUSE(BREG)=0
GRUSE[7] = 0;
// 3903 %FINISH
L_0390:
// 3904 %END
return;
_imp_endofblock: ;
} // End of block RESETAUXSTACK at level 5
// 3905 %ROUTINE RT EXIT
void RTEXIT( void )
{
__label__ _imp_endofblock;
// 3906 !***********************************************************************
// 3907 !* THIS ROUTINE COMPILES CODE FOR ROUTINE EXIT(IE '%RETURN') *
// 3908 !***********************************************************************
// 3909 RESET AUX STACK
RESETAUXSTACK();
// 3910 PSF1(EXIT,0,-16_40)
PSF1(56, 0, (-(64)));
// 3911 %END
return;
_imp_endofblock: ;
} // End of block RTEXIT at level 5
// 3912 %ROUTINE CLAIM ST FRAME(%INTEGER AT,VALUE)
void CLAIMSTFRAME( int AT, int VALUE )
{
__label__ _imp_endofblock;
// 3913 !***********************************************************************
// 3914 !* FILL ASF INSTN IN RT ENTRY SEQUENCE TO CLAIM THE STACKFRAME *
// 3915 !***********************************************************************
// 3916 %INTEGER INSTR, WK
int INSTR;
int WK;
// 3917 WK=AT>>18; ! BYTES CLAIMED BY ENTRY SEQ
WK = (int)(((unsigned int)(AT)) >> ((18)));
// 3918 AT=AT&16_3FFFF; ! ADRR OF ASF INSTRN
AT = ((AT)) & ((262143));
// 3919 INSTR=(ASF+12*PARMCHK)<<24!3<<23!(VALUE-WK+3)>>2
INSTR = ((((((((110)) + ((((12)) * ((PARMCHK)))))) << ((24)))) | ((((3)) << ((23)))))) | (((int)(((unsigned int)(((((VALUE)) - ((WK)))) + ((3)))) >> ((2)))));
// 3920 PLUG(1,AT,INSTR,4)
PLUG(1, AT, INSTR, 4);
// 3921 %END
return;
_imp_endofblock: ;
} // End of block CLAIMSTFRAME at level 5
// 3922 %ROUTINE CEND (%INTEGER KKK)
void CEND( int KKK )
{
__label__ _imp_endofblock;
// 3923 !***********************************************************************
// 3924 !* DEAL WITH ALL OCCURENCES OF '%END' *
// 3925 !* KKK=PTYPE(>=16_1000) FOR ROUTINES,FNS AND MAPS *
// 3926 !* KKK=0 FOR ENDS OF '%BEGIN' BLOCKS *
// 3927 !* KKK=1 FOR '%ENDOFPROGRAM' *
// 3928 !* %ENDOFPROGRAM IS REALLY TWO ENDS. THE FIRST IS THE USERS *
// 3929 !* AND THE SECOND IS PERMS. KKK=2 FOR A RECURSIVE CALL OF CEND *
// 3930 !* ON END OF PROGRAM TO DEAL WITH THE %END CORRESPONDING TO *
// 3931 !* THE %BEGIN COMPILED IN THE INITIALISATION SEQUENCE *
// 3932 !***********************************************************************
// 3933 %INTEGER KP,JJ,BIT
int KP;
int JJ;
int BIT;
// 3934 %ROUTINESPEC DTABLE(%INTEGER LEVEL)
auto void DTABLE( int LEVEL );
// 3935 SET LINE %UNLESS KKK=2
if (( KKK ) == ( 2 )) goto L_0391;
SETLINE();
L_0391:
// 3936 FORGET(-1)
FORGET((-(1)));
// 3937 BIT=1<<LEVEL
BIT = ((1)) << ((LEVEL));
// 3938 !
// 3939 ! NOW PLANT AN ERROR EXIT FOR FNS AND MAPS - CONTROL SHOULD BE RETURNED
// 3940 ! VIA %RESULT= AN SHOULD NEVVER REACH THE %END INSTRUCTION
// 3941 !
// 3942 %IF KKK&16_3FFF>16_1000 %AND COMPILER=0 %AND LAST INST=0 %THEN PPJ(15,10); ! RUN FAULT 11
if (( ((KKK)) & ((16383)) ) <= ( 4096 )) goto L_0392;
if (( COMPILER ) != ( 0 )) goto L_0392;
if (( LASTINST ) != ( 0 )) goto L_0392;
PPJ(15, 10);
L_0392:
// 3943 NMAX=N %IF N>NMAX; ! WORK SPACE POINTER
if (( N ) <= ( NMAX )) goto L_0393;
NMAX = N;
L_0393:
// 3944 !
// 3945 ! CLEAR OUT THE LABEL LIST FAULTING LABELS WITH JUMPS OUTSTANDING
// 3946 ! AS NOT SET AND COMMENTING ON LABELS NOT USED
// 3947 !
// 3948 %WHILE LABEL(LEVEL)#0 %CYCLE
L_0394:
if (( LABEL[LEVEL] ) == ( 0 )) goto L_0395;
// 3949 POP(LABEL(LEVEL),I,J,KP)
POP( &LABEL[LEVEL], &I, &J, &KP);
// 3950 I=I>>24
I = (int)(((unsigned int)(I)) >> ((24)));
// 3951 %IF J&16_FFFF#0 %THEN %START
if (( ((J)) & ((65535)) ) == ( 0 )) goto L_0397;
// 3952 J=J&16_FFFF
J = ((J)) & ((65535));
// 3953 %IF 0<KP<=MAX ULAB %THEN FAULT2(11,FROM3(J),KP)
if (( 0 ) >= ( KP )) goto L_0398;
if (( KP ) > ( MAXULAB )) goto L_0398;
FAULT2(11, FROM3(J), KP);
L_0398:
// 3954 CLEAR LIST(J)
CLEARLIST( &J);
// 3955 %FINISH %ELSE %START
goto L_0399;
L_0397:
// 3956 %IF I=0 %AND KP<MAX ULAB %THEN WARN(3,KP)
if (( I ) != ( 0 )) goto L_039a;
if (( KP ) >= ( MAXULAB )) goto L_039a;
WARN(3, KP);
L_039a:
// 3957 %FINISH
L_0399:
// 3958 %REPEAT
goto L_0394;
L_0395:
// 3959 !
// 3960 %CYCLE JJ=0,1,4
JJ = ((0)) - ((1));
L_039b:
if (( JJ ) == ( 4 )) goto L_039c;
JJ = ((JJ)) + ((1));
// 3961 CLEAR LIST(AVL WSP(JJ,LEVEL));! RELEASE TEMPORARY LOCATIONS
CLEARLIST/* BAD FORM %array (11) - NOT CALLABLE!*/ // 3962 %REPEAT
goto L_039b;
L_039c:
// 3963 !
// 3964 DTABLE(LEVEL); ! OUTPUT DIAGNOSTIC TABLES
DTABLE(LEVEL);
// 3965 !
// 3966 ! CLEAR DECLARATIONS - POP UP ANY GLOBAL NAMES THAT WERE REDECLARED
// 3967 ! DESTROY SIDE CHAINS FOR ROUTINES,FORMATS AND SWITCHES
// 3968 !
// 3969 !
// 3970 ! NOW CLAIM THE STACK FRAME BY FILING THE ASF IN THE BLOCK ENTRY CODING
// 3971 !
// 3972 NMAX=(NMAX+7)&(-8)
NMAX = ((((NMAX)) + ((7)))) & (((-(8))));
// 3973 %IF KKK=2 %THEN %RETURN
if (( KKK ) != ( 2 )) goto L_039e;
return;
L_039e:
// 3974 %IF KKK>=16_1000 %OR KKK=1 %THEN CLAIM ST FRAME(SET(RLEVEL),NMAX)
if (( KKK ) >= ( 4096 )) goto L_039d;
if (( KKK ) != ( 1 )) goto L_039f;
L_039d:
CLAIMSTFRAME(SET[RLEVEL], NMAX);
L_039f:
// 3975 !
// 3976 ! NOW PLANT THE BLOCK EXIT SEQUENCE
// 3977 !
// 3978 %IF KKK&16_3FFF=16_1000 %AND LAST INST=0 %THEN RT EXIT
if (( ((KKK)) & ((16383)) ) != ( 4096 )) goto L_03a0;
if (( LASTINST ) != ( 0 )) goto L_03a0;
RTEXIT();
L_03a0:
// 3979 PPJ(15,21) %IF KKK=1 %AND LAST INST=0;! %STOP AT %ENDOFPROGRAM
if (( KKK ) != ( 1 )) goto L_03a1;
if (( LASTINST ) != ( 0 )) goto L_03a1;
PPJ(15, 21);
L_03a1:
// 3980 %IF KKK=0 %THEN %START; ! BEGIN BLOCK EXIT
if (( KKK ) != ( 0 )) goto L_03a2;
// 3981 %IF PARMTRACE=1 %THEN %START; ! RESTORE DIAGS POINTERS
if (( PARMTRACE ) != ( 1 )) goto L_03a3;
// 3982 PSF1(LD,1,12)
PSF1(120, 1, 12);
// 3983 DIAG POINTER(LEVEL-1)
DIAGPOINTER(((LEVEL)) - ((1)));
// 3984 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 3985 %FINISH
L_03a3:
// 3986 %IF STACK#0 %START
if (( STACK ) == ( 0 )) goto L_03a4;
// 3987 JJ=NMDECS(LEVEL)>>14
JJ = (int)(((unsigned int)(NMDECS[LEVEL])) >> ((14)));
// 3988 %IF JJ#0 %THEN %START; ! ARRAYS TO BE UNDECLARED
if (( JJ ) == ( 0 )) goto L_03a5;
// 3989 PF1(STSF,0,TOS,0)
PF1(94, 0, 6, 0);
// 3990 PF1(LSS,0,TOS,0)
PF1(98, 0, 6, 0);
// 3991 PSF1(ISB,1,JJ)
PSF1(226, 1, JJ);
// 3992 PSF1(USH,0,-2)
PSF1(200, 0, (-(2)));
// 3993 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 3994 PF1(ASF,0,TOS,0)
PF1(110, 0, 6, 0);
// 3995 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 3996 %FINISH
L_03a5:
// 3997 %FINISH %ELSE RESET AUX STACK
goto L_03a6;
L_03a4:
RESETAUXSTACK();
L_03a6:
// 3998 %FINISH
L_03a2:
// 3999 !
// 4000 ! RETURN TO PREVIOUS LEVEL PROVIDED THERE IS A VALID ONE !
// 4001 !
// 4002 %UNLESS LEVEL>2 %OR (LEVEL=2 %AND CPRMODE=2) %THEN %START
if (( LEVEL ) > ( 2 )) goto L_03a7;
if (( LEVEL ) != ( 2 )) goto L_03a8;
if (( CPRMODE ) == ( 2 )) goto L_03a7;
L_03a8:
// 4003 %IF KKK=1 %AND LEVEL=2 %THEN KKK=2 %ELSE FAULT(14,0) %AND %STOP
if (( KKK ) != ( 1 )) goto L_03a9;
if (( LEVEL ) != ( 2 )) goto L_03a9;
KKK = 2;
goto L_03aa;
L_03a9:
FAULT(14, 0);
exit(0);
L_03aa:
// 4004 %FINISH
L_03a7:
// 4005 LEVEL=LEVEL-1
LEVEL = ((LEVEL)) - ((1));
// 4006 %IF KKK>=16_1000 %THEN %START
if (( KKK ) < ( 4096 )) goto L_03ab;
// 4007 RLEVEL=RLEVEL-1
RLEVEL = ((RLEVEL)) - ((1));
// 4008 RBASE=RLEVEL
RBASE = RLEVEL;
// 4009 %FINISH
L_03ab:
// 4010 !
// 4011 ! RESTORE INFORMATION ABOUT THE (NEW) CURRENT LEVEL
// 4012 !
// 4013 POP(LEVELINF,KP,N,KP)
POP( &LEVELINF, &KP, &N, &KP);
// 4014 NMAX=N>>16 %IF KKK>=16_1000
if (( KKK ) < ( 4096 )) goto L_03ac;
NMAX = (int)(((unsigned int)(N)) >> ((16)));
L_03ac:
// 4015 N=N&16_7FFF
N = ((N)) & ((32767));
// 4016 %IF KKK=2 %THEN CEND(KKK); ! ROUND AGAIN FOR 'ENDOFPROGRAM'
if (( KKK ) != ( 2 )) goto L_03ad;
CEND(KKK);
L_03ad:
// 4017 !
// 4018 ! COMPLETE THE JUMP AROUND ALL NON-EXTERNAL ROUTINES EXCEPT WHEN
// 4019 ! %TRUSTEDPROGRAM IS IN OPERATION.
// 4020 !
// 4021 %IF ASL WARN#0 %THEN ASL WARN=0 %AND EPILOGUE
if (( ASLWARN ) == ( 0 )) goto L_03ae;
ASLWARN = 0;
EPILOGUE();
L_03ae:
// 4022 %IF KKK>=16_1000 %AND COMPILER=0 %AND(RLEVEL>0 %OR CPRMODE#2) %THEN %START
if (( KKK ) < ( 4096 )) goto L_03af;
if (( COMPILER ) != ( 0 )) goto L_03af;
if (( RLEVEL ) > ( 0 )) goto L_03b0;
if (( CPRMODE ) == ( 2 )) goto L_03af;
L_03b0:
// 4023 JJ=NEXTP+6
JJ = ((NEXTP)) + ((6));
// 4024 %UNLESS A(NEXTP+5)=11 %AND A(JJ+FROMAR2(JJ))=2 %START
if (( A[((NEXTP)) + ((5))] ) != ( 11 )) goto L_03b1;
if (( A[((JJ)) + ((FROMAR2(JJ)))] ) == ( 2 )) goto L_03b2;
L_03b1:
// 4025 JJ=ENTER LAB(JROUND(LEVEL+1),0)
JJ = ENTERLAB(JROUND[((LEVEL)) + ((1))], 0);
// 4026 JROUND(LEVEL+1)=0
JROUND[((LEVEL)) + ((1))] = 0;
// 4027 %FINISH
L_03b2:
// 4028 %FINISH
L_03af:
// 4029 %RETURN
return;
// 4030 !
// 4031 ! LAYOUT OF DIAGNOSIC TABLES
// 4032 ! ****** ** ********* ******
// 4033 !
// 4034 ! THE BOUND FIELD OF PLT DESCRIPTOR STORED AT (LNB+3 & LNB+4) IF
// 4035 ! USED TO CONTAIN A DISPLACEMENT RELATIVE TO THE START OF SST OF THE
// 4036 ! DIAGNOSTIC TABLES FOR THE BLOCK OR ROUTINE BEING EXECUTED.
// 4037 ! A ZERO BOUND MEANS NO DIAGNOSTIC REQUESTED.(NB THIS MAY MEAN A DUMMY
// 4038 ! FIRST WORD IN THE SST).
// 4039 ! THE ABSOLUTE ADDRESS OF THE SST FOR THE CURRENT CODE SEGMENT WILL
// 4040 ! ALWAYS BE FOUND IN THE STANDARD 10 WORDS OF THE GLA/PLT
// 4041 !
// 4042 ! FORM OF THE TABLES:-
// 4043 !
// 4044 ! WORD 0 = LINE OF RT IN SOURCE PROG <<16 ! LINE NO POSN(FROM LNB)
// 4045 ! WORD 1 = (12 LANG DEPENDENT BITS)<<18 ! ENVIRONMENT
// 4046 ! ( TOP 2 BITS OF LANG DEPENDENT HAS LITL FROM PTYPE)
// 4047 ! ( BOTTOM 4 BITS HAVE TEXTUAL LEVEL)
// 4048 ! WORD 2 = DISPLAY POSN (FROM LNB)<<16 ! RT TYPE INFO
// 4049 ! WORD 3 = ZERO FOR BLKS OR STRING(<=11BYTES) BEING THE
// 4050 ! RT NAME. THIS WILL TAKE WORDS 4 AND 5 IF NEEDED
// 4051 ! WORD 6 = LANGUAGE DEPENDENT INFO . IMP ON CONDITIONS ETC
// 4052 !
// 4053 ! THE REST IS MADE UP OF VARIABLE ENTRIES AND THE SECTION IS TERMINATED BY
// 4054 ! A WORD OF 16_FFFFFFFF
// 4055 !
// 4056 ! EACH VARIABLE ENTRY CONSISTS OF THE VARIABLE WORD FOLLOWED BY
// 4057 ! THE VARIABLE NAME AS A STRING. THE WORD CONSISTS OF
// 4058 ! BITS 2**31 TO 2**20 TYPE INFORMATION (MAY BE LANGUAGE DEPENDENT
// 4059 ! BIT 2**19 =0 UNDER LNB =1 IN GLA
// 4060 ! BITS 2**18 TO 2**0 DISPLACEMENT FROM LNB(GLA) IN BYTES
// 4061 !
// 4062 !
// 4063 ! THE ENVIRONMENT IS A POINTER (RELATIVE TO SST) OF THE NEXT OUTERMOST
// 4064 ! BLOCK OR A POINTER TO GLOBAL OWNS, EXTERNAL OR COMMON AREAS
// 4065 ! A ZERO MEANS NO ENCLOSING BLOCK. WORD1=WORD3=0 IS AN
// 4066 ! IMP MAIN PROGRAM AND WILL TERMINATE THE DIAGNOSTICS.
// 4067 !
// 4068 %ROUTINE DTABLE(%INTEGER LEVEL)
void DTABLE( int LEVEL )
{
__label__ _imp_endofblock;
// 4069 !***********************************************************************
// 4070 !* THIS ROUTINE LOOKS AT THE DECLARATIONS FOR THE CURRENT LEVEL & *
// 4071 !* SETS UP THE SEGMENT OF SHARABLE SYMBOL TABLES TO DESCRIBE THEM.*
// 4072 !* FOR MAIN PROGRAMS OR EXTERNAL ROUTINES THE 'GLOBAL' VARIABLES *
// 4073 !* (IF ANY) ARE ALSO INCLUDED. *
// 4074 !***********************************************************************
// 4075 %STRING(31) RT NAME
_imp_string /*%string(31)*/ RTNAME;
// 4076 %STRING(11) LOCAL NAME
_imp_string /*%string(11)*/ LOCALNAME;
// 4077 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 4078 %CONSTINTEGER LARRROUT=16_F300
// 4079 %INTEGER DPTR,LNUM,ML,KK,JJ,Q,DEND,BIT,S1,S2,S3,S4,LANGD,II
int DPTR;
int LNUM;
int ML;
int KK;
int JJ;
int Q;
int DEND;
int BIT;
int S1;
int S2;
int S3;
int S4;
int LANGD;
int II;
// 4080 %INTEGERARRAY DD(0:500); ! BUFFER FOR SEGMENT OF SST
int DD[(500)-(0)+1];
// 4081 !
// 4082 ! FILL ALL OUTSTANDING REFERENCES TO THIS DIAGS BLOCK
// 4083 !
// 4084 BIT=1<<LEVEL
BIT = ((1)) << ((LEVEL));
// 4085 LANGD=KKK>>14<<30!LEVEL<<18; ! GET LITL FROM PTYPE
LANGD = (((((int)(((unsigned int)(KKK)) >> ((14))))) << ((30)))) | ((((LEVEL)) << ((18))));
// 4086 %WHILE RAL(LEVEL)#0 %CYCLE
L_03b3:
if (( RAL[LEVEL] ) == ( 0 )) goto L_03b4;
// 4087 POP(RAL(LEVEL),Q,JJ,KK)
POP( &RAL[LEVEL], &Q, &JJ, &KK);
// 4088 PLUG(Q,JJ,KK!SSTL,4)
PLUG(Q, JJ, ((KK)) | ((SSTL)), 4);
// 4089 %REPEAT
goto L_03b3;
L_03b4:
// 4090 PUSH(RAL(LEVEL-1),4,SSTL+4,LANGD) %IF PARMTRACE#0
if (( PARMTRACE ) == ( 0 )) goto L_03b6;
PUSH( &RAL[((LEVEL)) - ((1))], 4, ((SSTL)) + ((4)), LANGD);
L_03b6:
// 4091 DD(0)=L(LEVEL)<<16!(DIAGINF(LEVEL))
DD[0] = ((((L[LEVEL])) << ((16)))) | ((DIAGINF[LEVEL]));
// 4092 DD(1)=LANGD
DD[1] = LANGD;
// 4093 DD(2)=DISPLAY(RLEVEL)<<16!FLAG(LEVEL)&16_3FFF
DD[2] = ((((DISPLAY[RLEVEL])) << ((16)))) | ((((FLAG[LEVEL])) & ((16383))));
// 4094 ML=M(LEVEL); ! ROUTINE NAME(=0 FOR %BEGIN)
ML = M[LEVEL];
// 4095 LNUM=BYTEINTEGER(DICTBASE+ML); ! LENGTH OF THE NAME
LNUM = *BYTEINTEGER(((DICTBASE)) + ((ML)));
// 4096 DPTR=4; DEND=0
DPTR = 4;
DEND = 0;
// 4097 %IF LNUM=0 %THEN DD(3)=0 %ELSE %START
if (( LNUM ) != ( 0 )) goto L_03b7;
DD[3] = 0;
goto L_03b8;
L_03b7:
// 4098 Q=DICTBASE+ML
Q = ((DICTBASE)) + ((ML));
// 4099 RT NAME<-STRING(Q); ! FOR RTS MOVE IN 1ST 32 CHARS
RTNAME = *STRING(Q);
// 4100 LNUM=BYTE INTEGER(ADDR(RT NAME))
LNUM = *BYTEINTEGER(ADDR( &RTNAME));
// 4101 STRING(ADDR(DD(3)))=RTNAME; ! AND UPDATE POINTER PAST
*STRING(ADDR( &DD[3])) = RTNAME;
// 4102 DPTR=DPTR+LNUM>>2; ! ACTUAL NO OF CHARS
DPTR = ((DPTR)) + (((int)(((unsigned int)(LNUM)) >> ((2)))));
// 4103 %FINISH
L_03b8:
// 4104 DD(DPTR)=ONWORD(LEVEL); ! ON CONDITION WORD
DD[DPTR] = ONWORD[LEVEL];
// 4105 DPTR=DPTR+1
DPTR = ((DPTR)) + ((1));
// 4106 JJ=NAMES(LEVEL)
JJ = NAMES[LEVEL];
// 4107 %WHILE 0<=JJ<16_3FFF %CYCLE
L_03b9:
if (( 0 ) > ( JJ )) goto L_03ba;
if (( JJ ) >= ( 16383 )) goto L_03ba;
// 4108 LCELL==ASLIST(TAGS(JJ))
LCELL = (&(ASLIST[TAGS[JJ]]));
// 4109 ! OBTAIN NEXT NAME FORM DECLNS
// 4110 %IF LCELL_S1&16_F000=0 %THEN WARN(2,JJ)
if (( ((LCELL->S1)) & ((61440)) ) != ( 0 )) goto L_03bc;
WARN(2, JJ);
L_03bc:
// 4111 !
// 4112 ! GET ONLY THE MINIMUM OF DETALS NECESSARY
// 4113 !
// 4114 S1=LCELL_S1; S2=LCELL_S2
S1 = LCELL->S1;
S2 = LCELL->S2;
// 4115 S3=LCELL_S3; S4=LCELL_LINK
S3 = LCELL->S3;
S4 = LCELL->LINK;
// 4116 LCELL_LINK=ASL; ASL=TAGS(JJ)
LCELL->LINK = ASL;
ASL = TAGS[JJ];
// 4117 TAGS(JJ)=S4&16_3FFFF
TAGS[JJ] = ((S4)) & ((262143));
// 4118 PTYPE=S1>>16; TYPE=PTYPE&15
PTYPE = (int)(((unsigned int)(S1)) >> ((16)));
TYPE = ((PTYPE)) & ((15));
// 4119 I=S1>>4&15
I = (((int)(((unsigned int)(S1)) >> ((4))))) & ((15));
// 4120 J=S1&15
J = ((S1)) & ((15));
// 4121 K=S3>>16
K = (int)(((unsigned int)(S3)) >> ((16)));
// 4122 !
// 4123 ! ALLOW OWNS (LITL=0) AND EXTERNALS (=2) NOT CONSTS(=1) OR EXTRINSIC(=3)
// 4124 !
// 4125 %IF PARMDIAG#0 %AND PTYPE&16_7300<=16_200 %AND DPTR<497 %AND (TYPE=1 %OR TYPE=2 %OR TYPE=5) %START
if (( PARMDIAG ) == ( 0 )) goto L_03bd;
if (( ((PTYPE)) & ((29440)) ) > ( 512 )) goto L_03bd;
if (( DPTR ) >= ( 497 )) goto L_03bd;
if (( TYPE ) == ( 1 )) goto L_03be;
if (( TYPE ) == ( 2 )) goto L_03be;
if (( TYPE ) != ( 5 )) goto L_03bd;
L_03be:
// 4126 Q=DICTBASE+WORD(JJ); ! ADDRESS OF NAME
Q = ((DICTBASE)) + ((WORD[JJ]));
// 4127 %IF I=0 %THEN II=1 %ELSE II=0; ! GLA OR LNB BIT
if (( I ) != ( 0 )) goto L_03bf;
II = 1;
goto L_03c0;
L_03bf:
II = 0;
L_03c0:
// 4128 DD(DPTR)=PTYPE<<20!II<<18!K
DD[DPTR] = ((((((PTYPE)) << ((20)))) | ((((II)) << ((18)))))) | ((K));
// 4129 LOCAL NAME<-STRING(Q); ! TEXT OF NAME FROM DICTIONARY
LOCALNAME = *STRING(Q);
// 4130 LNUM=BYTE INTEGER(ADDR(LOCAL NAME))
LNUM = *BYTEINTEGER(ADDR( &LOCALNAME));
// 4131 STRING(ADDR(DD(DPTR))+4)=LOCAL NAME;! MOVE IN NAME
*STRING(((ADDR( &DD[DPTR]))) + ((4))) = LOCALNAME;
// 4132 DPTR=DPTR+(LNUM+8)>>2
DPTR = ((DPTR)) + (((int)(((unsigned int)(((LNUM)) + ((8)))) >> ((2)))));
// 4133 %FINISH
L_03bd:
// 4134 %IF J=15 %AND S2#0 %THEN FAULT2(28,0,JJ)
if (( J ) != ( 15 )) goto L_03c1;
if (( S2 ) == ( 0 )) goto L_03c1;
FAULT2(28, 0, JJ);
L_03c1:
// 4135 ! SPEC&CALLED BUT NO BODY GIVEN
// 4136 %IF PTYPE&16_3000#0 %OR TYPE=4 %OR TYPE=6 %THEN CLEAR LIST(K) %ELSE %START
if (( ((PTYPE)) & ((12288)) ) != ( 0 )) goto L_03c2;
if (( TYPE ) == ( 4 )) goto L_03c2;
if (( TYPE ) != ( 6 )) goto L_03c3;
L_03c2:
CLEARLIST( &K);
goto L_03c4;
L_03c3:
// 4137 %IF I#0 %AND K>511 %AND PTYPE&LARRROUT=0 %AND TYPE#7 %THEN WARN(5,JJ)
if (( I ) == ( 0 )) goto L_03c5;
if (( K ) <= ( 511 )) goto L_03c5;
if (( ((PTYPE)) & ((62208)) ) != ( 0 )) goto L_03c5;
if (( TYPE ) == ( 7 )) goto L_03c5;
WARN(5, JJ);
L_03c5:
// 4138 %FINISH
L_03c4:
// 4139 JJ=S4>>18
JJ = (int)(((unsigned int)(S4)) >> ((18)));
// 4140 %REPEAT
goto L_03b9;
L_03ba:
// 4141 DD(DPTR)=-1; ! 'END OF SEGMENT' MARK
DD[DPTR] = (-(1));
// 4142 DPTR=DPTR<<2+4
DPTR = ((((DPTR)) << ((2)))) + ((4));
// 4143 %IF PARMTRACE=1 %THEN %START
if (( PARMTRACE ) != ( 1 )) goto L_03c6;
// 4144 LPUT(4,DPTR,SSTL,ADDR(DD(0)));! ADD TO SHARABLE SYM TABS
LPUT(4, DPTR, SSTL, ADDR( &DD[0]));
// 4145 SSTL=SSTL+DPTR
SSTL = ((SSTL)) + ((DPTR));
// 4146 %FINISH
L_03c6:
// 4147 %END; ! OF ROUTINE DTABLE
return;
_imp_endofblock: ;
} // End of block DTABLE at level 6
// 4148 %END
return;
_imp_endofblock: ;
} // End of block CEND at level 5
// 4149 %ROUTINE MAKE DECS(%INTEGER Q)
void MAKEDECS( int Q )
{
__label__ _imp_endofblock;
// 4150 !***********************************************************************
// 4151 !* Q IS TO AR ENTRY FOR HEAD OF LINKED DECLARATIONS *
// 4152 !***********************************************************************
// 4153 %INTEGER QQ,HEAD,PRIO,COUNT,SL
int QQ;
int HEAD;
int PRIO;
int COUNT;
int SL;
// 4154 %INTEGERNAME THEAD
int *THEAD;
// 4155 %RECORD(LISTF)%NAME CELL{(LISTF)
LISTF *CELL;
// 4156 SL=LINE; QQ=FROM AR4(Q)
SL = LINE;
QQ = FROMAR4(Q);
// 4157 HEAD=0; COUNT=0
HEAD = 0;
COUNT = 0;
// 4158 %WHILE QQ#0 %CYCLE
L_03c7:
if (( QQ ) == ( 0 )) goto L_03c8;
// 4159 COUNT=COUNT+1
COUNT = ((COUNT)) + ((1));
// 4160 ABORT %UNLESS A(QQ+5)=8; ! LINE IS A DECLARATION
if (( A[((QQ)) + ((5))] ) == ( 8 )) goto L_03ca;
ABORT();
L_03ca:
// 4161 P=QQ+10; CLT
P = ((QQ)) + ((10));
CLT();
// 4162 %IF PREC=3 %OR A(P)#1 %OR A(P+1)# 3 %START
if (( PREC ) == ( 3 )) goto L_03cb;
if (( A[P] ) != ( 1 )) goto L_03cb;
if (( A[((P)) + ((1))] ) == ( 3 )) goto L_03cc;
L_03cb:
// 4163 INSERT AT END(HEAD,16_FFFF,QQ,0) %IF A(P)=1
if (( A[P] ) != ( 1 )) goto L_03cd;
INSERTATEND( &HEAD, 65535, QQ, 0);
L_03cd:
// 4164 %FINISH %ELSE %START
goto L_03ce;
L_03cc:
// 4165 PRIO=PREC<<4!TYPE
PRIO = ((((PREC)) << ((4)))) | ((TYPE));
// 4166 THEAD==HEAD
THEAD = (&(HEAD));
// 4167 %CYCLE
L_03cf:
// 4168 CELL==ASLIST(THEAD)
CELL = (&(ASLIST[THEAD]));
// 4169 %IF THEAD=0 %OR PRIO<CELL_S1 %THEN PUSH(THEAD,PRIO,QQ,0) %AND %EXIT
if (( THEAD ) == ( 0 )) goto L_02c9;
if (( PRIO ) >= ( CELL->S1 )) goto L_03d2;
L_02c9:
PUSH(THEAD, PRIO, QQ, 0);
goto L_03d0;
L_03d2:
// 4170 THEAD==CELL_LINK
THEAD = (&(CELL->LINK));
// 4171 %REPEAT
goto L_03cf;
L_03d0:
// 4172 %FINISH
L_03ce:
// 4173 QQ=FROM AR4(QQ+6)
QQ = FROMAR4(((QQ)) + ((6)));
// 4174 %REPEAT
goto L_03c7;
L_03c8:
// 4175 !
// 4176 ! NOW MAKE THE ORDEREED DECLARATIONS
// 4177 ! FIRST GRAB TWO TEMPORARIES IF SPACE IS LIKELY TO BE TIGHT
// 4178 !
// 4179 %IF COUNT>=7 %START
if (( COUNT ) < ( 7 )) goto L_03d3;
// 4180 GET WSP(QQ,2); ! A DIUBLE WORD
GETWSP( &QQ, 2);
// 4181 %IF AVL WSP(1,LEVEL)=0 %THEN GET WSP(QQ,1)
AVLWSPif (( /* This array object (985331) has not had bounds information attached. */
/* Object was created at line 940 */
/* No array bound info found for: */1[LEVEL] ) != ( 0 )) goto L_03d4;
GETWSP( &QQ, 1);
L_03d4:
// 4182 %FINISH
L_03d3:
// 4183 %WHILE HEAD#0 %CYCLE
L_03d5:
if (( HEAD ) == ( 0 )) goto L_03d6;
// 4184 POP(HEAD,PRIO,QQ,COUNT)
POP( &HEAD, &PRIO, &QQ, &COUNT);
// 4185 LINE=FROM AR2(QQ+3)
LINE = FROMAR2(((QQ)) + ((3)));
// 4186 P=QQ+10; CLT
P = ((QQ)) + ((10));
CLT();
// 4187 ROUT=0; LITL=0
ROUT = 0;
LITL = 0;
// 4188 CQN(P+1); P=P+2
CQN(((P)) + ((1)));
P = ((P)) + ((2));
// 4189 DECLARE SCALARS(1,0)
DECLARESCALARS(1, 0);
// 4190 %REPEAT
goto L_03d5;
L_03d6:
// 4191 LINE=SL
LINE = SL;
// 4192 %END
return;
_imp_endofblock: ;
} // End of block MAKEDECS at level 5
// 4193 %ROUTINE DECLARE SCALARS(%INTEGER PERMIT,XTRA)
void DECLARESCALARS( int PERMIT, int XTRA )
{
__label__ _imp_endofblock;
// 4194 !***********************************************************************
// 4195 !* THIS ROUTINE DECLARES A LIST OF SCALARS FROM INFORMATION *
// 4196 !* IN THE GLOBAL VARIABLES ROUT,NAM,ARR,PREC,TYPE & ACC.IT WORKS *
// 4197 !* OUT ROUNDING FACTORS FOR ITSELF. *
// 4198 !* P POINTS TO THE NAMELIST ON ENTRY AND IS UPDATED. *
// 4199 !***********************************************************************
// 4200 %INTEGER INC,Q,SCHAIN,DMADE,NPARMS,D0,SCAL NAME,TYPEP
int INC;
int Q;
int SCHAIN;
int DMADE;
int NPARMS;
int D0;
int SCALNAME;
int TYPEP;
// 4201 PACK(PTYPE); J=0
PACK( &PTYPE);
J = 0;
// 4202 INC=ACC; DMADE=0; SNDISP=0
INC = ACC;
DMADE = 0;
SNDISP = 0;
// 4203 %IF PTYPE=16_33 %THEN INC=(INC+3)&(-4)
if (( PTYPE ) != ( 51 )) goto L_03d8;
INC = ((((INC)) + ((3)))) & (((-(4))));
L_03d8:
// 4204 %IF NAM#0 %AND ROUT=0 %AND ARR=0 %THEN INC=8
if (( NAM ) == ( 0 )) goto L_03d9;
if (( ROUT ) != ( 0 )) goto L_03d9;
if (( ARR ) != ( 0 )) goto L_03d9;
INC = 8;
L_03d9:
// 4205 %IF NAM>0 %AND ARR>0 %THEN INC=16
if (( NAM ) <= ( 0 )) goto L_03da;
if (( ARR ) <= ( 0 )) goto L_03da;
INC = 16;
L_03da:
// 4206 %IF PTYPE=16_35 %AND ACC=0 %THEN FAULT(70,0)
if (( PTYPE ) != ( 53 )) goto L_03db;
if (( ACC ) != ( 0 )) goto L_03db;
FAULT(70, 0);
L_03db:
// 4207 %IF PERMIT#0 %AND (INC=8 %OR INC=16) %THEN ODD ALIGN
if (( PERMIT ) == ( 0 )) goto L_03dc;
if (( INC ) == ( 8 )) goto L_03d7;
if (( INC ) != ( 16 )) goto L_03dc;
L_03d7:
ODDALIGN();
L_03dc:
// 4208 %IF PTYPE=16_33 %OR (PTYPE=16_35 %AND PERMIT#0)%START
if (( PTYPE ) == ( 51 )) goto L_03dd;
if (( PTYPE ) != ( 53 )) goto L_03de;
if (( PERMIT ) == ( 0 )) goto L_03de;
L_03dd:
// 4209 D0=16_18000000+ACC
D0 = ((402653184)) + ((ACC));
// 4210 STORE CONST(Q,4,ADDR(D0))
STORECONST( &Q, 4, ADDR( &D0));
// 4211 PF1(LDTB,0,PC,Q)
PF1(116, 0, 4, Q);
// 4212 GRUSE(DR)=0
GRUSE[1] = 0;
// 4213 %FINISH
L_03de:
// 4214 %IF PTYPE=16_35 %START
if (( PTYPE ) != ( 53 )) goto L_03df;
// 4215 INC=8
INC = 8;
// 4216 %IF PERMIT#0 %START
if (( PERMIT ) == ( 0 )) goto L_03e0;
// 4217 PF1(STSF,0,TOS,0)
PF1(94, 0, 6, 0);
// 4218 PF1(LDA,0,TOS,0)
PF1(114, 0, 6, 0);
// 4219 %FINISH
L_03e0:
// 4220 %FINISH
L_03df:
// 4221 N=(N+3)&(-4)
N = ((((N)) + ((3)))) & (((-(4))));
// 4222 %IF PTYPE=16_33 %THEN %START
if (( PTYPE ) != ( 51 )) goto L_03e1;
// 4223 PSF1(LDA,1,PTR OFFSET(RBASE))
PSF1(114, 1, PTROFFSET(RBASE));
// 4224 PSF1(INCA,0,N+8)
PSF1(20, 0, ((N)) + ((8)));
// 4225 %FINISH
L_03e1:
// 4226 {%UNTIL A(P-1)=2} %CYCLE; ! DOWN THE NAMELIST
L_03e2:
// 4227 DMADE=DMADE+1
DMADE = ((DMADE)) + ((1));
// 4228 SCAL NAME=FROM AR2(P)
SCALNAME = FROMAR2(P);
// 4229 %IF PTYPE=16_31 %AND PERMIT=0 %THEN N=N+3;! BYTE PARAMS
if (( PTYPE ) != ( 49 )) goto L_03e5;
if (( PERMIT ) != ( 0 )) goto L_03e5;
N = ((N)) + ((3));
L_03e5:
// 4230 %IF PTYPE=16_41 %AND PERMIT=0 %THEN N=N+2
if (( PTYPE ) != ( 65 )) goto L_03e6;
if (( PERMIT ) != ( 0 )) goto L_03e6;
N = ((N)) + ((2));
L_03e6:
// 4231 SCHAIN=N
SCHAIN = N;
// 4232 KFORM=XTRA
KFORM = XTRA;
// 4233 %IF ROUT=1 %THEN %START
if (( ROUT ) != ( 1 )) goto L_03e7;
// 4234 TYPEP=PTYPE; ! CHANGED BY CFPLIST!
TYPEP = PTYPE;
// 4235 Q=P
Q = P;
// 4236 P=P+3 %UNTIL A(P-1)=2; ! TO FPP
L_03e8:
P = ((P)) + ((3));
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_03e9;
goto L_03e8;
L_03e9:
// 4237 CFPLIST(SCHAIN,NPARMS)
CFPLIST( &SCHAIN, &NPARMS);
// 4238 P=Q
P = Q;
// 4239 J=13
J = 13;
// 4240 KFORM=NPARMS; ! NO OF PARAMS OF FORMAL
KFORM = NPARMS;
// 4241 ACC=N; ! DISPLACEMENT TO MIDCELL
ACC = N;
// 4242 PTYPE=TYPEP; UNPACK
PTYPE = TYPEP;
UNPACK();
// 4243 %FINISH
L_03e7:
// 4244 P=P+3
P = ((P)) + ((3));
// 4245 %IF PTYPE=16_33 %THEN %START
if (( PTYPE ) != ( 51 )) goto L_03eb;
// 4246 PSF1(STD,1,N)
PSF1(88, 1, N);
// 4247 N=N+8; SCHAIN=N
N = ((N)) + ((8));
SCHAIN = N;
// 4248 %IF A(P-1)=1 %THEN PSF1(INCA,0,INC+8)
if (( A[((P)) - ((1))] ) != ( 1 )) goto L_03ec;
PSF1(20, 0, ((INC)) + ((8)));
L_03ec:
// 4249 %FINISH
L_03eb:
// 4250 %IF PTYPE=16_35 %AND PERMIT#0 %START
if (( PTYPE ) != ( 53 )) goto L_03ed;
if (( PERMIT ) == ( 0 )) goto L_03ed;
// 4251 PSF1(STD,1,N)
PSF1(88, 1, N);
// 4252 %IF A(P-1)=1 %THEN PSF1(INCA,0,(ACC+3)&(-4)) %ELSE %START
if (( A[((P)) - ((1))] ) != ( 1 )) goto L_03ee;
PSF1(20, 0, ((((ACC)) + ((3)))) & (((-(4)))));
goto L_03ef;
L_03ee:
// 4253 Q=((ACC+3)>>2)*DMADE
Q = (((int)(((unsigned int)(((ACC)) + ((3)))) >> ((2))))) * ((DMADE));
// 4254 PSF1(ASF+12*PARMCHK,0,Q)
PSF1(((110)) + ((((12)) * ((PARMCHK)))), 0, Q);
// 4255 %IF PARMCHK#0 %THEN PPJ(0,4)
if (( PARMCHK ) == ( 0 )) goto L_03f0;
PPJ(0, 4);
L_03f0:
// 4256 %FINISH
L_03ef:
// 4257 %FINISH
L_03ed:
// 4258 STORE TAG(SCAL NAME,SCHAIN)
STORETAG(SCALNAME, SCHAIN);
// 4259 N=N+INC
N = ((N)) + ((INC));
// 4260 %REPEAT %UNTIL A(P-1)=2
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_03e3;
goto L_03e2;
L_03e3:
// 4261 N=(N+3)&(-4) %IF PERMIT#0;! NO ROUNDING AMONG PARAMS
if (( PERMIT ) == ( 0 )) goto L_03f1;
N = ((((N)) + ((3)))) & (((-(4))));
L_03f1:
// 4262 %END
return;
_imp_endofblock: ;
} // End of block DECLARESCALARS at level 5
// 4263 %INTEGERFN DOPE VECTOR(%INTEGER TYPEP,ELSIZE,MODE,IDEN,%INTEGERNAME ASIZE,LB)
int DOPEVECTOR( int TYPEP, int ELSIZE, int MODE, int IDEN, int *ASIZE, int *LB )
{
__label__ _imp_endofblock;
// 4264 !***********************************************************************
// 4265 !* CONSTRUCTS THE DOPE-VECTOR FOR A CONSTANT ARRAY IN THE *
// 4266 !* SHAREABLE SYMBOL TABLES AND RETURNS ITS DISPLACEMENT AS RESULT*
// 4267 !* EVENTUALLY ALL NON DYNAMIC DOPE VECTORS SHOULD GO VIA HERE *
// 4268 !* P IS TO ALT (MUST BE 1!) OF P<BPAIR> *
// 4269 !* DOPE VECTOR CONSISTS OF :- *
// 4270 !* DESRIPTOR (SCALED WORD) POINTING AT FIRST TRIPLE BND=3*ND *
// 4271 !* SIZE (IN BYTES OF ENTIRE ARRAY) FOR STACK ADJUSTMENT *
// 4272 !* AND ND TRIPLES EACH CONSISTING OF:- *
// 4273 !* LBI - THE LOWER BOUND OF THE ITH DIMENSION *
// 4274 !* MI - THE STRIDE FOR THE ITH DIMENSION *
// 4275 !* CBI THE UPPER CHECK =(UBI-LBI+1)*MI *
// 4276 !* WHERE M1=1(SCALED ARRAYS) OR THE ELEMENT SIZE AND *
// 4277 !* MI = M(I-1)*RANGE(I-1) *
// 4278 !* MODE=0 DV MUST BE CONST, MODE#0 CAN BE DYNAMIC *
// 4279 !* P TO ALT (ALWAYS=1) OF P(BPAIR) *
// 4280 !***********************************************************************
// 4281 %INTEGER I, JJ, K, ND, D, UNSCAL, M0, HEAD, NOPS, TYPEPP, PIN, PTR
int I;
int JJ;
int K;
int ND;
int D;
int UNSCAL;
int M0;
int HEAD;
int NOPS;
int TYPEPP;
int PIN;
int PTR;
// 4282 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 4283 %INTEGERARRAY LBH,LBB,UBH,UBB(0:12)
int LBH[(12)-(0)+1];
int LBB[(12)-(0)+1];
int UBH[(12)-(0)+1];
int UBB[(12)-(0)+1];
// 4284 %INTEGERARRAY DV(0:39); ! ENOUGH FOR 12 DIMENSIONS
int DV[(39)-(0)+1];
// 4285 ND=0; NOPS=0; TYPEPP=0; PIN=P
ND = 0;
NOPS = 0;
TYPEPP = 0;
PIN = P;
// 4286 %IF TYPEP>2 %OR (TYPEP=1 %AND PREC=4) %THEN UNSCAL=1 %AND M0=ELSIZE %ELSE UNSCAL=0 %AND M0=1
if (( TYPEP ) > ( 2 )) goto L_03e4;
if (( TYPEP ) != ( 1 )) goto L_03f2;
if (( PREC ) != ( 4 )) goto L_03f2;
L_03e4:
UNSCAL = 1;
M0 = ELSIZE;
goto L_03f3;
L_03f2:
UNSCAL = 0;
M0 = 1;
L_03f3:
// 4287 {%UNTIL A(P)=2} %CYCLE
L_03f4:
// 4288 ND=ND+1; P=P+4
ND = ((ND)) + ((1));
P = ((P)) + ((4));
// 4289 LBH(ND)=0; LBB(ND)=0
LBH[ND] = 0;
LBB[ND] = 0;
// 4290 UBB(ND)=0; UBH(ND)=0
/* No array bound info found for: */UBB[ND] = 0;
UBH[ND] = 0;
// 4291 TORP(LBH(ND),LBB(ND),NOPS)
TORP( &LBH[ND], &LBB[ND], &NOPS);
// 4292 P=P+3
P = ((P)) + ((3));
// 4293 TYPEPP=TYPEPP!TYPE
TYPEPP = ((TYPEPP)) | ((TYPE));
// 4294 TORP(UBH(ND),UBB(ND),NOPS)
TORP( &UBH[ND], &/* No array bound info found for: */UBB[ND], &NOPS);
// 4295 TYPEPP=TYPEPP!TYPE
TYPEPP = ((TYPEPP)) | ((TYPE));
// 4296 %REPEAT %UNTIL A(P)=2
if (( A[P] ) == ( 2 )) goto L_03f5;
goto L_03f4;
L_03f5:
// 4297 P=P+1
P = ((P)) + ((1));
// 4298 ->NONCONST %UNLESS TYPEPP=1 %AND NOPS&16_40040000=0
if (( TYPEPP ) != ( 1 )) goto L_03f6;
if (( ((NOPS)) & ((1074003968)) ) == ( 0 )) goto L_03f7;
L_03f6:
goto U_01f3;
L_03f7:
// 4299 !
// 4300 ! NOW ONE CAN WORK OUT AND FILL IN THE TRIPLES
// 4301 !
// 4302 PTR=1
PTR = 1;
// 4303 %CYCLE D=ND,-1,1
D = ((ND)) - (((-(1))));
L_03f8:
if (( D ) == ( 1 )) goto L_03f9;
D = ((D)) + (((-(1))));
// 4304 K=3*D
K = ((3)) * ((D));
// 4305 EXPOP(LBH(PTR),ACCR,NOPS,16_251)
EXPOP(LBH[PTR], 0, NOPS, 593);
// 4306 EXPOPND_D=0 %AND FAULT(41,0) %UNLESS EXPOPND_FLAG<=1 %AND EXPOPND_PTYPE=16_51
if (( EXPOPND.FLAG ) > ( 1 )) goto L_03fb;
if (( EXPOPND.PTYPE ) == ( 81 )) goto L_03fc;
L_03fb:
EXPOPND.D = 0;
FAULT(41, 0);
L_03fc:
// 4307 DV(K)=EXPOPND_D
DV[K] = EXPOPND.D;
// 4308 DV(K+1)=M0
DV[((K)) + ((1))] = M0;
// 4309 EXPOP(UBH(PTR),ACCR,NOPS,16_251)
EXPOP(UBH[PTR], 0, NOPS, 593);
// 4310 EXPOPND_D=10 %AND FAULT(41,0) %UNLESS EXPOPND_FLAG<=1 %AND EXPOPND_PTYPE=16_51
if (( EXPOPND.FLAG ) > ( 1 )) goto L_03fd;
if (( EXPOPND.PTYPE ) == ( 81 )) goto L_03fe;
L_03fd:
EXPOPND.D = 10;
FAULT(41, 0);
L_03fe:
// 4311 JJ=EXPOPND_D
JJ = EXPOPND.D;
// 4312 M0=M0*(JJ-DV(K)+1)
M0 = ((M0)) * ((((((JJ)) - ((DV[K])))) + ((1))));
// 4313 FAULT2(38,1-M0,IDEN) %UNLESS JJ>=DV(K)
if (( JJ ) >= ( DV[K] )) goto L_03ff;
FAULT2(38, ((1)) - ((M0)), IDEN);
L_03ff:
// 4314 DV(K+2)=M0
DV[((K)) + ((2))] = M0;
// 4315 PTR=PTR+1
PTR = ((PTR)) + ((1));
// 4316 %REPEAT
goto L_03f8;
L_03f9:
// 4317 !
// 4318 %IF UNSCAL=0 %THEN M0=M0*ELSIZE
if (( UNSCAL ) != ( 0 )) goto L_0400;
M0 = ((M0)) * ((ELSIZE));
L_0400:
// 4319 %IF ND=1 %THEN LB=DV(3)
if (( ND ) != ( 1 )) goto L_0401;
LB = DV[3];
L_0401:
// 4320 ASIZE=M0
ASIZE = M0;
// 4321 DV(2)=ASIZE
DV[2] = ASIZE;
// 4322 DV(1)=12
DV[1] = 12;
// 4323 DV(0)=5<<27!3*ND; ! DESPTR FOR DV
DV[0] = ((((5)) << ((27)))) | ((((3)) * ((ND))));
// 4324 K=3*ND+2
K = ((((3)) * ((ND)))) + ((2));
// 4325 J=ND; ! DIMENSIONALITY FOR DECLN
J = ND;
// 4326 HEAD=DVHEADS(ND)
HEAD = DVHEADS[ND];
// 4327 %WHILE HEAD#0 %CYCLE
L_0402:
if (( HEAD ) == ( 0 )) goto L_0403;
// 4328 LCELL==ASLIST(HEAD)
LCELL = (&(ASLIST[HEAD]));
// 4329 %IF LCELL_S2=ASIZE %AND LCELL_S3=DV(5) %START
if (( LCELL->S2 ) != ( ASIZE )) goto L_0405;
if (( LCELL->S3 ) != ( DV[5] )) goto L_0405;
// 4330 %CYCLE D=0,1,K
D = ((0)) - ((1));
L_0406:
if (( D ) == ( K )) goto L_0407;
D = ((D)) + ((1));
// 4331 ->ON %UNLESS DV(D)=CTABLE_val(D+LCELL_S1)
if (( DV[D] ) == ( /* No array bound info found for: */CTABLE->VAL[((D)) + ((LCELL->S1))] )) goto L_0409;
goto U_01f4;
L_0409:
// 4332 %REPEAT
goto L_0406;
L_0407:
// 4333 %RESULT=16_80000000!4*LCELL_S1
return ((-2147483648)) | ((((4)) * ((LCELL->S1))));
// 4334 %FINISH
L_0405:
// 4335 ON:
U_01f4:
// 4336 HEAD=LCELL_LINK
HEAD = LCELL->LINK;
// 4337 %REPEAT
goto L_0402;
L_0403:
// 4338 %IF CONST PTR&1#0 %THEN CONST HOLE=CONST PTR %AND CONST PTR=CONST PTR+1
if (( ((CONSTPTR)) & ((1)) ) == ( 0 )) goto L_040a;
CONSTHOLE = CONSTPTR;
CONSTPTR = ((CONSTPTR)) + ((1));
L_040a:
// 4339 I=4*CONST PTR!16_80000000
I = ((((4)) * ((CONSTPTR)))) | ((-2147483648));
// 4340 PUSH(DVHEADS(ND),CONSTPTR,ASIZE,DV(5))
PUSH( &DVHEADS[ND], CONSTPTR, *ASIZE, DV[5]);
// 4341 %CYCLE D=0,1,K
D = ((0)) - ((1));
L_040b:
if (( D ) == ( K )) goto L_040c;
D = ((D)) + ((1));
// 4342 CTABLE_val(CONST PTR)=DV(D)
/* No array bound info found for: */CTABLE->VAL[CONSTPTR] = DV[D];
// 4343 CONST PTR=CONST PTR+1
CONSTPTR = ((CONSTPTR)) + ((1));
// 4344 %REPEAT
goto L_040b;
L_040c:
// 4345 %IF CONST PTR>CONST LIMIT %THEN FAULT(107,0)
if (( CONSTPTR ) <= ( CONSTLIMIT )) goto L_040e;
FAULT(107, 0);
L_040e:
// 4346 WAYOUT:
U_01f5:
// 4347 %CYCLE D=ND,-1,1
D = ((ND)) - (((-(1))));
L_040f:
if (( D ) == ( 1 )) goto L_0410;
D = ((D)) + (((-(1))));
// 4348 ASLIST(LBB(D))_LINK=ASL
ASLIST[LBB[D]].LINK = ASL;
// 4349 ASL=LBH(D)
ASL = LBH[D];
// 4350 ASLIST(UBB(D))_LINK=ASL
ASLIST[/* No array bound info found for: */UBB[D]].LINK = ASL;
// 4351 ASL=UBH(D)
ASL = UBH[D];
// 4352 %REPEAT
goto L_040f;
L_0410:
// 4353 %RESULT =I
return I;
// 4354 NONCONST: ! NOT A CONST DV
U_01f3:
// 4355 J=ND; I=-1
J = ND;
I = (-(1));
// 4356 LB=0; ASIZE=ELSIZE
LB = 0;
ASIZE = ELSIZE;
// 4357 %IF MODE=0 %THEN FAULT(41,0) %ELSE P=PIN
if (( MODE ) != ( 0 )) goto L_0412;
FAULT(41, 0);
goto L_0413;
L_0412:
P = PIN;
L_0413:
// 4358 ->WAYOUT
goto U_01f5;
// 4359 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block DOPEVECTOR at level 5
// 4360
// 4361 %ROUTINE DECLARE ARRAYS(%INTEGER FORMAT, FINF)
void DECLAREARRAYS( int FORMAT, int FINF )
{
__label__ _imp_endofblock;
// 4362 !***********************************************************************
// 4363 !* FORMAT=1 FOR 'ARRAYFORMAT' =0 OTHERWISE *
// 4364 !* FINF>0 FOR RECORD FORMAT INFORMATION =0 OTHERWISE *
// 4365 !* P IS AT P<ADECLN> IN *
// 4366 !* *
// 4367 !* P<ADECLN>=<NAMELIST> <BPAIR> <RESTOFDECLN> *
// 4368 !* P<BPAIR> = '('<EXPR>':'<EXRR><RESTOFBP>*')' *
// 4369 !* *
// 4370 !* ARRAYS WITH CONSTANT BOUNDS HAVE THEIR D-V IN THE SST *
// 4371 !* ALL OTHER ARRAYS HAVE A DOPE VECTOR AMONG THE LOCALS AND GET *
// 4372 !* THEIR SPACE OFF THE STACK AT RUN TIME *
// 4373 !* BOTH SORTS OF ARRAYS HAVE A FOUR WORD HEAD AND D-V TO EMAS *
// 4374 !* SYSTEM STANDARDS *
// 4375 !***********************************************************************
// 4376 %ROUTINESPEC CLAIM AS
auto void CLAIMAS( void );
// 4377 %INTEGER DVDISP, PP, DVF, ELSIZE, TOTSIZE, D0, D1, PTYPEP, {%C
int DVDISP;
int PP;
int DVF;
int ELSIZE;
int TOTSIZE;
int D0;
int D1;
int PTYPEP;
int ARRP;
int NN;
int ND;
int II;
int JJ;
int QQ;
int R;
int CDV;
int UNSCAL;
int DESC;
int SC;
int LWB;
int PTYPEPP;
int JJJ;
int JJJJ;
int ADJ;
// 4378 ARRP, NN, ND, II, JJ, QQ, R, CDV, UNSCAL, DESC, SC, {%C
// 4379 LWB, PTYPEPP, JJJ, JJJJ, ADJ
// 4380 %IF STACK#0 %AND FLAG(LEVEL)=0=NMDECS(LEVEL)>>14 %START
if (( STACK ) == ( 0 )) goto L_0414;
if (( FLAG[LEVEL] ) != ( 0 )) goto L_0414;
if (( 0 ) != ( (int)(((unsigned int)(NMDECS[LEVEL])) >> ((14))) )) goto L_0414;
// 4381 PSF1(STSF,1,N)
PSF1(94, 1, N);
// 4382 NMDECS(LEVEL)=NMDECS(LEVEL)!(N<<14)
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((((N)) << ((14))));
// 4383 N=N+4
N = ((N)) + ((4));
// 4384 %FINISH
L_0414:
// 4385 %IF STACK=0 %THEN SAVE AUX STACK
if (( STACK ) != ( 0 )) goto L_0415;
SAVEAUXSTACK();
L_0415:
// 4386 ARRP=2*FORMAT+1; ARR=ARRP; PACK(PTYPEP)
ARRP = ((((2)) * ((FORMAT)))) + ((1));
ARR = ARRP;
PACK( &PTYPEP);
// 4387 ELSIZE=ACC
ELSIZE = ACC;
// 4388 %IF TYPE>2 %OR (TYPE=1 %AND PREC=4) %THEN UNSCAL=1 %AND SC=3 %ELSE UNSCAL=0 %AND SC=PREC
if (( TYPE ) > ( 2 )) goto L_0411;
if (( TYPE ) != ( 1 )) goto L_0416;
if (( PREC ) != ( 4 )) goto L_0416;
L_0411:
UNSCAL = 1;
SC = 3;
goto L_0417;
L_0416:
UNSCAL = 0;
SC = PREC;
L_0417:
// 4389 DESC=SC<<27!UNSCAL<<25!(1-PARMARR)<<24;! ARRAY DESCRIPTOR SKELETON
DESC = ((((((SC)) << ((27)))) | ((((UNSCAL)) << ((25)))))) | ((((((1)) - ((PARMARR)))) << ((24))));
// 4390 %IF PREC=4 %THEN DESC=16_58000002
if (( PREC ) != ( 4 )) goto L_0418;
DESC = 1476395010;
L_0418:
// 4391 START:NN=1; P=P+1; ! NO OF NAMES IN NAMELIST
U_01f6:
NN = 1;
P = ((P)) + ((1));
// 4392 PP=P; CDV=0; PTYPEPP=PTYPEP
PP = P;
CDV = 0;
PTYPEPP = PTYPEP;
// 4393 P=P+3 %AND NN=NN+1 %WHILE A(P+2)=1
L_0419:
if (( A[((P)) + ((2))] ) != ( 1 )) goto L_041a;
P = ((P)) + ((3));
NN = ((NN)) + ((1));
goto L_0419;
L_041a:
// 4394 P=P+3
P = ((P)) + ((3));
// 4395 DVDISP=DOPE VECTOR(TYPE,ELSIZE,1,FROMAR2(PP),TOTSIZE,LWB)
DVDISP = DOPEVECTOR(TYPE, ELSIZE, 1, FROMAR2(PP), &TOTSIZE, &LWB);
// 4396 ND=J
ND = J;
// 4397 ->CONSTDV %UNLESS DVDISP=-1
if (( DVDISP ) == ( (-(1)) )) goto L_041c;
goto U_01f7;
L_041c:
// 4398 ! NORMAL CASE - PLANT CODE TO SET UP DOPE-VECTOR AT RUN TIME
// 4399
// 4400 DVF=0; TOTSIZE=16_FFFF
DVF = 0;
TOTSIZE = 65535;
// 4401 DVDISP=N; ! DVDISP IS D-V POSITION
DVDISP = N;
// 4402 N=N+12*ND+12; ! CLAIM SPACE FOR THE D-V
N = ((((N)) + ((((12)) * ((ND)))))) + ((12));
// 4403 FAULT(37,0) %IF ND>12; ! TOO MANY DIMENSIONS
if (( ND ) <= ( 12 )) goto L_041d;
FAULT(37, 0);
L_041d:
// 4404 D0=5<<27!3*ND; D1=12; ! DESCPTR FOR DV
D0 = ((((5)) << ((27)))) | ((((3)) * ((ND))));
D1 = 12;
// 4405 STORE CONST(JJ,8,ADDR(D0))
STORECONST( &JJ, 8, ADDR( &D0));
// 4406 PF1(LD,0,PC,JJ)
PF1(120, 0, 4, JJ);
// 4407 PSF1(STD,1,DVDISP)
PSF1(88, 1, DVDISP);
// 4408 GRUSE(DR)=0
GRUSE[1] = 0;
// 4409
// 4410 %IF UNSCAL=0 %THEN JJ=1 %ELSE JJ=ELSIZE
if (( UNSCAL ) != ( 0 )) goto L_041e;
JJ = 1;
goto L_041f;
L_041e:
JJ = ELSIZE;
L_041f:
// 4411 PSF1(LSS,0,JJ); ! M1 THE FIRST MULTIPLIER
PSF1(98, 0, JJ);
// 4412 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 4413 %CYCLE II=ND,-1,1
II = ((ND)) - (((-(1))));
L_0420:
if (( II ) == ( 1 )) goto L_0421;
II = ((II)) + (((-(1))));
// 4414 P=P+1
P = ((P)) + ((1));
// 4415 QQ=DVDISP+12*II; ! TRIPLE FOR IITH DIMENSION
QQ = ((DVDISP)) + ((((12)) * ((II))));
// 4416 PSF1(ST,1,QQ+4); ! STORE MULTIPLIER
PSF1(72, 1, ((QQ)) + ((4)));
// 4417 CSEXP(ACCR,16_51); ! LOWER BOUND
CSEXP(0, 81);
// 4418 %IF ND=1 %AND PTYPEP&7<=3 %AND FORMAT=0 %AND GRUSE(ACCR)=5 %AND GRINF1(ACCR)=0 %THEN PTYPEPP=PTYPEPP+256
if (( ND ) != ( 1 )) goto L_0423;
if (( ((PTYPEP)) & ((7)) ) > ( 3 )) goto L_0423;
if (( FORMAT ) != ( 0 )) goto L_0423;
if (( GRUSE[0] ) != ( 5 )) goto L_0423;
if (( GRINF1[0] ) != ( 0 )) goto L_0423;
PTYPEPP = ((PTYPEPP)) + ((256));
L_0423:
// 4419 PSF1(ST,1,QQ); ! STORED IN DV
PSF1(72, 1, QQ);
// 4420 CSEXP(ACCR,16_51); ! UPPER BOUND
CSEXP(0, 81);
// 4421 PSF1(ISB,1,QQ)
PSF1(226, 1, QQ);
// 4422 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 4423 %IF COMPILER=0 %OR PARMARR#0 %START
if (( COMPILER ) == ( 0 )) goto L_0424;
if (( PARMARR ) == ( 0 )) goto L_0425;
L_0424:
// 4424 PF3(JAF,6,0,3); ! JUMP UNLESS NEGATIVE
PF3(6, 6, 0, 3);
// 4425 PSF1(LSS,0,-1); ! SET UP -1 (ENSURES 0 ELEMENTS
PSF1(98, 0, (-(1)));
// 4426 %FINISH
L_0425:
// 4427 PSF1(IAD,0,1); ! CONVERTED TO RANGE
PSF1(224, 0, 1);
// 4428 PSF1(IMY,1,QQ+4); ! RANGE*MULTIPLIER
PSF1(234, 1, ((QQ)) + ((4)));
// 4429 PSF1(ST,1,QQ+8); ! AND STORED IN DV
PSF1(72, 1, ((QQ)) + ((8)));
// 4430 %REPEAT
goto L_0420;
L_0421:
// 4431 P=P+1
P = ((P)) + ((1));
// 4432 %IF UNSCAL=0 %AND ELSIZE#1 %THEN PSF1(IMY,0,ELSIZE)
if (( UNSCAL ) != ( 0 )) goto L_0426;
if (( ELSIZE ) == ( 1 )) goto L_0426;
PSF1(234, 0, ELSIZE);
L_0426:
// 4433 PSF1(ST,1,DVDISP+8)
PSF1(72, 1, ((DVDISP)) + ((8)));
// 4434 SNDISP=0; ! DV NOT AVAILABLE AT COMPILETIME
SNDISP = 0;
// 4435 ->DECL
goto U_01f8;
// 4436 CONSTDV: ! ONE DIMENSION - CONSTANT BOUNDS
U_01f7:
// 4437 DVF=1; CDV=1
DVF = 1;
CDV = 1;
// 4438 %IF ND=1 %AND LWB=0 %AND PTYPEP&15<=3 %AND FORMAT=0 %THEN PTYPEPP=PTYPEP+256
if (( ND ) != ( 1 )) goto L_0427;
if (( LWB ) != ( 0 )) goto L_0427;
if (( ((PTYPEP)) & ((15)) ) > ( 3 )) goto L_0427;
if (( FORMAT ) != ( 0 )) goto L_0427;
PTYPEPP = ((PTYPEP)) + ((256));
L_0427:
// 4439 ! SET ARR=2 IF LWB=ZERO
// 4440 SNDISP=(DVDISP&16_FFFFFF)>>2
SNDISP = (int)(((unsigned int)(((DVDISP)) & ((16777215)))) >> ((2)));
// 4441 DECL: ! MAKE DECLN - BOTH WAYS
U_01f8:
// 4442 J=ND
J = ND;
// 4443 ODD ALIGN
ODDALIGN();
// 4444 PTYPE=PTYPEPP; UNPACK
PTYPE = PTYPEPP;
UNPACK();
// 4445 %IF DVF#0 %THEN %START; ! ARRAY IS STRING OF LOCALS
if (( DVF ) == ( 0 )) goto L_0428;
// 4446 R=TOTSIZE
R = TOTSIZE;
// 4447 %IF UNSCAL=0 %THEN R=R//ELSIZE
if (( UNSCAL ) != ( 0 )) goto L_0429;
R = ((int)(R)) / ((int)(ELSIZE));
L_0429:
// 4448 D0=DESC
D0 = DESC;
// 4449 D0=D0!R %UNLESS PREC=4
if (( PREC ) == ( 4 )) goto L_042a;
D0 = ((D0)) | ((R));
L_042a:
// 4450 STORE CONST(D1,4,ADDR(D0))
STORECONST( &D1, 4, ADDR( &D0));
// 4451 PF1(LB,0,PC,D1)
PF1(122, 0, 4, D1);
// 4452 %FINISH %ELSE %START
goto L_042b;
L_0428:
// 4453 STORE CONST(D1,4,ADDR(DESC))
STORECONST( &D1, 4, ADDR( &DESC));
// 4454 PF1(LB,0,PC,D1)
PF1(122, 0, 4, D1);
// 4455 PSF1(ADB,1,DVDISP+20) %UNLESS PREC=4
if (( PREC ) == ( 4 )) goto L_042c;
PSF1(32, 1, ((DVDISP)) + ((20)));
L_042c:
// 4456 %FINISH
L_042b:
// 4457 %IF DVF#0 %THEN QQ=PC %ELSE QQ=LNB
if (( DVF ) == ( 0 )) goto L_042d;
QQ = 4;
goto L_042e;
L_042d:
QQ = 2;
L_042e:
// 4458 PSORLF1(LDRL,0,QQ,DVDISP)
PSORLF1(112, 0, QQ, DVDISP);
// 4459 GRUSE(BREG)=0; GRUSE(DR)=0
GRUSE[7] = 0;
GRUSE[1] = 0;
// 4460 %CYCLE JJJ=0,1,NN-1; ! DOWN NAMELIST
JJJ = ((0)) - ((1));
L_042f:
if (( JJJ ) == ( ((NN)) - ((1)) )) goto L_0430;
JJJ = ((JJJ)) + ((1));
// 4461 PSF1(STB,1,N+16*JJJ); ! ARRAY BOUND
PSF1(90, 1, ((N)) + ((((16)) * ((JJJ)))));
// 4462 PSF1(STD,1,N+8+16*JJJ); ! DV POINTER
PSF1(88, 1, ((((N)) + ((8)))) + ((((16)) * ((JJJ)))));
// 4463 %REPEAT
goto L_042f;
L_0430:
// 4464 %IF PARMARR=0 %AND PARMCHK=0 %AND ND=1 %AND TYPE<=3 %AND PTYPEPP&16_F00#16_200 %THEN ADJ=1 %ELSE ADJ=0
if (( PARMARR ) != ( 0 )) goto L_0432;
if (( PARMCHK ) != ( 0 )) goto L_0432;
if (( ND ) != ( 1 )) goto L_0432;
if (( TYPE ) > ( 3 )) goto L_0432;
if (( ((PTYPEPP)) & ((3840)) ) == ( 512 )) goto L_0432;
ADJ = 1;
goto L_0433;
L_0432:
ADJ = 0;
L_0433:
// 4465 %CYCLE JJJ=0,1,NN-1; ! DOWN NAMELIST
JJJ = ((0)) - ((1));
L_0434:
if (( JJJ ) == ( ((NN)) - ((1)) )) goto L_0435;
JJJ = ((JJJ)) + ((1));
// 4466 %IF ADJ#0 %START; ! ADJUST DESC
if (( ADJ ) == ( 0 )) goto L_0437;
// 4467 %IF STACK#0 %START; ! ARRAY ON AUTOMATIC STACK
if (( STACK ) == ( 0 )) goto L_0438;
// 4468 PF1(STSF,0,BREG,0); ! CURRENT SF TO B
PF1(94, 0, 7, 0);
// 4469 %IF DVF#0 %THEN PSF1(SBB,0,LWB*ELSIZE) %ELSE %START
if (( DVF ) == ( 0 )) goto L_0439;
PSF1(34, 0, ((LWB)) * ((ELSIZE)));
goto L_043a;
L_0439:
// 4470 %IF ELSIZE=1 %THEN PSF1(SBB,1,DVDISP+12) %ELSESTART
if (( ELSIZE ) != ( 1 )) goto L_043b;
PSF1(34, 1, ((DVDISP)) + ((12)));
goto L_043c;
L_043b:
// 4471 PSF1(SLB,1,DVDISP+12)
PSF1(82, 1, ((DVDISP)) + ((12)));
// 4472 PSF1(MYB,0,ELSIZE)
PSF1(42, 0, ELSIZE);
// 4473 PF1(SLB,0,TOS,0)
PF1(82, 0, 6, 0);
// 4474 PF1(SBB,0,TOS,0)
PF1(34, 0, 6, 0);
// 4475 %FINISH
L_043c:
// 4476 %FINISH
L_043a:
// 4477 PSF1(STB,1,N+4)
PSF1(90, 1, ((N)) + ((4)));
// 4478 GRUSE(BREG)=0
GRUSE[7] = 0;
// 4479 %FINISH %ELSE %START; ! ARRAY ON AUX STACK
goto L_043d;
L_0438:
// 4480 %IF DVF#0 %START; ! CONST DOPE VECTOR
if (( DVF ) == ( 0 )) goto L_043e;
// 4481 %UNLESS GRUSE(ACCR)=11 %%START
if (( GRUSE[0] ) == ( 11 )) goto L_043f;
// 4482 PSF1(LSS,2,AUXSBASE(LEVEL))
PSF1(98, 2, AUXSBASE[LEVEL]);
// 4483 GRUSE(ACCR)=11; GRINF1(ACCR)=0
GRUSE[0] = 11;
GRINF1[0] = 0;
// 4484 %FINISH
L_043f:
// 4485 JJJJ=LWB*ELSIZE-GRINF1(ACCR)
JJJJ = ((((LWB)) * ((ELSIZE)))) - ((GRINF1[0]));
// 4486 PSF1(ISB,0,JJJJ) %UNLESS JJJJ=0
if (( JJJJ ) == ( 0 )) goto L_0440;
PSF1(226, 0, JJJJ);
L_0440:
// 4487 GRINF1(ACCR)=LWB*ELSIZE
GRINF1[0] = ((LWB)) * ((ELSIZE));
// 4488 %FINISH %ELSE %START; ! DYNAMIC ARRAYS
goto L_0441;
L_043e:
// 4489 %IF GRUSE(ACCR)=11 %AND GRINF1(ACCR)=0 %AND ELSIZE=1 %THEN PSF1(ISB,1,DVDISP+12) %ELSESTART
if (( GRUSE[0] ) != ( 11 )) goto L_0442;
if (( GRINF1[0] ) != ( 0 )) goto L_0442;
if (( ELSIZE ) != ( 1 )) goto L_0442;
PSF1(226, 1, ((DVDISP)) + ((12)));
goto L_0443;
L_0442:
// 4490 PSF1(LSS,1,DVDISP+12)
PSF1(98, 1, ((DVDISP)) + ((12)));
// 4491 PSF1(IMY,0,ELSIZE) %UNLESS ELSIZE=1
if (( ELSIZE ) == ( 1 )) goto L_0444;
PSF1(234, 0, ELSIZE);
L_0444:
// 4492 PSF1(IRSB,2,AUXSBASE(LEVEL))
PSF1(228, 2, AUXSBASE[LEVEL]);
// 4493 %FINISH
L_0443:
// 4494 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 4495 %FINISH
L_0441:
// 4496 PSF1(ST,1,N+4)
PSF1(72, 1, ((N)) + ((4)));
// 4497 %FINISH
L_043d:
// 4498 %FINISH %ELSE %START; ! NO ADJUSTMENT OF DESCRPT
goto L_0445;
L_0437:
// 4499 %IF STACK#0 %THEN PSF1(STSF,1,N+4) %ELSE %START
if (( STACK ) == ( 0 )) goto L_0446;
PSF1(94, 1, ((N)) + ((4)));
goto L_0447;
L_0446:
// 4500 PSF1(LSS,2,AUXSBASE(LEVEL)) %UNLESS GRUSE(ACCR)=11 %AND GRINF1(ACCR)=0
if (( GRUSE[0] ) != ( 11 )) goto L_0448;
if (( GRINF1[0] ) == ( 0 )) goto L_0449;
L_0448:
PSF1(98, 2, AUXSBASE[LEVEL]);
L_0449:
// 4501 PSF1(ST,1,N+4)
PSF1(72, 1, ((N)) + ((4)));
// 4502 GRUSE(ACCR)=11; GRINF1(ACCR)=0
GRUSE[0] = 11;
GRINF1[0] = 0;
// 4503 %FINISH
L_0447:
// 4504 %FINISH
L_0445:
// 4505
// 4506 ACC=ELSIZE; ! RESET ACC AFTER DV CMPLD
ACC = ELSIZE;
// 4507 KFORM=FINF; ! FORMAT INFORMATION
KFORM = FINF;
// 4508 K=FROM AR2(PP+3*JJJ)
K = FROMAR2(((PP)) + ((((3)) * ((JJJ)))));
// 4509 STORE TAG(K,N)
STORETAG(K, N);
// 4510 CLAIM AS %IF FORMAT = 0
if (( FORMAT ) != ( 0 )) goto L_044a;
CLAIMAS();
L_044a:
// 4511 N=N+16
N = ((N)) + ((16));
// 4512 %REPEAT
goto L_0434;
L_0435:
// 4513 P=P+1; ! PAST REST OF ARRAYLIST
P = ((P)) + ((1));
// 4514 %IF A(P-1)=1 %THEN ->START
if (( A[((P)) - ((1))] ) != ( 1 )) goto L_044b;
goto U_01f6;
L_044b:
// 4515 %RETURN
return;
// 4516 %ROUTINE CLAIM AS
void CLAIMAS( void )
{
__label__ _imp_endofblock;
// 4517 !***********************************************************************
// 4518 !* CLAIM THE SPACE FOR AN ARRAY FROM STACK OR AUX STACK *
// 4519 !***********************************************************************
// 4520 %INTEGER T, B, D,ADJMENT
int T;
int B;
int D;
int ADJMENT;
// 4521 %IF STACK=1 %THEN %START; ! FROM AUTOMATIC STACK
if (( STACK ) != ( 1 )) goto L_044c;
// 4522 %IF CDV=1 %THEN %START; ! CONSTANT BOUNDS
if (( CDV ) != ( 1 )) goto L_044d;
// 4523 T=(TOTSIZE+3)//4
T = ((int)(((TOTSIZE)) + ((3)))) / ((int)(4));
// 4524 PSF1(ASF+12*PARMCHK,0,T); ! ASF OR LB
PSF1(((110)) + ((((12)) * ((PARMCHK)))), 0, T);
// 4525 PPJ(0,4) %IF PARMCHK#0
if (( PARMCHK ) == ( 0 )) goto L_044e;
PPJ(0, 4);
L_044e:
// 4526 %FINISH %ELSE %START; ! DYNAMIC BOUNDS
goto L_044f;
L_044d:
// 4527 %IF PARMCHK=0 %AND PTYPEP&7<=2 %AND (ELSIZE=4 %OR ELSIZE=8) %START
if (( PARMCHK ) != ( 0 )) goto L_0450;
if (( ((PTYPEP)) & ((7)) ) > ( 2 )) goto L_0450;
if (( ELSIZE ) == ( 4 )) goto L_0408;
if (( ELSIZE ) != ( 8 )) goto L_0450;
L_0408:
// 4528 PSF1(ASF,1,DVDISP+20); ! SIZE IN ELEMENTS WORD
PSF1(110, 1, ((DVDISP)) + ((20)));
// 4529 PSF1(ASF,1,DVDISP+20) %IF ELSIZE=8
if (( ELSIZE ) != ( 8 )) goto L_0451;
PSF1(110, 1, ((DVDISP)) + ((20)));
L_0451:
// 4530 %FINISH %ELSE %START
goto L_0452;
L_0450:
// 4531 PSF1(LSS,1,DVDISP+8); ! ARRAY SIZE BYTES
PSF1(98, 1, ((DVDISP)) + ((8)));
// 4532 PSF1(IAD,0,3) %IF ELSIZE&3#0
if (( ((ELSIZE)) & ((3)) ) == ( 0 )) goto L_0453;
PSF1(224, 0, 3);
L_0453:
// 4533 PSF1(USH,0,-2); ! ARRAY SIZE WORDS
PSF1(200, 0, (-(2)));
// 4534 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 4535 FORGET(BREG)
FORGET(7);
// 4536 %IF PARMCHK#0 %THEN PPJ(0,4) %ELSE PF1(ASF,0,BREG,0)
if (( PARMCHK ) == ( 0 )) goto L_0454;
PPJ(0, 4);
goto L_0455;
L_0454:
PF1(110, 0, 7, 0);
L_0455:
// 4537 %FINISH
L_0452:
// 4538 %FINISH
L_044f:
// 4539 CHECK STOF
CHECKSTOF();
// 4540 %FINISH %ELSE %START
goto L_0456;
L_044c:
// 4541 %UNLESS GRUSE(ACCR)=11 %AND (GRINF1(ACCR)=0 %OR CDV=1) %START
if (( GRUSE[0] ) != ( 11 )) goto L_0457;
if (( GRINF1[0] ) == ( 0 )) goto L_0458;
if (( CDV ) == ( 1 )) goto L_0458;
L_0457:
// 4542 PSF1(LSS,2,AUXSBASE(LEVEL))
PSF1(98, 2, AUXSBASE[LEVEL]);
// 4543 GRUSE(ACCR)=11; GRINF1(ACCR)=0
GRUSE[0] = 11;
GRINF1[0] = 0;
// 4544 %FINISH
L_0458:
// 4545 %IF CDV=1 %THEN %START
if (( CDV ) != ( 1 )) goto L_0459;
// 4546 ADJMENT=(TOTSIZE+7)&(-8)+GRINF1(ACCR)
ADJMENT = ((((((TOTSIZE)) + ((7)))) & (((-(8)))))) + ((GRINF1[0]));
// 4547 %IF ADJMENT<16_1FFFF %THEN B=0 %AND D=ADJMENT %ELSE %START
if (( ADJMENT ) >= ( 131071 )) goto L_045a;
B = 0;
D = ADJMENT;
goto L_045b;
L_045a:
// 4548 STORE CONST(D,4,ADDR(ADJMENT))
STORECONST( &D, 4, ADDR( &ADJMENT));
// 4549 B=PC
B = 4;
// 4550 %FINISH
L_045b:
// 4551 %IF ADJ=1 %AND JJJ#NN-1 %AND PARMOPT=0 %THEN GRINF1(ACCR)=ADJMENT %ELSE %START
if (( ADJ ) != ( 1 )) goto L_045c;
if (( JJJ ) == ( ((NN)) - ((1)) )) goto L_045c;
if (( PARMOPT ) != ( 0 )) goto L_045c;
GRINF1[0] = ADJMENT;
goto L_045d;
L_045c:
// 4552 GRINF1(ACCR)=0
GRINF1[0] = 0;
// 4553 PSORLF1(IAD,0,B,D) %UNLESS B=D=0
if (( B ) != ( D )) goto L_045e;
if (( D ) == ( 0 )) goto L_045f;
L_045e:
PSORLF1(224, 0, B, D);
L_045f:
// 4554 %FINISH
L_045d:
// 4555 %FINISH %ELSE %START
goto L_0460;
L_0459:
// 4556 B=LNB; D=DVDISP+8
B = 2;
D = ((DVDISP)) + ((8));
// 4557 PSF1(IAD,1,D)
PSF1(224, 1, D);
// 4558 %UNLESS ELSIZE&7=0 %START
if (( ((ELSIZE)) & ((7)) ) == ( 0 )) goto L_0461;
// 4559 PSF1(IAD,0,7)
PSF1(224, 0, 7);
// 4560 PSF1(AND,0,-8)
PSF1(138, 0, (-(8)));
// 4561 %FINISH
L_0461:
// 4562 GRINF1(ACCR)=0
GRINF1[0] = 0;
// 4563 %FINISH
L_0460:
// 4564 PSF1(ST,2,AUXSBASE(LEVEL)) %IF JJJ=NN-1 %OR (ADJ=1 %AND CDV=0)
if (( JJJ ) == ( ((NN)) - ((1)) )) goto L_0462;
if (( ADJ ) != ( 1 )) goto L_0463;
if (( CDV ) != ( 0 )) goto L_0463;
L_0462:
PSF1(72, 2, AUXSBASE[LEVEL]);
L_0463:
// 4565 %IF PARMOPT#0 %THEN %START
if (( PARMOPT ) == ( 0 )) goto L_0464;
// 4566 PSF1(ICP,1,AUXSBASE(LEVEL)+16)
PSF1(230, 1, ((AUXSBASE[LEVEL])) + ((16)));
// 4567 PPJ(2,8)
PPJ(2, 8);
// 4568 %FINISH
L_0464:
// 4569 %IF PARMCHK#0 %START
if (( PARMCHK ) == ( 0 )) goto L_0465;
// 4570 PF1(LDTB,0,PC,PARAM DES(3))
PF1(116, 0, 4, PARAMDES(3));
// 4571 PSORLF1(LDB,0,B,D)
PSORLF1(118, 0, B, D);
// 4572 PSF1(LDA,1,N+4)
PSF1(114, 1, ((N)) + ((4)));
// 4573 PF2(MVL,1,1,0,0,UNASSPAT&255)
PF2(176, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 4574 GRUSE(DR)=0
GRUSE[1] = 0;
// 4575 %FINISH
L_0465:
// 4576 %FINISH
L_0456:
// 4577 %END
return;
_imp_endofblock: ;
} // End of block CLAIMAS at level 6
// 4578 %END
return;
_imp_endofblock: ;
} // End of block DECLAREARRAYS at level 5
// 4579 ! %ROUTINE TEST NST
// 4580 !!***********************************************************************
// 4581 !!* SEE IF NAME 'K' HAS BEEN DECLARED BEFORE AT THIS LEVEL *
// 4582 !!***********************************************************************
// 4583 ! FNAME=K
// 4584 ! FAULT(7,FNAME) %IF FROM1(TAGS(FNAME))>>8&15=LEVEL
// 4585 ! %END
// 4586 %ROUTINE CLT
void CLT( void )
{
__label__ _imp_endofblock;
// 4587 !***********************************************************************
// 4588 !* DEAL WITH PHRASE TYPE AND SET PREC,TYPE & ACC *
// 4589 !* ONLY PROBLEM IS STRING WHICH HAS OPTIONAL MAX LENGTH ALSO *
// 4590 !* P ON PHRASE TYPE AT ENTRY - TO NEXT PHRASE AT EXIT. *
// 4591 !***********************************************************************
// 4592 %CONSTBYTEINTEGERARRAY TYPEFLAG(1:10)= {%C
const unsigned char TYPEFLAG[(10)-(1)+1] = { 81, 82, 0, 49, 53, 65, 0, 98, 97, 114, };
// 4593 16_51,16_52,0,16_31,16_35,
// 4594 16_41,0,16_62,16_61,16_72;
// 4595 %INTEGER ALT
int ALT;
// 4596 ALT=A(P)
ALT = A[P];
// 4597 TYPE=TYPEFLAG(ALT)
TYPE = (TYPEFLAG-1)[ALT];
// 4598 %IF TYPE=0 %THEN P=P+1 %AND TYPE=TYPEFLAG(A(P)+7)
if (( TYPE ) != ( 0 )) goto L_0466;
P = ((P)) + ((1));
TYPE = (TYPEFLAG-1)[((A[P])) + ((7))];
L_0466:
// 4599 PREC=TYPE>>4
PREC = (int)(((unsigned int)(TYPE)) >> ((4)));
// 4600 TYPE=TYPE&7
TYPE = ((TYPE)) & ((7));
// 4601 PREC=6 %IF TYPE=2 %AND ALL LONG#0 %AND PREC<=5;! DEAL WITH '%REALSLONG'
if (( TYPE ) != ( 2 )) goto L_0467;
if (( ALLLONG ) == ( 0 )) goto L_0467;
if (( PREC ) > ( 5 )) goto L_0467;
PREC = 6;
L_0467:
// 4602 ACC=BYTES(PREC)
ACC = BYTES[PREC];
// 4603 %IF TYPE=5 %THEN %START; ! P<TYPE>='%STRING'
if (( TYPE ) != ( 5 )) goto L_0468;
// 4604 %IF A(P+1)=1 %THEN %START;! MAX LENGTH GIVEN
if (( A[((P)) + ((1))] ) != ( 1 )) goto L_0469;
// 4605 P=P+2
P = ((P)) + ((2));
// 4606 ACC=A(P)+1
ACC = ((A[P])) + ((1));
// 4607 %FINISH %ELSE ACC=0 %AND P=P+1
goto L_046a;
L_0469:
ACC = 0;
P = ((P)) + ((1));
L_046a:
// 4608 %FINISH
L_0468:
// 4609 P=P+1
P = ((P)) + ((1));
// 4610 %END
return;
_imp_endofblock: ;
} // End of block CLT at level 5
// 4611 %ROUTINE CQN(%INTEGER P)
void CQN( int P )
{
__label__ _imp_endofblock;
// 4612 !***********************************************************************
// 4613 !* SET NAM,ARR & ACC FROM ALTERNATIVE OF PHRASE <QNAME'> *
// 4614 !* P<QNAME'>='%ARRAYNAME','%NAME',<%NULL> *
// 4615 !* P POINTS TO THE ANALYSIS RECORD ENTRY AS IS NOT UPDATED *
// 4616 !***********************************************************************
// 4617 %INTEGER I
int I;
// 4618 I=A(P);NAM=0;ARR=0
I = A[P];
NAM = 0;
ARR = 0;
// 4619 %IF I=1 %THEN ARR=1 %AND ACC=16;! ARRAYNAMES
if (( I ) != ( 1 )) goto L_046b;
ARR = 1;
ACC = 16;
L_046b:
// 4620 %IF I<=2 %THEN NAM=1; ! ARRAYNAMES & NAMES
if (( I ) > ( 2 )) goto L_046c;
NAM = 1;
L_046c:
// 4621 %IF I=2 %THEN ACC=8; ! NAMES USE 8-BYTE DESCRIPTOR
if (( I ) != ( 2 )) goto L_046d;
ACC = 8;
L_046d:
// 4622 %END
return;
_imp_endofblock: ;
} // End of block CQN at level 5
// 4623 %ROUTINE CRSPEC (%INTEGER M)
void CRSPEC( int M )
{
__label__ _imp_endofblock;
// 4624 !***********************************************************************
// 4625 !* MODE=0 FOR NORMAL ROUTINE SPEC *
// 4626 !* MODE=1 FOR EXTERNAL(ETC) ROUTINE SPECS XREF NEEDED *
// 4627 !* P ON ENTRY TO P(RT) IN (RT)(MARK)(%SPEC')(NAME)(FPP) *
// 4628 !***********************************************************************
// 4629 %INTEGER KK,JJ,TYPEP,OPHEAD,NPARMS
int KK;
int JJ;
int TYPEP;
int OPHEAD;
int NPARMS;
// 4630 %STRING(34) XNAME
_imp_string /*%string(34)*/ XNAME;
// 4631 LITL=EXTRN&3
LITL = ((EXTRN)) & ((3));
// 4632 %IF A(P)=1 %THEN %START; ! P<RT>=%ROUTINE
if (( A[P] ) != ( 1 )) goto L_046e;
// 4633 TYPEP=LITL<<14!16_1000
TYPEP = ((((LITL)) << ((14)))) | ((4096));
// 4634 P=P+2; ! IGNORING ALT OF P(SPEC')
P = ((P)) + ((2));
// 4635 %FINISH %ELSE %START; ! P<RT>=<TYPE><FNORMAP>
goto L_046f;
L_046e:
// 4636 ROUT=1; ARR=0; P=P+1
ROUT = 1;
ARR = 0;
P = ((P)) + ((1));
// 4637 CLT; NAM=0
CLT();
NAM = 0;
// 4638 %IF A(P)=2 %THEN NAM=2; ! 2 FOR MAP 0 FOR FN
if (( A[P] ) != ( 2 )) goto L_0470;
NAM = 2;
L_0470:
// 4639 PACK(TYPEP)
PACK( &TYPEP);
// 4640 P=P+2; ! AGAIN IGNORING ALT OF P(SPEC')
P = ((P)) + ((2));
// 4641 %FINISH
L_046f:
// 4642 P=P+4; ! PAST HOLE FOR DECLINKS
P = ((P)) + ((4));
// 4643 KK=FROM AR2(P)
KK = FROMAR2(P);
// 4644 JJ=0
JJ = 0;
// 4645 P=P+2
P = ((P)) + ((2));
// 4646 CFPLIST(OPHEAD,NPARMS)
CFPLIST( &OPHEAD, &NPARMS);
// 4647 %IF M=1 %THEN %START
if (( M ) != ( 1 )) goto L_0471;
// 4648 XNAME<-STRING(DICTBASE+WORD(KK))
XNAME = *STRING(((DICTBASE)) + ((WORD[KK])));
// 4649 %IF EXTRN=1 %THEN XNAME<-"S#".XNAME
if (( EXTRN ) != ( 1 )) goto L_0472;
XNAME = _imp_strcat((&(_imp_str_literal("S#"))), XNAME);
L_0472:
// 4650 CXREF(XNAME,PARMDYNAMIC!(EXTRN//3),2,JJ); ! %STSTEM & %EXTERNAL =STATIC
CXREF(XNAME, ((PARMDYNAMIC)) | ((((int)(EXTRN)) / ((int)(3)))), 2, &JJ);
// 4651 ! %DYNAMIC = DYNAMIC
// 4652 %FINISH
L_0471:
// 4653 %IF M=0 %AND RLEVEL=0 %THEN CODE DES(JJ)
if (( M ) != ( 0 )) goto L_0473;
if (( RLEVEL ) != ( 0 )) goto L_0473;
CODEDES( &JJ);
L_0473:
// 4654 J=15-M; PTYPE=TYPEP
J = ((15)) - ((M));
PTYPE = TYPEP;
// 4655 KFORM=NPARMS
KFORM = NPARMS;
// 4656 SNDISP=JJ>>16
SNDISP = (int)(((unsigned int)(JJ)) >> ((16)));
// 4657 ACC=JJ&16_FFFF
ACC = ((JJ)) & ((65535));
// 4658 STORE TAG(KK,OPHEAD)
STORETAG(KK, OPHEAD);
// 4659 %END
return;
_imp_endofblock: ;
} // End of block CRSPEC at level 5
// 4660 %ROUTINE CFPLIST(%INTEGERNAME OPHEAD,NPARMS)
void CFPLIST( int *OPHEAD, int *NPARMS )
{
__label__ _imp_endofblock;
// 4661 !***********************************************************************
// 4662 !* COMPILE A FORMAL PARAMETER PART INTO A LIST OF PARAMETER TYPES *
// 4663 !* P(FPP)='('{(HOLE)(FPDEL)(NAMELIST)(MARK)}*')',0. *
// 4664 !* *
// 4665 !* THE LIST OF PARAMETER LOOKS LIKE:- *
// 4666 !* S1 = PTYPE FOR PARAM<<16! DIMENSION (DIMEN DEDUCED LATER) *
// 4667 !* S2 = ACC <<16 ! SPARE *
// 4668 !* S3 = 0 (RESERVED FOR FPP OF RTS) *
// 4669 !* *
// 4670 !* ON ENTRY P IS AT ALT OF FPP (WHICH MAY BE NULL) *
// 4671 !***********************************************************************
// 4672 %INTEGER OPBOT, PP
int OPBOT;
int PP;
// 4673 OPHEAD=0; OPBOT=0
OPHEAD = 0;
OPBOT = 0;
// 4674 NPARMS=0; ! ZERO PARAMETERS AS YET
NPARMS = 0;
// 4675 %WHILE A(P)=1 %CYCLE; ! WHILE SOME(MORE) FPS
L_0474:
if (( A[P] ) != ( 1 )) goto L_0475;
// 4676 PP=P+1+FROMAR2(P+1); ! TO NEXT FPDEL
PP = ((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))));
// 4677 P=P+3; ! TO ALT OF FPDEL
P = ((P)) + ((3));
// 4678 CFPDEL; ! GET TYPE & ACC FOR NEXT GROUP
CFPDEL();
// 4679 {%UNTIL A(P-1)=2} %CYCLE; ! DOWN <NAMELIST> FOR EACH DEL
L_0477:
// 4680 BINSERT(OPHEAD,OPBOT,PTYPE<<16,ACC<<16,0)
BINSERT(OPHEAD, &OPBOT, ((PTYPE)) << ((16)), ((ACC)) << ((16)), 0);
// 4681 NPARMS=NPARMS+1
NPARMS = ((NPARMS)) + ((1));
// 4682 P=P+3
P = ((P)) + ((3));
// 4683 %REPEAT %UNTIL A(P-1)=2; ! DOWN <NAMELIST> FOR EACH DEL
if (( A[((P)) - ((1))] ) == ( 2 )) goto L_0478;
goto L_0477;
L_0478:
// 4684 P=PP
P = PP;
// 4685 %REPEAT
goto L_0474;
L_0475:
// 4686 P=P+1
P = ((P)) + ((1));
// 4687 %END
return;
_imp_endofblock: ;
} // End of block CFPLIST at level 5
// 4688 %ROUTINE CFPDEL
void CFPDEL( void )
{
__label__ _imp_endofblock;
// 4689 !***********************************************************************
// 4690 !* SET UP PTYPE & ACC FOR A FORMAL PARAMETER DEFINITION *
// 4691 !* P<FPDEL>=<TYPE><%QNAME'>, *
// 4692 !* '%RECORD'<%ARRAY'>'%NAME'. *
// 4693 !* (RT)(%NAME')(NAMELIST)(FPP), *
// 4694 !* '%NAME'. *
// 4695 !***********************************************************************
// 4696 %SWITCH FP(1:4)
static int FP_idx;
static const void * /*SWITCH*/ FP[(4)-(1)+1] = { &&FP_1, &&FP_2, &&FP_3, &&FP_4, };
// 4697 %INTEGER FPALT
int FPALT;
// 4698 FPALT=A(P); P=P+1
FPALT = A[P];
P = ((P)) + ((1));
// 4699 KFORM=0; LITL=0
KFORM = 0;
LITL = 0;
// 4700 ->FP(FPALT)
goto *(FP-1)[FPALT]; /* Bounds=1:4 */
// 4701 FP(1): ! (TYPE)(%QNAME')
FP_1:
// 4702 ROUT=0; CLT
ROUT = 0;
CLT();
// 4703 CQN(P)
CQN(P);
// 4704 FAULT(70,0) %IF TYPE=5 %AND ACC=0
if (( TYPE ) != ( 5 )) goto L_047a;
if (( ACC ) != ( 0 )) goto L_047a;
FAULT(70, 0);
L_047a:
// 4705 P=P+1
P = ((P)) + ((1));
// 4706 ->PK
goto U_01dd;
// 4707 FP(2): ! RECORD(%ARRAY')%NAME
FP_2:
// 4708 ARR=2-A(P); ROUT=0
ARR = ((2)) - ((A[P]));
ROUT = 0;
// 4709 ACC=8+8*ARR; TYPE=3; PREC=3
ACC = ((8)) + ((((8)) * ((ARR))));
TYPE = 3;
PREC = 3;
// 4710 NAM=1; P=P+1; ->PK
NAM = 1;
P = ((P)) + ((1));
goto U_01dd;
// 4711 FP(3): ! (RT)(%NAME')(NAMELIST)(FPP)
FP_3:
// 4712 ROUT=1; NAM=1
ROUT = 1;
NAM = 1;
// 4713 ARR=0
ARR = 0;
// 4714 %IF A(P)=1 %THEN %START; ! RT=%ROUITNE
if (( A[P] ) != ( 1 )) goto L_047b;
// 4715 TYPE=0; PREC=0
TYPE = 0;
PREC = 0;
// 4716 P=P+2
P = ((P)) + ((2));
// 4717 %FINISH %ELSE %START
goto L_047c;
L_047b:
// 4718 P=P+1; CLT; ! RT=(TYPE)(FM)
P = ((P)) + ((1));
CLT();
// 4719 NAM=1
NAM = 1;
// 4720 %IF A(P)=2 %THEN NAM=3; ! 1 FOR FN 3 FOR MAP
if (( A[P] ) != ( 2 )) goto L_047d;
NAM = 3;
L_047d:
// 4721 P=P+2; ! PAST (%NAME') WHICH IS IGNORED
P = ((P)) + ((2));
// 4722 %FINISH
L_047c:
// 4723 ACC=16
ACC = 16;
// 4724 ->PK
goto U_01dd;
// 4725 FP(4): ! %NAME
FP_4:
// 4726 ACC=8; NAM=1
ACC = 8;
NAM = 1;
// 4727 ROUT=0; TYPE=0
ROUT = 0;
TYPE = 0;
// 4728 ARR=0; PREC=0
ARR = 0;
PREC = 0;
// 4729 PK: PACK(PTYPE)
U_01dd:
PACK( &PTYPE);
// 4730 %END
return;
_imp_endofblock: ;
} // End of block CFPDEL at level 5
// 4731 %ROUTINE DIAG POINTER(%INTEGER LEVEL)
void DIAGPOINTER( int LEVEL )
{
__label__ _imp_endofblock;
// 4732 %IF PARMTRACE#0 %THEN %START
if (( PARMTRACE ) == ( 0 )) goto L_047e;
// 4733 PUSH(RAL(LEVEL),1,CA,LDB<<24!3<<23)
PUSH( &RAL[LEVEL], 1, CA, ((((118)) << ((24)))) | ((((3)) << ((23)))));
// 4734 PF1(LDB,0,0,0)
PF1(118, 0, 0, 0);
// 4735 GRUSE(DR)=0
GRUSE[1] = 0;
// 4736 %FINISH
L_047e:
// 4737 %END
return;
_imp_endofblock: ;
} // End of block DIAGPOINTER at level 5
// 4738 %ROUTINE RHEAD(%INTEGER KK)
void RHEAD( int KK )
{
__label__ _imp_endofblock;
// 4739 !***********************************************************************
// 4740 !* COMPILES CODE FOR BLOCK AND ROUTINE ENTRY *
// 4741 !* KK IS THE RT/FN/MAP NAME (=-1 FOR %BEGIN BLOCKS) *
// 4742 !***********************************************************************
// 4743 %INTEGER W1, W3, INSRN, AT
int W1;
int W3;
int INSRN;
int AT;
// 4744 PUSH(LEVELINF, 0, NMAX<<16!N, 0)
PUSH( &LEVELINF, 0, ((((NMAX)) << ((16)))) | ((N)), 0);
// 4745 LEVEL=LEVEL+1
LEVEL = ((LEVEL)) + ((1));
// 4746 NMDECS(LEVEL)=0; AUXSBASE(LEVEL)=0
NMDECS[LEVEL] = 0;
AUXSBASE[LEVEL] = 0;
// 4747 NAMES(LEVEL)=-1
NAMES[LEVEL] = (-(1));
// 4748 ONINF(LEVEL)=0; ONWORD(LEVEL)=0
ONINF[LEVEL] = 0;
ONWORD[LEVEL] = 0;
// 4749 %IF KK>=0 %THEN %START
if (( KK ) < ( 0 )) goto L_047f;
// 4750 RLEVEL=RLEVEL+1; RBASE=RLEVEL
RLEVEL = ((RLEVEL)) + ((1));
RBASE = RLEVEL;
// 4751 %FINISH
L_047f:
// 4752 FAULT(34, 0) %IF LEVEL=MAX LEVELS
if (( LEVEL ) != ( 31 )) goto L_0480;
FAULT(34, 0);
L_0480:
// 4753 FAULT(105, 0) %IF LEVEL>MAX LEVELS
if (( LEVEL ) <= ( 31 )) goto L_0481;
FAULT(105, 0);
L_0481:
// 4754 %IF KK>=0 %AND RLEVEL>1 %START;! ROUTINE ENTRY
if (( KK ) < ( 0 )) goto L_0482;
if (( RLEVEL ) <= ( 1 )) goto L_0482;
// 4755 COPY TAG(KK); JJ=K; ! LIST OF JUMPS
COPYTAG(KK);
JJ = K;
// 4756 J=MIDCELL
J = MIDCELL;
// 4757 %IF J=0 %AND LEVEL>2 %START;! REPLACE 'NOT USED' BIT
if (( J ) != ( 0 )) goto L_0483;
if (( LEVEL ) <= ( 2 )) goto L_0483;
// 4758 REPLACE1(TAGS(KK), FROM1(TAGS(KK))&16_FFFF3FFF)
REPLACE1(TAGS[KK], ((FROM1(TAGS[KK]))) & ((-49153)));
// 4759 %FINISH
L_0483:
// 4760 !
// 4761 ! NOW FILL ANY JUMPS TO THIS ROUTINE PLANTED SINCE
// 4762 ! THE ROUTINESPEC WAS COMPILED. SEE ALSO 'RT JUMP'
// 4763 !
// 4764 %WHILE J#0 %CYCLE
L_0484:
if (( J ) == ( 0 )) goto L_0485;
// 4765 POP(J, INSRN, AT, W1)
POP( &J, &INSRN, &AT, &W1);
// 4766 W3=CA-AT
W3 = ((CA)) - ((AT));
// 4767 W3=W3//2 %IF INSRN>>25=CALL>>1
if (( (int)(((unsigned int)(INSRN)) >> ((25))) ) != ( (int)(((unsigned int)(30)) >> ((1))) )) goto L_0487;
W3 = ((int)(W3)) / ((int)(2));
L_0487:
// 4768 INSRN=INSRN+W3
INSRN = ((INSRN)) + ((W3));
// 4769 PLUG(1, AT, INSRN,4)
PLUG(1, AT, INSRN, 4);
// 4770 %REPEAT
goto L_0484;
L_0485:
// 4771 REPLACE2(TAGS(KK), CA); ! NOTE ADDR FOR FUTURE CALLS
REPLACE2(TAGS[KK], CA);
// 4772 %FINISH
L_0482:
// 4773 %IF KK>=0 %AND RLEVEL=1 %THEN DIAG POINTER(LEVEL) %AND PSF1(STD,1,12)
if (( KK ) < ( 0 )) goto L_0488;
if (( RLEVEL ) != ( 1 )) goto L_0488;
DIAGPOINTER(LEVEL);
PSF1(88, 1, 12);
L_0488:
// 4774 %IF KK<0 %THEN W3=0 %ELSE W3=WORD(KK)
if (( KK ) >= ( 0 )) goto L_0489;
W3 = 0;
goto L_048a;
L_0489:
W3 = WORD[KK];
L_048a:
// 4775 L(LEVEL)=LINE; M(LEVEL)=W3
L[LEVEL] = LINE;
M[LEVEL] = W3;
// 4776 FLAG(LEVEL)=PTYPE; ! CURRENT BLOCK TYPE MARKER
FLAG[LEVEL] = PTYPE;
// 4777 %END
return;
_imp_endofblock: ;
} // End of block RHEAD at level 5
// 4778 %ROUTINE RDISPLAY(%INTEGER KK)
void RDISPLAY( int KK )
{
__label__ _imp_endofblock;
// 4779 !***********************************************************************
// 4780 !* SET UP OR COPY THE DISPLAY (A WORD ARRAY CONTAINING COPIES OF *
// 4781 !* LNB FOR THE GLOBAL LEVELS. THE HIGHEST LEVEL ENTRY IS TO THE *
// 4782 !* GLA(PLT) FOR OWNS AND IS ALSO KEPT IN(LNB+4) IN CASE WE WISH *
// 4783 !* TO MOVE TO READ-ONLY PLTS. ON INTERNAL CALLS THE LNB FOR THE *
// 4784 !* NEXT MOST GLOBAL LEVEL IS STACKED AS AN EXTRA PARAMETER *
// 4785 !***********************************************************************
// 4786 %INTEGER W1,W2,STACK,OP,INC
int W1;
int W2;
int STACK;
int OP;
int INC;
// 4787 %IF KK>=0 %OR LEVEL=2 %START; ! DISPLAY NEEDED
if (( KK ) >= ( 0 )) goto L_0476;
if (( LEVEL ) != ( 2 )) goto L_048b;
L_0476:
// 4788 STACK=0; DISPLAY(RLEVEL)=N
STACK = 0;
DISPLAY[RLEVEL] = N;
// 4789 GRUSE(XNB)=0
GRUSE[3] = 0;
// 4790 GRUSE(CTB)=0; GRUSE(BREG)=0
GRUSE[5] = 0;
GRUSE[7] = 0;
// 4791 %IF LEVEL#2 %THEN %START
if (( LEVEL ) == ( 2 )) goto L_048c;
// 4792 ! PF1(LXN,0,TOS,0)
// 4793 GRUSE(XNB)=4; GRINF1(XNB)=RLEVEL-1; GRAT(XNB)=CA
GRUSE[3] = 4;
GRINF1[3] = ((RLEVEL)) - ((1));
GRAT[3] = CA;
// 4794 PF1(LD,0,XNB,12); ! COPY PLT DESCRIPTOR
PF1(120, 0, 3, 12);
// 4795 DIAG POINTER(LEVEL)
DIAGPOINTER(LEVEL);
// 4796 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 4797 W1=RLEVEL-1; W2=DISPLAY(W1)
W1 = ((RLEVEL)) - ((1));
W2 = DISPLAY[W1];
// 4798 %IF W1=1 %THEN PF1(STXN,0,TOS,0) %AND N=N+4 %ELSE %START
if (( W1 ) != ( 1 )) goto L_048d;
PF1(76, 0, 6, 0);
N = ((N)) + ((4));
goto L_048e;
L_048d:
// 4799 %WHILE W1>0 %CYCLE
L_048f:
if (( W1 ) <= ( 0 )) goto L_0490;
// 4800 OP=LSS; INC=1
OP = 98;
INC = 1;
// 4801 %IF W1>=2 %THEN OP=LSD %AND INC=2
if (( W1 ) < ( 2 )) goto L_0492;
OP = 100;
INC = 2;
L_0492:
// 4802 %IF W1>=4 %THEN OP=LSQ %AND INC=4
if (( W1 ) < ( 4 )) goto L_0493;
OP = 102;
INC = 4;
L_0493:
// 4803 PF1(OP+STACK,0,XNB,W2)
PF1(((OP)) + ((STACK)), 0, 3, W2);
// 4804 STACK=-32; N=N+4*INC
STACK = (-(32));
N = ((N)) + ((((4)) * ((INC))));
// 4805 W2=W2+4*INC; W1=W1-INC
W2 = ((W2)) + ((((4)) * ((INC))));
W1 = ((W1)) - ((INC));
// 4806 %REPEAT
goto L_048f;
L_0490:
// 4807 %FINISH
L_048e:
// 4808 %FINISH
L_048c:
// 4809 %IF STACK#0 %THEN PF1(ST,0,TOS,0); ! ST TOS
if (( STACK ) == ( 0 )) goto L_0494;
PF1(72, 0, 6, 0);
L_0494:
// 4810 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 4811 N=N+4
N = ((N)) + ((4));
// 4812 %FINISH
L_048b:
// 4813 !
// 4814 ! IF IN DIAGNOSTIC MODE PLANT CODE TO SAVE THE LINE & ROUTINE NO OF
// 4815 ! THE CALLING ROUTINE AND SET UP THE NEW BLOCK/ROUTINE IDENT NO.
// 4816 !
// 4817 %IF PARMTRACE#0 %START
if (( PARMTRACE ) == ( 0 )) goto L_0495;
// 4818 PF1(LSS,0,PC,4*CONST BTM!16_80000000) %IF PARMOPT#0;! M'IDIA'
if (( PARMOPT ) == ( 0 )) goto L_0496;
PF1(98, 0, 4, ((((4)) * ((CONSTBTM)))) | ((-2147483648)));
L_0496:
// 4819 %IF KK>=0 %OR LEVEL=2 %START
if (( KK ) >= ( 0 )) goto L_0486;
if (( LEVEL ) != ( 2 )) goto L_0497;
L_0486:
// 4820 %IF PARMOPT#0 %THEN %START
if (( PARMOPT ) == ( 0 )) goto L_0498;
// 4821 PSF1(SLSS,0,LINE)
PSF1(66, 0, LINE);
// 4822 N=N+4
N = ((N)) + ((4));
// 4823 %FINISH %ELSE PSF1(LSS,0,LINE)
goto L_0499;
L_0498:
PSF1(98, 0, LINE);
L_0499:
// 4824 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 4825 %FINISH %ELSE %START
goto L_049a;
L_0497:
// 4826 %IF PARMOPT#0 %THEN %START
if (( PARMOPT ) == ( 0 )) goto L_049b;
// 4827 PSF1(ST,1,N)
PSF1(72, 1, N);
// 4828 N=N+4
N = ((N)) + ((4));
// 4829 %FINISH
L_049b:
// 4830 PSF1(LSS,0,LINE)
PSF1(98, 0, LINE);
// 4831 PSF1(ST,1,N)
PSF1(72, 1, N);
// 4832 PSF1(LD,1,12); ! UPDATE BND FIELD
PSF1(120, 1, 12);
// 4833 DIAG POINTER(LEVEL)
DIAGPOINTER(LEVEL);
// 4834 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 4835 %FINISH
L_049a:
// 4836 DIAGINF(LEVEL)=N
DIAGINF[LEVEL] = N;
// 4837 N=N+4
N = ((N)) + ((4));
// 4838 GRUSE(ACCR)=0; ! NEEDED FOR %BEGIN BLOCKS
GRUSE[0] = 0;
// 4839 %FINISH
L_0495:
// 4840 %IF PARMOPT#0 %AND KK>=0 %AND LEVEL=2 %START
if (( PARMOPT ) == ( 0 )) goto L_049c;
if (( KK ) < ( 0 )) goto L_049c;
if (( LEVEL ) != ( 2 )) goto L_049c;
// 4841 PF1(STSF,0,BREG,0)
PF1(94, 0, 7, 0);
// 4842 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 4843 PF1(SBB,0,TOS,0)
PF1(34, 0, 6, 0);
// 4844 PSF1(CPB,0,N)
PSF1(38, 0, N);
// 4845 PPJ(7,13)
PPJ(7, 13);
// 4846 %FINISH
L_049c:
// 4847 !
// 4848 ! CLAIM (THE REST OF) THE STACK FRAME
// 4849 !
// 4850 %IF KK>=0 %OR LEVEL=2 %START
if (( KK ) >= ( 0 )) goto L_049d;
if (( LEVEL ) != ( 2 )) goto L_049e;
L_049d:
// 4851 SET(RLEVEL)=N<<18!CA
SET[RLEVEL] = ((((N)) << ((18)))) | ((CA));
// 4852 NMAX=N
NMAX = N;
// 4853 PF1(ASF+12*PARMCHK,0,0,0); ! ASF OR LB
PF1(((110)) + ((((12)) * ((PARMCHK)))), 0, 0, 0);
// 4854 PPJ(0,4) %IF PARMCHK#0
if (( PARMCHK ) == ( 0 )) goto L_049f;
PPJ(0, 4);
L_049f:
// 4855 %FINISH
L_049e:
// 4856 !
// 4857 %IF KK>=0 %AND PARMCHK#0 %START
if (( KK ) < ( 0 )) goto L_04a0;
if (( PARMCHK ) == ( 0 )) goto L_04a0;
// 4858 CHECK STOF; ! CHECK FOR STACK O'FLOW
CHECKSTOF();
// 4859 %FINISH
L_04a0:
// 4860 %IF PARMDBUG#0 %THEN SET LINE; ! TO CALL DBUG PACKAGE
if (( PARMDBUG ) == ( 0 )) goto L_04a1;
SETLINE();
L_04a1:
// 4861 %END
return;
_imp_endofblock: ;
} // End of block RDISPLAY at level 5
// 4862 %ROUTINE CHECK STOF
void CHECKSTOF( void )
{
__label__ _imp_endofblock;
// 4863 !***********************************************************************
// 4864 !* CHECK THE STACK FOR OVERFLOW (LEAVING 4K MARGIN FOR MDIAG *
// 4865 !***********************************************************************
// 4866 %IF PARMOPT#0 %THEN %START
if (( PARMOPT ) == ( 0 )) goto L_04a2;
// 4867 !
// 4868 ! STSF TOS GET STACK POINTER
// 4869 ! LSS TOS
// 4870 ! USH +14
// 4871 ! USH -15 LOSE SEGMENT NO
// 4872 ! ICP 16_1F800 CHECK WITHIN SEG ADDRESS
// 4873 ! SHIFTED DOWN 1 PLACE
// 4874 ! JCC 2,EXCESS BLKS
// 4875 !
// 4876 PF1(STSF,0,TOS,0)
PF1(94, 0, 6, 0);
// 4877 PF1(LSS,0,TOS,0)
PF1(98, 0, 6, 0);
// 4878 PSF1(USH,0,14)
PSF1(200, 0, 14);
// 4879 PSF1(USH,0,-15)
PSF1(200, 0, (-(15)));
// 4880 PF1(ICP,0,0,ST LIMIT>>1)
PF1(230, 0, 0, (int)(((unsigned int)(STLIMIT)) >> ((1))));
// 4881 PPJ(2,8)
PPJ(2, 8);
// 4882 %FINISH
L_04a2:
// 4883 %END; ! OF ROUTINE RHEAD
return;
_imp_endofblock: ;
} // End of block CHECKSTOF at level 5
// 4884 %ROUTINE CIOCP(%INTEGER N,REG)
void CIOCP( int N, int REG )
{
__label__ _imp_endofblock;
// 4885 !***********************************************************************
// 4886 !* COMPILES A CALL ON IOCP ENTRY POINT NO 'N' *
// 4887 !* 2ND PARAMETER IS ALREAD IN THE ACC WHICH IS 32 BITS *
// 4888 !***********************************************************************
// 4889 %INTEGER XYNB,OP1,OP2
int XYNB;
int OP1;
int OP2;
// 4890 %IF IOCPDISP=0 %THEN CXREF(IOCPEP,PARMDYNAMIC,2,IOCPDISP)
if (( IOCPDISP ) != ( 0 )) goto L_04a3;
CXREF(IOCPEP, PARMDYNAMIC, 2, &IOCPDISP);
L_04a3:
// 4891 %IF REGISTER(BREG)#0 %THEN BOOT OUT(BREG)
if (( REGISTER[7] ) == ( 0 )) goto L_04a4;
BOOTOUT(7);
L_04a4:
// 4892 %IF REG=ACCR %THEN OP1=LUH %AND OP2=ST %ELSE OP1=LDTB %AND OP2=STD
if (( REG ) != ( 0 )) goto L_04a5;
OP1 = 106;
OP2 = 72;
goto L_04a6;
L_04a5:
OP1 = 116;
OP2 = 88;
L_04a6:
// 4893 PSF1(OP1,0,N)
PSF1(OP1, 0, N);
// 4894 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 4895 PF1(OP2,0,TOS,0)
PF1(OP2, 0, 6, 0);
// 4896 XYNB=SET XORYNB(-1,-1); ! TO PLT
XYNB = SETXORYNB((-(1)), (-(1)));
// 4897 PSF1(RALN,0,7)
PSF1(108, 0, 7);
// 4898 PF1(CALL,2,XYNB,IOCPDISP)
PF1(30, 2, XYNB, IOCPDISP);
// 4899 FORGET(-1)
FORGET((-(1)));
// 4900 %END
return;
_imp_endofblock: ;
} // End of block CIOCP at level 5
// 4901 %ROUTINE CUI(%INTEGER CODE)
void CUI( int CODE )
{
__label__ _imp_endofblock;
// 4902 !***********************************************************************
// 4903 !* COMPILE AN UNCONDITIONAL INSTRN WHEREEVER IT OCCURS *
// 4904 !* CODE=0 UNCONDITIOALLY,=1 AFTER %THEN, =2 AFTER %ELSE *
// 4905 !***********************************************************************
// 4906 %INTEGER MARKER,J,LNAME,TYPEP,PRECP,GWRDD,LWB,XYNB,ARRP,ALT
int MARKER;
int J;
int LNAME;
int TYPEP;
int PRECP;
int GWRDD;
int LWB;
int XYNB;
int ARRP;
int ALT;
// 4907 %SWITCH SW(1:9)
static int SW_idx;
static const void * /*SWITCH*/ SW[(9)-(1)+1] = { &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, &&SW_6, &&SW_7, &&SW_8, &&SW_9, };
// 4908 REPORTUI=0
REPORTUI = 0;
// 4909 ALT=A(P)
ALT = A[P];
// 4910 ->SW(ALT)
goto *(SW-1)[ALT]; /* Bounds=1:9 */
// 4911 SW(1): ! (NAME)(APP)(ASSMNT?)
SW_1:
// 4912 P=P+1; MARKER=P+FROMAR2(P)
P = ((P)) + ((1));
MARKER = ((P)) + ((FROMAR2(P)));
// 4913 %IF A(MARKER)=1 %THEN %START
if (( A[MARKER] ) != ( 1 )) goto L_04a7;
// 4914 J=P+2; P=MARKER+2
J = ((P)) + ((2));
P = ((MARKER)) + ((2));
// 4915 ASSIGN(A(MARKER+1),J)
ASSIGN(A[((MARKER)) + ((1))], J);
// 4916 %FINISH %ELSE %START
goto L_04a8;
L_04a7:
// 4917 P=P+2
P = ((P)) + ((2));
// 4918 CNAME(0,0)
CNAME(0, 0);
// 4919 P=P+1
P = ((P)) + ((1));
// 4920 %FINISH
L_04a8:
// 4921 AUI: J=A(P); P=P+1
U_01e8:
J = A[P];
P = ((P)) + ((1));
// 4922 %IF J=1 %THEN CUI(CODE)
if (( J ) != ( 1 )) goto L_04a9;
CUI(CODE);
L_04a9:
// 4923 %RETURN
return;
// 4924 SW(2): ! -> (NAME)(APP)
SW_2:
// 4925 NMDECS(LEVEL)=NMDECS(LEVEL)!1
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((1));
// 4926 CURR INST=1 %IF CODE=0
if (( CODE ) != ( 0 )) goto L_04aa;
CURRINST = 1;
L_04aa:
// 4927 LNAME=FROM AR2(P+1)
LNAME = FROMAR2(((P)) + ((1)));
// 4928 J=A(P+3); P=P+4
J = A[((P)) + ((3))];
P = ((P)) + ((4));
// 4929 %IF J=2 %THEN %START; ! SIMPLE LABEL
if (( J ) != ( 2 )) goto L_04ab;
// 4930 ENTER JUMP(15,LNAME,0)
ENTERJUMP(15, LNAME, 0);
// 4931 REPORTUI=1
REPORTUI = 1;
// 4932 %FINISH %ELSE %START; ! SWITCH LABELS
goto L_04ac;
L_04ab:
// 4933 COPY TAG(LNAME)
COPYTAG(LNAME);
// 4934 ARRP=ARR
ARRP = ARR;
// 4935 GWRDD=SNDISP<<2; ! BYTE DISP OF DESCRIPTOR IN PLT
GWRDD = ((SNDISP)) << ((2));
// 4936 %UNLESS OLDI=LEVEL %AND TYPE=6 %START
if (( OLDI ) != ( LEVEL )) goto L_04ad;
if (( TYPE ) == ( 6 )) goto L_04ae;
L_04ad:
// 4937 FAULT(4,LNAME); P=P-1; SKIP APP
FAULT(4, LNAME);
P = ((P)) - ((1));
SKIPAPP();
// 4938 %RETURN
return;
// 4939 %FINISH
L_04ae:
// 4940 LWB=FROM2(K); ! GET LOWER BOUND
LWB = FROM2(K);
// 4941 CSEXP(BREG,16_51)
CSEXP(7, 81);
// 4942 %IF ARRP=1 %THEN PSF1(SBB,0,LWB)
if (( ARRP ) != ( 1 )) goto L_04af;
PSF1(34, 0, LWB);
L_04af:
// 4943 XYNB=SET XORYNB(-1,-1); ! TO PLT
XYNB = SETXORYNB((-(1)), (-(1)));
// 4944 PF1(JUNC,3,XYNB,GWRDD); ! JUMP INDIRECT VIA WORD ARRAY
PF1(26, 3, XYNB, GWRDD);
// 4945 ! OF 32 BIT RELOCATED ADDRESSES
// 4946 REPORTUI=1; FORGET(-1)
REPORTUI = 1;
FORGET((-(1)));
// 4947 %FINISH
L_04ac:
// 4948 %RETURN
return;
// 4949 SW(3): ! RETURN
SW_3:
// 4950 FAULT(30,0) %UNLESS FLAG(LEVEL)&16_3FFF=16_1000
if (( ((FLAG[LEVEL])) & ((16383)) ) == ( 4096 )) goto L_04b0;
FAULT(30, 0);
L_04b0:
// 4951 P=P+1
P = ((P)) + ((1));
// 4952 RET: RT EXIT
U_01e9:
RTEXIT();
// 4953 REPORT UI=1
REPORTUI = 1;
// 4954 CURR INST=1 %IF CODE=0
if (( CODE ) != ( 0 )) goto L_04b1;
CURRINST = 1;
L_04b1:
// 4955 %RETURN
return;
// 4956 SW(4): ! %RESULT(ASSOP)(EXPR)
SW_4:
// 4957 PTYPE=FLAG(LEVEL)&16_3FFF; UNPACK
PTYPE = ((FLAG[LEVEL])) & ((16383));
UNPACK();
// 4958 %IF PTYPE>16_1000 %AND A(P+1)#3 %THEN %START;! ASSOP #'->'
if (( PTYPE ) <= ( 4096 )) goto L_04b2;
if (( A[((P)) + ((1))] ) == ( 3 )) goto L_04b2;
// 4959 %IF A(P+1)=1 %AND NAM#0 %AND A(P+5)=4 %AND A(P+6)=1 %START
if (( A[((P)) + ((1))] ) != ( 1 )) goto L_04b3;
if (( NAM ) == ( 0 )) goto L_04b3;
if (( A[((P)) + ((5))] ) != ( 4 )) goto L_04b3;
if (( A[((P)) + ((6))] ) != ( 1 )) goto L_04b3;
// 4960 P=P+7; TYPEP=TYPE; PRECP=PREC
P = ((P)) + ((7));
TYPEP = TYPE;
PRECP = PREC;
// 4961 CNAME(4,ACCR)
CNAME(4, 0);
// 4962 FAULT(81,0) %UNLESS A(P)=2; P=P+1
if (( A[P] ) == ( 2 )) goto L_04b4;
FAULT(81, 0);
L_04b4:
P = ((P)) + ((1));
// 4963 FAULT(83,0) %UNLESS TYPEP=TYPE %AND PRECP=PREC
if (( TYPEP ) != ( TYPE )) goto L_04b5;
if (( PRECP ) == ( PREC )) goto L_04b6;
L_04b5:
FAULT(83, 0);
L_04b6:
// 4964 ->RET
goto U_01e9;
// 4965 %FINISH
L_04b3:
// 4966 %IF A(P+1)=2 %THEN %START; ! ASSOP='='
if (( A[((P)) + ((1))] ) != ( 2 )) goto L_04b7;
// 4967 P=P+2
P = ((P)) + ((2));
// 4968 %IF NAM#0 %THEN TYPE=1; ! MAPS HAVE INTEGER RESULTS
if (( NAM ) == ( 0 )) goto L_04b8;
TYPE = 1;
L_04b8:
// 4969 %IF TYPE=5 %THEN %START
if (( TYPE ) != ( 5 )) goto L_04b9;
// 4970 CSTREXP(0,ACCR)
CSTREXP(0, 0);
// 4971 PSF1(LD,1,DISPLAY(RBASE)-8); ! RESULT DESCRPT
PSF1(120, 1, ((DISPLAY[RBASE])) - ((8)));
// 4972 PF1(IAD,0,PC,SPECIAL CONSTS(2))
PF1(224, 0, 4, SPECIALCONSTS(2));
// 4973 PF2(MV,1,1,0,0,UNASSPAT&255)
PF2(178, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 4974 PSF1(LDB,2,DISPLAY(RBASE)-8)
PSF1(118, 2, ((DISPLAY[RBASE])) - ((8)));
// 4975 COPY DR
COPYDR();
// 4976 %FINISH %ELSE %START
goto L_04ba;
L_04b9:
// 4977 %IF PREC<5 %THEN PREC=5
if (( PREC ) >= ( 5 )) goto L_04bb;
PREC = 5;
L_04bb:
// 4978 %IF NAM=0 %THEN KK=PREC<<4!TYPE %ELSE KK=16_51
if (( NAM ) != ( 0 )) goto L_04bc;
KK = ((((PREC)) << ((4)))) | ((TYPE));
goto L_04bd;
L_04bc:
KK = 81;
L_04bd:
// 4979 CSEXP(ACCR,KK)
CSEXP(0, KK);
// 4980 %FINISH; ->RET
L_04ba:
goto U_01e9;
// 4981 %FINISH
L_04b7:
// 4982 %FINISH
L_04b2:
// 4983 FAULT(31,0)
FAULT(31, 0);
// 4984 P=P+2; SKIP EXP; ! IGNORE SPURIOUS RESULT
P = ((P)) + ((2));
SKIPEXP();
// 4985 %RETURN
return;
// 4986 SW(5): ! %MONITOR (AUI)
SW_5:
// 4987 PSF1(LSD,0,0); ! ERR=0 & EXTRA =0
PSF1(100, 0, 0);
// 4988 PPJ(0,2); ! TO ERROR ROUTINE
PPJ(0, 2);
// 4989 P=P+1; ->AUI
P = ((P)) + ((1));
goto U_01e8;
// 4990 SW(6): ! %STOP
SW_6:
// 4991 PPJ(0,21)
PPJ(0, 21);
// 4992 P=P+1
P = ((P)) + ((1));
// 4993 CURR INST=1 %IF CODE=0
if (( CODE ) != ( 0 )) goto L_04be;
CURRINST = 1;
L_04be:
// 4994 REPORTUI=1
REPORTUI = 1;
// 4995 %RETURN
return;
// 4996 SW(7): !'%SIGNAL'(EVENT')(N)(OPEXPR)
SW_7:
// 4997 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 4998 PSF1(JLK,0,1); ! STACK DUMMY PC
PSF1(28, 0, 1);
// 4999 %IF NMDECS(LEVEL)&16 #0 %START;! IN AN 'ON' GROUP
if (( ((NMDECS[LEVEL])) & ((16)) ) == ( 0 )) goto L_04bf;
// 5000 %IF FLAG(LEVEL)<=2 %START; ! IN A BEGIN BLOCK
if (( FLAG[LEVEL] ) > ( 2 )) goto L_04c0;
// 5001 PSF1(LD,1,12); ! SO RESET DIAG POINTER
PSF1(120, 1, 12);
// 5002 DIAGPOINTER(LEVEL-1); ! TO NEXT OUTER BLOCK
DIAGPOINTER(((LEVEL)) - ((1)));
// 5003 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 5004 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 5005 %FINISH %ELSE %START; ! 'ON IN A RT/FN/MAP
goto L_04c1;
L_04c0:
// 5006 PSF1(LSS,1,0); ! GET PREVIOUS LNB
PSF1(98, 1, 0);
// 5007 PF1(ST,0,TOS,0); ! AND STACK THAT
PF1(72, 0, 6, 0);
// 5008 %FINISH
L_04c1:
// 5009 %FINISH %ELSE PF1(STLN,0,TOS,0)
goto L_04c2;
L_04bf:
PF1(92, 0, 6, 0);
L_04c2:
// 5010 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5011 J=A(P+2); ! EVENT NO
J = A[((P)) + ((2))];
// 5012 FAULT2(26,J,0) %UNLESS 1<=J<=15
if (( 1 ) > ( J )) goto L_04c3;
if (( J ) <= ( 15 )) goto L_04c4;
L_04c3:
FAULT2(26, J, 0);
L_04c4:
// 5013 %IF A(P+3)=1 %START; ! SUBEVENT SPECIFIED
if (( A[((P)) + ((3))] ) != ( 1 )) goto L_04c5;
// 5014 P=P+4; CSEXP(ACCR,16_51)
P = ((P)) + ((4));
CSEXP(0, 81);
// 5015 PF1(AND,0,0,255)
PF1(138, 0, 0, 255);
// 5016 PF1(OR,0,0,256*J)
PF1(140, 0, 0, ((256)) * ((J)));
// 5017 %FINISH %ELSE PF1(LSS,0,0,256*J)
goto L_04c6;
L_04c5:
PF1(98, 0, 0, ((256)) * ((J)));
L_04c6:
// 5018 PSF1(SLSS,0,0)
PSF1(66, 0, 0);
// 5019 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 5020 XYNB=SET XORYNB(-1,-1); ! TO PLT
XYNB = SETXORYNB((-(1)), (-(1)));
// 5021 PSF1(RALN,0,9)
PSF1(108, 0, 9);
// 5022 PF1(CALL,2,XYNB,40)
PF1(30, 2, XYNB, 40);
// 5023 CURR INST=1 %IF CODE=0
if (( CODE ) != ( 0 )) goto L_04c7;
CURRINST = 1;
L_04c7:
// 5024 REPORTUI=1; %RETURN
REPORTUI = 1;
return;
// 5025 SW(8): ! %EXIT
SW_8:
// 5026 SW(9): ! %CONTINUE
SW_9:
// 5027 ALT=ALT&7; ! 0 FOR EXIT 1 FOR CONTINUE
ALT = ((ALT)) & ((7));
// 5028 %IF EXITLAB=0 %THEN FAULT2(54+ALT,0,0) %AND %RETURN
if (( EXITLAB ) != ( 0 )) goto L_04c8;
FAULT2(((54)) + ((ALT)), 0, 0);
return;
L_04c8:
// 5029 KK=INTEGER(ADDR(EXITLAB)+4*ALT)
KK = *INTEGER(((ADDR( &EXITLAB))) + ((((4)) * ((ALT)))));
// 5030 ENTER JUMP(15,KK,B'10')
ENTERJUMP(15, KK, 2);
// 5031 REPORTUI=1
REPORTUI = 1;
// 5032 CURR INST=1 %IF CODE=0
if (( CODE ) != ( 0 )) goto L_04c9;
CURRINST = 1;
L_04c9:
// 5033 %END
return;
_imp_endofblock: ;
} // End of block CUI at level 5
// 5034 %ROUTINE CIFTHEN(%INTEGER MARKIU,MARKC,MARKUI,MARKE,MARKR,SKIP)
void CIFTHEN( int MARKIU, int MARKC, int MARKUI, int MARKE, int MARKR, int SKIP )
{
__label__ _imp_endofblock;
// 5035 !***********************************************************************
// 5036 !* THIS ROUTINE COMPILES CONDITIONAL EXPRESSIONS.IT REQUIRES THE *
// 5037 !* FOLLOWING PARAMETERS TO BE SET TO THEIR A .R. ENTRY. *
// 5038 !* MARKIU TO THE ENTRY FOR P(%IU) *
// 5039 !* MARKC TO THE ENTRY FOR P(COND) *
// 5040 !* MARKUI TO THE ENTRY FOR (FIRST OCCURRENCE OF) P(UI) *
// 5041 !* MARKE TO THE ENTRY FOR P(ELSE') - =0 FOR BACKWARDS CONDITION *
// 5042 !* MARKR TO ENTRY FOR P(RESTOFIU) - =0 FOR BACKWARDS CONDITION *
// 5043 !***********************************************************************
// 5044 %INTEGER ALTUI,CCRES,ELRES,THENLAB,ELSELAB,USERLAB,REPORT,START,ELSEALT,K
int ALTUI;
int CCRES;
int ELRES;
int THENLAB;
int ELSELAB;
int USERLAB;
int REPORT;
int START;
int ELSEALT;
int K;
// 5045 %CONSTINTEGER NULL ELSE=4
// 5046 %SWITCH ESW(1:NULL ELSE)
static int ESW_idx;
static const void * /*SWITCH*/ ESW[(4)-(1)+1] = { &&ESW_1, &&ESW_2, &&ESW_3, &&ESW_4, };
// 5047 SET LINE %UNLESS SKIP=YES
if (( SKIP ) == ( 1 )) goto L_04ca;
SETLINE();
L_04ca:
// 5048 MARKIU=A(MARKIU); ! ALT OF IU 1=%IF,2=%UNLESS
MARKIU = A[MARKIU];
// 5049 PLABEL=PLABEL-1
PLABEL = ((PLABEL)) - ((1));
// 5050 THENLAB=PLABEL
THENLAB = PLABEL;
// 5051 START=0; ! NO START IN CONDITION YET
START = 0;
// 5052 ELSELAB=0; ! MEANS NO ELSE CLAUSE
ELSELAB = 0;
// 5053 P=MARKC
P = MARKC;
// 5054 %IF MARKR>0 %AND A(MARKR)<=2 %THEN START=1;! '%START' OR '%THENSTART'
if (( MARKR ) <= ( 0 )) goto L_04cb;
if (( A[MARKR] ) > ( 2 )) goto L_04cb;
START = 1;
L_04cb:
// 5055 %IF MARKE#0 %AND LEVEL<2 %AND START=0 %THEN FAULT(57,0)
if (( MARKE ) == ( 0 )) goto L_04cc;
if (( LEVEL ) >= ( 2 )) goto L_04cc;
if (( START ) != ( 0 )) goto L_04cc;
FAULT(57, 0);
L_04cc:
// 5056 USERLAB=-1
USERLAB = (-(1));
// 5057 %IF START#0 %THEN ALTUI=0 %ELSE ALTUI=A(MARKUI)
if (( START ) == ( 0 )) goto L_04cd;
ALTUI = 0;
goto L_04ce;
L_04cd:
ALTUI = A[MARKUI];
L_04ce:
// 5058 %IF ALTUI=2 %AND A(MARKUI+3)=2 %THEN USERLAB=FROM AR2(MARKUI+1); ! UI = SIMPLE LABEL
if (( ALTUI ) != ( 2 )) goto L_04cf;
if (( A[((MARKUI)) + ((3))] ) != ( 2 )) goto L_04cf;
USERLAB = FROMAR2(((MARKUI)) + ((1)));
L_04cf:
// 5059 %IF 8<=ALTUI<=9 %AND EXITLAB#0 %START; ! VALID EXIT
if (( 8 ) > ( ALTUI )) goto L_04d0;
if (( ALTUI ) > ( 9 )) goto L_04d0;
if (( EXITLAB ) == ( 0 )) goto L_04d0;
// 5060 %IF ALTUI=8 %THEN USERLAB=EXITLAB %ELSE USERLAB=CONTLAB
if (( ALTUI ) != ( 8 )) goto L_04d1;
USERLAB = EXITLAB;
goto L_04d2;
L_04d1:
USERLAB = CONTLAB;
L_04d2:
// 5061 %FINISH
L_04d0:
// 5062 !
// 5063 %IF SKIP=YES %THEN %START; ! NO CODE NEEDED
if (( SKIP ) != ( 1 )) goto L_04d3;
// 5064 %IF START#0 %START
if (( START ) == ( 0 )) goto L_04d4;
// 5065 P=MARKR+1
P = ((MARKR)) + ((1));
// 5066 CSTART(2,1); ! NO CODE
CSTART(2, 1);
// 5067 MARKE=P
MARKE = P;
// 5068 %FINISH
L_04d4:
// 5069 CCRES=1; ! NO CODE FOR ELSE
CCRES = 1;
// 5070 ->ELSE
goto U_01ed;
// 5071 %FINISH
L_04d3:
// 5072 !
// 5073 %IF USERLAB>=0 %THEN %START; ! FIRST UI IS'->'<LABEL>
if (( USERLAB ) < ( 0 )) goto L_04d5;
// 5074 NMDECS(LEVEL)=NMDECS(LEVEL)!1
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((1));
// 5075 CCRES=CCOND(0,3-MARKIU,USERLAB)
CCRES = CCOND(0, ((3)) - ((MARKIU)), USERLAB);
// 5076 %IF CCRES#0 %THEN CCRES=CCRES!!3;! CONDITION BACKWARDS!
if (( CCRES ) == ( 0 )) goto L_04d6;
CCRES = ((CCRES)) ^ ((3));
L_04d6:
// 5077 THENLAB=0; ! NO THENLAB IN THIS CASE
THENLAB = 0;
// 5078 REPORT=1; ! UI TRANSFERED CONTROL
REPORT = 1;
// 5079 %FINISH %ELSE %START
goto L_04d7;
L_04d5:
// 5080 CCRES=CCOND(1,MARKIU,THENLAB)
CCRES = CCOND(1, MARKIU, THENLAB);
// 5081 %IF START#0 %THEN %START; ! %THEN %START
if (( START ) == ( 0 )) goto L_04d8;
// 5082 %IF CCRES=0 %START; ! CONDITIONAL
if (( CCRES ) != ( 0 )) goto L_04d9;
// 5083 FAULT(57,0) %IF LEVEL<2
if (( LEVEL ) >= ( 2 )) goto L_04da;
FAULT(57, 0);
L_04da:
// 5084 NMDECS(LEVEL)=NMDECS(LEVEL)!1
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((1));
// 5085 %FINISH
L_04d9:
// 5086 P=MARKR+1
P = ((MARKR)) + ((1));
// 5087 CSTART(CCRES,1)
CSTART(CCRES, 1);
// 5088 %IF A(P)<=2 %THEN PLABEL=PLABEL-1 %AND ELSELAB=PLABEL
if (( A[P] ) > ( 2 )) goto L_04db;
PLABEL = ((PLABEL)) - ((1));
ELSELAB = PLABEL;
L_04db:
// 5089 MARKE=P
MARKE = P;
// 5090 REPORT=LAST INST
REPORT = LASTINST;
// 5091 %FINISH %ELSE %START
goto L_04dc;
L_04d8:
// 5092 %IF CCRES#2 %START
if (( CCRES ) == ( 2 )) goto L_04dd;
// 5093 P=MARKUI; CUI(1)
P = MARKUI;
CUI(1);
// 5094 REPORT=REPORTUI
REPORT = REPORTUI;
// 5095 %FINISH %ELSE %START; ! FIRST UI NEVER EXECUTED
goto L_04de;
L_04dd:
// 5096 REPORT=1
REPORT = 1;
// 5097 %FINISH
L_04de:
// 5098 %FINISH
L_04dc:
// 5099 %FINISH
L_04d7:
// 5100 ELSE: ! ELSE PART
U_01ed:
// 5101 %IF MARKE=0 %THEN ELSEALT=NULL ELSE %ELSE ELSEALT=A(MARKE)
if (( MARKE ) != ( 0 )) goto L_04df;
ELSEALT = 4;
goto L_04e0;
L_04df:
ELSEALT = A[MARKE];
L_04e0:
// 5102 %IF ELSEALT<NULL ELSE %THEN PLABEL=PLABEL-1 %AND ELSELAB=PLABEL
if (( ELSEALT ) >= ( 4 )) goto L_04e1;
PLABEL = ((PLABEL)) - ((1));
ELSELAB = PLABEL;
L_04e1:
// 5103 P=MARKE+1
P = ((MARKE)) + ((1));
// 5104 %IF REPORT=0=CCRES %AND ELSEALT<NULL ELSE %THEN REPORT=1 %AND ENTER JUMP(15,ELSELAB,B'10');! LONG JUMP BUT SAVE ENV
if (( REPORT ) != ( 0 )) goto L_04e2;
if (( 0 ) != ( CCRES )) goto L_04e2;
if (( ELSEALT ) >= ( 4 )) goto L_04e2;
REPORT = 1;
ENTERJUMP(15, ELSELAB, 2);
L_04e2:
// 5105 %IF THENLAB>0 %THEN ELRES=ENTER LAB(THENLAB,B'11'!REPORT<<2)
if (( THENLAB ) <= ( 0 )) goto L_04e3;
ELRES = ENTERLAB(THENLAB, ((3)) | ((((REPORT)) << ((2)))));
L_04e3:
// 5106 ! CONDITIONAL&MERGE OR REPLACE
// 5107 ->ESW(ELSEALT)
goto *(ESW-1)[ELSEALT]; /* Bounds=1:4 */
// 5108 ESW(1): ! '%ELSESTART'
ESW_1:
// 5109 %IF CCRES=0 %THEN NMDECS(LEVEL)=NMDECS(LEVEL)!1
if (( CCRES ) != ( 0 )) goto L_04e4;
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((1));
L_04e4:
// 5110 CSTART(CCRES,2)
CSTART(CCRES, 2);
// 5111 REPORT=LAST INST
REPORT = LASTINST;
// 5112 ->ENTER ELSELAB
goto U_01ee;
// 5113 ESW(2): ! '%ELSE' (%IU) ETC
ESW_2:
// 5114 MARKE=0; MARKUI=0
MARKE = 0;
MARKUI = 0;
// 5115 MARKR=P+1+FROMAR2(P+1)
MARKR = ((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))));
// 5116 %IF A(MARKR)=3 %THEN %START
if (( A[MARKR] ) != ( 3 )) goto L_04e5;
// 5117 MARKE=MARKR+1+FROM AR2(MARKR+1)
MARKE = ((((MARKR)) + ((1)))) + ((FROMAR2(((MARKR)) + ((1)))));
// 5118 MARKUI=MARKR+3
MARKUI = ((MARKR)) + ((3));
// 5119 %FINISH
L_04e5:
// 5120 %IF CCRES=1 %OR SKIP=YES %THEN K=YES %ELSE K=NO
if (( CCRES ) == ( 1 )) goto L_04e6;
if (( SKIP ) != ( 1 )) goto L_04e7;
L_04e6:
K = 1;
goto L_04e8;
L_04e7:
K = 0;
L_04e8:
// 5121 CIFTHEN(P,P+3,MARKUI,MARKE,MARKR,K)
CIFTHEN(P, ((P)) + ((3)), MARKUI, MARKE, MARKR, K);
// 5122 ->ENTER ELSELAB
goto U_01ee;
// 5123 ESW(3): ! '%ELSE'<UI>
ESW_3:
// 5124 %IF CCRES#1 %THEN %START
if (( CCRES ) == ( 1 )) goto L_04e9;
// 5125 %IF START#0 %THEN SET LINE; ! FOR CORRECT LINE IF FAILS IN UI
if (( START ) == ( 0 )) goto L_04ea;
SETLINE();
L_04ea:
// 5126 %IF THENLAB=0 %THEN K=0 %ELSE K=2
if (( THENLAB ) != ( 0 )) goto L_04eb;
K = 0;
goto L_04ec;
L_04eb:
K = 2;
L_04ec:
// 5127 CUI(K)
CUI(K);
// 5128 REPORT=REPORTUI
REPORT = REPORTUI;
// 5129 %FINISH
L_04e9:
// 5130 ENTER ELSELAB:
U_01ee:
// 5131 %IF ELSELAB>0 %THEN ELRES=ENTER LAB(ELSELAB,B'11'!REPORT<<2)
if (( ELSELAB ) <= ( 0 )) goto L_04ed;
ELRES = ENTERLAB(ELSELAB, ((3)) | ((((REPORT)) << ((2)))));
L_04ed:
// 5132 ! CONDITIONAL MERGE
// 5133 ESW(NULL ELSE): ! NULL ELSE CLAUSE
ESW_4:
// 5134 %END
return;
_imp_endofblock: ;
} // End of block CIFTHEN at level 5
// 5135 %ROUTINE CSTART(%INTEGER CCRES,CODE)
void CSTART( int CCRES, int CODE )
{
__label__ _imp_endofblock;
// 5136 !***********************************************************************
// 5137 !* COMPILE A COMPLETE START-FINISH BLOCK BY RECURSION *
// 5138 !* IF START NEVER EXECUTED SKIP TO CORRESPONDING FINISH *
// 5139 !* CODE=0 WAS UNCONDITIONAL NOW SHOULD BE UNUSED *
// 5140 !* CODE=1 AFTER THEN *
// 5141 !* CODE=2 AFTER ELSE *
// 5142 !* CODE=3 AFTER ONEVENT *
// 5143 !* P ON ENTRY TO FORWARD POINTER TO THE RIGHT FINISH *
// 5144 !* P ON EXIT TO THE ELSE CLAUSE AFTER THE RIGHT FINISH *
// 5145 !***********************************************************************
// 5146 %INTEGER SKIPCODE,FINISHAR,OLDNEXTP,OLDLINE
int SKIPCODE;
int FINISHAR;
int OLDNEXTP;
int OLDLINE;
// 5147 SKIPCODE=NO
SKIPCODE = 0;
// 5148 %IF 1<=CODE<=2 %AND CCRES!CODE=3 %THEN SKIPCODE=YES;! NEVER EXECUTED
if (( 1 ) > ( CODE )) goto L_04ee;
if (( CODE ) > ( 2 )) goto L_04ee;
if (( ((CCRES)) | ((CODE)) ) != ( 3 )) goto L_04ee;
SKIPCODE = 1;
L_04ee:
// 5149 FINISHAR=FROMAR4(P); ! TO START OF AR FOR FINISH
FINISHAR = FROMAR4(P);
// 5150 %IF FINISHAR<=P %THEN ABORT; ! FOR TESTING
if (( FINISHAR ) > ( P )) goto L_04ef;
ABORT();
L_04ef:
// 5151 OLDLINE=LINE; ! FOR ERROR MESSAGES
OLDLINE = LINE;
// 5152 %CYCLE; ! THROUGH INTERVENING STATMNTS {I didn't change this one. Looks like both forms of until were accepted.}
L_04f0:
// 5153 OLDNEXTP=NEXTP
OLDNEXTP = NEXTP;
// 5154 %IF SKIP CODE=NO %THEN COMPILE A STMNT %ELSE %START
if (( SKIPCODE ) != ( 0 )) goto L_04f3;
COMPILEASTMNT();
goto L_04f4;
L_04f3:
// 5155 LINE=A(NEXTP+3)<<8!A(NEXTP+4)
LINE = ((((A[((NEXTP)) + ((3))])) << ((8)))) | ((A[((NEXTP)) + ((4))]));
// 5156 NEXTP=NEXTP+A(NEXTP)<<16+A(NEXTP+1)<<8+A(NEXTP+2)
NEXTP = ((((((NEXTP)) + ((((A[NEXTP])) << ((16)))))) + ((((A[((NEXTP)) + ((1))])) << ((8)))))) + ((A[((NEXTP)) + ((2))]));
// 5157 %FINISH
L_04f4:
// 5158 %REPEAT %UNTIL OLDNEXTP>=FINISHAR;! HAVING COMPILED FINISH
if (( OLDNEXTP ) >= ( FINISHAR )) goto L_04f1;
goto L_04f0;
L_04f1:
// 5159 P=FINISHAR+6; ! TO ELSE CLAUSE
P = ((FINISHAR)) + ((6));
// 5160 !
// 5161 %IF A(P)<=2 %AND CODE#1 %THEN FAULT2(45+CODE,OLDLINE,0)
if (( A[P] ) > ( 2 )) goto L_04f5;
if (( CODE ) == ( 1 )) goto L_04f5;
FAULT2(((45)) + ((CODE)), OLDLINE, 0);
L_04f5:
// 5162 %IF SKIPCODE=YES %THEN LAST INST=1
if (( SKIPCODE ) != ( 1 )) goto L_04f6;
LASTINST = 1;
L_04f6:
// 5163 %END
return;
_imp_endofblock: ;
} // End of block CSTART at level 5
// 5164 %ROUTINE CCYCBODY(%INTEGER UA,ELAB,CLAB)
void CCYCBODY( int UA, int ELAB, int CLAB )
{
__label__ _imp_endofblock;
// 5165 !***********************************************************************
// 5166 !* COMPILES A CYCLE REPEAT BODY BY RECURSION *
// 5167 !* ON ENTRY P IS TO FORWARD POINTER. ON EXIT TO ALT OF UNTIL *
// 5168 !* UA = O IF UNTIL NOT ALLOWED *
// 5169 !* ELAB&CLAB ARE LABELS FOR ELSE & CONTINUE *
// 5170 !***********************************************************************
// 5171 %INTEGER FINISHAR,OLDLINE,SAVEE,SAVEC
int FINISHAR;
int OLDLINE;
int SAVEE;
int SAVEC;
// 5172 FINISHAR=FROMAR4(P)
FINISHAR = FROMAR4(P);
// 5173 %IF FINISHAR<=P %THEN ABORT
if (( FINISHAR ) > ( P )) goto L_04f7;
ABORT();
L_04f7:
// 5174 OLDLINE=LINE; SAVEE=EXIT LAB; SAVEC=CONTLAB
OLDLINE = LINE;
SAVEE = EXITLAB;
SAVEC = CONTLAB;
// 5175 EXITLAB=ELAB; CONTLAB=CLAB
EXITLAB = ELAB;
CONTLAB = CLAB;
// 5176 %WHILE NEXTP<=FINISHAR %CYCLE
L_04f8:
if (( NEXTP ) > ( FINISHAR )) goto L_04f9;
// 5177 COMPILE A STMNT
COMPILEASTMNT();
// 5178 %REPEAT
goto L_04f8;
L_04f9:
// 5179 EXIT LAB=SAVEE; CONTLAB=SAVEC
EXITLAB = SAVEE;
CONTLAB = SAVEC;
// 5180 P=FINISHAR+6
P = ((FINISHAR)) + ((6));
// 5181 %IF A(P)=1 %AND UA=0 %THEN FAULT2(12,OLDLINE,0)
if (( A[P] ) != ( 1 )) goto L_04fb;
if (( UA ) != ( 0 )) goto L_04fb;
FAULT2(12, OLDLINE, 0);
L_04fb:
// 5182 %END
return;
_imp_endofblock: ;
} // End of block CCYCBODY at level 5
// 5183
// 5184 %ROUTINE CLOOP(%INTEGER ALT, MARKC, MARKUI)
void CLOOP( int ALT, int MARKC, int MARKUI )
{
__label__ _imp_endofblock;
// 5185 !***********************************************************************
// 5186 !* ALT=1 FOR %WHILE, =2 FOR %UNTIL, =3 FOR %FOR *
// 5187 !* MARKC IS TO THE CONDITION OR CONTROL CLAUSE *
// 5188 !* MARKUI IS TO THE UI, SPECIAL FOR %CYCLE *
// 5189 !***********************************************************************
// 5190 %INTEGER L1,L2,L3,CCRES,ELRES
int L1;
int L2;
int L3;
int CCRES;
int ELRES;
// 5191 %INTEGER FORNAME,INITTYPE,INITVAL,STEPTYPE,STEPVAL,FINALTYPE,FINALVAL,FACC,FDISP,FBASE,INITP,REPMASK,USEDEBJ,DEBTO
int FORNAME;
int INITTYPE;
int INITVAL;
int STEPTYPE;
int STEPVAL;
int FINALTYPE;
int FINALVAL;
int FACC;
int FDISP;
int FBASE;
int INITP;
int REPMASK;
int USEDEBJ;
int DEBTO;
// 5192 %ROUTINESPEC FOREXP(%INTEGERNAME ETYPE,EVALUE,%INTEGER TT,REG)
auto void FOREXP( int *ETYPE, int *EVALUE, int TT, int REG );
// 5193 %ROUTINESPEC VALIDATE FOR
auto void VALIDATEFOR( void );
// 5194 %SWITCH SW(0:6)
static int SW_idx;
static const void * /*SWITCH*/ SW[(6)-(0)+1] = { &&SW_0, &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, &&SW_6, };
// 5195 P=MARKC
P = MARKC;
// 5196 SFLABEL=SFLABEL-2
SFLABEL = ((SFLABEL)) - ((2));
// 5197 L1=SFLABEL; L2=L1+1
L1 = SFLABEL;
L2 = ((L1)) + ((1));
// 5198 !
// 5199 ! SET L3 FOR ALTS 0,5&6 ONLY
// 5200 !
// 5201 L3=0
L3 = 0;
// 5202 %IF B'1100001'&1<<ALT#0 %THEN L3=SFLABEL-1 %AND SFLABEL=L3
if (( ((97)) & ((((1)) << ((ALT)))) ) == ( 0 )) goto L_04fc;
L3 = ((SFLABEL)) - ((1));
SFLABEL = L3;
L_04fc:
// 5203 !
// 5204 ! UPDATE THE LINE NUMBER FOR ALTS 1 TO 3 ONLY
// 5205 !
// 5206 %IF 1<=ALT<=3 %THEN SET LINE
if (( 1 ) > ( ALT )) goto L_04fd;
if (( ALT ) > ( 3 )) goto L_04fd;
SETLINE();
L_04fd:
// 5207 !
// 5208 ! ENTER THE FIRST LABEL(L1) FOR ALL ALTS EXCEPT 3 & 6
// 5209 !
// 5210 %IF B'0110111'&1<<ALT#0 %THEN ELRES=ENTER LAB(L1,0)
if (( ((55)) & ((((1)) << ((ALT)))) ) == ( 0 )) goto L_04fe;
ELRES = ENTERLAB(L1, 0);
L_04fe:
// 5211 ->SW(ALT)
SW_idx = ALT; if ((0 <= ALT_idx) && (ALT_idx <= 6)) goto *ALT[ALT_idx]; else {/*_imp_signal(6, ALT_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index ALT(%d) not in range 0:6 at %s:%d\n", ALT_idx, _imp_current_file, _imp_current_line); exit(1); }
// 5212 SW(0): ! %CYCLE
SW_0:
// 5213 C CYC BODY(1,L2,L3)
CCYCBODY(1, L2, L3);
// 5214 ELRES=ENTER LAB(L3,B'011')
ELRES = ENTERLAB(L3, 3);
// 5215 %IF A(P)=1 %START; ! %REPEAT %UNTIL <COND>
if (( A[P] ) != ( 1 )) goto L_04ff;
// 5216 P=P+1; CCRES=CCOND(0,1,L1)
P = ((P)) + ((1));
CCRES = CCOND(0, 1, L1);
// 5217 %FINISH %ELSE ENTER JUMP(15,L1,0)
goto L_0500;
L_04ff:
ENTERJUMP(15, L1, 0);
L_0500:
// 5218 ELRES=ENTER LAB(L2,B'011')
ELRES = ENTERLAB(L2, 3);
// 5219 WAYOUT: ! REMOVE LABELS NOT REQUIRED
U_01f5:
// 5220 REMOVE LAB(L1)
REMOVELAB(L1);
// 5221 REMOVE LAB(L2)
REMOVELAB(L2);
// 5222 REMOVE LAB(L3) %IF L3>0
if (( L3 ) <= ( 0 )) goto L_0501;
REMOVELAB(L3);
L_0501:
// 5223 %RETURN
return;
// 5224 SW(1): ! UI WHILE COND
SW_1:
// 5225 CCRES=CCOND(0,1,L2)
CCRES = CCOND(0, 1, L2);
// 5226 P=MARKUI
P = MARKUI;
// 5227 CUI(1)
CUI(1);
// 5228 ENTERJUMP(15,L1,0); ! UNCONDITIONALLY BACK TO WHILE
ENTERJUMP(15, L1, 0);
// 5229 ELRES =ENTER LAB(L2,B'111'); ! CONDITIONAL(?) & REPLACE ENV
ELRES = ENTERLAB(L2, 7);
// 5230 ->WAYOUT
goto U_01f5;
// 5231 SW(2): ! UI %UNTIL COND
SW_2:
// 5232 P=MARKUI
P = MARKUI;
// 5233 CUI(1)
CUI(1);
// 5234 P=MARKC
P = MARKC;
// 5235 CCRES=CCOND(0,1,L1)
CCRES = CCOND(0, 1, L1);
// 5236 ->WAYOUT
goto U_01f5;
// 5237 SW(3): ! UI %FOR ....
SW_3:
// 5238 SW(6): ! %FOR ... %CYCLE
SW_6:
// 5239
// 5240 FORNAME=FROMAR2(P)
FORNAME = FROMAR2(P);
// 5241 INITP=P+2; P=INITP
INITP = ((P)) + ((2));
P = INITP;
// 5242 COPY TAG(FORNAME)
COPYTAG(FORNAME);
// 5243 FDISP=K; FBASE=I; FACC=2*NAM
FDISP = K;
FBASE = I;
FACC = ((2)) * ((NAM));
// 5244 FAULT2(91,0,FORNAME) %UNLESS TYPE=1 %AND PREC=5 %AND ROUT=0=ARR
if (( TYPE ) != ( 1 )) goto L_04fa;
if (( PREC ) != ( 5 )) goto L_04fa;
if (( ROUT ) != ( 0 )) goto L_04fa;
if (( 0 ) == ( ARR )) goto L_0502;
L_04fa:
FAULT2(91, 0, FORNAME);
L_0502:
// 5245 WARN(4,FORNAME) %UNLESS FBASE=RBASE
if (( FBASE ) == ( RBASE )) goto L_0503;
WARN(4, FORNAME);
L_0503:
// 5246 !
// 5247 SKIP EXP; ! P TO STEP EXPRSN
SKIPEXP();
// 5248 FOR EXP(STEPTYPE,STEPVAL,1,ACCR); ! STEP TO ACCR AND TEMP
FOREXP( &STEPTYPE, &STEPVAL, 1, 0);
// 5249 %IF STEPTYPE=0 %START
if (( STEPTYPE ) != ( 0 )) goto L_0504;
// 5250 FAULT2(92,0,0) %IF STEPVAL=0; ! ZERO STEP
if (( STEPVAL ) != ( 0 )) goto L_0505;
FAULT2(92, 0, 0);
L_0505:
// 5251 %FINISH %ELSE %START
goto L_0506;
L_0504:
// 5252 %IF PARMOPT#0 %THEN PPJ(26,11);! FAULT COMPUTED ZERO STEP
if (( PARMOPT ) == ( 0 )) goto L_0507;
PPJ(26, 11);
L_0507:
// 5253 %FINISH
L_0506:
// 5254 !
// 5255 FOR EXP(FINALTYPE,FINALVAL,1,ACCR);! EVALUATE FINAL
FOREXP( &FINALTYPE, &FINALVAL, 1, 0);
// 5256 !
// 5257 P=INITP
P = INITP;
// 5258 FOR EXP(INITTYPE,INITVAL,0,BREG);! INITIAL VALUE TO B
FOREXP( &INITTYPE, &INITVAL, 0, 7);
// 5259 %IF PARMOPT#0 %THEN VALIDATE FOR
if (( PARMOPT ) == ( 0 )) goto L_0508;
VALIDATEFOR();
L_0508:
// 5260 !
// 5261 USEDEBJ=0; ! DONT USE IT
USEDEBJ = 0;
// 5262 %IF STEPVAL=-1 %AND FINALTYPE!STEPTYPE=0 %AND FINALVAL=1 %START
if (( STEPVAL ) != ( (-(1)) )) goto L_0509;
if (( ((FINALTYPE)) | ((STEPTYPE)) ) != ( 0 )) goto L_0509;
if (( FINALVAL ) != ( 1 )) goto L_0509;
// 5263 USEDEBJ=1; ! CAN USE BEST BRANCH INSTRN
USEDEBJ = 1;
// 5264 PSF1(LB,0,INITVAL) %IF INITTYPE=0
if (( INITTYPE ) != ( 0 )) goto L_050a;
PSF1(122, 0, INITVAL);
L_050a:
// 5265 %UNLESS INITTYPE=0 %AND INITVAL>=1 %THEN ENTERJUMP(32+13,L2,B'10'); ! JAF B>0 NO TRAVERSES
if (( INITTYPE ) != ( 0 )) goto L_050b;
if (( INITVAL ) >= ( 1 )) goto L_050c;
L_050b:
ENTERJUMP(((32)) + ((13)), L2, 2);
L_050c:
// 5266 DEBTO=CA; ! SAVE CA FOR DEBJ
DEBTO = CA;
// 5267 %FINISH %ELSE %START
goto L_050d;
L_0509:
// 5268 %IF INITTYPE!STEPTYPE=0 %THEN %START
if (( ((INITTYPE)) | ((STEPTYPE)) ) != ( 0 )) goto L_050e;
// 5269 PSF1(LB,0,INITVAL-STEPVAL)
PSF1(122, 0, ((INITVAL)) - ((STEPVAL)));
// 5270 %FINISH %ELSE %START
goto L_050f;
L_050e:
// 5271 PSF1(LB,0,INITVAL) %IF INITTYPE=0
if (( INITTYPE ) != ( 0 )) goto L_0510;
PSF1(122, 0, INITVAL);
L_0510:
// 5272 PSF1(SBB,STEPTYPE,STEPVAL)
PSF1(34, STEPTYPE, STEPVAL);
// 5273 %FINISH
L_050f:
// 5274 !
// 5275 ! HAVE B SET TO INIT-STEP. FOR COMPUTED STEPS NOW MUST CHECK
// 5276 ! FOR NEGATIVE TRAVERSES. FOR FIXED STEPS THIS CAN BE SET
// 5277 ! IN MASK FOR REPEATING
// 5278 !
// 5279 %IF STEPTYPE=1 %THEN %START
if (( STEPTYPE ) != ( 1 )) goto L_0511;
// 5280 PF1(LSS,0,BREG,0)
PF1(98, 0, 7, 0);
// 5281 PSF1(IRSB,FINALTYPE,FINALVAL)
PSF1(228, FINALTYPE, FINALVAL);
// 5282 PSF1(IDV,1,STEPVAL)
PSF1(170, 1, STEPVAL);
// 5283 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5284 ENTERJUMP(37,L2,B'10')
ENTERJUMP(37, L2, 2);
// 5285 REPMASK=7
REPMASK = 7;
// 5286 %FINISH %ELSE REPMASK=8!(2<<(STEPVAL>>31)); ! A OR C
goto L_0512;
L_0511:
REPMASK = ((8)) | ((((2)) << (((int)(((unsigned int)(STEPVAL)) >> ((31)))))));
L_0512:
// 5287 !
// 5288 ELRES=ENTER LAB(L1,0); ! LABEL FOR REPEATING
ELRES = ENTERLAB(L1, 0);
// 5289 !
// 5290 %IF STEPTYPE=0 %AND STEPVAL=1 %START
if (( STEPTYPE ) != ( 0 )) goto L_0513;
if (( STEPVAL ) != ( 1 )) goto L_0513;
// 5291 PSF1(CPIB,FINALTYPE,FINALVAL)
PSF1(46, FINALTYPE, FINALVAL);
// 5292 %FINISH %ELSE %START
goto L_0514;
L_0513:
// 5293 PSF1(CPB,FINALTYPE,FINALVAL)
PSF1(38, FINALTYPE, FINALVAL);
// 5294 PSF1(ADB,STEPTYPE,STEPVAL)
PSF1(32, STEPTYPE, STEPVAL);
// 5295 %FINISH
L_0514:
// 5296 GRUSE(BREG)=0
GRUSE[7] = 0;
// 5297 ENTER JUMP(REPMASK,L2,B'10')
ENTERJUMP(REPMASK, L2, 2);
// 5298 %FINISH
L_050d:
// 5299 BASE=FBASE; AREA=-1
BASE = FBASE;
AREA = (-(1));
// 5300 PSORLF1(STB,FACC,AREA CODE,FDISP)
PSORLF1(90, FACC, AREACODE(), FDISP);
// 5301 NOTE ASSMENT(BREG,2,FORNAME)
NOTEASSMENT(7, 2, FORNAME);
// 5302 !
// 5303 P=MARKUI; ! TO UI OR '%CYCLE'(HOLE)
P = MARKUI;
// 5304 %IF ALT=3 %THEN %START; ! DEAL WITH CONTROLLED STMNTS
if (( ALT ) != ( 3 )) goto L_0515;
// 5305 CUI(0)
CUI(0);
// 5306 %FINISH %ELSE %START
goto L_0516;
L_0515:
// 5307 CCYCBODY(0,L2,L3)
CCYCBODY(0, L2, L3);
// 5308 ELRES=ENTER LAB(L3,B'011'); ! LABEL FOR CONTINUE
ELRES = ENTERLAB(L3, 3);
// 5309 %FINISH
L_0516:
// 5310 BASE=FBASE; ACCESS=FACC
BASE = FBASE;
ACCESS = FACC;
// 5311 AREA=-1; DISP=FDISP
AREA = (-(1));
DISP = FDISP;
// 5312 NAMEOP(2,BREG,4,FORNAME); ! CONTROL TO B
NAMEOP(2, 7, 4, FORNAME);
// 5313 %IF USEDEBJ=0 %THEN ENTER JUMP(15,L1,0) %ELSE PSF1(DEBJ,0,(DEBTO-CA)//2) %AND GRUSE(BREG)=0
if (( USEDEBJ ) != ( 0 )) goto L_0517;
ENTERJUMP(15, L1, 0);
goto L_0518;
L_0517:
PSF1(36, 0, ((int)(((DEBTO)) - ((CA)))) / ((int)(2)));
GRUSE[7] = 0;
L_0518:
// 5314 ELRES=ENTERLAB(L2,B'111'!!(USEDEBJ<<2));! REPLACE ENV UNLESS DEBJ
ELRES = ENTERLAB(L2, ((7)) ^ ((((USEDEBJ)) << ((2)))));
// 5315 ! WHEN MERGE ENV
// 5316 ->WAYOUT
goto U_01f5;
// 5317 SW(4): ! %WHILE COND %CYCLE
SW_4:
// 5318 CCRES = CCOND(0,1,L2)
CCRES = CCOND(0, 1, L2);
// 5319 C CYC BODY(0,L2,L1)
CCYCBODY(0, L2, L1);
// 5320 ENTER JUMP(15,L1,0)
ENTERJUMP(15, L1, 0);
// 5321 ELRES = ENTER LAB(L2,B'111'); ! CONDITIONAL & REPLACE ENV
ELRES = ENTERLAB(L2, 7);
// 5322 ->WAYOUT
goto U_01f5;
// 5323 SW(5): ! %UNTIL ... %CYCLE
SW_5:
// 5324 ! ALSO %CYCLE... %REPEAT %UNTIL
// 5325 ! MARKUI TO %CYCLE
// 5326 P=MARKUI
P = MARKUI;
// 5327 C CYC BODY(0,L2,L3)
CCYCBODY(0, L2, L3);
// 5328 P=MARKC; ELRES=ENTER LAB(L3,B'011');! CONTINUE LABEL IF NEEDED
P = MARKC;
ELRES = ENTERLAB(L3, 3);
// 5329 CCRES=CCOND(0,1,L1)
CCRES = CCOND(0, 1, L1);
// 5330 ELRES=ENTER LAB(L2,B'011')
ELRES = ENTERLAB(L2, 3);
// 5331 ->WAYOUT
goto U_01f5;
// 5332 %ROUTINE FOREXP(%INTEGERNAME ETYPE,EVALUE,%INTEGER TOTEMP,USEREG)
void FOREXP( int *ETYPE, int *EVALUE, int TOTEMP, int USEREG )
{
__label__ _imp_endofblock;
// 5333 !***********************************************************************
// 5334 !* P INDEXES EXPRESSION. IF CONST PUT INTO EVALUE OTHERWISE *
// 5335 !* COMPILE TO USEREG AND STORE IN TEMP IF TOTEMP#0 *
// 5336 !***********************************************************************
// 5337 %INTEGER INP,VAL,OP
int INP;
int VAL;
int OP;
// 5338 INP=P; P=P+3
INP = P;
P = ((P)) + ((3));
// 5339 %IF INTEXP(VAL)=0 %AND IMOD(VAL)<16_1FFFF %START
if (( INTEXP( &VAL) ) != ( 0 )) goto L_0519;
if (( IMOD(VAL) ) >= ( 131071 )) goto L_0519;
// 5340 EVALUE=VAL; ETYPE=0; ! EXPRESSION A LITERAL CONST
EVALUE = VAL;
ETYPE = 0;
// 5341 %RETURN
return;
// 5342 %FINISH
L_0519:
// 5343 P=INP
P = INP;
// 5344 CSEXP(USEREG,16_51); ! INTEGER MODE TO REG
CSEXP(USEREG, 81);
// 5345 ETYPE=1; ! NOT CONST
ETYPE = 1;
// 5346 %IF TOTEMP#0 %START
if (( TOTEMP ) == ( 0 )) goto L_051a;
// 5347 GET WSP(VAL,1)
GETWSP( &VAL, 1);
// 5348 %IF USEREG=ACCR %THEN OP=ST %ELSE OP=STB
if (( USEREG ) != ( 0 )) goto L_051b;
OP = 72;
goto L_051c;
L_051b:
OP = 90;
L_051c:
// 5349 PSF1(OP,1,VAL)
PSF1(OP, 1, VAL);
// 5350 EVALUE=VAL
EVALUE = VAL;
// 5351 %FINISH
L_051a:
// 5352 %END
return;
_imp_endofblock: ;
} // End of block FOREXP at level 6
// 5353 %ROUTINE VALIDATE FOR
void VALIDATEFOR( void )
{
__label__ _imp_endofblock;
// 5354 !***********************************************************************
// 5355 !* INITIAL VALUE IN BREG OR A CONSTANT *
// 5356 !***********************************************************************
// 5357 %INTEGER I
int I;
// 5358 %IF INITTYPE!STEPTYPE!FINALTYPE=0 %START
if (( ((((INITTYPE)) | ((STEPTYPE)))) | ((FINALTYPE)) ) != ( 0 )) goto L_051d;
// 5359 J=FINALVAL-INITVAL; ! ALL CONSTANT CAN CHECK NOW
J = ((FINALVAL)) - ((INITVAL));
// 5360 %IF (J//STEPVAL)*STEPVAL#J %THEN FAULT2(93,0,0)
if (( ((((int)(J)) / ((int)(STEPVAL)))) * ((STEPVAL)) ) == ( J )) goto L_051e;
FAULT2(93, 0, 0);
L_051e:
// 5361 %RETURN
return;
// 5362 %FINISH
L_051d:
// 5363 %IF STEPTYPE=0 %AND IMOD(STEPVAL)=1 %THEN %RETURN
if (( STEPTYPE ) != ( 0 )) goto L_051f;
if (( IMOD(STEPVAL) ) != ( 1 )) goto L_051f;
return;
L_051f:
// 5364 !
// 5365 ! CHECK BY PLANTING CODE
// 5366 !
// 5367 %IF INITTYPE=0 %THEN PSF1(LSS,0,INITVAL) %ELSE PF1(LSS,0,BREG,0)
if (( INITTYPE ) != ( 0 )) goto L_0520;
PSF1(98, 0, INITVAL);
goto L_0521;
L_0520:
PF1(98, 0, 7, 0);
L_0521:
// 5368 PSF1(IRSB,FINALTYPE,FINALVAL)
PSF1(228, FINALTYPE, FINALVAL);
// 5369 PSF1(IMDV,STEPTYPE,STEPVAL)
PSF1(174, STEPTYPE, STEPVAL);
// 5370 PF1(LSS,0,TOS,0)
PF1(98, 0, 6, 0);
// 5371 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5372 PPJ(36,11)
PPJ(36, 11);
// 5373 %END
return;
_imp_endofblock: ;
} // End of block VALIDATEFOR at level 6
// 5374 %END
return;
_imp_endofblock: ;
} // End of block CLOOP at level 5
// 5375 %ROUTINE ASSIGN(%INTEGER ASSOP,P1)
void ASSIGN( int ASSOP, int P1 )
{
__label__ _imp_endofblock;
// 5376 !***********************************************************************
// 5377 !* HANDLES ARITHMETIC,STRING & ADDRESS ASSIGNMENTS TO VARIABLES *
// 5378 !* FORMAL PARAMETERS AND DOPEVECTORS *
// 5379 !* ASSOP:- *
// 5380 !* 1 IS FOR '==' *
// 5381 !* 2 IS FOR '=' *
// 5382 !* 3 IS FOR '<-' (JAM TRANSFER) *
// 5383 !* 4 IS FOR '->' (UNCONDITIONAL RESOLUTION) *
// 5384 !* >4 IS FOR STORE ACC BY 'ASSOP&3' INTO NAME *
// 5385 !* *
// 5386 !* P POINTS TO THE EXPRESSION. P1 TO THE NAME ON LHS *
// 5387 !***********************************************************************
// 5388 %INTEGER Q,QQ,KK,TYPEP,PRECP,PTYPEP,JJJ,P2,JJ,REG,STCODE,RHTYPE,ACCP,II,HEAD1,NOPS,TPCELL,LVL,BOT1,LHNAME,RHNAME
int Q;
int QQ;
int KK;
int TYPEP;
int PRECP;
int PTYPEP;
int JJJ;
int P2;
int JJ;
int REG;
int STCODE;
int RHTYPE;
int ACCP;
int II;
int HEAD1;
int NOPS;
int TPCELL;
int LVL;
int BOT1;
int LHNAME;
int RHNAME;
// 5389 %RECORD (RD) R{(RD)
RD R;
// 5390 %SWITCH SW(0:3); ! TO SWITCH ON ASSOP
static int SW_idx;
static const void * /*SWITCH*/ SW[(3)-(0)+1] = { &&SW_0, &&SW_1, &&SW_2, &&SW_3, };
// 5391 P2=P
P2 = P;
// 5392 %IF ASSOP>4 %THEN RHTYPE=TYPE
if (( ASSOP ) <= ( 4 )) goto L_0522;
RHTYPE = TYPE;
L_0522:
// 5393 LHNAME=A(P1)<<8!A(P1+1)
LHNAME = ((((A[P1])) << ((8)))) | ((A[((P1)) + ((1))]));
// 5394 P=P1; REDUCE TAG; ! LOOK AT LH SIDE
P = P1;
REDUCETAG();
// 5395 PTYPEP=PTYPE; JJ=J
PTYPEP = PTYPE;
JJ = J;
// 5396 KK=K; II=I; LVL=OLDI
KK = K;
II = I;
LVL = OLDI;
// 5397 TPCELL=TCELL; ACCP=ACC
TPCELL = TCELL;
ACCP = ACC;
// 5398 P=P2; TYPEP=TYPE; PRECP=PREC; ! SAVE USEFUL INFO FOR LATER
P = P2;
TYPEP = TYPE;
PRECP = PREC;
// 5399 -> SW(ASSOP&3)
SW_idx = ((ASSOP)) & ((3)); if ((0 <= ASSOP_idx) && (ASSOP_idx <= 3)) goto *ASSOP[ASSOP_idx]; else {/*_imp_signal(6, ASSOP_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index ASSOP(%d) not in range 0:3 at %s:%d\n", ASSOP_idx, _imp_current_file, _imp_current_line); exit(1); }
// 5400 !
// 5401 SW(2):SW(3): ! ARITHMETIC ASSIGNMENTS
SW_2:
SW_3:
// 5402 %IF TYPE=3 %THEN ->RECOP
if (( TYPE ) != ( 3 )) goto L_0523;
goto U_01f5;
L_0523:
// 5403 TYPE=1 %UNLESS TYPE=2 %OR TYPE=5;! IN CASE OF RUBBISHY SUBNAMES
if (( TYPE ) == ( 2 )) goto L_0524;
if (( TYPE ) == ( 5 )) goto L_0524;
TYPE = 1;
L_0524:
// 5404 ->STring %IF TYPE=5; ! LHS IS A STRING
if (( TYPE ) != ( 5 )) goto L_0525;
goto U_01f6;
L_0525:
// 5405 BACK: HEAD1=0; ! CLEAR TEMPORAYRY LIST HEADS
U_01f7:
HEAD1 = 0;
// 5406 TYPE=1 %UNLESS TYPE=2; ! DEAL WITH UNSET NAMES
if (( TYPE ) == ( 2 )) goto L_0526;
TYPE = 1;
L_0526:
// 5407 TYPEP=TYPE
TYPEP = TYPE;
// 5408 NOPS=1<<18+1; P=P2+3
NOPS = ((((1)) << ((18)))) + ((1));
P = ((P2)) + ((3));
// 5409 PUSH(HEAD1,ASSOP&3+33,PRECP,0); ! ASSIGNMENT OPERATOR
PUSH( &HEAD1, ((((ASSOP)) & ((3)))) + ((33)), PRECP, 0);
// 5410 BOT1=HEAD1
BOT1 = HEAD1;
// 5411 PUSH(HEAD1,PTYPEP<<16!2,P1,0); ! LHS
PUSH( &HEAD1, ((((PTYPEP)) << ((16)))) | ((2)), P1, 0);
// 5412 %IF ASSOP>4 %THEN %START
if (( ASSOP ) <= ( 4 )) goto L_0527;
// 5413 FAULT(24,0) %UNLESS TYPE=RHTYPE
if (( TYPE ) == ( RHTYPE )) goto L_0528;
FAULT(24, 0);
L_0528:
// 5414 PUSH(HEAD1,RHTYPE<<16!9,0,0)
PUSH( &HEAD1, ((((RHTYPE)) << ((16)))) | ((9)), 0, 0);
// 5415 OLINK(ACCR)=HEAD1
OLINK[0] = HEAD1;
// 5416 %FINISH %ELSE TORP(HEAD1,BOT1,NOPS); ! RHS TO REVERSE POLISH
goto L_0529;
L_0527:
TORP( &HEAD1, &BOT1, &NOPS);
L_0529:
// 5417 EXPOP(HEAD1,-1,NOPS,256+PRECP<<4+TYPEP); ! PLANT CODE
EXPOP(HEAD1, (-(1)), NOPS, ((((256)) + ((((PRECP)) << ((4)))))) + ((TYPEP)));
// 5418 ! CLEAR LIST(HEAD1)
// 5419 ASLIST(BOT1)_LINK=ASL
ASLIST[BOT1].LINK = ASL;
// 5420 ASL=HEAD1
ASL = HEAD1;
// 5421 %RETURN
return;
// 5422 !NA: NOTE ASSMENT(-1,ASSOP&3,A(P1))
// 5423 STring: ! STRINGS
U_01f6:
// 5424 !
// 5425 ! PICK OFF NULL STRINGS AND SUBSTITUTE A CRAFTY MVL FOR S=""
// 5426 !
// 5427 %IF A(P+3)=4 %AND A(P+4)=2 %AND A(P+5)=16_35 %AND A(P+10)=0 %AND A(P+11)=2 %THEN %START
if (( A[((P)) + ((3))] ) != ( 4 )) goto L_052a;
if (( A[((P)) + ((4))] ) != ( 2 )) goto L_052a;
if (( A[((P)) + ((5))] ) != ( 53 )) goto L_052a;
if (( A[((P)) + ((10))] ) != ( 0 )) goto L_052a;
if (( A[((P)) + ((11))] ) != ( 2 )) goto L_052a;
// 5428 Q=P+12-A(P+10)>>1
Q = ((((P)) + ((12)))) - (((int)(((unsigned int)(A[((P)) + ((10))])) >> ((1)))));
// 5429 P=P1; CNAME(1,DR)
P = P1;
CNAME(1, 1);
// 5430 PF2(MVL,0,1,0,0,0)
PF2(176, 0, 1, 0, 0, 0);
// 5431 P=Q; %RETURN
P = Q;
return;
// 5432 %FINISH
L_052a:
// 5433 %IF ASSOP<=3 %THEN CSTREXP(0,ACCR)
if (( ASSOP ) > ( 3 )) goto L_052b;
CSTREXP(0, 0);
L_052b:
// 5434 ASSOP=ASSOP&3
ASSOP = ((ASSOP)) & ((3));
// 5435 QQ=STRINGL; Q=P
QQ = STRINGL;
Q = P;
// 5436 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 5437 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 5438 R_PTYPE=16_51; R_FLAG=9; R_UPTYPE=0
R.PTYPE = 81;
R.FLAG = 9;
R.UPTYPE = 0;
// 5439 R_XB=ACCR
R.XB = 0;
// 5440 P=P1; CNAME(1,DR)
P = P1;
CNAME(1, 1);
// 5441 %IF R_FLAG#9 %THEN PF1(LSD,0,TOS,0)
if (( R.FLAG ) == ( 9 )) goto L_052c;
PF1(100, 0, 6, 0);
L_052c:
// 5442 PF1(IAD,0,PC,SPECIAL CONSTS(2))
PF1(224, 0, 4, SPECIALCONSTS(2));
// 5443 %IF ASSOP#3 %AND (ROUT#0 %OR NAM#0=ARR) %AND QQ=0 %START
if (( ASSOP ) == ( 3 )) goto L_052d;
if (( ROUT ) != ( 0 )) goto L_052e;
if (( NAM ) == ( 0 )) goto L_052d;
if (( 0 ) != ( ARR )) goto L_052d;
L_052e:
if (( QQ ) != ( 0 )) goto L_052d;
// 5444 ! LHS=MAP : DR BOUND NOT VALID
// 5445 ! ALSO NAMES MAPPED ==STRING(ADDR)
// 5446 %IF PARMOPT#0 %THEN PPJ(0,18) %ELSE %START
if (( PARMOPT ) == ( 0 )) goto L_052f;
PPJ(0, 18);
goto L_0530;
L_052f:
// 5447 PF1(STUH,0,BREG,0)
PF1(74, 0, 7, 0);
// 5448 PF1(LUH,0,BREG,0)
PF1(106, 0, 7, 0);
// 5449 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 5450 %FINISH
L_0530:
// 5451 GRUSE(BREG)=0
GRUSE[7] = 0;
// 5452 %FINISH
L_052d:
// 5453 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5454 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 5455 %IF QQ>0 %AND ASSOP#3 %THEN PF2(MV,0,0,QQ,0,0) %ELSESTART
if (( QQ ) <= ( 0 )) goto L_0531;
if (( ASSOP ) == ( 3 )) goto L_0531;
PF2(178, 0, 0, QQ, 0, 0);
goto L_0532;
L_0531:
// 5456 %IF ASSOP=3 %THEN PF1(STD,0,TOS,0)
if (( ASSOP ) != ( 3 )) goto L_0533;
PF1(88, 0, 6, 0);
L_0533:
// 5457 PF2(MV,1,1,0,0,UNASSPAT&255)
PF2(178, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 5458 %IF PARMARR#0 %OR ASSOP=3 %THEN PSF1(USH,0,8) %AND PSF1(USH,0,-40)
if (( PARMARR ) != ( 0 )) goto L_0534;
if (( ASSOP ) != ( 3 )) goto L_0535;
L_0534:
PSF1(200, 0, 8);
PSF1(200, 0, (-(40)));
L_0535:
// 5459 %IF PARMARR#0 %AND ASSOP=2 %THEN PPJ(36,9)
if (( PARMARR ) == ( 0 )) goto L_0536;
if (( ASSOP ) != ( 2 )) goto L_0536;
PPJ(36, 9);
L_0536:
// 5460 %IF ASSOP=3 %THEN %START
if (( ASSOP ) != ( 3 )) goto L_0537;
// 5461 PF1(IRSB,2,TOS,0)
PF1(228, 2, 6, 0);
// 5462 PF1(ST,2,7,0); ! STORE AMENDED CURRENT LENGTH {EMAS Imp9 vs Imp77 - ST is both a constant and a label in EMAS Imp9}
PF1(72, 2, 7, 0);
// 5463 %FINISH
L_0537:
// 5464 %FINISH
L_0532:
// 5465 P=Q; %RETURN
P = Q;
return;
// 5466 !
// 5467 ! THIS SECTION DEALS WITH OPERATIONS ON COMPLETE RECORDS
// 5468 !
// 5469 RECOP: ! LHS IS RECORD WITHOUT SUBNAME
U_01f5:
// 5470 REG=ACCR; ! IN CASE FAULT 66
REG = 0;
// 5471 Q=TSEXP(JJJ)
Q = TSEXP( &JJJ);
// 5472 %IF Q=1 %AND JJJ=0 %START; ! CLEAR A RECORD TO ZERO
if (( Q ) != ( 1 )) goto L_0538;
if (( JJJ ) != ( 0 )) goto L_0538;
// 5473 P=P1; CNAME(3,DR)
P = P1;
CNAME(3, 1);
// 5474 %IF ACC<=128 %THEN JJ=0 %AND KK=ACC-1 %ELSE %START
if (( ACC ) > ( 128 )) goto L_0539;
JJ = 0;
KK = ((ACC)) - ((1));
goto L_053a;
L_0539:
// 5475 JJ=1; KK=0
JJ = 1;
KK = 0;
// 5476 %IF NAM#0 %OR ARR#0 %THEN PSF1(LDB,0,ACC)
if (( NAM ) != ( 0 )) goto L_053b;
if (( ARR ) == ( 0 )) goto L_053c;
L_053b:
PSF1(118, 0, ACC);
L_053c:
// 5477 %FINISH
L_053a:
// 5478 PF2(MVL,JJ,1,KK,0,0)
PF2(176, JJ, 1, KK, 0, 0);
// 5479 %FINISH %ELSE %START
goto L_053d;
L_0538:
// 5480 ->BACK %UNLESS TYPE=3 %AND A(P2+3)=4 %AND A(P2+4)=1
if (( TYPE ) != ( 3 )) goto L_053e;
if (( A[((P2)) + ((3))] ) != ( 4 )) goto L_053e;
if (( A[((P2)) + ((4))] ) == ( 1 )) goto L_053f;
L_053e:
goto U_01f7;
L_053f:
// 5481 P=P2+5; CNAME(3,ACCR)
P = ((P2)) + ((5));
CNAME(3, 0);
// 5482 ACCP=ACC
ACCP = ACC;
// 5483 %UNLESS A(P)=2 %THEN FAULT2(66,0,LHNAME) %AND ->F00
if (( A[P] ) == ( 2 )) goto L_0540;
FAULT2(66, 0, LHNAME);
goto U_01f8;
L_0540:
// 5484 R_PTYPE=16_61; R_FLAG=9
R.PTYPE = 97;
R.FLAG = 9;
// 5485 R_XB=ACCR<<5; R_D=0
R.XB = ((0)) << ((5));
R.D = 0;
// 5486 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 5487 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 5488 P=P1; CNAME(3,DR)
P = P1;
CNAME(3, 1);
// 5489 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 5490 %IF R_FLAG#9 %THEN PF1(LSD,0,TOS,0)
if (( R.FLAG ) == ( 9 )) goto L_0541;
PF1(100, 0, 6, 0);
L_0541:
// 5491 %IF ASSOP=2 %AND ACCP#ACC %THEN FAULT2(67,LHNAME,FROMAR2(P2+5)) %AND ->F00
if (( ASSOP ) != ( 2 )) goto L_0542;
if (( ACCP ) == ( ACC )) goto L_0542;
FAULT2(67, LHNAME, FROMAR2(((P2)) + ((5))));
goto U_01f8;
L_0542:
// 5492 %IF ACCP>ACC %THEN ACCP=ACC
if (( ACCP ) <= ( ACC )) goto L_0543;
ACCP = ACC;
L_0543:
// 5493 {%UNTIL ACCP=0} %CYCLE
L_0544:
// 5494 %IF ACCP>128 %THEN KK=128 %ELSE KK=ACCP
if (( ACCP ) <= ( 128 )) goto L_0547;
KK = 128;
goto L_0548;
L_0547:
KK = ACCP;
L_0548:
// 5495 PF2(MV,0,0,KK-1,0,0)
PF2(178, 0, 0, ((KK)) - ((1)), 0, 0);
// 5496 ACCP=ACCP-KK
ACCP = ((ACCP)) - ((KK));
// 5497 %REPEAT %UNTIL ACCP=0
if (( ACCP ) == ( 0 )) goto L_0545;
goto L_0544;
L_0545:
// 5498 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5499 %FINISH
L_053d:
// 5500 P=P2; SKIP EXP
P = P2;
SKIPEXP();
// 5501 GRUSE(DR)=0
GRUSE[1] = 0;
// 5502 %RETURN
return;
// 5503 SW(0): ! RESOLUTION
SW_0:
// 5504 P=P1; CNAME(2,DR)
P = P1;
CNAME(2, 1);
// 5505 P=P2;
P = P2;
// 5506 %IF TYPE=5 %THEN CRES(0) %ELSE %START
if (( TYPE ) != ( 5 )) goto L_0549;
CRES(0);
goto L_054a;
L_0549:
// 5507 SKIP EXP
SKIPEXP();
// 5508 FAULT2(71,0,FROMAR2(P1)) %UNLESS TYPE=7
if (( TYPE ) == ( 7 )) goto L_054b;
FAULT2(71, 0, FROMAR2(P1));
L_054b:
// 5509 %FINISH
L_054a:
// 5510 %RETURN
return;
// 5511 SW(1): ! '==' AND %NAME PARAMETERS
SW_1:
// 5512 REG=ACCR; STCODE=ST; ! NORMALLY USE ACC
REG = 0;
STCODE = 72;
// 5513 ->F81 %UNLESS A(P2+3)=4 %AND A(P2+4)=1
if (( A[((P2)) + ((3))] ) != ( 4 )) goto L_054c;
if (( A[((P2)) + ((4))] ) == ( 1 )) goto L_054d;
L_054c:
goto U_01f9;
L_054d:
// 5514 FAULT2(82,0,LHNAME) %AND ->F00 %UNLESS NAM=1; ! ONLY POINTERS ON LHS OF==
if (( NAM ) == ( 1 )) goto L_054e;
FAULT2(82, 0, LHNAME);
goto U_01f8;
L_054e:
// 5515 P=P2+5
P = ((P2)) + ((5));
// 5516 RHNAME=A(P)<<8!A(P+1)
RHNAME = ((((A[P])) << ((8)))) | ((A[((P)) + ((1))]));
// 5517 ->ARRNAME %IF ARR=1
if (( ARR ) != ( 1 )) goto L_054f;
goto U_01fa;
L_054f:
// 5518 %IF A(P1+2)=2=A(P1+3) %START; ! LHS SCALAR POINTERNAME
if (( A[((P1)) + ((2))] ) != ( 2 )) goto L_0550;
if (( 2 ) != ( A[((P1)) + ((3))] )) goto L_0550;
// 5519 COPYTAG(RHNAME) ; ! LOOK AT RHS
COPYTAG(RHNAME);
// 5520 %IF PTYPE#SNPT %AND ARR#0 %THEN REG=DR %AND STCODE=STD
if (( PTYPE ) == ( 4102 )) goto L_0551;
if (( ARR ) == ( 0 )) goto L_0551;
REG = 1;
STCODE = 88;
L_0551:
// 5521 %FINISH
L_0550:
// 5522 CNAME(3,REG); ! DESCRPTR TO ACC
CNAME(3, REG);
// 5523 R_PTYPE=16_61; R_FLAG=9
R.PTYPE = 97;
R.FLAG = 9;
// 5524 R_XB=REG
R.XB = REG;
// 5525 OLINK(REG)=ADDR(R)
OLINK[REG] = ADDR( &R);
// 5526 REGISTER(REG)=1
REGISTER[REG] = 1;
// 5527 ->F81 %UNLESS A(P)=2; ! NO REST OF EXP ON RHS
if (( A[P] ) == ( 2 )) goto L_0552;
goto U_01f9;
L_0552:
// 5528 Q=P+1; P=P1
Q = ((P)) + ((1));
P = P1;
// 5529 ->F83 %UNLESS TYPE=TYPEP %AND PREC=PRECP
if (( TYPE ) != ( TYPEP )) goto L_0553;
if (( PREC ) == ( PRECP )) goto L_0554;
L_0553:
goto U_01fb;
L_0554:
// 5530 ->F86 %UNLESS OLDI<=LVL %OR BASE=0 %OR NAM#0
if (( OLDI ) <= ( LVL )) goto L_0555;
if (( BASE ) == ( 0 )) goto L_0555;
if (( NAM ) != ( 0 )) goto L_0555;
goto U_01fc;
L_0555:
// 5531 ! GLOBAL == NONOWN LOCAL
// 5532 CNAME(6,0)
CNAME(6, 0);
// 5533 %IF R_FLAG#9 %THEN %START
if (( R.FLAG ) == ( 9 )) goto L_0556;
// 5534 %IF REG#ACCR %THEN ABORT
if (( REG ) == ( 0 )) goto L_0557;
ABORT();
L_0557:
// 5535 PF1(LSD,0,TOS,0)
PF1(100, 0, 6, 0);
// 5536 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 5537 %FINISH
L_0556:
// 5538 REGISTER(REG)=0
REGISTER[REG] = 0;
// 5539 COM: PSORLF1(STCODE,ACCESS,AREA CODE,DISP)
U_01fd:
PSORLF1(STCODE, ACCESS, AREACODE(), DISP);
// 5540 %IF REG=DR %AND ACCESS#0 %THEN ABORT
if (( REG ) != ( 1 )) goto L_0558;
if (( ACCESS ) == ( 0 )) goto L_0558;
ABORT();
L_0558:
// 5541 NOTE ASSMENT(REG,1,A(P1)<<8!A(P1+1))
NOTEASSMENT(REG, 1, ((((A[P1])) << ((8)))) | ((A[((P1)) + ((1))])));
// 5542 P=Q; %RETURN
P = Q;
return;
// 5543 ARRNAME: CNAME(12,ACCR)
U_01fa:
CNAME(12, 0);
// 5544 %IF ACCESS>=8 %THEN ACCESS=ACCESS-4 %ELSE ACCESS=0
if (( ACCESS ) < ( 8 )) goto L_0559;
ACCESS = ((ACCESS)) - ((4));
goto L_055a;
L_0559:
ACCESS = 0;
L_055a:
// 5545 ->F83 %UNLESS TYPE=TYPEP %AND PREC=PRECP %AND ARR>0
if (( TYPE ) != ( TYPEP )) goto L_055b;
if (( PREC ) != ( PRECP )) goto L_055b;
if (( ARR ) > ( 0 )) goto L_055c;
L_055b:
goto U_01fb;
L_055c:
// 5546 ->F86 %UNLESS OLDI<=LVL %OR BASE=0 %OR NAM#0
if (( OLDI ) <= ( LVL )) goto L_055d;
if (( BASE ) == ( 0 )) goto L_055d;
if (( NAM ) != ( 0 )) goto L_055d;
goto U_01fc;
L_055d:
// 5547 ! GLOBAL == NONOWN LOCAL
// 5548 TYPE=0
TYPE = 0;
// 5549 NAMEOP(2,ACCR,16,-1)
NAMEOP(2, 0, 16, (-(1)));
// 5550 R_PTYPE=16_72; R_UPTYPE=0
R.PTYPE = 114;
R.UPTYPE = 0;
// 5551 R_FLAG=9; R_XB=ACCR
R.FLAG = 9;
R.XB = 0;
// 5552 R_D=-1
R.D = (-(1));
// 5553 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 5554 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 5555 ->F81 %UNLESS A(P)=2
if (( A[P] ) == ( 2 )) goto L_055e;
goto U_01f9;
L_055e:
// 5556 Q=P+1; P=P1
Q = ((P)) + ((1));
P = P1;
// 5557 CNAME(6,0)
CNAME(6, 0);
// 5558 PF1(LSQ,0,TOS,0) %UNLESS R_FLAG=9
if (( R.FLAG ) == ( 9 )) goto L_055f;
PF1(102, 0, 6, 0);
L_055f:
// 5559 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 5560 ->COM
goto U_01fd;
// 5561 F83: FAULT2(83,LHNAME,RHNAME); ->F00
U_01fb:
FAULT2(83, LHNAME, RHNAME);
goto U_01f8;
// 5562 F86: FAULT2(86,LHNAME,RHNAME); ->F00
U_01fc:
FAULT2(86, LHNAME, RHNAME);
goto U_01f8;
// 5563 F81: FAULT2(81,0,LHNAME)
U_01f9:
FAULT2(81, 0, LHNAME);
// 5564 F00:
U_01f8:
// 5565 REGISTER(REG)=0
REGISTER[REG] = 0;
// 5566 P=P2; SKIP EXP
P = P2;
SKIPEXP();
// 5567 %END
return;
_imp_endofblock: ;
} // End of block ASSIGN at level 5
// 5568 %ROUTINE CSEXP(%INTEGER REG,MODE)
void CSEXP( int REG, int MODE )
{
__label__ _imp_endofblock;
// 5569 !***********************************************************************
// 5570 !* COMPILE A SIGNED EXPRESSION TO REGISTER 'REG' IN MODE 'MODE' *
// 5571 !* MODE=1 FOR %INTEGER, =2 REAL, =3 LONG,=0 INTEGER %IF POSSIBLE *
// 5572 !* MODE=5 FOR ADDRESS EXPRESSNS(IE LEAVE ANY CONSTANT IN 'ADISP')*
// 5573 !***********************************************************************
// 5574 %INTEGER EXPHEAD,NOPS,EXPBOT
int EXPHEAD;
int NOPS;
int EXPBOT;
// 5575 EXPHEAD=0; EXPBOT=0
EXPHEAD = 0;
EXPBOT = 0;
// 5576 NOPS=0
NOPS = 0;
// 5577 P=P+3
P = ((P)) + ((3));
// 5578 TORP(EXPHEAD,EXPBOT,NOPS)
TORP( &EXPHEAD, &EXPBOT, &NOPS);
// 5579 !
// 5580 EXPOP(EXPHEAD,REG,NOPS,MODE)
EXPOP(EXPHEAD, REG, NOPS, MODE);
// 5581 ! CLEAR LIST(EXPHEAD)
// 5582 ASLIST(EXPBOT)_LINK=ASL
ASLIST[EXPBOT].LINK = ASL;
// 5583 ASL=EXPHEAD
ASL = EXPHEAD;
// 5584 %END
return;
_imp_endofblock: ;
} // End of block CSEXP at level 5
// 5585 %INTEGERFN CONSTEXP(%INTEGER PRECTYPE)
int CONSTEXP( int PRECTYPE )
{
__label__ _imp_endofblock;
// 5586 !***********************************************************************
// 5587 !* COMPILES AN EXPRESSION WHICH SHOULD EVALUATE TO A CONSTANT OF *
// 5588 !* TYPE 'PRECTYPE'. P AS FOR FN INTEXP. *
// 5589 !***********************************************************************
// 5590 %INTEGER EXPHEAD,EXPBOT,NOPS,RES
int EXPHEAD;
int EXPBOT;
int NOPS;
int RES;
// 5591 EXPHEAD=0; EXPBOT=0; NOPS=0; RES=0
EXPHEAD = 0;
EXPBOT = 0;
NOPS = 0;
RES = 0;
// 5592 TORP(EXPHEAD,EXPBOT,NOPS)
TORP( &EXPHEAD, &EXPBOT, &NOPS);
// 5593 ->WAYOUT %UNLESS NOPS&16_00040000=0
if (( ((NOPS)) & ((262144)) ) == ( 0 )) goto L_0560;
goto U_01e1;
L_0560:
// 5594 EXPOP(EXPHEAD,ACCR,NOPS,16_200+PRECTYPE)
EXPOP(EXPHEAD, 0, NOPS, ((512)) + ((PRECTYPE)));
// 5595 %IF EXPOPND_FLAG=3 %THEN RES=EXPOPND_XTRA %AND ->WAYOUT
if (( EXPOPND.FLAG ) != ( 3 )) goto L_0561;
RES = EXPOPND.XTRA;
goto U_01e1;
L_0561:
// 5596 ->WAYOUT %UNLESS EXPOPND_FLAG<=1
if (( EXPOPND.FLAG ) <= ( 1 )) goto L_0562;
goto U_01e1;
L_0562:
// 5597 RES=ADDR(EXPOPND_D)
RES = ADDR( &EXPOPND.D);
// 5598 WAYOUT:
U_01e1:
// 5599 %MONITOR %IF RES=0 %AND DCOMP#0
if (( RES ) != ( 0 )) goto L_0563;
if (( DCOMP ) == ( 0 )) goto L_0563;
_imp_monitor(0, _imp_current_line, _imp_current_file, __PRETTY_FUNCTION__);
L_0563:
// 5600 ASLIST(EXPBOT)_LINK=ASL
ASLIST[EXPBOT].LINK = ASL;
// 5601 ASL=EXPHEAD
ASL = EXPHEAD;
// 5602 %RESULT=RES
return RES;
// 5603 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block CONSTEXP at level 5
// 5604 %INTEGERFN INTEXP(%INTEGERNAME VALUE)
int INTEXP( int *VALUE )
{
__label__ _imp_endofblock;
// 5605 !***********************************************************************
// 5606 !* COMPILES AN EXPRESSION WHICH SHOULD EVALUATE TO A CONSTANT *
// 5607 !* VALUE RETURNED IN VALUE. RESULT#0 IF FAILED TO EVALUATE *
// 5608 !* P POINTS TO P(+') IN (+')(OPERNAD)(RESTOFEXPR) *
// 5609 !***********************************************************************
// 5610 %INTEGER EXPHEAD,EXPBOT,NOPS,CODE,SPTYPE,SACC
int EXPHEAD;
int EXPBOT;
int NOPS;
int CODE;
int SPTYPE;
int SACC;
// 5611 EXPHEAD=0; EXPBOT=0; NOPS=0; CODE=0
EXPHEAD = 0;
EXPBOT = 0;
NOPS = 0;
CODE = 0;
// 5612 SPTYPE=PTYPE; SACC=ACC; ! CALLED IN DECLARATIONS
SPTYPE = PTYPE;
SACC = ACC;
// 5613 TORP(EXPHEAD,EXPBOT,NOPS)
TORP( &EXPHEAD, &EXPBOT, &NOPS);
// 5614 %IF NOPS&16_00040000=0 %AND TYPE=1 %START
if (( ((NOPS)) & ((262144)) ) != ( 0 )) goto L_0564;
if (( TYPE ) != ( 1 )) goto L_0564;
// 5615 EXPOP(EXPHEAD,ACCR,NOPS,16_251)
EXPOP(EXPHEAD, 0, NOPS, 593);
// 5616 CODE=1 %UNLESS EXPOPND_FLAG<=1 %AND EXPOPND_PTYPE=16_51
if (( EXPOPND.FLAG ) > ( 1 )) goto L_0546;
if (( EXPOPND.PTYPE ) == ( 81 )) goto L_0565;
L_0546:
CODE = 1;
L_0565:
// 5617 VALUE=EXPOPND_D
VALUE = EXPOPND.D;
// 5618 %FINISH %ELSE CODE=1 %AND VALUE=1
goto L_0566;
L_0564:
CODE = 1;
VALUE = 1;
L_0566:
// 5619 ASLIST(EXPBOT)_LINK=ASL
ASLIST[EXPBOT].LINK = ASL;
// 5620 ASL=EXPHEAD
ASL = EXPHEAD;
// 5621 ACC=SACC; PTYPE=SPTYPE
ACC = SACC;
PTYPE = SPTYPE;
// 5622 UNPACK
UNPACK();
// 5623 %RESULT=CODE
return CODE;
// 5624 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block INTEXP at level 5
// 5625 %ROUTINE TORP(%INTEGERNAME HEAD,BOT,NOPS)
void TORP( int *HEAD, int *BOT, int *NOPS )
{
__label__ _imp_endofblock;
// 5626 !***********************************************************************
// 5627 !* CONVERT THE SIGNED EXPRESSION INDEXED BY P INTO REVERSE *
// 5628 !* POLISH NOTATION. THE REVERSE POLISH LIST IS ADDED TO 'HEAD' *
// 5629 !* WHICH MAY CONTAIN ANOTHER EXPRESSION. THE NUMBER OF OPERATORS *
// 5630 !* IS ADDED TO NOPS. *
// 5631 !* N.B. AN INTEGER EXPRESSION IS A SPECIAL CASE OF A REAL EXPRSN *
// 5632 !* THE TOP 20 BITS OF NOPS ARE USED TO RETURN DETAILS OF THE EXPR *
// 5633 !* THESE BITS SIGNIFY AS FOLLOWS:- *
// 5634 !* 1<<17 CONTAINS VARIABLE OF MORE THAN 32 BITS *
// 5635 !* 1<<18 NOT CONSTANT EXPRSSN IE CONTAINS AT LEAST 1 VARIABLE *
// 5636 !* 1<<19 COMPLEX IE CONTAINS FN CALL OR NEEDS DR TO EVALUATE *
// 5637 !* 1<<20 CONTAINS THE OPERATOR + *
// 5638 !* 1<<21 CONTAINS THE - OPERATOR(INCLUDES UNARY MINUS) *
// 5639 !* 1<<22 CONTAINS OPERATOR !! (INCUDES UNARY NOT) *
// 5640 !* 1<<23-7 CONTAINS OPERATORS !,*,//,/,& RESPECTIVELY *
// 5641 !* 1<28&9 CONTAINS << OR >> *
// 5642 !* 1<<30 CONTAINS EXPONETIATION *
// 5643 !***********************************************************************
// 5644 %SWITCH OPERAND(1:3)
static int OPERAND_idx;
static const void * /*SWITCH*/ OPERAND[(3)-(1)+1] = { &&OPERAND_1, &&OPERAND_2, &&OPERAND_3, };
// 5645 %CONSTBYTEINTEGERARRAY PRECEDENCE(1:15)=3,3,4,5,5,4,3,3,4,4,5,5,3,5,5;
const unsigned char PRECEDENCE[(15)-(1)+1] = { 3, 3, 4, 5, 5, 4, 3, 3, 4, 4, 5, 5, 3, 5, 5, };
// 5646 %CONSTBYTEINTEGERARRAY OPVAL(1:15)=20,21,27,37,30,24,22,23,25,26,
const unsigned char OPVAL[(15)-(1)+1] = { 20, 21, 27, 37, 30, 24, 22, 23, 25, 26, 28, 29, 20, 37, 30, };
// 5647 28,29,20,37,30;
// 5648 %INTEGER RPHEAD,PASSHEAD,SAVEHEAD,REAL,REALOP,COMPLEX,{%C
int RPHEAD;
int PASSHEAD;
int SAVEHEAD;
int REAL;
int REALOP;
int COMPLEX;
int OPERATOR;
int OPPREC;
int OPND;
int C;
int D;
int E;
int RPTYPE;
int RPINF;
int BDISP;
int OPNAME;
int OPMASK;
int XTRA;
int RPBOT;
int OPSTK;
int OPPSTK;
int PASSBOT;
// 5649 OPERATOR,OPPREC,OPND,C,D,E,RPTYPE,RPINF,BDISP,{%C
// 5650 OPNAME,OPMASK,XTRA,RPBOT,OPSTK,OPPSTK,PASSBOT
// 5651 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 5652 !
// 5653 PASSHEAD=0; RPHEAD=0; SAVEHEAD=0
PASSHEAD = 0;
RPHEAD = 0;
SAVEHEAD = 0;
// 5654 REAL=0; REALOP=0; BDISP=0
REAL = 0;
REALOP = 0;
BDISP = 0;
// 5655 RPBOT=0; OPSTK=0; OPPSTK=0
RPBOT = 0;
OPSTK = 0;
OPPSTK = 0;
// 5656 !
// 5657 C=A(P)
C = A[P];
// 5658 %IF 2<=C<=3 %THEN %START; ! INITIAL '-' OR '\'
if (( 2 ) > ( C )) goto L_0567;
if (( C ) > ( 3 )) goto L_0567;
// 5659 NOPS=NOPS+1
NOPS = ((NOPS)) + ((1));
// 5660 ! '-' =(11,3) '\' =(10,5)
// 5661 OPSTK=4-C
OPSTK = ((4)) - ((C));
// 5662 OPPSTK=C<<1-1
OPPSTK = ((((C)) << ((1)))) - ((1));
// 5663 OPMASK=1<<(19+C); ! - %OR !!
OPMASK = ((1)) << ((((19)) + ((C))));
// 5664 %FINISH %ELSE OPMASK=0
goto L_0568;
L_0567:
OPMASK = 0;
L_0568:
// 5665 NEXTOPND:OPND=A(P+1); P=P+2
U_01f9:
OPND = A[((P)) + ((1))];
P = ((P)) + ((2));
// 5666 COMPLEX=0; XTRA=0
COMPLEX = 0;
XTRA = 0;
// 5667 -> OPERAND(OPND); ! SWITCH ON OPERAND
goto *(OPERAND-1)[OPND]; /* Bounds=1:3 */
// 5668 OPERAND(1): ! NAME
OPERAND_1:
// 5669 OPNAME=A(P)<<8+A(P+1)
OPNAME = ((((A[P])) << ((8)))) + ((A[((P)) + ((1))]));
// 5670 LCELL==ASLIST(TAGS(OPNAME))
LCELL = (&(ASLIST[TAGS[OPNAME]]));
// 5671 PTYPE=LCELL_S1>>16
PTYPE = (int)(((unsigned int)(LCELL->S1)) >> ((16)));
// 5672 %IF PTYPE=16_FFFF %THEN PTYPE=7;! NAME NOT SET
if (( PTYPE ) != ( 65535 )) goto L_0569;
PTYPE = 7;
L_0569:
// 5673 TYPE=PTYPE&7; PREC=PTYPE>>4&15
TYPE = ((PTYPE)) & ((7));
PREC = (((int)(((unsigned int)(PTYPE)) >> ((4))))) & ((15));
// 5674 %IF PTYPE=SNPT %THEN %START
if (( PTYPE ) != ( 4102 )) goto L_056a;
// 5675 D=LCELL_S3>>16
D = (int)(((unsigned int)(LCELL->S3)) >> ((16)));
// 5676 %IF D=38 %AND A(P+2)=2 %THEN %START; ! PICK OFF NL
if (( D ) != ( 38 )) goto L_056b;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_056b;
// 5677 RPTYPE=0; RPINF=10; PTYPE=16_51; P=P+2; ->SKNAM
RPTYPE = 0;
RPINF = 10;
PTYPE = 81;
P = ((P)) + ((2));
goto U_01fa;
// 5678 %FINISH
L_056b:
// 5679 %IF D=52 %AND A(P+2)=2 %START;! PICK OFF PI
if (( D ) != ( 52 )) goto L_056c;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_056c;
// 5680 RPTYPE=1; PTYPE=16_62; RPINF=16_413243F6
RPTYPE = 1;
PTYPE = 98;
RPINF = 1093813238;
// 5681 XTRA=16_A8885A31
XTRA = -1467459023;
// 5682 P=P+2; REAL=1; ->SKNAM
P = ((P)) + ((2));
REAL = 1;
goto U_01fa;
// 5683 %FINISH
L_056c:
// 5684 COMPLEX=1
COMPLEX = 1;
// 5685 PTYPE=TSNAME(D); UNPACK
PTYPE = TSNAME[D];
UNPACK();
// 5686 %FINISH
L_056a:
// 5687 %IF PTYPE&16_FF00=16_4000 %AND A(P+2)=2=A(P+3) %AND 1<=TYPE<=2 %THEN %START; ! CONST VAR
if (( ((PTYPE)) & ((65280)) ) != ( 16384 )) goto L_056d;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_056d;
if (( 2 ) != ( A[((P)) + ((3))] )) goto L_056d;
if (( 1 ) > ( TYPE )) goto L_056d;
if (( TYPE ) > ( 2 )) goto L_056d;
// 5688 LCELL_S1=LCELL_S1!16_8000; ! SET USED BIT
LCELL->S1 = ((LCELL->S1)) | ((32768));
// 5689 RPINF=LCELL_S2; XTRA=LCELL_S3
RPINF = LCELL->S2;
XTRA = LCELL->S3;
// 5690 RPTYPE=1; PTYPE=PTYPE&255
RPTYPE = 1;
PTYPE = ((PTYPE)) & ((255));
// 5691 %IF TYPE=1 %AND PREC<=5 %AND 16_FFFE0000<=RPINF<=16_1FFFF %THEN RPTYPE=0 %AND PTYPE=16_51
if (( TYPE ) != ( 1 )) goto L_056e;
if (( PREC ) > ( 5 )) goto L_056e;
if (( -131072 ) > ( RPINF )) goto L_056e;
if (( RPINF ) > ( 131071 )) goto L_056e;
RPTYPE = 0;
PTYPE = 81;
L_056e:
// 5692 %IF PREC=7 %THEN RPTYPE=3
if (( PREC ) != ( 7 )) goto L_056f;
RPTYPE = 3;
L_056f:
// 5693 REAL=1 %IF TYPE=2
if (( TYPE ) != ( 2 )) goto L_0570;
REAL = 1;
L_0570:
// 5694 P=P+2; ->SKNAM
P = ((P)) + ((2));
goto U_01fa;
// 5695 %FINISH
L_056d:
// 5696 XTRA=OPNAME
XTRA = OPNAME;
// 5697 %IF PTYPE&16_3F00#0 %OR PARMCHK=1 %OR PREC<5 %THEN COMPLEX=1 %AND XTRA=-1
if (( ((PTYPE)) & ((16128)) ) != ( 0 )) goto L_0571;
if (( PARMCHK ) == ( 1 )) goto L_0571;
if (( PREC ) >= ( 5 )) goto L_0572;
L_0571:
COMPLEX = 1;
XTRA = (-(1));
L_0572:
// 5698 OPMASK=OPMASK!(COMPLEX<<19)
OPMASK = ((OPMASK)) | ((((COMPLEX)) << ((19))));
// 5699 %IF A(P+2)#2 %OR A(P+3)#2 %THEN XTRA=-1;! XTRA=NAME FOR LOCAL SCALRS ONLY
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0573;
if (( A[((P)) + ((3))] ) == ( 2 )) goto L_0574;
L_0573:
XTRA = (-(1));
L_0574:
// 5700 %IF TYPE=3 %THEN %START
if (( TYPE ) != ( 3 )) goto L_0575;
// 5701 D=P; KFORM=LCELL_S3&16_FFFF
D = P;
KFORM = ((LCELL->S3)) & ((65535));
// 5702 C=COPY RECORD TAG(E); P=D;
C = COPYRECORDTAG( &E);
P = D;
// 5703 COMPLEX=1 %UNLESS E=1 %AND 1<=TYPE<=2 %AND NAM=ARR=0 %AND PREC#3
if (( E ) != ( 1 )) goto L_0576;
if (( 1 ) > ( TYPE )) goto L_0576;
if (( TYPE ) > ( 2 )) goto L_0576;
if (( NAM ) != ( ARR )) goto L_0576;
if (( ARR ) != ( 0 )) goto L_0576;
if (( PREC ) != ( 3 )) goto L_0577;
L_0576:
COMPLEX = 1;
L_0577:
// 5704 %FINISH
L_0575:
// 5705 %IF PREC>=6 %THEN OPMASK=OPMASK!1<<17;! MORE THAN 32 BITS
if (( PREC ) < ( 6 )) goto L_0578;
OPMASK = ((OPMASK)) | ((((1)) << ((17))));
L_0578:
// 5706 RPTYPE=2; RPINF=P; PTYPE=16_51 %IF PTYPE=7
RPTYPE = 2;
RPINF = P;
if (( PTYPE ) != ( 7 )) goto L_0579;
PTYPE = 81;
L_0579:
// 5707 %IF TYPE=5 %THEN FAULT2(76,0,OPNAME) %AND RPTYPE=0 %AND PTYPE=16_51
if (( TYPE ) != ( 5 )) goto L_057a;
FAULT2(76, 0, OPNAME);
RPTYPE = 0;
PTYPE = 81;
L_057a:
// 5708 %IF TYPE=2 %THEN REAL=1
if (( TYPE ) != ( 2 )) goto L_057b;
REAL = 1;
L_057b:
// 5709 P=P+2
P = ((P)) + ((2));
// 5710 SKNAM: %IF A(P)=2 %THEN P=P+1 %ELSE SKIP APP
U_01fa:
if (( A[P] ) != ( 2 )) goto L_057c;
P = ((P)) + ((1));
goto L_057d;
L_057c:
SKIPAPP();
L_057d:
// 5711 %IF A(P)=1 %THEN P=P+3 %AND ->SKNAM
if (( A[P] ) != ( 1 )) goto L_057e;
P = ((P)) + ((3));
goto U_01fa;
L_057e:
// 5712 P=P+2
P = ((P)) + ((2));
// 5713 INS: %IF RPTYPE=2 %THEN OPMASK=OPMASK!1<<18
U_01fb:
if (( RPTYPE ) != ( 2 )) goto L_057f;
OPMASK = ((OPMASK)) | ((((1)) << ((18))));
L_057f:
// 5714 BINSERT(RPHEAD,RPBOT,PTYPE<<16!COMPLEX<<8!RPTYPE,RPINF,XTRA)
BINSERT( &RPHEAD, &RPBOT, ((((((PTYPE)) << ((16)))) | ((((COMPLEX)) << ((8)))))) | ((RPTYPE)), RPINF, XTRA);
// 5715 -> OP
goto U_01fc;
// 5716 OPERAND(2): ! CONSTANT
OPERAND_2:
// 5717 PTYPE=A(P); D=PTYPE>>4
PTYPE = A[P];
D = (int)(((unsigned int)(PTYPE)) >> ((4)));
// 5718 C=PTYPE&7
C = ((PTYPE)) & ((7));
// 5719 %IF D=4 %THEN %START
if (( D ) != ( 4 )) goto L_0580;
// 5720 RPINF=FROM AR2(P+1)
RPINF = FROMAR2(((P)) + ((1)));
// 5721 PTYPE=16_51
PTYPE = 81;
// 5722 %FINISH %ELSE RPINF=FROM AR4(P+1)
goto L_0581;
L_0580:
RPINF = FROMAR4(((P)) + ((1)));
L_0581:
// 5723 REAL=1 %IF C=2; RPTYPE=1
if (( C ) != ( 2 )) goto L_0582;
REAL = 1;
L_0582:
RPTYPE = 1;
// 5724 %IF D=6 %THEN XTRA=FROM AR4(P+5)
if (( D ) != ( 6 )) goto L_0583;
XTRA = FROMAR4(((P)) + ((5)));
L_0583:
// 5725 %IF C=5 %THEN %START; ! STRING CONSTANT
if (( C ) != ( 5 )) goto L_0584;
// 5726 FAULT2(77,0,0); RPINF=1; RPTYPE=0
FAULT2(77, 0, 0);
RPINF = 1;
RPTYPE = 0;
// 5727 P=P+A(P+5)+7; PTYPE=16_51
P = ((((P)) + ((A[((P)) + ((5))])))) + ((7));
PTYPE = 81;
// 5728 %FINISH %ELSE %START
goto L_0585;
L_0584:
// 5729 %IF D=7 %THEN XTRA=ADDR(A(P+1)) %AND RPTYPE=3
if (( D ) != ( 7 )) goto L_0586;
XTRA = ADDR( &A[((P)) + ((1))]);
RPTYPE = 3;
L_0586:
// 5730 %IF PTYPE=16_51 %AND 16_FFFE0000<=RPINF<=16_1FFFF %THEN RPTYPE=0
if (( PTYPE ) != ( 81 )) goto L_0587;
if (( -131072 ) > ( RPINF )) goto L_0587;
if (( RPINF ) > ( 131071 )) goto L_0587;
RPTYPE = 0;
L_0587:
// 5731 P=P+2+BYTES(D)
P = ((((P)) + ((2)))) + ((BYTES[D]));
// 5732 %FINISH; -> INS
L_0585:
goto U_01fb;
// 5733 OPERAND(3): ! SUB EXPRESSION
OPERAND_3:
// 5734 PASSHEAD=0; PASSBOT=0
PASSHEAD = 0;
PASSBOT = 0;
// 5735 P=P+3
P = ((P)) + ((3));
// 5736 TORP(PASSHEAD,PASSBOT,NOPS)
TORP( &PASSHEAD, &PASSBOT, NOPS);
// 5737 REAL=1 %IF TYPE=2
if (( TYPE ) != ( 2 )) goto L_0588;
REAL = 1;
L_0588:
// 5738 ! CONCAT(RPHEAD,PASSHEAD)
// 5739 %IF RPBOT=0 %THEN RPHEAD=PASSHEAD %ELSE ASLIST(RPBOT)_LINK=PASSHEAD
if (( RPBOT ) != ( 0 )) goto L_0589;
RPHEAD = PASSHEAD;
goto L_058a;
L_0589:
ASLIST[RPBOT].LINK = PASSHEAD;
L_058a:
// 5740 RPBOT=PASSBOT
RPBOT = PASSBOT;
// 5741 P=P+1
P = ((P)) + ((1));
// 5742 OP: ! DEAL WITH OPERATOR
U_01fc:
// 5743 -> EOE %IF A(P-1)=2; ! EXPR FINISHED
if (( A[((P)) - ((1))] ) != ( 2 )) goto L_058b;
goto U_01fd;
L_058b:
// 5744 OPERATOR=A(P)
OPERATOR = A[P];
// 5745 !
// 5746 ! THE STRING OPERATOR '.' CAUSES CHAOS IN AN ARITHMETIC EXPRSN
// 5747 ! SO FAULT IT AND CHANGE IT TO THE INNOCUOUS '+'
// 5748 !
// 5749 %IF OPERATOR=CONCOP %THEN FAULT2(78,0,0)
if (( OPERATOR ) != ( 13 )) goto L_058c;
FAULT2(78, 0, 0);
L_058c:
// 5750 OPPREC=PRECEDENCE(OPERATOR)
OPPREC = (PRECEDENCE-1)[OPERATOR];
// 5751 OPERATOR=OPVAL(OPERATOR)
OPERATOR = (OPVAL-1)[OPERATOR];
// 5752 %IF OPERATOR=26 %OR OPERATOR=30 %THEN REAL=1
if (( OPERATOR ) == ( 26 )) goto L_058d;
if (( OPERATOR ) != ( 30 )) goto L_058e;
L_058d:
REAL = 1;
L_058e:
// 5753 NOPS=NOPS+1
NOPS = ((NOPS)) + ((1));
// 5754 !
// 5755 ! UNLOAD THE OPERATOR STACK OF ALL OPERATORS WHOSE PRECEDENCE IS
// 5756 ! NOT LOWER THAN THE CURRENT OPERATOR. AN EMPTY STACK GIVES'-1'
// 5757 ! AS PRECEDENCE.
// 5758 !
// 5759 %WHILE OPPREC<=OPPSTK&31 %CYCLE
L_058f:
if (( OPPREC ) > ( ((OPPSTK)) & ((31)) )) goto L_0590;
// 5760 BINSERT(RPHEAD,RPBOT,OPSTK&31+9,0,0)
BINSERT( &RPHEAD, &RPBOT, ((((OPSTK)) & ((31)))) + ((9)), 0, 0);
// 5761 OPSTK=OPSTK>>5; OPPSTK=OPPSTK>>5
OPSTK = (int)(((unsigned int)(OPSTK)) >> ((5)));
OPPSTK = (int)(((unsigned int)(OPPSTK)) >> ((5)));
// 5762 %REPEAT
goto L_058f;
L_0590:
// 5763 !
// 5764 ! THE CURRENT OPERATOR CAN NOW BE STORED
// 5765 !
// 5766 OPSTK=OPSTK<<5!(OPERATOR-9)
OPSTK = ((((OPSTK)) << ((5)))) | ((((OPERATOR)) - ((9))));
// 5767 OPPSTK=OPPSTK<<5!OPPREC
OPPSTK = ((((OPPSTK)) << ((5)))) | ((OPPREC));
// 5768 %IF OPERATOR>=31 %THEN OPERATOR=30
if (( OPERATOR ) < ( 31 )) goto L_0592;
OPERATOR = 30;
L_0592:
// 5769 OPMASK=OPMASK!(1<<OPERATOR)
OPMASK = ((OPMASK)) | ((((1)) << ((OPERATOR))));
// 5770 -> NEXTOPND
goto U_01f9;
// 5771 EOE: ! END OF EXPRESSION
U_01fd:
// 5772 ! EMPTY REMAINING OPERATORS
// 5773 %WHILE OPSTK#0 %CYCLE
L_0593:
if (( OPSTK ) == ( 0 )) goto L_0594;
// 5774 BINSERT(RPHEAD,RPBOT,OPSTK&31+9,0,0)
BINSERT( &RPHEAD, &RPBOT, ((((OPSTK)) & ((31)))) + ((9)), 0, 0);
// 5775 OPSTK=OPSTK>>5
OPSTK = (int)(((unsigned int)(OPSTK)) >> ((5)));
// 5776 %REPEAT
goto L_0593;
L_0594:
// 5777 PTYPE=REAL+1
PTYPE = ((REAL)) + ((1));
// 5778 TYPE=PTYPE
TYPE = PTYPE;
// 5779 ! CONCAT(RPHEAD,HEAD)
// 5780 %IF HEAD=0 %THEN BOT=RPBOT %ELSE ASLIST(RPBOT)_LINK=HEAD
if (( HEAD ) != ( 0 )) goto L_0596;
BOT = RPBOT;
goto L_0597;
L_0596:
ASLIST[RPBOT].LINK = HEAD;
L_0597:
// 5781 HEAD=RPHEAD; ! HEAD BACK TO TOP OF LIST
HEAD = RPHEAD;
// 5782 NOPS=NOPS!OPMASK
NOPS = ((NOPS)) | ((OPMASK));
// 5783 %END
return;
_imp_endofblock: ;
} // End of block TORP at level 5
// 5784 %ROUTINE EXPOP(%INTEGER INHEAD,REG,NOPS,MODE)
void EXPOP( int INHEAD, int REG, int NOPS, int MODE )
{
__label__ _imp_endofblock;
// 5785 !***********************************************************************
// 5786 !* EVALUATE A LIST OF OPERAND AND'NOPS' OPERATORS AND LEAVE *
// 5787 !* THE RESULT IN REG *
// 5788 !* INHEAD HOLDS THE LIST THE BOTTOM BYTE OF STREAM 1 DEFINES THE *
// 5789 !* ENTRY AS FOLLOWS:- *
// 5790 !* 0 = SHORT (INTEGER) CONSTANT <18 BITS --S2=CONSTANT *
// 5791 !* 1 = OTHER CONSTANT S2 (+S3 IF NEEDED) = CONSTANT *
// 5792 !* 2 = VARIABLE S2 POINT TO AR ENTRY FOR NAME&SUBSCRIPTS *
// 5793 !* (3 = DOPE VECTOR ITEM IF NEEDED) *
// 5794 !* (4 = CONDITONAL EXPRESSION AS IN ALGOL) *
// 5795 !* 7 = INTERMEDIATE RESULT UNDER LNB S2=DISPLCMNT FROM LNB *
// 5796 !* 8 = INTERMEDIATE RESULT STACKED *
// 5797 !* 9 = INTERMEDIATE RESULT IN A REGISTER S2 = REG *
// 5798 !* *
// 5799 !* 10-19 = UNARY OPERATOR S2=OP S3 =EXTRA *
// 5800 !* 20 UP = BINARY OPERATOR *
// 5801 !* *
// 5802 !* ARRAY MCINST HOLD THE OPCODES CORRESPONDING TO THE OPERATORS:- *
// 5803 !* TOP BYTE = REAL FORWARD FORM *
// 5804 !* 2ND BYTE = REAL REVERSE FORM *
// 5805 !* 3RD BYTE = INTEGER FORWARD FORM *
// 5806 !* BTM BYTE = INTEGER REVERSE FORM *
// 5807 !* MODE HAS TYPE & PREC REQD +256 BIT IF NO RESULT REQD *
// 5808 !***********************************************************************
// 5809 %ROUTINESPEC CTOP(%INTEGERNAME A)
auto void CTOP( int *A );
// 5810 %ROUTINESPEC VMY
auto void VMY( void );
// 5811 %ROUTINESPEC VMY1
auto void VMY1( void );
// 5812 %ROUTINESPEC CHOOSE(%INTEGERNAME I)
auto void CHOOSE( int *I );
// 5813 %ROUTINESPEC PUT
auto void PUT( void );
// 5814 %ROUTINESPEC STARSTAR
auto void STARSTAR( void );
// 5815 %ROUTINESPEC REXP
auto void REXP( void );
// 5816 %ROUTINESPEC LOAD(%RECORD(RD)%NAME OP,%INTEGER REG,MODE)
auto void LOAD( RD *OP, int REG, int MODE );
// 5817 %ROUTINESPEC FLOAT(%RECORD(RD)%NAME OPND,%INTEGER OTHERPTYPE)
auto void FLOAT( RD *OPND, int OTHERPTYPE );
// 5818 %ROUTINESPEC COERCET(%RECORD(RD)%NAME OP1,OP2,%INTEGER MODE)
auto void COERCET( RD *OP1, RD *OP2, int MODE );
// 5819 %ROUTINESPEC COERCEP(%RECORD(RD)%NAME OP1,OP2)
auto void COERCEP( RD *OP1, RD *OP2 );
// 5820 %ROUTINESPEC LENGTHEN(%RECORD(RD)%NAME OP)
auto void LENGTHEN( RD *OP );
// 5821 %ROUTINESPEC SHORTEN (%RECORD(RD)%NAME OP)
auto void SHORTEN( RD *OP );
// 5822 !
// 5823 %INTEGERARRAY OPERAND(1:2),STK(0:99)
int OPERAND[(2)-(1)+1];
int STK[(99)-(0)+1];
// 5824 %RECORD(LISTF)%NAME LIST{(LISTF)
LISTF *LIST;
// 5825 %RECORD(RD)%name OPND1,OPND2,OPND {(RD)
RD *OPND1;
RD *OPND2;
RD *OPND;
// 5826 !
// 5827 %INTEGER C,D,KK,JJ,OPCODE,COMM,XTRA,PP,PT,JJJ,LOADREG,EVALREG,STPTR,CONSTFORM,CONDFORM,SAVEP
int C;
int D;
int KK;
int JJ;
int OPCODE;
int COMM;
int XTRA;
int PP;
int PT;
int JJJ;
int LOADREG;
int EVALREG;
int STPTR;
int CONSTFORM;
int CONDFORM;
int SAVEP;
// 5828 %CONSTINTEGERARRAY MCINST(10:37)=16_8E8E,16_F4F4E4E4,16_A8A8,
const int MCINST[(37)-(10)+1] = { 36494, -185277212, 43176, -185277212, 0, 0, 0, 0, 0, 0, -252649248, -218832156, 36494, 35980, -84219158, 43692, -1162084352, 35466, 51200, 51200, -100663296, -151591194, 16122086, 738208768, 33554944, 1207977984, 1207977984, 59904, };
// 5829 16_F4F4E4E4,0(6),
// 5830 16_F0F0E0E0,16_F2F4E2E4,
// 5831 16_8E8E,16_8C8C,16_FAFAEAEA,
// 5832 16_AAAC,16_BABC0000,
// 5833 16_8A8A,16_C800(2),16_FA000000,
// 5834 16_F6F6E6E6,16_00F600E6,
// 5835 16_2C002C00,16_02000200,
// 5836 16_48004800(2),16_EA00;
// 5837 %CONSTBYTEINTEGERARRAY CORULES(20:37)=16_1F(2),16_11(2),16_1F,16_11,
const unsigned char CORULES[(37)-(20)+1] = { 31, 31, 17, 17, 31, 17, 18, 17, 1, 1, 0, 31, 31, 0, 0, 0, 0, 1, };
// 5838 16_12,16_11,1,1,0,16_1F(2),
// 5839 0(4),1;
// 5840 %CONSTBYTEINTEGERARRAY FCOMP(1:28)={%C
const unsigned char FCOMP[(28)-(1)+1] = { 8, 10, 2, 7, 12, 4, 7, 8, 12, 4, 7, 10, 2, 7, 16, 34, 17, 32, 33, 18, 32, 16, 33, 18, 32, 34, 17, 32, };
// 5841 8,10,2,7,12,4,7,
// 5842 8,12,4,7,10,2,7,
// 5843 16,34,17,32,33,18,32,
// 5844 16,33,18,32,34,17,32;
// 5845 %SWITCH SW(10:37)
static int SW_idx;
static const void * /*SWITCH*/ SW[(37)-(10)+1] = { &&SW_10, &&SW_11, &&SW_12, &&SW_13, &&SW_14, &&SW_15, &&SW_16, &&SW_17, &&SW_18, &&SW_19, &&SW_20, &&SW_21, &&SW_22, &&SW_23, &&SW_24, &&SW_25, &&SW_26, &&SW_27, &&SW_28, &&SW_29, &&SW_30, &&SW_31, &&SW_32, &&SW_33, &&SW_34, &&SW_35, &&SW_36, &&SW_37, };
// 5846 !
// 5847 STPTR=0; CONSTFORM= MODE&512
STPTR = 0;
CONSTFORM = ((MODE)) & ((512));
// 5848 CONDFORM=MODE&256
CONDFORM = ((MODE)) & ((256));
// 5849 SAVEP=P
SAVEP = P;
// 5850 EVALREG=ACCR; ! EVALUATE IN ACC UNLESS
EVALREG = 0;
// 5851 %IF REG=BREG %AND NOPS&16_7EC20000=0 %THEN EVALREG=BREG
if (( REG ) != ( 7 )) goto L_0598;
if (( ((NOPS)) & ((2126643200)) ) != ( 0 )) goto L_0598;
EVALREG = 7;
L_0598:
// 5852 ! ONLY '+' %AND '*' PRESENT
// 5853 ! NOTHING >32 BITS
// 5854 NEXT: LIST==ASLIST(INHEAD)
U_0207:
LIST = (&(ASLIST[INHEAD]));
// 5855 C=LIST_S1; XTRA=LIST_S2
C = LIST->S1;
XTRA = LIST->S2;
// 5856 JJ=C&255; D=INHEAD
JJ = ((C)) & ((255));
D = INHEAD;
// 5857 INHEAD=LIST_LINK
INHEAD = LIST->LINK;
// 5858 -> OPERATOR %IF JJ>=10
if (( JJ ) < ( 10 )) goto L_0599;
goto U_0208;
L_0599:
// 5859 !
// 5860 ! ANY OPERAND WHICH MAY NEED DR OR B OR ACC IN THEIR EVALUATION
// 5861 ! EG FUNCTIONS,ARRAY ELEMENTS ETC ARE FETCHED AND STACKKED FIRST
// 5862 !
// 5863 OPERAND(1)=ADDR(ASLIST(D))
(OPERAND-1)[1] = ADDR( &ASLIST[D]);
// 5864 { OPND1==ASLIST(D) { <--- format mismatch!
// 5865 OPND1==RECORD(ADDR(ASLIST(D))) { force format.
OPND1 = * /*(recfm)*/ RECORD(ADDR( &ASLIST[D]));
// 5866 {
// 5867 { This looks weird!
// 5868 {
// 5869 { %RECORDFORMAT RD(%BYTEINTEGER UPTYPE,PTYPE,XB,FLAG,%C
// 5870 { %INTEGER D,XTRA)
// 5871 {
// 5872 { %RECORDFORMAT LISTF(%INTEGER S1,S2,S3,LINK)
// 5873 {
// 5874 { %RECORDARRAY ASLIST(0:ASL)(LISTF)
// 5875 {
// 5876 { %RECORDNAME OPND1,OPND2,OPND (RD)
// 5877 {
// 5878 %IF OPND1_FLAG=2 %AND OPND1_XB#0 %THEN LOAD(OPND1,EVALREG,0)
if (( OPND1->FLAG ) != ( 2 )) goto L_059a;
if (( OPND1->XB ) == ( 0 )) goto L_059a;
LOAD(OPND1, EVALREG, 0);
L_059a:
// 5879 STK(STPTR)=OPERAND(1)
STK[STPTR] = (OPERAND-1)[1];
// 5880 STPTR=STPTR+1
STPTR = ((STPTR)) + ((1));
// 5881 ABORT %IF STPTR>99
if (( STPTR ) <= ( 99 )) goto L_059b;
ABORT();
L_059b:
// 5882 ANYMORE:
U_0209:
// 5883 ->NEXT %UNLESS INHEAD=0 %OR MODE=100
if (( INHEAD ) == ( 0 )) goto L_059c;
if (( MODE ) == ( 100 )) goto L_059c;
goto U_0207;
L_059c:
// 5884 -> FINISH
goto U_020a;
// 5885 OPERATOR:
U_0208:
// 5886 %IF JJ<19 %THEN KK=1 %ELSE KK=2; ! UNARY OR BINARY
if (( JJ ) >= ( 19 )) goto L_059d;
KK = 1;
goto L_059e;
L_059d:
KK = 2;
L_059e:
// 5887 %CYCLE KK=KK,-1,1
KK = ((KK)) - (((-(1))));
L_059f:
if (( KK ) == ( 1 )) goto L_05a0;
KK = ((KK)) + (((-(1))));
// 5888 STPTR=STPTR-1
STPTR = ((STPTR)) - ((1));
// 5889 C=STK(STPTR)
C = STK[STPTR];
// 5890 OPERAND(KK)=C
(OPERAND-1)[KK] = C;
// 5891 %REPEAT
goto L_059f;
L_05a0:
// 5892 OPCODE=MCINST(JJ)
OPCODE = /* No array bound info found for: */MCINST[JJ];
// 5893 COMM=1
COMM = 1;
// 5894 OPND1 == RECORD(OPERAND(1))
OPND1 = * /*(recfm)*/ RECORD((OPERAND-1)[1]);
// 5895 OPND2 == OPND1
OPND2 = OPND1;
// 5896 %IF JJ>=19 %THEN %START
if (( JJ ) < ( 19 )) goto L_05a2;
// 5897 OPND2==RECORD(OPERAND(2))
OPND2 = * /*(recfm)*/ RECORD((OPERAND-1)[2]);
// 5898 C=CORULES(JJ)
C = (CORULES-20)[JJ];
// 5899 %IF C&15#0 %THEN COERCET(OPND1,OPND2,C&15)
if (( ((C)) & ((15)) ) == ( 0 )) goto L_05a3;
COERCET(OPND1, OPND2, ((C)) & ((15)));
L_05a3:
// 5900 %IF C>>4#0 %THEN COERCEP(OPND1,OPND2)
if (( (int)(((unsigned int)(C)) >> ((4))) ) == ( 0 )) goto L_05a4;
COERCEP(OPND1, OPND2);
L_05a4:
// 5901 %FINISH
L_05a2:
// 5902 %IF JJ>19 %START
if (( JJ ) <= ( 19 )) goto L_05a5;
// 5903 CHOOSE(COMM)
CHOOSE( &COMM);
// 5904 OPND1==RECORD(OPERAND(COMM))
OPND1 = * /*(recfm)*/ RECORD((OPERAND-1)[COMM]);
// 5905 OPND2==RECORD(OPERAND(3-COMM))
OPND2 = * /*(recfm)*/ RECORD((OPERAND-1)[((3)) - ((COMM))]);
// 5906 %FINISH
L_05a5:
// 5907 PTYPE=OPND1_PTYPE; TYPE=PTYPE&7
PTYPE = OPND1->PTYPE;
TYPE = ((PTYPE)) & ((7));
// 5908 %IF TYPE=1 %THEN OPCODE=OPCODE&16_FFFF %ELSE OPCODE=OPCODE>>16;! INTEGER OR REAL FORMS
if (( TYPE ) != ( 1 )) goto L_05a6;
OPCODE = ((OPCODE)) & ((65535));
goto L_05a7;
L_05a6:
OPCODE = (int)(((unsigned int)(OPCODE)) >> ((16)));
L_05a7:
// 5909 %IF 2#OPND1_FLAG<4 %AND 2#OPND2_FLAG<4 %THEN CTOP(JJ)
if (( 2 ) == ( OPND1->FLAG )) goto L_05a8;
if (( OPND1->FLAG ) >= ( 4 )) goto L_05a8;
if (( 2 ) == ( OPND2->FLAG )) goto L_05a8;
if (( OPND2->FLAG ) >= ( 4 )) goto L_05a8;
CTOP( &JJ);
L_05a8:
// 5910 -> STRES %IF JJ=0; ! CTOP CARRIED OUT
if (( JJ ) != ( 0 )) goto L_05a9;
goto U_020b;
L_05a9:
// 5911 -> SW(JJ)
goto *(SW-10)[JJ]; /* Bounds=10:37 */
// 5912 SW(10): ! \
SW_10:
// 5913 LOAD(OPND1,EVALREG,2)
LOAD(OPND1, EVALREG, 2);
// 5914 FAULT(24,0) %UNLESS TYPE=1 %OR TYPE=7
if (( TYPE ) == ( 1 )) goto L_05aa;
if (( TYPE ) == ( 7 )) goto L_05aa;
FAULT(24, 0);
L_05aa:
// 5915 PSF1(OPCODE&255,0,-1); ! NEQ -1
PSF1(((OPCODE)) & ((255)), 0, (-(1)));
// 5916 GRUSE(EVALREG)=0
GRUSE[EVALREG] = 0;
// 5917 SUSE: OLINK(EVALREG)=OPERAND(COMM)
U_020c:
OLINK[EVALREG] = (OPERAND-1)[COMM];
// 5918 STRES: STK(STPTR)=OPERAND(COMM)
U_020b:
STK[STPTR] = (OPERAND-1)[COMM];
// 5919 STPTR=STPTR+1
STPTR = ((STPTR)) + ((1));
// 5920 ->ANYMORE
goto U_0209;
// 5921 SW(11): ! NEGATE
SW_11:
// 5922 LOAD(OPND1,EVALREG,2)
LOAD(OPND1, EVALREG, 2);
// 5923 %IF EVALREG=BREG %THEN PSF1(SLB,0,0) %AND PF1(SBB,0,TOS,0) %ELSE PSF1(OPCODE&255,0,0); ! IRSB 0 OR RRSB 0
if (( EVALREG ) != ( 7 )) goto L_05ab;
PSF1(82, 0, 0);
PF1(34, 0, 6, 0);
goto L_05ac;
L_05ab:
PSF1(((OPCODE)) & ((255)), 0, 0);
L_05ac:
// 5924 GRUSE(EVALREG)=0
GRUSE[EVALREG] = 0;
// 5925 -> SUSE
goto U_020c;
// 5926 SW(12): ! FLOAT
SW_12:
// 5927 ABORT
ABORT();
// 5928 SW(13): ! ABS
SW_13:
// 5929 LOAD(OPND1,EVALREG,2); ! OPERAND TO ACC
LOAD(OPND1, EVALREG, 2);
// 5930 %IF TYPE=2 %THEN C=2 %ELSE C=6
if (( TYPE ) != ( 2 )) goto L_05ad;
C = 2;
goto L_05ae;
L_05ad:
C = 6;
L_05ae:
// 5931 PF3(JAF,C,0,3); ! JAF *+3 ON ACC<0
PF3(6, C, 0, 3);
// 5932 PSF1(OPCODE&255,0,0); ! IRSB 0 OR RRSB 0
PSF1(((OPCODE)) & ((255)), 0, 0);
// 5933 GRUSE(EVALREG)=0
GRUSE[EVALREG] = 0;
// 5934 ->SUSE
goto U_020c;
// 5935 SW(14): ! STRETCH
SW_14:
// 5936 ABORT
ABORT();
// 5937 SW(20): ! ADD
SW_20:
// 5938 %IF TYPE=1 %AND GRUSE(EVALREG)=10 %AND OPND1_FLAG=2 %AND OPND2_FLAG=0 %AND REGISTER(EVALREG)=0 %START
if (( TYPE ) != ( 1 )) goto L_05af;
if (( GRUSE[EVALREG] ) != ( 10 )) goto L_05af;
if (( OPND1->FLAG ) != ( 2 )) goto L_05af;
if (( OPND2->FLAG ) != ( 0 )) goto L_05af;
if (( REGISTER[EVALREG] ) != ( 0 )) goto L_05af;
// 5939 P=OPND1_D; D=GRINF1(EVALREG)
P = OPND1->D;
D = GRINF1[EVALREG];
// 5940 %IF FROMAR2(P)=D&16_FFFF %AND A(P+2)=2=A(P+3) %START
if (( FROMAR2(P) ) != ( ((D)) & ((65535)) )) goto L_05b0;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_05b0;
if (( 2 ) != ( A[((P)) + ((3))] )) goto L_05b0;
// 5941 %IF EVALREG=ACCR %THEN C=IAD %ELSE C=ADB
if (( EVALREG ) != ( 0 )) goto L_05b1;
C = 224;
goto L_05b2;
L_05b1:
C = 32;
L_05b2:
// 5942 PSF1(C,0,OPND2_D-D>>16)
PSF1(C, 0, ((OPND2->D)) - (((int)(((unsigned int)(D)) >> ((16))))));
// 5943 GRINF1(EVALREG)=D&16_FFFF!OPND2_D<<16
GRINF1[EVALREG] = ((((D)) & ((65535)))) | ((((OPND2->D)) << ((16))));
// 5944 REGISTER(EVALREG)=1
REGISTER[EVALREG] = 1;
// 5945 OPND1_FLAG=9; OPND1_XB=EVALREG<<4
OPND1->FLAG = 9;
OPND1->XB = ((EVALREG)) << ((4));
// 5946 OPND1_D=0; ->SUSE
OPND1->D = 0;
goto U_020c;
// 5947 %FINISH
L_05b0:
// 5948 %FINISH
L_05af:
// 5949 BINOP: LOAD(OPND1,EVALREG,2);
U_020d:
LOAD(OPND1, EVALREG, 2);
// 5950 LOAD(OPND2,EVALREG,1)
LOAD(OPND2, EVALREG, 1);
// 5951 PUT; -> SUSE
PUT();
goto U_020c;
// 5952 SW(21): ! SUBTRACT
SW_21:
// 5953 ->BINOP
goto U_020d;
// 5954 SW(22): ! EXCLUSIVE OR
SW_22:
// 5955 SW(23): ! OR
SW_23:
// 5956 SW(27): ! AND
SW_27:
// 5957 ->BINOP %IF TYPE=1
if (( TYPE ) != ( 1 )) goto L_05b3;
goto U_020d;
L_05b3:
// 5958 F24: FAULT(24,0) %UNLESS TYPE=7
U_020e:
if (( TYPE ) == ( 7 )) goto L_05b4;
FAULT(24, 0);
L_05b4:
// 5959 JJ=20; OPCODE=MCINST(20)
JJ = 20;
OPCODE = /* No array bound info found for: */MCINST[20];
// 5960 ->BINOP; ! CHANGE OPN TO +
goto U_020d;
// 5961 SW(28): ! SRL
SW_28:
// 5962 %IF OPND2_FLAG=0 %THEN OPND2_D=-OPND2_D %ELSE %START
if (( OPND2->FLAG ) != ( 0 )) goto L_05b5;
OPND2->D = (-(OPND2->D));
goto L_05b6;
L_05b5:
// 5963 LOAD(OPND2,EVALREG,2); ! OPND TO ACC
LOAD(OPND2, EVALREG, 2);
// 5964 PSF1(IRSB,0,0); ! AND NEGATE IT
PSF1(228, 0, 0);
// 5965 GRUSE(EVALREG)=0
GRUSE[EVALREG] = 0;
// 5966 %FINISH
L_05b6:
// 5967 SW(29): ! SLL
SW_29:
// 5968 %IF OPND2_PTYPE>>4=6 %THEN SHORTEN(OPND2);! LONINT TO INT
if (( (int)(((unsigned int)(OPND2->PTYPE)) >> ((4))) ) != ( 6 )) goto L_05b7;
SHORTEN(OPND2);
L_05b7:
// 5969 -> BINOP
goto U_020d;
// 5970 SW(24): ! MULT
SW_24:
// 5971 -> BINOP
goto U_020d;
// 5972 SW(25): ! INTEGER DIVISION
SW_25:
// 5973 ->F24 %UNLESS TYPE=1
if (( TYPE ) == ( 1 )) goto L_05b8;
goto U_020e;
L_05b8:
// 5974 -> BINOP
goto U_020d;
// 5975 SW(26): ! NORMAL DIVISION
SW_26:
// 5976 -> BINOP
goto U_020d;
// 5977 SW(30): ! EXP IN REAL EXPRSN
SW_30:
// 5978 %IF OPND1_PTYPE&7=1 %THEN FLOAT(OPND1,0)
if (( ((OPND1->PTYPE)) & ((7)) ) != ( 1 )) goto L_05b9;
FLOAT(OPND1, 0);
L_05b9:
// 5979 %IF OPND2_PTYPE&7=1 %THEN STARSTAR %AND ->SUSE
if (( ((OPND2->PTYPE)) & ((7)) ) != ( 1 )) goto L_05ba;
STARSTAR();
goto U_020c;
L_05ba:
// 5980 ! REAL**REAL BY SUBROUTINE
// 5981 REXP; COMM=2; ->SUSE
REXP();
COMM = 2;
goto U_020c;
// 5982 SW(37): ! EXP IN INTEGER CONTEXT
SW_37:
// 5983 STARSTAR; -> SUSE
STARSTAR();
goto U_020c;
// 5984 SW(31): ! COMPARISONS
SW_31:
// 5985 SW(32): ! DSIDED COMPARISONS
SW_32:
// 5986 PTYPE=OPND1_PTYPE
PTYPE = OPND1->PTYPE;
// 5987 ->Z1 %IF OPND1_FLAG<=1 %AND OPND1_D=0 %AND JJ=31 %AND (OPND1_XTRA=0 %OR PTYPE>>4=5);! INT 0 OR LONGINT 0
if (( OPND1->FLAG ) > ( 1 )) goto L_05bb;
if (( OPND1->D ) != ( 0 )) goto L_05bb;
if (( JJ ) != ( 31 )) goto L_05bb;
if (( OPND1->XTRA ) == ( 0 )) goto L_05a1;
if (( (int)(((unsigned int)(PTYPE)) >> ((4))) ) != ( 5 )) goto L_05bb;
L_05a1:
goto U_020f;
L_05bb:
// 5988 -> Z2 %IF OPND2_FLAG<=1 %AND OPND2_D=0 %AND (OPND2_XTRA=0 %OR OPND2_PTYPE>>4=5)
if (( OPND2->FLAG ) > ( 1 )) goto L_05bc;
if (( OPND2->D ) != ( 0 )) goto L_05bc;
if (( OPND2->XTRA ) == ( 0 )) goto L_05bd;
if (( (int)(((unsigned int)(OPND2->PTYPE)) >> ((4))) ) != ( 5 )) goto L_05bc;
L_05bd:
goto U_0210;
L_05bc:
// 5989 LOAD(OPND1,EVALREG,2)
LOAD(OPND1, EVALREG, 2);
// 5990 LOAD(OPND2,EVALREG,1)
LOAD(OPND2, EVALREG, 1);
// 5991 PUT
PUT();
// 5992 REGISTER(EVALREG)=0
REGISTER[EVALREG] = 0;
// 5993 BFFLAG=COMM-1; ! NOTE BACKWARDS OR FORWARDS
BFFLAG = ((COMM)) - ((1));
// 5994 MASK=FCOMP(XTRA+7*BFFLAG)
MASK = (FCOMP-1)[((XTRA)) + ((((7)) * ((BFFLAG))))];
// 5995 COMM=2; ->STRES; ! 2ND OPERAND MAY BE NEEDED IN
COMM = 2;
goto U_020b;
// 5996 ! DOUBLE SIDED AND IS THEREFORE
// 5997 ! TAKEN AS THE 'RESULT'
// 5998 Z1: COMM=3-COMM
U_020f:
COMM = ((3)) - ((COMM));
// 5999 Z2: OPND==RECORD(OPERAND(COMM))
U_0210:
OPND = * /*(recfm)*/ RECORD((OPERAND-1)[COMM]);
// 6000 C=EVALREG; D=EVALREG!!7
C = EVALREG;
D = ((EVALREG)) ^ ((7));
// 6001 %IF OPND_FLAG=2 %AND GRUSE(D)=9 %AND (GRINF1(D)&16_FFFF=OPND_XTRA %OR GRINF1(D)>>16=OPND_XTRA) %THEN C=D
if (( OPND->FLAG ) != ( 2 )) goto L_05be;
if (( GRUSE[D] ) != ( 9 )) goto L_05be;
if (( ((GRINF1[D])) & ((65535)) ) == ( OPND->XTRA )) goto L_05bf;
if (( (int)(((unsigned int)(GRINF1[D])) >> ((16))) ) != ( OPND->XTRA )) goto L_05be;
L_05bf:
C = D;
L_05be:
// 6002 LOAD(OPND,C,2)
LOAD(OPND, C, 2);
// 6003 REGISTER(C)=0
REGISTER[C] = 0;
// 6004 MASK=FCOMP(XTRA+7*COMM+7)
MASK = (FCOMP-1)[((((XTRA)) + ((((7)) * ((COMM)))))) + ((7))];
// 6005 %IF TYPE=1 %THEN MASK=MASK+4
if (( TYPE ) != ( 1 )) goto L_05c0;
MASK = ((MASK)) + ((4));
L_05c0:
// 6006 %IF C=BREG %THEN MASK=MASK+8
if (( C ) != ( 7 )) goto L_05c1;
MASK = ((MASK)) + ((8));
L_05c1:
// 6007 COMM=2; ->STRES
COMM = 2;
goto U_020b;
// 6008 SW(33): ! SPECIAL MH FOR ARRAY ACCESS
SW_33:
// 6009 C=OPND2_D>>24; ! CURRENT DIMENSION
C = (int)(((unsigned int)(OPND2->D)) >> ((24)));
// 6010 D=OPND2_D>>16&31; ! TOTAL NO OF DIMENSIONS
D = (((int)(((unsigned int)(OPND2->D)) >> ((16))))) & ((31));
// 6011 %IF D=1 %THEN VMY1 %ELSE VMY
if (( D ) != ( 1 )) goto L_05c2;
VMY1();
goto L_05c3;
L_05c2:
VMY();
L_05c3:
// 6012 %IF OPND1_FLAG>1 %THEN OLINK(LOADREG)=OPERAND(COMM);! IF RESULT THEN PROTECT IT
if (( OPND1->FLAG ) <= ( 1 )) goto L_05c4;
OLINK[LOADREG] = (OPERAND-1)[COMM];
L_05c4:
// 6013 %IF C=1 %THEN ->STRES
if (( C ) != ( 1 )) goto L_05c5;
goto U_020b;
L_05c5:
// 6014 ->ANYMORE
goto U_0209;
// 6015 SW(34): ! ->LAB MASKS AND LAB AS OPND2
SW_34:
// 6016 ! OPND1 MIDDLE OF D-SIDED
// 6017 ABORT
ABORT();
// 6018 SW(35): ! ASSIGN(=)
SW_35:
// 6019 SW(36): ! ASSIGN(<-)
SW_36:
// 6020 PT=OPND2_PTYPE; PP=OPND2_D
PT = OPND2->PTYPE;
PP = OPND2->D;
// 6021 %IF PT&7=1 %AND OPND1_PTYPE&7=2 %THEN FAULT(24,0)
if (( ((PT)) & ((7)) ) != ( 1 )) goto L_05c6;
if (( ((OPND1->PTYPE)) & ((7)) ) != ( 2 )) goto L_05c6;
FAULT(24, 0);
L_05c6:
// 6022 %IF PT&7=2 %AND OPND1_PTYPE&7=1 %THEN FLOAT(OPND1,OPND2_PTYPE)
if (( ((PT)) & ((7)) ) != ( 2 )) goto L_05c7;
if (( ((OPND1->PTYPE)) & ((7)) ) != ( 1 )) goto L_05c7;
FLOAT(OPND1, OPND2->PTYPE);
L_05c7:
// 6023 LOAD(OPND1,EVALREG,2); ! RHS TO ACC
LOAD(OPND1, EVALREG, 2);
// 6024 REGISTER(EVALREG)=2
REGISTER[EVALREG] = 2;
// 6025 C=PT>>4; D=OPND1_PTYPE>>4
C = (int)(((unsigned int)(PT)) >> ((4)));
D = (int)(((unsigned int)(OPND1->PTYPE)) >> ((4)));
// 6026 %IF C<5 %THEN C=5
if (( C ) >= ( 5 )) goto L_05c8;
C = 5;
L_05c8:
// 6027 %IF D<5 %THEN D=5
if (( D ) >= ( 5 )) goto L_05c9;
D = 5;
L_05c9:
// 6028 LENGTHEN(OPND1) %AND D=OPND1_PTYPE>>4 %WHILE D<C
L_05ca:
if (( D ) >= ( C )) goto L_05cb;
LENGTHEN(OPND1);
D = (int)(((unsigned int)(OPND1->PTYPE)) >> ((4)));
goto L_05ca;
L_05cb:
// 6029 %WHILE (C<D %AND TYPE=1 %AND JJ#36) %OR C<D-1 %CYCLE
L_05cd:
if (( C ) >= ( D )) goto L_05d0;
if (( TYPE ) != ( 1 )) goto L_05d0;
if (( JJ ) != ( 36 )) goto L_05cf;
L_05d0:
if (( C ) >= ( ((D)) - ((1)) )) goto L_05ce;
L_05cf:
// 6030 SHORTEN(OPND1)
SHORTEN(OPND1);
// 6031 D=OPND1_PTYPE>>4
D = (int)(((unsigned int)(OPND1->PTYPE)) >> ((4)));
// 6032 %REPEAT
goto L_05cd;
L_05ce:
// 6033 P=PP; CNAME(1,0); ! STORE CALL
P = PP;
CNAME(1, 0);
// 6034 D=DISP; C=ACCESS; JJJ=AREA; ! SAVE INFO FOR STORE
D = DISP;
C = ACCESS;
JJJ = AREA;
// 6035 KK=PREC
KK = PREC;
// 6036 LOAD(OPND1,EVALREG,2); ! IN CASE STACKED
LOAD(OPND1, EVALREG, 2);
// 6037 %IF JJ=36 %AND TYPE=1 %START
if (( JJ ) != ( 36 )) goto L_05d1;
if (( TYPE ) != ( 1 )) goto L_05d1;
// 6038 %IF 3<=XTRA<=4 %THEN PF1(AND,0,0,(-1)>>(8*(6-XTRA))) %AND GRUSE(ACCR)=0
if (( 3 ) > ( XTRA )) goto L_05d2;
if (( XTRA ) > ( 4 )) goto L_05d2;
PF1(138, 0, 0, (int)(((unsigned int)((-(1)))) >> ((((8)) * ((((6)) - ((XTRA))))))));
GRUSE[0] = 0;
L_05d2:
// 6039 %IF KK<=5 %AND PREC=6 %THEN PSF1(MPSR,0,17) %AND GRUSE(ACCR)=0
if (( KK ) > ( 5 )) goto L_05d3;
if (( PREC ) != ( 6 )) goto L_05d3;
PSF1(50, 0, 17);
GRUSE[0] = 0;
L_05d3:
// 6040 %FINISH
L_05d1:
// 6041 %IF TYPE=2 %AND KK<PREC %THEN KK=STUH %ELSE KK=ST
if (( TYPE ) != ( 2 )) goto L_05d4;
if (( KK ) >= ( PREC )) goto L_05d4;
KK = 74;
goto L_05d5;
L_05d4:
KK = 72;
L_05d5:
// 6042 %IF EVALREG=BREG %THEN KK=STB
if (( EVALREG ) != ( 7 )) goto L_05d6;
KK = 90;
L_05d6:
// 6043 PSORLF1(KK,C,JJJ,D)
PSORLF1(KK, C, JJJ, D);
// 6044 %IF (C&1=0 %AND STNAME>0) %OR (C=3 %AND STNAME>>16>0) %THEN NOTE ASSMENT(EVALREG,JJ-33,STNAME)
if (( ((C)) & ((1)) ) != ( 0 )) goto L_05d7;
if (( STNAME ) > ( 0 )) goto L_05d8;
L_05d7:
if (( C ) != ( 3 )) goto L_05d9;
if (( (int)(((unsigned int)(STNAME)) >> ((16))) ) <= ( 0 )) goto L_05d9;
L_05d8:
NOTEASSMENT(EVALREG, ((JJ)) - ((33)), STNAME);
L_05d9:
// 6045 %IF C>=2 %AND JJJ#7 %START; ! DR WILL BE LOADED SY STORE
if (( C ) < ( 2 )) goto L_05da;
if (( JJJ ) == ( 7 )) goto L_05da;
// 6046 %IF STNAME>0 %THEN GRUSE(DR)=7 %AND GRINF1(DR)=STNAME&16_FFFF %ELSE GRUSE(DR)=0
if (( STNAME ) <= ( 0 )) goto L_05db;
GRUSE[1] = 7;
GRINF1[1] = ((STNAME)) & ((65535));
goto L_05dc;
L_05db:
GRUSE[1] = 0;
L_05dc:
// 6047 %FINISH
L_05da:
// 6048 %IF KK=STUH %THEN GRUSE(ACCR)=0
if (( KK ) != ( 74 )) goto L_05dd;
GRUSE[0] = 0;
L_05dd:
// 6049 COMM=1; ->STRES
COMM = 1;
goto U_020b;
// 6050 FINISH: C=STK(STPTR-1)
U_020a:
C = STK[((STPTR)) - ((1))];
// 6051 OPERAND(1)=C
(OPERAND-1)[1] = C;
// 6052 OPND1==RECORD(C)
OPND1 = * /*(recfm)*/ RECORD(C);
// 6053 %IF OPND1_PTYPE>>4&15<5 %THEN OPND1_PTYPE=OPND1_PTYPE&16_F!16_50;! BITS&BYTES->INTEGERS
if (( (((int)(((unsigned int)(OPND1->PTYPE)) >> ((4))))) & ((15)) ) >= ( 5 )) goto L_05de;
OPND1->PTYPE = ((((OPND1->PTYPE)) & ((15)))) | ((80));
L_05de:
// 6054 %IF CONDFORM=0 %START; ! IN CONDS ONLY CC MATTERS
if (( CONDFORM ) != ( 0 )) goto L_05df;
// 6055 ! SKIP GETIING OPND INRIGHT FORM
// 6056 ! AND IN THE RIGHT REGISTER
// 6057 D=MODE>>4&7; D=5 %IF D<5
D = (((int)(((unsigned int)(MODE)) >> ((4))))) & ((7));
if (( D ) >= ( 5 )) goto L_05e0;
D = 5;
L_05e0:
// 6058 %IF MODE&7=2 %AND OPND1_PTYPE&7=1 %THEN FLOAT(OPND1,D<<4)
if (( ((MODE)) & ((7)) ) != ( 2 )) goto L_05e1;
if (( ((OPND1->PTYPE)) & ((7)) ) != ( 1 )) goto L_05e1;
FLOAT(OPND1, ((D)) << ((4)));
L_05e1:
// 6059 SHORTEN(OPND1) %WHILE D<OPND1_PTYPE>>4
L_05e2:
if (( D ) >= ( (int)(((unsigned int)(OPND1->PTYPE)) >> ((4))) )) goto L_05e3;
SHORTEN(OPND1);
goto L_05e2;
L_05e3:
// 6060 LENGTHEN(OPND1) %WHILE D>OPND1_PTYPE>>4
L_05e5:
if (( D ) <= ( (int)(((unsigned int)(OPND1->PTYPE)) >> ((4))) )) goto L_05e6;
LENGTHEN(OPND1);
goto L_05e5;
L_05e6:
// 6061 %IF CONSTFORM=0 %OR 2<=OPND1_FLAG#3 %THEN LOAD(OPND1,REG,2)
if (( CONSTFORM ) == ( 0 )) goto L_05e7;
if (( 2 ) > ( OPND1->FLAG )) goto L_05e8;
if (( OPND1->FLAG ) == ( 3 )) goto L_05e8;
L_05e7:
LOAD(OPND1, REG, 2);
L_05e8:
// 6062 %FINISH
L_05df:
// 6063 EXPOPND=OPND1; ! SET RESULT RECORD
EXPOPND = OPND1;
// 6064 PTYPE=OPND1_PTYPE
PTYPE = OPND1->PTYPE;
// 6065 TYPE=PTYPE&7; PREC=PTYPE>>4
TYPE = ((PTYPE)) & ((7));
PREC = (int)(((unsigned int)(PTYPE)) >> ((4)));
// 6066 %IF TYPE=2 %AND MODE&7=1 %THEN FAULT(24,0)
if (( TYPE ) != ( 2 )) goto L_05e9;
if (( ((MODE)) & ((7)) ) != ( 1 )) goto L_05e9;
FAULT(24, 0);
L_05e9:
// 6067 %IF OPND1_FLAG=9 %THEN REGISTER(OPND1_XB>>4)=0
if (( OPND1->FLAG ) != ( 9 )) goto L_05ea;
REGISTER[(int)(((unsigned int)(OPND1->XB)) >> ((4)))] = 0;
L_05ea:
// 6068 P=SAVEP
P = SAVEP;
// 6069 %RETURN
return;
// 6070 !
// 6071 %ROUTINE CHOOSE(%INTEGERNAME CHOICE)
void CHOOSE( int *CHOICE )
{
__label__ _imp_endofblock;
// 6072 %RECORD (RD) %NAME OPND1,OPND2{(RD)
RD *OPND1;
RD *OPND2;
// 6073 OPND1==RECORD(OPERAND(1))
OPND1 = * /*(recfm)*/ RECORD((OPERAND-1)[1]);
// 6074 OPND2==RECORD(OPERAND(2))
OPND2 = * /*(recfm)*/ RECORD((OPERAND-1)[2]);
// 6075 CHOICE=1
CHOICE = 1;
// 6076 %RETURN %IF JJ=21 %AND EVALREG=BREG;! NO REVERSE SUBTRACT B
if (( JJ ) != ( 21 )) goto L_05eb;
if (( EVALREG ) != ( 7 )) goto L_05eb;
return;
L_05eb:
// 6077 CHOICE=2 %IF OPCODE&16_FF00FF00=0 %OR (OPCODE&16_FF00FF#0 %AND (OPND2_FLAG=9 %OR(OPND2_FLAG=2 %AND GRUSE(EVALREG)=9 %AND GRINF1(EVALREG)=OPND2_XTRA>0)))
if (( ((OPCODE)) & ((-16711936)) ) == ( 0 )) goto L_05ec;
if (( ((OPCODE)) & ((16711935)) ) == ( 0 )) goto L_05ed;
if (( OPND2->FLAG ) == ( 9 )) goto L_05ec;
if (( OPND2->FLAG ) != ( 2 )) goto L_05ed;
if (( GRUSE[EVALREG] ) != ( 9 )) goto L_05ed;
if (( GRINF1[EVALREG] ) != ( OPND2->XTRA )) goto L_05ed;
if (( OPND2->XTRA ) <= ( 0 )) goto L_05ed;
L_05ec:
CHOICE = 2;
L_05ed:
// 6078 %END
return;
_imp_endofblock: ;
} // End of block CHOOSE at level 6
// 6079 %ROUTINE LOAD(%RECORD (RD) %NAME OPND,%INTEGER REG,MODE)
void LOAD( RD *OPND, int REG, int MODE )
{
__label__ _imp_endofblock;
// 6080 !***********************************************************************
// 6081 !* LOAD OPERAND OPND AS DIRECTED BY MODE TO REGISTER REG *
// 6082 !* MODE=0 LEAVE IN STORE IF POSSIBLE *
// 6083 !* MODE=1 LEAVE IN STORE IF SUITABLE FOR RX INSTRUCTIONS *
// 6084 !* MODE=2 LOAD TO REGISTER REGARDLESS *
// 6085 !***********************************************************************
// 6086 %INTEGER K,KK
int K;
int KK;
// 6087 {%RECORDSPEC OPND(RD)
// 6088 %SWITCH SW(0:9)
static int SW_idx;
static const void * /*SWITCH*/ SW[(9)-(0)+1] = { &&SW_0, &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, &&SW_6, &&SW_7, &&SW_8, &&SW_9, };
// 6089 K=OPND_FLAG
K = OPND->FLAG;
// 6090 %RETURN %UNLESS MODE=2 %OR K=2 %OR(K<=3 %AND MODE=1)
if (( MODE ) == ( 2 )) goto L_05ee;
if (( K ) == ( 2 )) goto L_05ee;
if (( K ) > ( 3 )) goto L_05ef;
if (( MODE ) == ( 1 )) goto L_05ee;
L_05ef:
return;
L_05ee:
// 6091 PTYPE=OPND_PTYPE
PTYPE = OPND->PTYPE;
// 6092 TYPE=PTYPE&15
TYPE = ((PTYPE)) & ((15));
// 6093 PREC=PTYPE>>4
PREC = (int)(((unsigned int)(PTYPE)) >> ((4)));
// 6094 %IF K<0 %OR K>9 %THEN ABORT
if (( K ) < ( 0 )) goto L_05f0;
if (( K ) <= ( 9 )) goto L_05f1;
L_05f0:
ABORT();
L_05f1:
// 6095 ->SW(K)
SW_idx = K; if ((0 <= K_idx) && (K_idx <= 9)) goto *K[K_idx]; else {/*_imp_signal(6, K_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index K(%d) not in range 0:9 at %s:%d\n", K_idx, _imp_current_file, _imp_current_line); exit(1); }
// 6096 SW(0):LITCONST: ! CONSTANT < 18 BITS
SW_0:
U_0217:
// 6097 AREA=0; ACCESS=0
AREA = 0;
ACCESS = 0;
// 6098 %IF PREC<=5 %THEN DISP=OPND_D %ELSE %START
if (( PREC ) > ( 5 )) goto L_05f2;
DISP = OPND->D;
goto L_05f3;
L_05f2:
// 6099 DISP=OPND_XTRA
DISP = OPND->XTRA;
// 6100 ABORT %UNLESS (DISP>=0 %AND OPND_D=0) %OR (DISP<0 %AND OPND_D=-1)
if (( DISP ) < ( 0 )) goto L_05f4;
if (( OPND->D ) == ( 0 )) goto L_05f5;
L_05f4:
if (( DISP ) >= ( 0 )) goto L_05f6;
if (( OPND->D ) == ( (-(1)) )) goto L_05f5;
L_05f6:
ABORT();
L_05f5:
// 6101 %FINISH
L_05f3:
// 6102 %IF MODE=2 %THEN %START; ! FETCH TO REG
if (( MODE ) != ( 2 )) goto L_05f7;
// 6103 %IF GRUSE(REG)&255=5=PREC %AND GRINF1(REG)=DISP %START
if (( ((GRUSE[REG])) & ((255)) ) != ( 5 )) goto L_05f8;
if (( 5 ) != ( PREC )) goto L_05f8;
if (( GRINF1[REG] ) != ( DISP )) goto L_05f8;
// 6104 %IF REGISTER(REG)#0 %THEN BOOT OUT(REG)
if (( REGISTER[REG] ) == ( 0 )) goto L_05f9;
BOOTOUT(REG);
L_05f9:
// 6105 %FINISHELSE GET IN ACC(REG,BYTES(PREC)>>2,ACCESS,AREA,DISP)
goto L_05fa;
L_05f8:
GETINACC(REG, (int)(((unsigned int)(BYTES[PREC])) >> ((2))), ACCESS, AREA, DISP);
L_05fa:
// 6106 %IF PREC<=5 %THEN GRUSE(REG)=5 %AND GRINF1(REG)=DISP
if (( PREC ) > ( 5 )) goto L_05fb;
GRUSE[REG] = 5;
GRINF1[REG] = DISP;
L_05fb:
// 6107 ->LDED
goto U_0218;
// 6108 %FINISH
L_05f7:
// 6109 %IF PREC=3 %THEN OPND_PTYPE=16_51; ! CONSTBYTEINTEGERS AGAIN
if (( PREC ) != ( 3 )) goto L_05fc;
OPND->PTYPE = 81;
L_05fc:
// 6110 OPND_FLAG=7; OPND_XB=AREA<<4!ACCESS
OPND->FLAG = 7;
OPND->XB = ((((AREA)) << ((4)))) | ((ACCESS));
// 6111 OPND_D=DISP
OPND->D = DISP;
// 6112 %RETURN
return;
// 6113 SW(1): ! LONG CONSTANT
SW_1:
// 6114 %IF OPND_D=0=OPND_XTRA %AND PREC<=6 %THEN ->LITCONST
if (( OPND->D ) != ( 0 )) goto L_05fd;
if (( 0 ) != ( OPND->XTRA )) goto L_05fd;
if (( PREC ) > ( 6 )) goto L_05fd;
goto U_0217;
L_05fd:
// 6115 SW(3): ! 128 BIT CONSTANT
SW_3:
// 6116 %IF PREC=7 %THEN KK=OPND_XTRA %ELSE KK=ADDR(OPND_D)
if (( PREC ) != ( 7 )) goto L_05fe;
KK = OPND->XTRA;
goto L_05ff;
L_05fe:
KK = ADDR( &OPND->D);
L_05ff:
// 6117 STORE CONST(DISP,BYTES(PREC),KK)
STORECONST( &DISP, BYTES[PREC], KK);
// 6118 %IF MODE#2 %THEN %START
if (( MODE ) == ( 2 )) goto L_0600;
// 6119 OPND_FLAG=7; OPND_XB=PC<<4
OPND->FLAG = 7;
OPND->XB = ((4)) << ((4));
// 6120 OPND_D=DISP; %RETURN
OPND->D = DISP;
return;
// 6121 %FINISH
L_0600:
// 6122 %IF GRUSE(REG)&255=6 %AND GRINF1(REG)=DISP %THEN %START
if (( ((GRUSE[REG])) & ((255)) ) != ( 6 )) goto L_0601;
if (( GRINF1[REG] ) != ( DISP )) goto L_0601;
// 6123 %IF REGISTER(REG)#0 %THEN BOOT OUT (REG)
if (( REGISTER[REG] ) == ( 0 )) goto L_0602;
BOOTOUT(REG);
L_0602:
// 6124 %FINISH %ELSE GET IN ACC(REG,BYTES(PREC)>>2,0,PC,DISP)
goto L_0603;
L_0601:
GETINACC(REG, (int)(((unsigned int)(BYTES[PREC])) >> ((2))), 0, 4, DISP);
L_0603:
// 6125 GRUSE(REG)=6; GRINF1(REG)=DISP
GRUSE[REG] = 6;
GRINF1[REG] = DISP;
// 6126 ->LDED
goto U_0218;
// 6127 SW(2): ! NAME
SW_2:
// 6128 P=OPND_D
P = OPND->D;
// 6129 -> LOAD %IF MODE=2 %OR OPND_XB#0;! COMPLEX NAMES MUST BE LOADED
if (( MODE ) == ( 2 )) goto L_0604;
if (( OPND->XB ) == ( 0 )) goto L_0605;
L_0604:
goto U_0219;
L_0605:
// 6130 CNAME(5,REG)
CNAME(5, REG);
// 6131 ->LDED %IF NEST>=0
if (( NEST ) < ( 0 )) goto L_0606;
goto U_0218;
L_0606:
// 6132 AREA=-1
AREA = (-(1));
// 6133 AREA=AREA CODE
AREA = AREACODE();
// 6134 OPND_PTYPE<-PTYPE
OPND->PTYPE = PTYPE;
// 6135 OPND_FLAG=7
OPND->FLAG = 7;
// 6136 OPND_XB=AREA<<4!ACCESS
OPND->XB = ((((AREA)) << ((4)))) | ((ACCESS));
// 6137 OPND_D=DISP; %RETURN
OPND->D = DISP;
return;
// 6138 LOAD: CNAME(2,REG)
U_0219:
CNAME(2, REG);
// 6139 LDED: REGISTER(REG)=1; ! CLAIM THE REGISTER
U_0218:
REGISTER[REG] = 1;
// 6140 OLINK(REG)=ADDR(OPND)
OLINK[REG] = ADDR(OPND);
// 6141 %IF PREC<5 %THEN OPND_PTYPE=OPND_PTYPE&15!16_50
if (( PREC ) >= ( 5 )) goto L_0607;
OPND->PTYPE = ((((OPND->PTYPE)) & ((15)))) | ((80));
L_0607:
// 6142 OPND_FLAG=9; OPND_D=0; OPND_XB=REG<<4
OPND->FLAG = 9;
OPND->D = 0;
OPND->XB = ((REG)) << ((4));
// 6143 %IF REG=BREG %AND REGISTER(ACCR)&1#0 %THEN REGISTER(BREG)=2
if (( REG ) != ( 7 )) goto L_0608;
if (( ((REGISTER[0])) & ((1)) ) == ( 0 )) goto L_0608;
REGISTER[7] = 2;
L_0608:
// 6144 %RETURN
return;
// 6145 SW(4): ! CONDITIONAL EXPRESSION
SW_4:
// 6146 SW(5): ! UNASSIGNED
SW_5:
// 6147 SW(6): ! UNASSIGNED
SW_6:
// 6148 ABORT
ABORT();
// 6149 SW(7): ! I-R IN A STACK FRAME
SW_7:
// 6150 AREA=OPND_XB>>4
AREA = (int)(((unsigned int)(OPND->XB)) >> ((4)));
// 6151 ACCESS=OPND_XB&15
ACCESS = ((OPND->XB)) & ((15));
// 6152 DISP=OPND_D
DISP = OPND->D;
// 6153 PICKUP: GET IN ACC(REG,BYTES(PREC)>>2,ACCESS,AREA,DISP)
U_021a:
GETINACC(REG, (int)(((unsigned int)(BYTES[PREC])) >> ((2))), ACCESS, AREA, DISP);
// 6154 ->LDED
goto U_0218;
// 6155 SW(8): ! I-R THAT HAS BEEN STACKED
SW_8:
// 6156 AREA=TOS; ACCESS=0; DISP=0; ->PICK UP
AREA = 6;
ACCESS = 0;
DISP = 0;
goto U_021a;
// 6157 SW(9): ! I-R IN A REGISTER
SW_9:
// 6158 %IF OPND_XB>>4=REG %THEN -> LDED
if (( (int)(((unsigned int)(OPND->XB)) >> ((4))) ) != ( REG )) goto L_0609;
goto U_0218;
L_0609:
// 6159 %IF REG#ACCR %THEN %START
if (( REG ) == ( 0 )) goto L_060a;
// 6160 BOOT OUT(BREG) %UNLESS REGISTER(BREG)=0
if (( REGISTER[7] ) == ( 0 )) goto L_060b;
BOOTOUT(7);
L_060b:
// 6161 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 6162 %FINISH %ELSE GET IN ACC(ACCR,1,0,BREG,0)
goto L_060c;
L_060a:
GETINACC(0, 1, 0, 7, 0);
L_060c:
// 6163 REGISTER(OPND_XB>>4)=0
REGISTER[(int)(((unsigned int)(OPND->XB)) >> ((4)))] = 0;
// 6164 OPND_XB=REG<<4; GRUSE(REG)=0
OPND->XB = ((REG)) << ((4));
GRUSE[REG] = 0;
// 6165 REGISTER(REG)=1; OLINK(REG)=ADDR(OPND)
REGISTER[REG] = 1;
OLINK[REG] = ADDR(OPND);
// 6166 %END
return;
_imp_endofblock: ;
} // End of block LOAD at level 6
// 6167 %ROUTINE PUT
void PUT( void )
{
__label__ _imp_endofblock;
// 6168 !***********************************************************************
// 6169 !* THIS ROUTINE PLANTS CODE TO PERFORM THE BASIC *
// 6170 !* OPERATION DEFINED BY OPND1,OPND2 & OPCODE *
// 6171 !***********************************************************************
// 6172 %INTEGER CODE,OCODE
int CODE;
int OCODE;
// 6173 CODE=OPCODE
CODE = OPCODE;
// 6174 %IF COMM=1 %THEN CODE=CODE>>8
if (( COMM ) != ( 1 )) goto L_060d;
CODE = (int)(((unsigned int)(CODE)) >> ((8)));
L_060d:
// 6175 CODE=CODE&255; OCODE=CODE
CODE = ((CODE)) & ((255));
OCODE = CODE;
// 6176 %IF EVALREG=BREG %THEN CODE=CODE-16_C0
if (( EVALREG ) != ( 7 )) goto L_060e;
CODE = ((CODE)) - ((192));
L_060e:
// 6177 ABORT %UNLESS OPND1_FLAG=9
if (( OPND1->FLAG ) == ( 9 )) goto L_060f;
ABORT();
L_060f:
// 6178 PSORLF1(CODE,OPND2_XB&15,OPND2_XB>>4,OPND2_D)
PSORLF1(CODE, ((OPND2->XB)) & ((15)), (int)(((unsigned int)(OPND2->XB)) >> ((4))), OPND2->D);
// 6179 %IF OCODE=IAD %AND GRUSE(EVALREG)=9 %AND OPND2_XB=0 %AND OPND2_D<4095 %AND GRINF1(EVALREG)>>16=0 %THEN %START
if (( OCODE ) != ( 224 )) goto L_0610;
if (( GRUSE[EVALREG] ) != ( 9 )) goto L_0610;
if (( OPND2->XB ) != ( 0 )) goto L_0610;
if (( OPND2->D ) >= ( 4095 )) goto L_0610;
if (( (int)(((unsigned int)(GRINF1[EVALREG])) >> ((16))) ) != ( 0 )) goto L_0610;
// 6180 GRUSE(EVALREG)=10
GRUSE[EVALREG] = 10;
// 6181 GRINF1(EVALREG)=GRINF1(EVALREG)&16_FFFF!OPND2_D<<16
GRINF1[EVALREG] = ((((GRINF1[EVALREG])) & ((65535)))) | ((((OPND2->D)) << ((16))));
// 6182 %FINISH %ELSE %START
goto L_0611;
L_0610:
// 6183 GRUSE(EVALREG)=0 %UNLESS 31<=JJ<=32
if (( 31 ) > ( JJ )) goto L_0612;
if (( JJ ) <= ( 32 )) goto L_0613;
L_0612:
GRUSE[EVALREG] = 0;
L_0613:
// 6184 %FINISH
L_0611:
// 6185 OLINK(EVALREG)=OPERAND(COMM)
OLINK[EVALREG] = (OPERAND-1)[COMM];
// 6186 %END
return;
_imp_endofblock: ;
} // End of block PUT at level 6
// 6187 %ROUTINE FLOAT(%RECORD(RD)%NAME OPND,%INTEGER OTHERPTYPE)
void FLOAT( RD *OPND, int OTHERPTYPE )
{
__label__ _imp_endofblock;
// 6188 !***********************************************************************
// 6189 !* PLANT CODE TO CONERT OPERAND FROM FIXED TO FLOATING *
// 6190 !***********************************************************************
// 6191 {%RECORDSPEC OPND(RD)
// 6192 %IF OPND_FLAG<=1 %THEN %START
if (( OPND->FLAG ) > ( 1 )) goto L_0614;
// 6193 CVALUE=OPND_D
CVALUE = OPND->D;
// 6194 OPND_D=INTEGER(ADDR(CVALUE))
OPND->D = *INTEGER(ADDR( &CVALUE));
// 6195 OPND_XTRA=INTEGER(ADDR(CVALUE)+4)
OPND->XTRA = *INTEGER(((ADDR( &CVALUE))) + ((4)));
// 6196 OPND_FLAG=1
OPND->FLAG = 1;
// 6197 %FINISH %ELSE %START
goto L_0615;
L_0614:
// 6198 LOAD(OPND,ACCR,2)
LOAD(OPND, 0, 2);
// 6199 %IF OTHERPTYPE&16_F0=16_70 %AND OPND_PTYPE&16_F0<=16_50 %THEN PSF1(IMYD,0,1) %AND OPND_PTYPE=OPND_PTYPE&15!16_60
if (( ((OTHERPTYPE)) & ((240)) ) != ( 112 )) goto L_0616;
if (( ((OPND->PTYPE)) & ((240)) ) > ( 80 )) goto L_0616;
PSF1(236, 0, 1);
OPND->PTYPE = ((((OPND->PTYPE)) & ((15)))) | ((96));
L_0616:
// 6200 PSF1(FLT,0,0)
PSF1(168, 0, 0);
// 6201 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 6202 %FINISH
L_0615:
// 6203 OPND_PTYPE=OPND_PTYPE+16_11
OPND->PTYPE = ((OPND->PTYPE)) + ((17));
// 6204 TYPE=2
TYPE = 2;
// 6205 %END
return;
_imp_endofblock: ;
} // End of block FLOAT at level 6
// 6206 %ROUTINE COERCET(%RECORD(RD)%NAME OPND1,OPND2,%INTEGER MODE)
void COERCET( RD *OPND1, RD *OPND2, int MODE )
{
__label__ _imp_endofblock;
// 6207 !***********************************************************************
// 6208 !* MODE=1 BOTH OPERANDS INTEGER ELSE ERROR *
// 6209 !* MODE=2 FORCE BOTH OPERAND TO BE OF TYPE REAL *
// 6210 !* MODE=15 BOTH OPERANDS TO BE OF LAGEST TYPE *
// 6211 !***********************************************************************
// 6212 {%RECORDSPEC OPND1(RD)
// 6213 {%RECORDSPEC OPND2(RD)
// 6214 %INTEGER PT1,PT2
int PT1;
int PT2;
// 6215 PT1=OPND1_PTYPE&7
PT1 = ((OPND1->PTYPE)) & ((7));
// 6216 PT2=OPND2_PTYPE&7
PT2 = ((OPND2->PTYPE)) & ((7));
// 6217 %IF (MODE=1 %OR MODE=15) %AND PT1=1=PT2 %THEN %RETURN
if (( MODE ) == ( 1 )) goto L_0617;
if (( MODE ) != ( 15 )) goto L_0618;
L_0617:
if (( PT1 ) != ( 1 )) goto L_0618;
if (( 1 ) != ( PT2 )) goto L_0618;
return;
L_0618:
// 6218 %IF MODE=1 %THEN FAULT(24,0) %AND %RETURN
if (( MODE ) != ( 1 )) goto L_0619;
FAULT(24, 0);
return;
L_0619:
// 6219 %IF PT1=1 %THEN FLOAT(OPND1,OPND2_PTYPE)
if (( PT1 ) != ( 1 )) goto L_061a;
FLOAT(OPND1, OPND2->PTYPE);
L_061a:
// 6220 %IF PT2=1 %THEN FLOAT(OPND2,OPND1_PTYPE)
if (( PT2 ) != ( 1 )) goto L_061b;
FLOAT(OPND2, OPND1->PTYPE);
L_061b:
// 6221 %END
return;
_imp_endofblock: ;
} // End of block COERCET at level 6
// 6222 %ROUTINE COERCEP(%RECORD(RD)%NAME OPND1,OPND2)
void COERCEP( RD *OPND1, RD *OPND2 )
{
__label__ _imp_endofblock;
// 6223 !***********************************************************************
// 6224 !* FORCE BOTH OPERAND TO THE SAME PRECISION BEFORE OPRNTN *
// 6225 !***********************************************************************
// 6226 {%RECORDSPEC OPND1(RD)
// 6227 {%RECORDSPEC OPND2(RD)
// 6228 %INTEGER PREC1,PREC2
int PREC1;
int PREC2;
// 6229 PREC1=OPND1_PTYPE>>4
PREC1 = (int)(((unsigned int)(OPND1->PTYPE)) >> ((4)));
// 6230 PREC2=OPND2_PTYPE>>4
PREC2 = (int)(((unsigned int)(OPND2->PTYPE)) >> ((4)));
// 6231 %WHILE PREC1<PREC2 %CYCLE
L_061c:
if (( PREC1 ) >= ( PREC2 )) goto L_061d;
// 6232 LENGTHEN(OPND1)
LENGTHEN(OPND1);
// 6233 PREC1=OPND1_PTYPE>>4
PREC1 = (int)(((unsigned int)(OPND1->PTYPE)) >> ((4)));
// 6234 %REPEAT
goto L_061c;
L_061d:
// 6235 !
// 6236 %WHILE PREC2<PREC1 %CYCLE
L_061f:
if (( PREC2 ) >= ( PREC1 )) goto L_0620;
// 6237 LENGTHEN(OPND2)
LENGTHEN(OPND2);
// 6238 PREC2=OPND2_PTYPE>>4
PREC2 = (int)(((unsigned int)(OPND2->PTYPE)) >> ((4)));
// 6239 %REPEAT
goto L_061f;
L_0620:
// 6240 %END
return;
_imp_endofblock: ;
} // End of block COERCEP at level 6
// 6241 %ROUTINE LENGTHEN(%RECORD(RD)%NAME OPND)
void LENGTHEN( RD *OPND )
{
__label__ _imp_endofblock;
// 6242 !***********************************************************************
// 6243 !* INCREASE OPND PRECISION BY ONE SIZE AT COMPILE TIME IF POSS *
// 6244 !***********************************************************************
// 6245 {%RECORDSPEC OPND(RD)
// 6246 %INTEGER TP,PR
int TP;
int PR;
// 6247 TP=OPND_PTYPE&7
TP = ((OPND->PTYPE)) & ((7));
// 6248 PR=OPND_PTYPE>>4
PR = (int)(((unsigned int)(OPND->PTYPE)) >> ((4)));
// 6249 %IF OPND_FLAG<=1 %AND PR<=4+TP %START; ! LENGTHEN CONSTANT
if (( OPND->FLAG ) > ( 1 )) goto L_0622;
if (( PR ) > ( ((4)) + ((TP)) )) goto L_0622;
// 6250 %IF TP=1 %AND OPND_FLAG<=1 %START;! INTEGER CONSTANT
if (( TP ) != ( 1 )) goto L_0623;
if (( OPND->FLAG ) > ( 1 )) goto L_0623;
// 6251 OPND_XTRA=OPND_D
OPND->XTRA = OPND->D;
// 6252 %IF OPND_XTRA<0 %THEN OPND_D=-1 %ELSE OPND_D=0
if (( OPND->XTRA ) >= ( 0 )) goto L_0624;
OPND->D = (-(1));
goto L_0625;
L_0624:
OPND->D = 0;
L_0625:
// 6253 %FINISH %ELSE %START
goto L_0626;
L_0623:
// 6254 %IF PR=6 %THEN %START
if (( PR ) != ( 6 )) goto L_0627;
// 6255 TOAR8(R,LONGREAL(ADDR(OPND_D)))
TOAR8(R, **LONGREAL(ADDR( &OPND->D)));
// 6256 TOAR8(R+8,0)
TOAR8(((R)) + ((8)), 0);
// 6257 OPND_XTRA=ADDR(A(R))
OPND->XTRA = ADDR( &A[R]);
// 6258 OPND_FLAG=3
OPND->FLAG = 3;
// 6259 R=R+16
R = ((R)) + ((16));
// 6260 %FINISH %ELSE OPND_XTRA=0
goto L_0628;
L_0627:
OPND->XTRA = 0;
L_0628:
// 6261 %FINISH
L_0626:
// 6262 %FINISH %ELSE %START; ! CODE PLANTING REQRD
goto L_0629;
L_0622:
// 6263 LOAD(OPND,ACCR,2)
LOAD(OPND, 0, 2);
// 6264 %IF TP=1 %THEN PSF1(IMYD,0,1) %ELSE PF1(RMYD,0,PC,SPECIAL CONSTS(1));! REAL ONE=16_41000000
if (( TP ) != ( 1 )) goto L_062a;
PSF1(236, 0, 1);
goto L_062b;
L_062a:
PF1(252, 0, 4, SPECIALCONSTS(1));
L_062b:
// 6265 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 6266 %FINISH
L_0629:
// 6267 OPND_PTYPE=(PR+1)<<4+TP
OPND->PTYPE = ((((((PR)) + ((1)))) << ((4)))) + ((TP));
// 6268 %END
return;
_imp_endofblock: ;
} // End of block LENGTHEN at level 6
// 6269 %ROUTINE SHORTEN(%RECORD(RD)%NAME OPND)
void SHORTEN( RD *OPND )
{
__label__ _imp_endofblock;
// 6270 !***********************************************************************
// 6271 !* PLANT CODE TO REDUCE ACC SIZE *
// 6272 !***********************************************************************
// 6273 {%RECORDSPEC OPND(RD)
// 6274 %INTEGER TY,PR,F,I,J
int TY;
int PR;
int F;
int I;
int J;
// 6275 TY=OPND_PTYPE&7
TY = ((OPND->PTYPE)) & ((7));
// 6276 PR=OPND_PTYPE>>4
PR = (int)(((unsigned int)(OPND->PTYPE)) >> ((4)));
// 6277 F=OPND_FLAG
F = OPND->FLAG;
// 6278 %IF F=3 %START; ! LONGLONGREAL CONSTS
if (( F ) != ( 3 )) goto L_062c;
// 6279 %CYCLE I=0,1,3
I = ((0)) - ((1));
L_062d:
if (( I ) == ( 3 )) goto L_062e;
I = ((I)) + ((1));
// 6280 BYTEINTEGER(ADDR(J)+I)=BYTEINTEGER(OPND_XTRA+4+I)
*BYTEINTEGER(((ADDR( &J))) + ((I))) = *BYTEINTEGER(((((OPND->XTRA)) + ((4)))) + ((I)));
// 6281 %REPEAT
goto L_062d;
L_062e:
// 6282 OPND_XTRA=J
OPND->XTRA = J;
// 6283 OPND_FLAG=1; ! CONST NOW IN _D & _XTRA
OPND->FLAG = 1;
// 6284 ->WAYOUT
goto U_0217;
// 6285 %FINISH
L_062c:
// 6286 %IF F<=1 %START
if (( F ) > ( 1 )) goto L_0630;
// 6287 %IF TY=2 %THEN ->WAYOUT
if (( TY ) != ( 2 )) goto L_0631;
goto U_0217;
L_0631:
// 6288 %IF (OPND_D=0 %AND OPND_XTRA>=0) %OR (OPND_D=-1 %AND OPND_XTRA<0) %THEN OPND_D=OPND_XTRA %AND ->WAYOUT
if (( OPND->D ) != ( 0 )) goto L_0632;
if (( OPND->XTRA ) >= ( 0 )) goto L_062f;
L_0632:
if (( OPND->D ) != ( (-(1)) )) goto L_0633;
if (( OPND->XTRA ) >= ( 0 )) goto L_0633;
L_062f:
OPND->D = OPND->XTRA;
goto U_0217;
L_0633:
// 6289 %FINISH
L_0630:
// 6290 LOAD(OPND,ACCR,2)
LOAD(OPND, 0, 2);
// 6291 %IF PR=7 %THEN %START; ! SHORTEN QUAD
if (( PR ) != ( 7 )) goto L_0634;
// 6292 PF1(RDDV,0,PC,SPECIAL CONSTS(1))
PF1(190, 0, 4, SPECIALCONSTS(1));
// 6293 %FINISH %ELSE %START
goto L_0635;
L_0634:
// 6294 %IF TYPE=1=PARMARR %THEN PSF1(ISH,0,32)
if (( TYPE ) != ( 1 )) goto L_0636;
if (( 1 ) != ( PARMARR )) goto L_0636;
PSF1(232, 0, 32);
L_0636:
// 6295 PSF1(USH,0,-32) %IF PARMARR=1 %OR TYPE#1
if (( PARMARR ) == ( 1 )) goto L_0637;
if (( TYPE ) == ( 1 )) goto L_0638;
L_0637:
PSF1(200, 0, (-(32)));
L_0638:
// 6296 %IF REGISTER(BREG)=0 %THEN PF1(STUH,0,BREG,0) %AND GRUSE(BREG)=0 %ELSE PSF1(MPSR,0,17);! ACS TO 1 WORD
if (( REGISTER[7] ) != ( 0 )) goto L_0639;
PF1(74, 0, 7, 0);
GRUSE[7] = 0;
goto L_063a;
L_0639:
PSF1(50, 0, 17);
L_063a:
// 6297 %FINISH
L_0635:
// 6298 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 6299 WAYOUT:
U_0217:
// 6300 OPND_PTYPE=(PR-1)<<4+TY
OPND->PTYPE = ((((((PR)) - ((1)))) << ((4)))) + ((TY));
// 6301 %END
return;
_imp_endofblock: ;
} // End of block SHORTEN at level 6
// 6302 %ROUTINE EXTRACT(%RECORD(RD)%NAME OPND,%LONGINTEGERNAME VAL,{%LONG}%LONGREALNAME RVAL)
void EXTRACT( RD *OPND, long long int *VAL, double *RVAL )
{
__label__ _imp_endofblock;
// 6303 !***********************************************************************
// 6304 !* EXTRACTS A CONTANT OPERAND RETURNING REAL &INT VALUES *
// 6305 !***********************************************************************
// 6306 {%RECORDSPEC OPND(RD)
// 6307 %INTEGER TYPE,PREC,S,I,AD
int TYPE;
int PREC;
int S;
int I;
int AD;
// 6308 TYPE=OPND_PTYPE; PREC=TYPE>>4
TYPE = OPND->PTYPE;
PREC = (int)(((unsigned int)(TYPE)) >> ((4)));
// 6309 TYPE=TYPE&15
TYPE = ((TYPE)) & ((15));
// 6310 %IF TYPE=1 %THEN %START
if (( TYPE ) != ( 1 )) goto L_063b;
// 6311 %IF PREC<=5 %THEN VAL=OPND_D %ELSE %START
if (( PREC ) > ( 5 )) goto L_063c;
VAL = OPND->D;
goto L_063d;
L_063c:
// 6312 INTEGER(ADDR(VAL))=OPND_D
*INTEGER(ADDR(VAL)) = OPND->D;
// 6313 INTEGER(ADDR(VAL)+4)=OPND_XTRA
*INTEGER(((ADDR(VAL))) + ((4))) = OPND->XTRA;
// 6314 %FINISH
L_063d:
// 6315 RVAL=VAL
RVAL = VAL;
// 6316 %FINISH %ELSE %START
goto L_063e;
L_063b:
// 6317 RVAL=0
RVAL = 0;
// 6318 %IF PREC=7 %THEN S=15 %AND AD=OPND_XTRA %ELSE S=7 %AND AD=ADDR(OPND_D)
if (( PREC ) != ( 7 )) goto L_063f;
S = 15;
AD = OPND->XTRA;
goto L_0640;
L_063f:
S = 7;
AD = ADDR( &OPND->D);
L_0640:
// 6319 %CYCLE I=0,1,S
I = ((0)) - ((1));
L_0641:
if (( I ) == ( S )) goto L_0642;
I = ((I)) + ((1));
// 6320 BYTEINTEGER(ADDR(RVAL)+I)=BYTEINTEGER(AD+I)
*BYTEINTEGER(((ADDR(RVAL))) + ((I))) = *BYTEINTEGER(((AD)) + ((I)));
// 6321 %REPEAT
goto L_0641;
L_0642:
// 6322 %FINISH
L_063e:
// 6323 %END
return;
_imp_endofblock: ;
} // End of block EXTRACT at level 6
// 6324
// 6325 %ROUTINE VMY1
void VMY1( void )
{
__label__ _imp_endofblock;
// 6326 !***********************************************************************
// 6327 !* DOES VECTOR MULTIPLIES FOR ONE DIMENSION ARRAYS *
// 6328 !***********************************************************************
// 6329 %INTEGER OPNAME,VUSE,DVPOS,DVNAME,X,Y,DTYPE,DPREC,DACC,DPTYPE
int OPNAME;
int VUSE;
int DVPOS;
int DVNAME;
int X;
int Y;
int DTYPE;
int DPREC;
int DACC;
int DPTYPE;
// 6330 DPTYPE=XTRA>>16
DPTYPE = (int)(((unsigned int)(XTRA)) >> ((16)));
// 6331 DVNAME=XTRA&16_FFFF
DVNAME = ((XTRA)) & ((65535));
// 6332 DVPOS=OPND2_D&16_FFFF
DVPOS = ((OPND2->D)) & ((65535));
// 6333 %IF DVPOS>0 %AND OPND1_FLAG<=1 %START;! CONST ITEM & DV FOLD IT
if (( DVPOS ) <= ( 0 )) goto L_0644;
if (( OPND1->FLAG ) > ( 1 )) goto L_0644;
// 6334 X=OPND1_D
X = OPND1->D;
// 6335 X=X-CTABLE_val(DVPOS+3)
X = ((X)) - ((/* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((3))]));
// 6336 X=X*CTABLE_val(DVPOS+4)
X = ((X)) * ((/* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((4))]));
// 6337 %IF X<0 %OR X>=CTABLE_val(DVPOS+5) %THEN FAULT2(50,X,DVNAME)
if (( X ) < ( 0 )) goto L_0643;
if (( X ) < ( /* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((5))] )) goto L_0645;
L_0643:
FAULT2(50, X, DVNAME);
L_0645:
// 6338 !
// 6339 ! IF ARRAY BASE HAS BEEN SHIFTED TO ZERO ELEMENT PUT BACK THE LB CORRN
// 6340 ! NOW THE BOUND CHECK HAS BEEN COMPUTED
// 6341 !
// 6342 %IF PARMARR=0=PARMCHK %AND DPTYPE&16_C0F<=3 %THEN X=X+CTABLE_val(DVPOS+3)*CTABLE_val(DVPOS+4)
if (( PARMARR ) != ( 0 )) goto L_0646;
if (( 0 ) != ( PARMCHK )) goto L_0646;
if (( ((DPTYPE)) & ((3087)) ) > ( 3 )) goto L_0646;
X = ((X)) + ((((/* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((3))])) * ((/* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((4))]))));
L_0646:
// 6343 OPND1_D=X
OPND1->D = X;
// 6344 %RETURN
return;
// 6345 %FINISH
L_0644:
// 6346 OPNAME=-1
OPNAME = (-(1));
// 6347 %IF OPND1_FLAG=2 %THEN OPNAME=OPND1_XTRA
if (( OPND1->FLAG ) != ( 2 )) goto L_0647;
OPNAME = OPND1->XTRA;
L_0647:
// 6348 VUSE=DVNAME!OPNAME<<16
VUSE = ((DVNAME)) | ((((OPNAME)) << ((16))));
// 6349 %IF OPNAME>=0 %AND GRUSE(BREG)=14 %AND GRINF1(BREG)= VUSE %THEN ->DONE
if (( OPNAME ) < ( 0 )) goto L_0648;
if (( GRUSE[7] ) != ( 14 )) goto L_0648;
if (( GRINF1[7] ) != ( VUSE )) goto L_0648;
goto U_021c;
L_0648:
// 6350 %IF PARMARR=0=PARMCHK %AND DVPOS>0 %START
if (( PARMARR ) != ( 0 )) goto L_0649;
if (( 0 ) != ( PARMCHK )) goto L_0649;
if (( DVPOS ) <= ( 0 )) goto L_0649;
// 6351 LOAD(OPND1,BREG,2)
LOAD(OPND1, 7, 2);
// 6352 X=CTABLE_val(DVPOS+4)
X = /* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((4))];
// 6353 %IF X#1 %THEN PSF1(MYB,0,X) %AND GRUSE(BREG)=0
if (( X ) == ( 1 )) goto L_064a;
PSF1(42, 0, X);
GRUSE[7] = 0;
L_064a:
// 6354 Y=X*CTABLE_val(DVPOS+3)
Y = ((X)) * ((/* No array bound info found for: */CTABLE->VAL[((DVPOS)) + ((3))]));
// 6355 %IF DPTYPE&16_C0F<=3 %THEN %START
if (( ((DPTYPE)) & ((3087)) ) > ( 3 )) goto L_064b;
// 6356 %IF X#1 %THEN ->DONE
if (( X ) == ( 1 )) goto L_064c;
goto U_021c;
L_064c:
// 6357 ->OUT
goto U_021d;
// 6358 %FINISH
L_064b:
// 6359 ! TEST NAM=0 WHEN ZERO ADJSTD
// 6360 %IF Y#0 %THEN PSF1(SBB,0,Y) %AND GRUSE(BREG)=0
if (( Y ) == ( 0 )) goto L_064d;
PSF1(34, 0, Y);
GRUSE[7] = 0;
L_064d:
// 6361 ->DONE
goto U_021c;
// 6362 %FINISH
L_0649:
// 6363 %IF PARMARR=0=PARMCHK %AND (DPTYPE&16_300=16_200 %OR DPTYPE&16_C0F<=3 %OR COMPILER#0)%START;! IE ARR=2 OR NAM=0
if (( PARMARR ) != ( 0 )) goto L_064e;
if (( 0 ) != ( PARMCHK )) goto L_064e;
if (( ((DPTYPE)) & ((768)) ) == ( 512 )) goto L_0621;
if (( ((DPTYPE)) & ((3087)) ) <= ( 3 )) goto L_0621;
if (( COMPILER ) == ( 0 )) goto L_064e;
L_0621:
// 6364 DTYPE=DPTYPE&15; DPREC=DPTYPE>>4&7
DTYPE = ((DPTYPE)) & ((15));
DPREC = (((int)(((unsigned int)(DPTYPE)) >> ((4))))) & ((7));
// 6365 LOAD (OPND1,BREG,2) %UNLESS OPND1_FLAG<=1
if (( OPND1->FLAG ) <= ( 1 )) goto L_064f;
LOAD(OPND1, 7, 2);
L_064f:
// 6366 %IF DTYPE>=3 %OR DPREC=4 %THEN %START
if (( DTYPE ) >= ( 3 )) goto L_0650;
if (( DPREC ) != ( 4 )) goto L_0651;
L_0650:
// 6367 DACC=LIST_S3; ! PUT THERE BY CANAME
DACC = LIST->S3;
// 6368 %IF OPND1_FLAG<=1 %THEN OPND1_D=OPND1_D*DACC %AND %RETURN
if (( OPND1->FLAG ) > ( 1 )) goto L_0652;
OPND1->D = ((OPND1->D)) * ((DACC));
return;
L_0652:
// 6369 PSF1(MYB,0,DACC) %UNLESS DACC=1
if (( DACC ) == ( 1 )) goto L_0653;
PSF1(42, 0, DACC);
L_0653:
// 6370 GRUSE(BREG)=0
GRUSE[7] = 0;
// 6371 ->DONE
goto U_021c;
// 6372 %FINISH
L_0651:
// 6373 %IF OPND1_FLAG<=1 %THEN %RETURN
if (( OPND1->FLAG ) > ( 1 )) goto L_0654;
return;
L_0654:
// 6374 LOADREG=BREG; ->OUT
LOADREG = 7;
goto U_021d;
// 6375 %FINISH
L_064e:
// 6376 %IF OPND1_FLAG=9 %AND OPND1_XB>>4=ACCR %THEN %START
if (( OPND1->FLAG ) != ( 9 )) goto L_0655;
if (( (int)(((unsigned int)(OPND1->XB)) >> ((4))) ) != ( 0 )) goto L_0655;
// 6377 PF1(ST,0,TOS,0); ! ACC CANNOT BE USED IN DVM
PF1(72, 0, 6, 0);
// 6378 CHANGE RD(ACCR)
CHANGERD(0);
// 6379 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 6380 %FINISH
L_0655:
// 6381 !
// 6382 BASE=OPND2_XTRA>>18; AREA=-1
BASE = (int)(((unsigned int)(OPND2->XTRA)) >> ((18)));
AREA = (-(1));
// 6383 GET IN ACC(DR,2,0,AREA CODE,OPND2_XTRA&16_1FFFF+8)
GETINACC(1, 2, 0, AREACODE(), ((((OPND2->XTRA)) & ((131071)))) + ((8)));
// 6384 !
// 6385 LOAD(OPND1,EVALREG,0)
LOAD(OPND1, EVALREG, 0);
// 6386 %IF OPND1_PTYPE>>4>=6 %THEN FAULT(24,0)
if (( (int)(((unsigned int)(OPND1->PTYPE)) >> ((4))) ) < ( 6 )) goto L_0656;
FAULT(24, 0);
L_0656:
// 6387 %IF REGISTER(BREG)>=1 %AND (OPND1_FLAG#9 %OR OPND1_XB>>4#BREG) %THEN %START
if (( REGISTER[7] ) < ( 1 )) goto L_0657;
if (( OPND1->FLAG ) != ( 9 )) goto L_0658;
if (( (int)(((unsigned int)(OPND1->XB)) >> ((4))) ) == ( 7 )) goto L_0657;
L_0658:
// 6388 OPND==RECORD(OLINK(BREG))
OPND = * /*(recfm)*/ RECORD(OLINK[7]);
// 6389 OPND_D=0
OPND->D = 0;
// 6390 REGISTER(BREG)=2
REGISTER[7] = 2;
// 6391 BOOT OUT(BREG)
BOOTOUT(7);
// 6392 %FINISH
L_0657:
// 6393 AREA=OPND1_XB>>4; ACCESS=OPND1_XB&15
AREA = (int)(((unsigned int)(OPND1->XB)) >> ((4)));
ACCESS = ((OPND1->XB)) & ((15));
// 6394 PSORLF1(OPCODE>>8,ACCESS,AREA,OPND1_D)
PSORLF1((int)(((unsigned int)(OPCODE)) >> ((8))), ACCESS, AREA, OPND1->D);
// 6395 GRUSE(BREG)=0
GRUSE[7] = 0;
// 6396 DONE:
U_021c:
// 6397 %IF OPNAME>=0 %THEN %START
if (( OPNAME ) < ( 0 )) goto L_0659;
// 6398 GRUSE(BREG)=14
GRUSE[7] = 14;
// 6399 GRINF1(BREG)=VUSE
GRINF1[7] = VUSE;
// 6400 GRINF2(BREG)=0
GRINF2[7] = 0;
// 6401 %FINISH
L_0659:
// 6402 OUT:
U_021d:
// 6403 LOADREG=BREG
LOADREG = 7;
// 6404 REGISTER(LOADREG)=1
REGISTER[LOADREG] = 1;
// 6405 OPND1_FLAG=9; OPND1_XB=LOADREG<<4
OPND1->FLAG = 9;
OPND1->XB = ((LOADREG)) << ((4));
// 6406 %END
return;
_imp_endofblock: ;
} // End of block VMY1 at level 6
// 6407 %ROUTINE VMY
void VMY( void )
{
__label__ _imp_endofblock;
// 6408 !***********************************************************************
// 6409 !* DOES ALL VECTOR MULTIPLIES EXCEPT ONE DIMENSION *
// 6410 !***********************************************************************
// 6411 %IF OPND1_FLAG=9 %AND OPND1_XB>>4=ACCR %THEN %START
if (( OPND1->FLAG ) != ( 9 )) goto L_065a;
if (( (int)(((unsigned int)(OPND1->XB)) >> ((4))) ) != ( 0 )) goto L_065a;
// 6412 PF1(ST,0,TOS,0); ! ACC CANNOT BE USED IN DVM
PF1(72, 0, 6, 0);
// 6413 CHANGE RD(ACCR)
CHANGERD(0);
// 6414 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 6415 %FINISH
L_065a:
// 6416 !
// 6417 %IF C=D %THEN %START; ! TOP DIMENSION LOAD DV DES
if (( C ) != ( D )) goto L_065b;
// 6418 BASE=OPND2_XTRA>>18; AREA=-1
BASE = (int)(((unsigned int)(OPND2->XTRA)) >> ((18)));
AREA = (-(1));
// 6419 GET IN ACC(DR,2,0,AREA CODE,OPND2_XTRA&16_1FFFF+8)
GETINACC(1, 2, 0, AREACODE(), ((((OPND2->XTRA)) & ((131071)))) + ((8)));
// 6420 %FINISH
L_065b:
// 6421 !
// 6422 LOAD(OPND1,EVALREG,0)
LOAD(OPND1, EVALREG, 0);
// 6423 %IF OPND1_PTYPE>>4>=6 %THEN FAULT(24,0)
if (( (int)(((unsigned int)(OPND1->PTYPE)) >> ((4))) ) < ( 6 )) goto L_065c;
FAULT(24, 0);
L_065c:
// 6424 %IF C=D %AND REGISTER(BREG)>=1 %AND (OPND1_FLAG#9 %OR OPND1_XB>>4#BREG) %THEN %START
if (( C ) != ( D )) goto L_065d;
if (( REGISTER[7] ) < ( 1 )) goto L_065d;
if (( OPND1->FLAG ) != ( 9 )) goto L_065e;
if (( (int)(((unsigned int)(OPND1->XB)) >> ((4))) ) == ( 7 )) goto L_065d;
L_065e:
// 6425 OPND==RECORD(OLINK(BREG))
OPND = * /*(recfm)*/ RECORD(OLINK[7]);
// 6426 OPND_D=0
OPND->D = 0;
// 6427 REGISTER(BREG)=2
REGISTER[7] = 2;
// 6428 BOOT OUT(BREG)
BOOTOUT(7);
// 6429 %FINISH
L_065d:
// 6430 AREA=OPND1_XB>>4; ACCESS=OPND1_XB&15
AREA = (int)(((unsigned int)(OPND1->XB)) >> ((4)));
ACCESS = ((OPND1->XB)) & ((15));
// 6431 PSORLF1(OPCODE>>8,ACCESS,AREA,OPND1_D)
PSORLF1((int)(((unsigned int)(OPCODE)) >> ((8))), ACCESS, AREA, OPND1->D);
// 6432 GRUSE(BREG)=0
GRUSE[7] = 0;
// 6433 !
// 6434 LOADREG=ACCR
LOADREG = 0;
// 6435 %IF C=D %THEN GET IN ACC(ACCR,1,0,7,0) %ELSE PF1(IAD,0,BREG,0)
if (( C ) != ( D )) goto L_065f;
GETINACC(0, 1, 0, 7, 0);
goto L_0660;
L_065f:
PF1(224, 0, 7, 0);
L_0660:
// 6436 %IF C=1 %THEN %START
if (( C ) != ( 1 )) goto L_0661;
// 6437 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 6438 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 6439 LOADREG=BREG
LOADREG = 7;
// 6440 %FINISH
L_0661:
// 6441 REGISTER(LOADREG)=1
REGISTER[LOADREG] = 1;
// 6442 OPND1_FLAG=9; OPND1_XB=LOADREG<<4
OPND1->FLAG = 9;
OPND1->XB = ((LOADREG)) << ((4));
// 6443 %END
return;
_imp_endofblock: ;
} // End of block VMY at level 6
// 6444 %ROUTINE CTOP(%INTEGERNAME FLAG)
void CTOP( int *FLAG )
{
__label__ _imp_endofblock;
// 6445 !***********************************************************************
// 6446 !* AN OPERATION HAS BEEN FOUND WHERE BOTH OPERANDS ARE CONSTANTS *
// 6447 !* THIS ROUTINE ATTEMPTS TO INTERPRET THIS OPERATION IF IT *
// 6448 !* CAN BE DONE SAFELY *
// 6449 !* ON EXIT FLAG=0 %IF OPERATION CARRIED OUT *
// 6450 !***********************************************************************
// 6451 %CONSTINTEGER TRUNCMASK=16_01300800
// 6452 %INTEGER K,TYPEP,PRECP,OP,TYPEPP,VAL,SVAL1,SVAL2
int K;
int TYPEP;
int PRECP;
int OP;
int TYPEPP;
int VAL;
int SVAL1;
int SVAL2;
// 6453 %LONGINTEGER VAL1,VAL2
long long int VAL1;
long long int VAL2;
// 6454 {%LONG}%LONGREAL RVAL1,RVAL2
double RVAL1;
double RVAL2;
// 6455 %SWITCH ISW,RSW(10:32)
static int RSW_idx;
static const void * /*SWITCH*/ RSW[(32)-(10)+1] = { &&RSW_10, &&RSW_11, &&RSW_12, &&RSW_13, &&RSW_14, &&RSW_15, &&RSW_16, &&RSW_17, &&RSW_18, &&RSW_19, &&RSW_20, &&RSW_21, &&RSW_22, &&RSW_23, &&RSW_24, &&RSW_25, &&RSW_26, &&RSW_27, &&RSW_28, &&RSW_29, &&RSW_30, &&RSW_31, &&RSW_32, };
// 6456 %ON %EVENT 1,2 %START
// 6457 %RETURN
return;
// 6458 %FINISH
L_0662:
// 6459 TYPEP=TYPE; PRECP=PTYPE>>4&15; OP=FLAG
TYPEP = TYPE;
PRECP = (((int)(((unsigned int)(PTYPE)) >> ((4))))) & ((15));
OP = FLAG;
// 6460 EXTRACT(OPND1,VAL1,RVAL1)
EXTRACT(OPND1, &VAL1, &RVAL1);
// 6461 EXTRACT(OPND2,VAL2,RVAL2)
EXTRACT(OPND2, &VAL2, &RVAL2);
// 6462 SVAL1<-VAL1; SVAL2<-VAL2
SVAL1 = VAL1;
SVAL2 = VAL2;
// 6463 %IF TYPEP=1 %AND OP=37 %THEN ->ISW37
if (( TYPEP ) != ( 1 )) goto L_0663;
if (( OP ) != ( 37 )) goto L_0663;
goto U_0221;
L_0663:
// 6464 %RETURN %IF OP>32
if (( OP ) <= ( 32 )) goto L_0664;
return;
L_0664:
// 6465 %IF TYPEP=2 %THEN ->RSW(OP) %ELSE ->ISW(OP)
if (( TYPEP ) != ( 2 )) goto L_0665;
goto *(RSW-10)[OP]; /* Bounds=10:32 */
L_0665:
goto *(ISW-10)[OP]; /* Bounds=10:32 */
// 6466 ISW(10): ! \
ISW_10:
// 6467 VAL1=\VAL1
VAL1 = (~(VAL1));
// 6468 INTEND:
U_0222:
// 6469 %IF PRECP=6 %THEN %START
if (( PRECP ) != ( 6 )) goto L_0666;
// 6470 OPND1_D<-VAL1>>32
OPND1->D = (int)(((unsigned int)(VAL1)) >> ((32)));
// 6471 OPND1_XTRA<-VAL1
OPND1->XTRA = VAL1;
// 6472 FLAG=0
FLAG = 0;
// 6473 %FINISH %ELSE %START
goto L_0667;
L_0666:
// 6474 VAL<-VAL1
VAL = VAL1;
// 6475 %IF VAL=VAL1 %OR 1<<OP&TRUNCMASK=0 %THEN FLAG=0 %AND OPND1_D=VAL;! NO ARITH OFLOW CONDITION
if (( VAL ) == ( VAL1 )) goto L_0668;
if (( ((((1)) << ((OP)))) & ((19924992)) ) != ( 0 )) goto L_0669;
L_0668:
FLAG = 0;
OPND1->D = VAL;
L_0669:
// 6476 %FINISH
L_0667:
// 6477 %IF FLAG=0 %START
if (( FLAG ) != ( 0 )) goto L_066a;
// 6478 OPND1_PTYPE=PRECP<<4!1
OPND1->PTYPE = ((((PRECP)) << ((4)))) | ((1));
// 6479 %IF 16_FFFE0000<=VAL1<=16_1FFFF %THEN OPND1_FLAG=0 %ELSE OPND1_FLAG=1
if (( -131072 ) > ( VAL1 )) goto L_066b;
if (( VAL1 ) > ( 131071 )) goto L_066b;
OPND1->FLAG = 0;
goto L_066c;
L_066b:
OPND1->FLAG = 1;
L_066c:
// 6480 %FINISH
L_066a:
// 6481 %RETURN
return;
// 6482 ISW(11): ! INTEGER NEGATE
ISW_11:
// 6483 VAL1=-VAL1; -> INT END
VAL1 = (-(VAL1));
goto U_0222;
// 6484 ISW(13): ! INTEGER ABS
ISW_13:
// 6485 VAL1=IMOD(VAL1); -> INT END
VAL1 = IMOD(VAL1);
goto U_0222;
// 6486 ISW(12): ! INTEGER FLOAT
ISW_12:
// 6487 RVAL1=VAL1; PRECP=5+XTRA
RVAL1 = VAL1;
PRECP = ((5)) + ((XTRA));
// 6488 ->REAL END
goto U_0223;
// 6489 RSW(14): ! STRETCH REAL
RSW_14:
// 6490 PRECP=PRECP+1
PRECP = ((PRECP)) + ((1));
// 6491 REAL END:OPND1_FLAG=1
U_0223:
OPND1->FLAG = 1;
// 6492 OPND1_D=INTEGER(ADDR(RVAL1))
OPND1->D = *INTEGER(ADDR( &RVAL1));
// 6493 OPND1_XTRA=INTEGER(ADDR(RVAL1)+4)
OPND1->XTRA = *INTEGER(((ADDR( &RVAL1))) + ((4)));
// 6494 %IF PRECP=7 %THEN %START
if (( PRECP ) != ( 7 )) goto L_066d;
// 6495 OPND1_FLAG=3
OPND1->FLAG = 3;
// 6496 OPND1_XTRA=ADDR(A(R))
OPND1->XTRA = ADDR( &A[R]);
// 6497 %CYCLE K=0,1,15
K = ((0)) - ((1));
L_066e:
if (( K ) == ( 15 )) goto L_066f;
K = ((K)) + ((1));
// 6498 A(R)=BYTEINTEGER(ADDR(RVAL1)+K)
A[R] = *BYTEINTEGER(((ADDR( &RVAL1))) + ((K)));
// 6499 R=R+1
R = ((R)) + ((1));
// 6500 %REPEAT
goto L_066e;
L_066f:
// 6501 %FINISH
L_066d:
// 6502 FLAG=0; OPND1_PTYPE=16*PRECP+2
FLAG = 0;
OPND1->PTYPE = ((((16)) * ((PRECP)))) + ((2));
// 6503 %RETURN
return;
// 6504 ISW(14): ! STRETCH INTEGER
ISW_14:
// 6505 RSW(12): ! FLOAT REAL
RSW_12:
// 6506 ABORT
ABORT();
// 6507 ISW(20): ! ADD
ISW_20:
// 6508 VAL1=VAL1+VAL2; -> INT END
VAL1 = ((VAL1)) + ((VAL2));
goto U_0222;
// 6509 ISW(21): ! MINUS
ISW_21:
// 6510 VAL1=VAL1-VAL2; -> INT END
VAL1 = ((VAL1)) - ((VAL2));
goto U_0222;
// 6511 ISW(22): ! EXCLUSIVE OR
ISW_22:
// 6512 VAL1=VAL1!!VAL2; -> INT END
VAL1 = ((VAL1)) ^ ((VAL2));
goto U_0222;
// 6513 ISW(23): ! OR
ISW_23:
// 6514 VAL1=VAL1!VAL2; -> INT END
VAL1 = ((VAL1)) | ((VAL2));
goto U_0222;
// 6515 ISW(24): ! MULT
ISW_24:
// 6516 VAL1=VAL1*VAL2; -> INT END
VAL1 = ((VAL1)) * ((VAL2));
goto U_0222;
// 6517 ISW(26): %RETURN; ! / DIVISION
ISW_26:
return;
// 6518 ISW(25): %RETURN %IF VAL2=0; ! // DIVISION
ISW_25:
if (( VAL2 ) != ( 0 )) goto L_0671;
return;
L_0671:
// 6519 VAL1=VAL1//VAL2; -> INT END
VAL1 = ((int)(VAL1)) / ((int)(VAL2));
goto U_0222;
// 6520 ISW(27): ! AND
ISW_27:
// 6521 VAL1=VAL1&VAL2; -> INT END
VAL1 = ((VAL1)) & ((VAL2));
goto U_0222;
// 6522 ISW(29): ! SLL
ISW_29:
// 6523 %IF PRECP=6 %THEN VAL1=VAL1<<SVAL2 %ELSE VAL1=SVAL1<<SVAL2
if (( PRECP ) != ( 6 )) goto L_0672;
VAL1 = ((VAL1)) << ((SVAL2));
goto L_0673;
L_0672:
VAL1 = ((SVAL1)) << ((SVAL2));
L_0673:
// 6524 ->INT END
goto U_0222;
// 6525 ISW(28): ! SRL
ISW_28:
// 6526 %IF PRECP=6 %THEN VAL1=VAL1>>SVAL2 %ELSE VAL1=SVAL1>>SVAL2
if (( PRECP ) != ( 6 )) goto L_0674;
VAL1 = (int)(((unsigned int)(VAL1)) >> ((SVAL2)));
goto L_0675;
L_0674:
VAL1 = (int)(((unsigned int)(SVAL1)) >> ((SVAL2)));
L_0675:
// 6527 ->INT END
goto U_0222;
// 6528
// 6529 ISW(31):ISW(32): ! COMPARISONS
ISW_31:
ISW_32:
// 6530 RSW(31):RSW(32): ! REAL COMPARISONS
RSW_31:
RSW_32:
// 6531 BFFLAG=COMM-1
BFFLAG = ((COMM)) - ((1));
// 6532 MASK=FCOMP(XTRA+7*BFFLAG)
MASK = (FCOMP-1)[((XTRA)) + ((((7)) * ((BFFLAG))))];
// 6533 COMM=2; FLAG=0
COMM = 2;
FLAG = 0;
// 6534 %IF TYPE=2 %THEN ->RCOMP
if (( TYPE ) != ( 2 )) goto L_0676;
goto U_0224;
L_0676:
// 6535 %IF (MASK&8#0 %AND VAL1=VAL2) %OR (MASK&4#0 %AND VAL1<VAL2) %OR (MASK&2#0 %AND VAL1>VAL2) %THEN MASK=15 %ELSE MASK=0
if (( ((MASK)) & ((8)) ) == ( 0 )) goto L_0677;
if (( VAL1 ) == ( VAL2 )) goto L_0678;
L_0677:
if (( ((MASK)) & ((4)) ) == ( 0 )) goto L_0679;
if (( VAL1 ) < ( VAL2 )) goto L_0678;
L_0679:
if (( ((MASK)) & ((2)) ) == ( 0 )) goto L_067a;
if (( VAL1 ) <= ( VAL2 )) goto L_067a;
L_0678:
MASK = 15;
goto L_067b;
L_067a:
MASK = 0;
L_067b:
// 6536 %RETURN
return;
// 6537 RCOMP:
U_0224:
// 6538 %IF (MASK&8#0 %AND RVAL1=RVAL2) %OR (MASK&4#0 %AND RVAL1<RVAL2) %OR (MASK&2#0 %AND RVAL1>RVAL2) %THEN MASK=15 %ELSE MASK=0
if (( ((MASK)) & ((8)) ) == ( 0 )) goto L_067c;
if (( RVAL1 ) == ( RVAL2 )) goto L_067d;
L_067c:
if (( ((MASK)) & ((4)) ) == ( 0 )) goto L_067e;
if (( RVAL1 ) < ( RVAL2 )) goto L_067d;
L_067e:
if (( ((MASK)) & ((2)) ) == ( 0 )) goto L_067f;
if (( RVAL1 ) <= ( RVAL2 )) goto L_067f;
L_067d:
MASK = 15;
goto L_0680;
L_067f:
MASK = 0;
L_0680:
// 6539 %RETURN
return;
// 6540 RSW(11): ! NEGATE
RSW_11:
// 6541 RVAL1=-RVAL1; -> REAL END
RVAL1 = (-(RVAL1));
goto U_0223;
// 6542 RSW(13): ! ABS
RSW_13:
// 6543 RVAL1=MOD(RVAL1); -> REAL END
RVAL1 = MOD(RVAL1);
goto U_0223;
// 6544 RSW(20): ! ADD
RSW_20:
// 6545 RVAL1=RVAL1+RVAL2; -> REAL END
RVAL1 = ((RVAL1)) + ((RVAL2));
goto U_0223;
// 6546 RSW(21): ! SUBTRACT
RSW_21:
// 6547 RVAL1=RVAL1-RVAL2; -> REAL END
RVAL1 = ((RVAL1)) - ((RVAL2));
goto U_0223;
// 6548 RSW(24): ! MULT
RSW_24:
// 6549 RVAL1=RVAL1*RVAL2; -> REAL END
RVAL1 = ((RVAL1)) * ((RVAL2));
goto U_0223;
// 6550 RSW(26): ! DIVISION
RSW_26:
// 6551 %RETURN %IF RVAL2=0; ! AVOID DIV BY ZERO
if (( RVAL2 ) != ( 0 )) goto L_0681;
return;
L_0681:
// 6552 RVAL1=RVAL1/RVAL2; -> REAL END
RVAL1 = ((float)(RVAL1)) / ((float)(RVAL2));
goto U_0223;
// 6553 ISW(30): ! '**' WITH 2 INTEGER OPERANDS
ISW_30:
// 6554 ISW37: ! '****' WITH 2 INTEGER OPERAND
U_0221:
// 6555 %RETURN %UNLESS 0<=VAL2<=63
if (( 0 ) > ( VAL2 )) goto L_0682;
if (( VAL2 ) <= ( 63 )) goto L_0683;
L_0682:
return;
L_0683:
// 6556 VAL2=1
VAL2 = 1;
// 6557 %WHILE SVAL2>0 %CYCLE
L_0684:
if (( SVAL2 ) <= ( 0 )) goto L_0685;
// 6558 VAL2=VAL2*VAL1
VAL2 = ((VAL2)) * ((VAL1));
// 6559 SVAL2=SVAL2-1
SVAL2 = ((SVAL2)) - ((1));
// 6560 %RETURN %IF VAL2#INTEGER(ADDR(VAL2)+4)
if (( VAL2 ) == ( *INTEGER(((ADDR( &VAL2))) + ((4))) )) goto L_0687;
return;
L_0687:
// 6561 %REPEAT
goto L_0684;
L_0685:
// 6562 VAL1=VAL2; ->INT END
VAL1 = VAL2;
goto U_0222;
// 6563 RSW(22):RSW(23):
RSW_22:
RSW_23:
// 6564 RSW(25):RSW(27):RSW(28):RSW(29):
RSW_25:
RSW_27:
RSW_28:
RSW_29:
// 6565 %END
return;
RSW_10:
RSW_15:
RSW_16:
RSW_17:
RSW_18:
RSW_19:
RSW_30:
fprintf(stderr, "%%SWITCH LABEL NOT SET - RSW(%d): at line %s:%d", RSW_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,RSW_idx,_imp_current_line,"SWITCH LABEL NOT SET - RSW";*/
ISW_15:
ISW_16:
ISW_17:
ISW_18:
ISW_19:
fprintf(stderr, "%%SWITCH LABEL NOT SET - ISW(%d): at line %s:%d", ISW_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,ISW_idx,_imp_current_line,"SWITCH LABEL NOT SET - ISW";*/
_imp_endofblock: ;
} // End of block CTOP at level 6
// 6566 %ROUTINE REXP
void REXP( void )
{
__label__ _imp_endofblock;
// 6567 !***********************************************************************
// 6568 !* CALLS A PERM ROUTINE TO PERFORM REAL**REAL *
// 6569 !***********************************************************************
// 6570 %INTEGER I,PR
int I;
int PR;
// 6571 %RECORD(RD)%NAME OPND{(RD)
RD *OPND;
// 6572 %IF REGISTER(BREG)>0 %THEN BOOT OUT(BREG)
if (( REGISTER[7] ) <= ( 0 )) goto L_0688;
BOOTOUT(7);
L_0688:
// 6573 %CYCLE I=1,1,2
I = ((1)) - ((1));
L_0689:
if (( I ) == ( 2 )) goto L_068a;
I = ((I)) + ((1));
// 6574 OPND==RECORD(OPERAND(I))
OPND = * /*(recfm)*/ RECORD((OPERAND-1)[I]);
// 6575 LOAD(OPND,ACCR,2) %UNLESS I=1 %AND OPND_FLAG=8
if (( I ) != ( 1 )) goto L_0670;
if (( OPND->FLAG ) == ( 8 )) goto L_068c;
L_0670:
LOAD(OPND, 0, 2);
L_068c:
// 6576 PR=OPND_PTYPE>>4
PR = (int)(((unsigned int)(OPND->PTYPE)) >> ((4)));
// 6577 %IF PR<6 %THEN LENGTHEN(OPND)
if (( PR ) >= ( 6 )) goto L_068d;
LENGTHEN(OPND);
L_068d:
// 6578 %IF PR>6 %THEN SHORTEN(OPND)
if (( PR ) <= ( 6 )) goto L_068e;
SHORTEN(OPND);
L_068e:
// 6579 %REPEAT
goto L_0689;
L_068a:
// 6580 PPJ(0,17)
PPJ(0, 17);
// 6581 %END
return;
_imp_endofblock: ;
} // End of block REXP at level 6
// 6582 %ROUTINE STARSTAR
void STARSTAR( void )
{
__label__ _imp_endofblock;
// 6583 !***********************************************************************
// 6584 !* PLANT IN-LINE CODE FOR EXPONENTIATION *
// 6585 !* IMP ALLOWS EXPONENTS IN INTEGER EXPRESSIONS FROM 0-63 AND *
// 6586 !* IN REAL EXPRESSIONS FROM-255 TO +255 *
// 6587 !***********************************************************************
// 6588 %INTEGER TYPEP,PRECP,WORK,C,EXPWORK,VALUE
int TYPEP;
int PRECP;
int WORK;
int C;
int EXPWORK;
int VALUE;
// 6589 PTYPE=OPND1_PTYPE; ! INSPECT THE OPERAND
PTYPE = OPND1->PTYPE;
// 6590 UNPACK
UNPACK();
// 6591 TYPEP=TYPE; PRECP=PREC
TYPEP = TYPE;
PRECP = PREC;
// 6592 %IF TYPEP=2 %THEN OPCODE=16_FA %ELSE OPCODE=16_EA
if (( TYPEP ) != ( 2 )) goto L_068f;
OPCODE = 250;
goto L_0690;
L_068f:
OPCODE = 234;
L_0690:
// 6593 VALUE=0
VALUE = 0;
// 6594 %IF OPND2_FLAG=0 %AND 1<=OPND2_D<=63*TYPE %THEN VALUE=OPND2_D; ! EXPONENT IS #0 AND CONSTANT
if (( OPND2->FLAG ) != ( 0 )) goto L_0691;
if (( 1 ) > ( OPND2->D )) goto L_0691;
if (( OPND2->D ) > ( ((63)) * ((TYPE)) )) goto L_0691;
VALUE = OPND2->D;
L_0691:
// 6595 LOAD(OPND1,ACCR,2); ! FETCH OPERAND TO ACC
LOAD(OPND1, 0, 2);
// 6596 %IF TYPEP=2 %AND PRECP=5 %THEN LENGTHEN(OPND1) %AND PRECP=6
if (( TYPEP ) != ( 2 )) goto L_0692;
if (( PRECP ) != ( 5 )) goto L_0692;
LENGTHEN(OPND1);
PRECP = 6;
L_0692:
// 6597 !
// 6598 ! OPTIMISE **2 **3 AND **4
// 6599 !
// 6600 %IF 2<=VALUE<=4 %THEN %START
if (( 2 ) > ( VALUE )) goto L_0693;
if (( VALUE ) > ( 4 )) goto L_0693;
// 6601 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 6602 %IF VALUE=3 %THEN PF1(ST,0,TOS,0)
if (( VALUE ) != ( 3 )) goto L_0694;
PF1(72, 0, 6, 0);
L_0694:
// 6603 PF1(OPCODE,0,TOS,0)
PF1(OPCODE, 0, 6, 0);
// 6604 %IF VALUE=4 %THEN PF1(ST,0,TOS,0)
if (( VALUE ) != ( 4 )) goto L_0695;
PF1(72, 0, 6, 0);
L_0695:
// 6605 %IF VALUE>2 %THEN PF1(OPCODE,0,TOS,0)
if (( VALUE ) <= ( 2 )) goto L_0696;
PF1(OPCODE, 0, 6, 0);
L_0696:
// 6606 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 6607 %RETURN
return;
// 6608 %FINISH
L_0693:
// 6609 !
// 6610 ! OTHERWISE STORE OPERAND IN 'WORK' AND GET HOLD OF EXPONENT
// 6611 !
// 6612 GET WSP(WORK,BYTES(PRECP)>>2)
GETWSP( &WORK, (int)(((unsigned int)(BYTES[PRECP])) >> ((2))));
// 6613 %IF TYPEP=2 %THEN GET WSP(EXPWORK,1)
if (( TYPEP ) != ( 2 )) goto L_0697;
GETWSP( &EXPWORK, 1);
L_0697:
// 6614 PSF1(ST,1,WORK)
PSF1(72, 1, WORK);
// 6615 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 6616 PLABEL=PLABEL-1; ! LABEL FOR JUMPING OUT
PLABEL = ((PLABEL)) - ((1));
// 6617 %IF OPND2_PTYPE>>4=6 %THEN SHORTEN(OPND2);! LONG EXPONENT
if (( (int)(((unsigned int)(OPND2->PTYPE)) >> ((4))) ) != ( 6 )) goto L_0698;
SHORTEN(OPND2);
L_0698:
// 6618 LOAD(OPND2,BREG,2); ! EXPONENT TO ANY REGISTER
LOAD(OPND2, 7, 2);
// 6619 %IF TYPEP=2 %THEN PSF1(STB,1,EXPWORK)
if (( TYPEP ) != ( 2 )) goto L_0699;
PSF1(90, 1, EXPWORK);
L_0699:
// 6620 !
// 6621 ! GET '1' INTO ACC IN APPROPIATE FORM
// 6622 !
// 6623 GET IN ACC(ACCR,BYTES(PRECP+1-TYPEP)>>2,0,0,1)
GETINACC(0, (int)(((unsigned int)(BYTES[((((PRECP)) + ((1)))) - ((TYPEP))])) >> ((2))), 0, 0, 1);
// 6624 %IF TYPEP=2 %THEN PSF1(FLT,0,0)
if (( TYPEP ) != ( 2 )) goto L_069a;
PSF1(168, 0, 0);
L_069a:
// 6625 !
// 6626 ! IF EXPONENT NOT KNOWN AT COMPILE TIME TO BE +VE CONSTANT MUST
// 6627 ! ALLOW FOR ZERO :- XX**0=1 FOR ALL XX
// 6628 ! ALSO ALLOW FOR X**(-N) WHICH IS 1/(X**N) FOR ALL X & N
// 6629 !
// 6630 %IF VALUE=0 %THEN %START; ! NOT +VE CONSTANT
if (( VALUE ) != ( 0 )) goto L_069b;
// 6631 ENTER JUMP(28,PLABEL,B'11'); ! J(B=0) END OF EXP ROUTINE
ENTERJUMP(28, PLABEL, 3);
// 6632 %IF TYPEP=2 %THEN %START
if (( TYPEP ) != ( 2 )) goto L_069c;
// 6633 PF3(JAT,13,0,4); ! J*+4 IF B>0
PF3(4, 13, 0, 4);
// 6634 PSF1(SLB,0,0)
PSF1(82, 0, 0);
// 6635 PF1(SBB,0,TOS,0)
PF1(34, 0, 6, 0);
// 6636 %FINISH
L_069c:
// 6637 !
// 6638 ! IN CHECKING MODE PLANT CODE TO CHECK RANGE OF EXPONENT
// 6639 !
// 6640 %IF PARMOPT=1 %THEN %START
if (( PARMOPT ) != ( 1 )) goto L_069d;
// 6641 %IF TYPEP=1 %THEN PPJ(30,7);! JUMP B<0
if (( TYPEP ) != ( 1 )) goto L_069e;
PPJ(30, 7);
L_069e:
// 6642 PSF1(CPB,0,64*TYPEP*TYPEP-1)
PSF1(38, 0, ((((((64)) * ((TYPEP)))) * ((TYPEP)))) - ((1)));
// 6643 PPJ(2,7)
PPJ(2, 7);
// 6644 %FINISH
L_069d:
// 6645 %FINISH
L_069b:
// 6646 C=CA
C = CA;
// 6647 PSF1(OPCODE,1,WORK)
PSF1(OPCODE, 1, WORK);
// 6648 PSF1(DEBJ,0,(C-CA)//2)
PSF1(36, 0, ((int)(((C)) - ((CA)))) / ((int)(2)));
// 6649 !
// 6650 ! FOR REAL EXPONENTS CHECK IF NEGATIVE AND EVALUATE INVERSE
// 6651 !
// 6652 %IF VALUE=0 %AND TYPEP=2 %THEN %START
if (( VALUE ) != ( 0 )) goto L_069f;
if (( TYPEP ) != ( 2 )) goto L_069f;
// 6653 PSF1(LB,1,EXPWORK); ! LB ON ORIGINAL EXPONENT
PSF1(122, 1, EXPWORK);
// 6654 ENTER JUMP(46,PLABEL,B'11');! BP END OF EXP ROUTINE
ENTERJUMP(46, PLABEL, 3);
// 6655 %IF PRECP<7 %THEN PF1(RRDV,0,PC,SPECIAL CONSTS(1))%ELSESTART
if (( PRECP ) >= ( 7 )) goto L_06a0;
PF1(188, 0, 4, SPECIALCONSTS(1));
goto L_06a1;
L_06a0:
// 6656 PSF1(SLSD,0,1); PSF1(FLT,0,0)
PSF1(68, 0, 1);
PSF1(168, 0, 0);
// 6657 PF1(RDV,0,TOS,0)
PF1(186, 0, 6, 0);
// 6658 %FINISH
L_06a1:
// 6659 %FINISH
L_069f:
// 6660 !
// 6661 ! ALL OVER. REAL RESULTS ARE IN FR WORK. INT RESULTS IN GR WORK+1
// 6662 ! FREE AND FORGET ANY OTHER REGISTERS
// 6663 !
// 6664 TYPE=TYPEP; PREC=PRECP
TYPE = TYPEP;
PREC = PRECP;
// 6665 REGISTER(BREG)=0
REGISTER[7] = 0;
// 6666 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 6667 GRUSE(BREG)=0
GRUSE[7] = 0;
// 6668 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 6669 OPND1_PTYPE=16*PREC+TYPE
OPND1->PTYPE = ((((16)) * ((PREC)))) + ((TYPE));
// 6670 OPND1_XB=0; OPND1_D=ACCR
OPND1->XB = 0;
OPND1->D = 0;
// 6671 C=ENTER LAB(PLABEL,B'11'); ! LABEL AT END OF EXP ROUTINE
C = ENTERLAB(PLABEL, 3);
// 6672 %END
return;
_imp_endofblock: ;
} // End of block STARSTAR at level 6
// 6673 %END; ! OF ROUTINE EXPOP
return;
SW_15:
SW_16:
SW_17:
SW_18:
SW_19:
fprintf(stderr, "%%SWITCH LABEL NOT SET - SW(%d): at line %s:%d", SW_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,SW_idx,_imp_current_line,"SWITCH LABEL NOT SET - SW";*/
_imp_endofblock: ;
} // End of block EXPOP at level 5
// 6674 %ROUTINE REDUCE ENV(%INTEGERNAME HEAD)
void REDUCEENV( int *HEAD )
{
__label__ _imp_endofblock;
// 6675 !***********************************************************************
// 6676 !* HEAD HAS AN ENVIRONMENT - THIS ROUTINE REMOVES ANYTHING *
// 6677 !* INCOMPATIBLE WITH THE CURRENT REGISTER STATE *
// 6678 !***********************************************************************
// 6679 %INTEGER NEWHEAD,I,J,K,REG,USE
int NEWHEAD;
int I;
int J;
int K;
int REG;
int USE;
// 6680 NEWHEAD=0
NEWHEAD = 0;
// 6681 %WHILE HEAD#0 %CYCLE
L_06a2:
if (( HEAD ) == ( 0 )) goto L_06a3;
// 6682 POP(HEAD,I,J,K)
POP(HEAD, &I, &J, &K);
// 6683 REG=K>>8; USE=K&255
REG = (int)(((unsigned int)(K)) >> ((8)));
USE = ((K)) & ((255));
// 6684 %IF USE=GRUSE(REG)&255 %AND I=GRINF1(REG) %THEN PUSH(NEWHEAD,I,J,K)
if (( USE ) != ( ((GRUSE[REG])) & ((255)) )) goto L_06a5;
if (( I ) != ( GRINF1[REG] )) goto L_06a5;
PUSH( &NEWHEAD, I, J, K);
L_06a5:
// 6685 %REPEAT
goto L_06a2;
L_06a3:
// 6686 HEAD=NEWHEAD
HEAD = NEWHEAD;
// 6687 %END
return;
_imp_endofblock: ;
} // End of block REDUCEENV at level 5
// 6688 %INTEGERFN CCOND(%INTEGER CTO,IU,FARLAB)
int CCOND( int CTO, int IU, int FARLAB )
{
__label__ _imp_endofblock;
// 6689 !***********************************************************************
// 6690 !* COMPILES <IU><SC><RESTOFCOND>%THEN<UI1>%ELSE<UI2> *
// 6691 !* CTO=0 JUMP TO FARLAB MUST BE PLANTED IF COND UNCONDITIONAL *
// 6692 !* CTO#0 JUMP MAY BE OMITTED *
// 6693 !* IU=1 FOR %IF =2 FOR UNLESS. FARLAB TO GO ON UI2 *
// 6694 !* THE ROUTINE MAKES FOUR PASSES THROUGH THE CONDITION *
// 6695 !* PASS 1 ANALYSES THE STRUCTURE AND DECIDES TO BRANCH ON TRUE *
// 6696 !* (TF=2) OR ON FALSE (TF=1) FOR EACH COMPARISON *
// 6697 !* PASS 2 WORKS OUT WHERE THE BRANCHES OF PASS 1 SHOULD GO TO *
// 6698 !* PASS 3 ASSIGNS LABEL NUMBERS *
// 6699 !* PASS 4 EVALUATES COMPARISIONS AND PLANTS THE CODE *
// 6700 !* *
// 6701 !* ON ENTRY P POINTS TO <SC> IN<HOLE><SC><RESTOFCOND> *
// 6702 !* RESULT=0 CONDITION COMPILED *
// 6703 !* RESULT=1 UNCONDITIONALLY TO 1ST ALTERNATIVE *
// 6704 !* RESULT=2 UNCONDITIONALLY TO 2ND ALTERNATIVE(FARLAB) *
// 6705 !***********************************************************************
// 6706 %ROUTINESPEC WRITE CONDLIST
auto void WRITECONDLIST( void );
// 6707 %ROUTINESPEC SKIP SC(%INTEGER REVERSED)
auto void SKIPSC( int REVERSED );
// 6708 %ROUTINESPEC SKIP COND(%INTEGER REVERSED)
auto void SKIPCOND( int REVERSED );
// 6709 %INTEGERFNSPEC CCOMP
auto int CCOMP( void );
// 6710 %%ROUTINESPEC JUMP(%INTEGER MASK,LAB,FLAGS)
auto void JUMP( int MASK, int LAB, int FLAGS );
// 6711 %ROUTINESPEC LAB UNUSED(%INTEGER LAB)
auto void LABUNUSED( int LAB );
// 6712 %ROUTINESPEC OMIT TO(%INTEGER LAB)
auto void OMITTO( int LAB );
// 6713 !
// 6714 ! FCOMP HAS BC MASKS FOR EACH STRING COMPARATOR.
// 6715 ! THE FIRST 7 ARE TO BRANCH IF TRUE WITH NORMAL COMPARISON
// 6716 ! THE SECOND SEVEN ARE TO BRANCH IF TRUE WITH BACKWARDS COMPARISON
// 6717 !
// 6718 %CONSTBYTEINTEGERARRAY FCOMP(1:21)=8,13,5,7,10,2,7,
const unsigned char FCOMP[(21)-(1)+1] = { 8, 13, 5, 7, 10, 2, 7, 8, 10, 2, 7, 13, 5, 7, 27, 0, 0, 43, 0, 0, 43, };
// 6719 8,10,2,7,13,5,7,
// 6720 27,0,0,43,0,0,43;
// 6721 !
// 6722 %INTEGER PIN,PP,II,L,CPTR,CMAX,LL,BITMASK,LA
int PIN;
int PP;
int II;
int L;
int CPTR;
int CMAX;
int LL;
int BITMASK;
int LA;
// 6723 %RECORDFORMAT CF(%BYTEINTEGER TF,CMP1,CMP2,LABU,LVL,JMP,REV,SP,%INTEGER LABNO,SP1,SP2)
typedef struct CF CF; // forward declaration to allow a 'next' pointer to a struct within that struct...
struct CF {
unsigned char TF;
unsigned char CMP1;
unsigned char CMP2;
unsigned char LABU;
unsigned char LVL;
unsigned char JMP;
unsigned char REV;
unsigned char SP;
int LABNO;
int SP1;
int SP2;
};
// 6724 %RECORD(CF)%ARRAY CLIST(1:30){(CF)
CF CLIST[(30)-(1)+1];
// 6725 %RECORD(CF)%NAME C1,C2{(CF)
CF *C1;
CF *C2;
// 6726 !
// 6727 ! PASS 1. ANALYSES THE CONDITION
// 6728 !
// 6729 PIN=P; ! SAVE INITIAL AR POINTER
PIN = P;
// 6730 CPTR=1; L=3; ! LEVEL=3 TO ALLOW 2 LOWER
CPTR = 1;
L = 3;
// 6731 C1==CLIST(CPTR); ! SET UP RECORD FOR FIRST CMPARSN
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6732 C1=0
C1 = 0;
// 6733 SKIP SC(0); ! SKIP THE 1ST CMPARSN
SKIPSC(0);
// 6734 SKIP COND(0); ! AND ANY %AND/%OR CLAUSES
SKIPCOND(0);
// 6735 C1_LVL=2; ! LEVEL =-1 FOR %IF/%THEN ENTRY
C1->LVL = 2;
// 6736 C1_TF=IU
C1->TF = IU;
// 6737 CMAX=CPTR+1
CMAX = ((CPTR)) + ((1));
// 6738 C1==CLIST(CMAX); C1=0
C1 = (&(/* No array bound info found for: */CLIST[CMAX]));
C1 = 0;
// 6739 C1_LVL=1; ! LEVEL =-2 FOR ELSE ENTRY
C1->LVL = 1;
// 6740 C1_TF=3-IU; ! C1_REV NEVER SET HERE (PDS HOPES)
C1->TF = ((3)) - ((IU));
// 6741 C1_LABNO=FARLAB
C1->LABNO = FARLAB;
// 6742 PP=P; ! SAVE FINAL AR POINTER
PP = P;
// 6743 FAULT(209,0) %IF CMAX>29; ! TOO COMPLICATED
if (( CMAX ) <= ( 29 )) goto L_06a6;
FAULT(209, 0);
L_06a6:
// 6744 !
// 6745 ! PASS 2 WORKS OUT WHERE TO JUMP TO
// 6746 ! THE JUMP IS FORWARD TO THE START OF THE CLAUSE WITH A DIFFERENT
// 6747 ! CONNECTOR (AND/OR) PROVIDED THIS IS AT A LOWER LEVEL THAN THE BRANCH
// 6748 ! AND ALSO AT A LOWER LEVEL THAN THE LOWEST POINT REACHED ENROUTE
// 6749 !
// 6750 ! ALSO CONTAINS PASS 3 (TRIVIAL)
// 6751 ! ASSIGN LABELS WHERE LABU SHOWS THEY ARE REQUIRED
// 6752 !
// 6753 %CYCLE CPTR=1,1,CMAX-1
CPTR = ((1)) - ((1));
L_06a7:
if (( CPTR ) == ( ((CMAX)) - ((1)) )) goto L_06a8;
CPTR = ((CPTR)) + ((1));
// 6754 C1==CLIST(CPTR)
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6755 L=C1_LVL; LL=L; ! LL FOR LOWEST LEVEL ENROUTE
L = C1->LVL;
LL = L;
// 6756 %CYCLE II=CPTR+1,1,CMAX+1
II = ((((CPTR)) + ((1)))) - ((1));
L_06aa:
if (( II ) == ( ((CMAX)) + ((1)) )) goto L_06ab;
II = ((II)) + ((1));
// 6757 C2==CLIST(II)
C2 = (&(/* No array bound info found for: */CLIST[II]));
// 6758 %EXIT %IF C1_TF#C2_TF %AND C2_LVL<LL
if (( C1->TF ) == ( C2->TF )) goto L_06ad;
if (( C2->LVL ) >= ( LL )) goto L_06ad;
goto L_06ab;
L_06ad:
// 6759 %IF C2_LVL<LL %THEN LL=C2_LVL
if (( C2->LVL ) >= ( LL )) goto L_06ae;
LL = C2->LVL;
L_06ae:
// 6760 %REPEAT
goto L_06aa;
L_06ab:
// 6761 C1_JMP=II; ! CLAUSE TO JUMP TO
C1->JMP = II;
// 6762 C2_LABU=C2_LABU+1
C2->LABU = ((C2->LABU)) + ((1));
// 6763 %IF C1_CMP2#0 %OR C1_CMP1=8 %START; ! D-SIDED OR RESLN
if (( C1->CMP2 ) != ( 0 )) goto L_06ac;
if (( C1->CMP1 ) != ( 8 )) goto L_06af;
L_06ac:
// 6764 ! REQIUIRES A LABEL ON THE
// 6765 C1_LABU=C1_LABU+1; ! THE NEXT SIMPLE CONDITION
C1->LABU = ((C1->LABU)) + ((1));
// 6766 %FINISH
L_06af:
// 6767 %IF C1_LABU#0 %AND C1_LABNO<=0 %THEN PLABEL=PLABEL-1 %AND C1_LABNO=PLABEL
if (( C1->LABU ) == ( 0 )) goto L_06b0;
if (( C1->LABNO ) > ( 0 )) goto L_06b0;
PLABEL = ((PLABEL)) - ((1));
C1->LABNO = PLABEL;
L_06b0:
// 6768 %REPEAT
goto L_06a7;
L_06a8:
// 6769 !
// 6770 ! PASS 4 GENERATE THE CODE
// 6771 ! MAINTAIN BIT MASK TO HELP. 2**0 JUMP TO FAR LAB PLANTED
// 6772 ! 2**1 JUMP TO INTERMEDIATE LAB PLANTED
// 6773 !
// 6774 WRITE CONDLIST %IF DCOMP=1
if (( DCOMP ) != ( 1 )) goto L_06b1;
WRITECONDLIST();
L_06b1:
// 6775 BITMASK=0
BITMASK = 0;
// 6776 CPTR=1
CPTR = 1;
// 6777 %CYCLE
L_06b2:
// 6778 C1==CLIST(CPTR)
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6779 LA=CCOMP
LA = CCOMP();
// 6780 %IF LA#0 %START
if (( LA ) == ( 0 )) goto L_06b5;
// 6781 OMIT TO(LA)
OMITTO(LA);
// 6782 %IF CPTR>=CMAX %THEN %START
if (( CPTR ) < ( CMAX )) goto L_06b6;
// 6783 %IF CTO=0 %THEN ENTER JUMP(15,LA,B'11')
if (( CTO ) != ( 0 )) goto L_06b7;
ENTERJUMP(15, LA, 3);
L_06b7:
// 6784 %RESULT=2
return 2;
// 6785 %FINISH
L_06b6:
// 6786 C1==CLIST(CPTR)
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6787 %FINISH
L_06b5:
// 6788 %IF C1_LABNO>0 %THEN II=ENTER LAB(C1_LABNO,B'11')
if (( C1->LABNO ) <= ( 0 )) goto L_06b8;
II = ENTERLAB(C1->LABNO, 3);
L_06b8:
// 6789 CPTR=CPTR+1
CPTR = ((CPTR)) + ((1));
// 6790 %EXIT %IF CPTR>=CMAX
if (( CPTR ) < ( CMAX )) goto L_06b9;
goto L_06b3;
L_06b9:
// 6791 %REPEAT
goto L_06b2;
L_06b3:
// 6792 !
// 6793 P=PP;
P = PP;
// 6794 %RESULT=1 %IF BITMASK&1=0
if (( ((BITMASK)) & ((1)) ) != ( 0 )) goto L_06ba;
return 1;
L_06ba:
// 6795 %RESULT=0
return 0;
// 6796 %ROUTINE LAB UNUSED(%INTEGER LAB)
void LABUNUSED( int LAB )
{
__label__ _imp_endofblock;
// 6797 !***********************************************************************
// 6798 !* A LABEL IS NOT JUMPED TO AS CONDITION ALWAYS FALSE *
// 6799 !* REMOVE IT FROM LIST *
// 6800 !***********************************************************************
// 6801 %INTEGER I
int I;
// 6802 %RECORD(CF)%NAME C1{(CF)
CF *C1;
// 6803 %CYCLE I=CPTR,1,CMAX-1
I = ((CPTR)) - ((1));
L_06bb:
if (( I ) == ( ((CMAX)) - ((1)) )) goto L_06bc;
I = ((I)) + ((1));
// 6804 C1==CLIST(I)
C1 = (&(/* No array bound info found for: */CLIST[I]));
// 6805 %IF C1_LABNO=LAB %START
if (( C1->LABNO ) != ( LAB )) goto L_06be;
// 6806 C1_LABU=C1_LABU-1; ! COUNT DOWN USE COUNT
C1->LABU = ((C1->LABU)) - ((1));
// 6807 %IF C1_LABU=0 %THEN C1_LABNO=0
if (( C1->LABU ) != ( 0 )) goto L_06bf;
C1->LABNO = 0;
L_06bf:
// 6808 %RETURN
return;
// 6809 %FINISH
L_06be:
// 6810 %REPEAT
goto L_06bb;
L_06bc:
// 6811 %END
return;
_imp_endofblock: ;
} // End of block LABUNUSED at level 6
// 6812 %ROUTINE OMIT TO(%INTEGER LAB)
void OMITTO( int LAB )
{
__label__ _imp_endofblock;
// 6813 !***********************************************************************
// 6814 !* A JUMP TURNS OUT TO BE UNCONDITIONAL. OMIT CODE FOR SKIPPED BIT *
// 6815 !***********************************************************************
// 6816 %RECORD(CF)%NAME C1{(CF)
CF *C1;
// 6817 %CYCLE
L_06c0:
// 6818 C1==CLIST(CPTR)
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6819 %IF C1_LABNO>0 %START
if (( C1->LABNO ) <= ( 0 )) goto L_06c3;
// 6820 %IF C1_LABNO=LAB % %THEN %RETURN
if (( C1->LABNO ) != ( LAB )) goto L_06c4;
return;
L_06c4:
// 6821 JUMP(15,LAB,B'11')
JUMP(15, LAB, 3);
// 6822 %RETURN
return;
// 6823 %FINISH
L_06c3:
// 6824 CPTR=CPTR+1
CPTR = ((CPTR)) + ((1));
// 6825 %EXIT %IF CPTR>=CMAX
if (( CPTR ) < ( CMAX )) goto L_06c5;
goto L_06c1;
L_06c5:
// 6826 %REPEAT
goto L_06c0;
L_06c1:
// 6827 %END
return;
_imp_endofblock: ;
} // End of block OMITTO at level 6
// 6828 %ROUTINE SKIP SC(%INTEGER REVERSED)
void SKIPSC( int REVERSED )
{
__label__ _imp_endofblock;
// 6829 !***********************************************************************
// 6830 !* REVERSED=1 FOR RECURSIVE CALL IN %NOT(SC) *
// 6831 !* SKIPS OVER A SIMPLE CONDITION. P ON ALT OF<SC> *
// 6832 !***********************************************************************
// 6833 %SWITCH SCALT(1:3)
static int SCALT_idx;
static const void * /*SWITCH*/ SCALT[(3)-(1)+1] = { &&SCALT_1, &&SCALT_2, &&SCALT_3, };
// 6834 %INTEGER ALT
int ALT;
// 6835 ALT=A(P); P=P+1
ALT = A[P];
P = ((P)) + ((1));
// 6836 ->SCALT(ALT)
goto *(SCALT-1)[ALT]; /* Bounds=1:3 */
// 6837 SCALT(1): ! <EXP><COMP><EXP><SECONDSIDE>
SCALT_1:
// 6838 C1_SP1=P-PIN
C1->SP1 = ((P)) - ((PIN));
// 6839 SKIP EXP
SKIPEXP();
// 6840 C1_CMP1=A(P)
C1->CMP1 = A[P];
// 6841 C1_REV=3*REVERSED
C1->REV = ((3)) * ((REVERSED));
// 6842 P=P+1; C1_SP2=P-PIN
P = ((P)) + ((1));
C1->SP2 = ((P)) - ((PIN));
// 6843 SKIP EXP
SKIPEXP();
// 6844 %IF A(P)=2 %THEN P=P+1 %ELSE %START
if (( A[P] ) != ( 2 )) goto L_06c6;
P = ((P)) + ((1));
goto L_06c7;
L_06c6:
// 6845 C1_CMP2=A(P+1); ! DEAL WITH 2ND HALF OF D-SIDED
C1->CMP2 = A[((P)) + ((1))];
// 6846 P=P+2; SKIP EXP
P = ((P)) + ((2));
SKIPEXP();
// 6847 %FINISH
L_06c7:
// 6848 %RETURN
return;
// 6849 SCALT(2): ! '('<SC><RESTOFCOND>')'
SCALT_2:
// 6850 L=L+1
L = ((L)) + ((1));
// 6851 SKIP SC(REVERSED)
SKIPSC(REVERSED);
// 6852 SKIP COND(REVERSED)
SKIPCOND(REVERSED);
// 6853 L=L-1
L = ((L)) - ((1));
// 6854 %RETURN
return;
// 6855 SCALT(3): ! %NOT(SC)
SCALT_3:
// 6856 SKIP SC(REVERSED!!1)
SKIPSC(((REVERSED)) ^ ((1)));
// 6857 %END; ! OF ROUTINE SKIP SC
return;
_imp_endofblock: ;
} // End of block SKIPSC at level 6
// 6858 %ROUTINE SKIP COND(%INTEGER REVERSED)
void SKIPCOND( int REVERSED )
{
__label__ _imp_endofblock;
// 6859 !***********************************************************************
// 6860 !* SKIPS OVER <RESTOFCOND> *
// 6861 !***********************************************************************
// 6862 %INTEGER ALT,ALTP
int ALT;
int ALTP;
// 6863 ALT=A(P); ! 1=%AND<ANDC>,2=%OR<ORC>,3=NULL
ALT = A[P];
// 6864 P=P+1
P = ((P)) + ((1));
// 6865 %IF ALT\=3 %THEN %START; ! NULL ALTERNATIVE NOTHING TO DO
if (( ALT ) == ( 3 )) goto L_06c8;
// 6866 {%UNTIL ALTP=2} %CYCLE; ! UNTIL NO MORE <SC>S
L_06c9:
// 6867 C1_LVL=L; C1_TF=ALT
C1->LVL = L;
C1->TF = ALT;
// 6868 C1_TF=C1_TF!!(3*REVERSED)
C1->TF = ((C1->TF)) ^ ((((3)) * ((REVERSED))));
// 6869 CPTR=CPTR+1
CPTR = ((CPTR)) + ((1));
// 6870 C1==CLIST(CPTR); C1=0
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
C1 = 0;
// 6871 SKIP SC(REVERSED)
SKIPSC(REVERSED);
// 6872 ALTP=A(P); P=P+1
ALTP = A[P];
P = ((P)) + ((1));
// 6873 %REPEAT %UNTIL ALTP=2; ! UNTIL NO MORE <SC>S
if (( ALTP ) == ( 2 )) goto L_06ca;
goto L_06c9;
L_06ca:
// 6874 %FINISH
L_06c8:
// 6875 %END
return;
_imp_endofblock: ;
} // End of block SKIPCOND at level 6
// 6876 %ROUTINE WRITE CONDLIST
void WRITECONDLIST( void )
{
__label__ _imp_endofblock;
// 6877 %CONSTSTRING(5) %ARRAY CM(0:10)=" "," ="," >="," >",
const _imp_string /*%string(5)*/ CM[(10)-(0)+1] = { _imp_str_literal(" "), _imp_str_literal(" ="), _imp_str_literal(" >="), _imp_str_literal(" >"), _imp_str_literal(" #"), _imp_str_literal(" <="), _imp_str_literal(" <"), _imp_str_literal(" \\="), _imp_str_literal(" ->"), _imp_str_literal(" =="), _imp_str_literal(" \\=="), };
// 6878 " #"," <="," <"," \="," ->",
// 6879 " =="," \==";
// 6880 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\n NO TF C1 C2 LABU LVL JMP REV LABNO\n"));
// 6881 NO TF C1 C2 LABU LVL JMP REV LABNO
// 6882 ")
// 6883 %CYCLE CPTR=1,1,CMAX
CPTR = ((1)) - ((1));
L_06cc:
if (( CPTR ) == ( CMAX )) goto L_06cd;
CPTR = ((CPTR)) + ((1));
// 6884 C1==CLIST(CPTR)
C1 = (&(/* No array bound info found for: */CLIST[CPTR]));
// 6885 WRITE(CPTR,2)
WRITE(CPTR, 2);
// 6886 WRITE(C1_TF,4)
WRITE(C1->TF, 4);
// 6887 PRINTSTRING(CM(C1_CMP1))
PRINTSTRING(CM[C1->CMP1]);
// 6888 PRINTSTRING(CM(C1_CMP2))
PRINTSTRING(CM[C1->CMP2]);
// 6889 WRITE(C1_LABU,6)
WRITE(C1->LABU, 6);
// 6890 WRITE(C1_LVL,5)
WRITE(C1->LVL, 5);
// 6891 WRITE(C1_JMP,4)
WRITE(C1->JMP, 4);
// 6892 WRITE(C1_REV,4)
WRITE(C1->REV, 4);
// 6893 WRITE(C1_LABNO,7)
WRITE(C1->LABNO, 7);
// 6894 NEWLINE
NEWLINE();
// 6895 %REPEAT
goto L_06cc;
L_06cd:
// 6896 %END
return;
_imp_endofblock: ;
} // End of block WRITECONDLIST at level 6
// 6897 %INTEGERFN CCOMP
int CCOMP( void )
{
__label__ _imp_endofblock;
// 6898 !***********************************************************************
// 6899 !* COMPILES A COMPARISION: THREE DIFFERENT CASES *
// 6900 !* 1) ARITHMETIC EXPRESSIONS EXPOP IS USED *
// 6901 !* 2) STRING EXPRESSION AD-HOC CODE PLANTED BY THIS ROUTINE *
// 6902 !* 3) RESOLUTIONS - CRES CAN BE USED *
// 6903 !* 4) EQUIVALENCES INTEGER COMPARISONS ON ADDRESSES *
// 6904 !* RESULT=0 CODE COMPILED *
// 6905 !* RESULT#0 UNCODITIONAL JUMP TO LAB=RESULT *
// 6906 !***********************************************************************
// 6907 %ROUTINESPEC ACOMP(%INTEGER TF,DS)
auto void ACOMP( int TF, int DS );
// 6908 %ROUTINESPEC ADCOMP(%INTEGER TF)
auto void ADCOMP( int TF );
// 6909 %ROUTINESPEC SCOMP(%INTEGER DS,TF,LAB,%INTEGERNAME WA)
auto void SCOMP( int DS, int TF, int LAB, int *WA );
// 6910 %INTEGER HEAD1,HEAD2,NOPS,TE1,TE2,TEX1,TEX2,P1,P2,FEXIT,IEXIT,CMP,WA1,WA2,WA3,BOT1,BOT2
int HEAD1;
int HEAD2;
int NOPS;
int TE1;
int TE2;
int TEX1;
int TEX2;
int P1;
int P2;
int FEXIT;
int IEXIT;
int CMP;
int WA1;
int WA2;
int WA3;
int BOT1;
int BOT2;
// 6911 !
// 6912 HEAD1=0; HEAD2=0; NOPS=0
HEAD1 = 0;
HEAD2 = 0;
NOPS = 0;
// 6913 BOT1=0; BOT2=0
BOT1 = 0;
BOT2 = 0;
// 6914 FEXIT=CLIST(C1_JMP)_LABNO; ! FINAL EXIT
FEXIT = /* No array bound info found for: */CLIST[C1->JMP].LABNO;
// 6915 IEXIT=FEXIT; ! INTERMEDIATE EXIT (D-SIDED ETC)
IEXIT = FEXIT;
// 6916 %IF C1_REV!!C1_TF=2 %AND (C1_CMP1=8 %OR C1_CMP2#0) %THEN IEXIT=C1_LABNO
if (( ((C1->REV)) ^ ((C1->TF)) ) != ( 2 )) goto L_06cf;
if (( C1->CMP1 ) == ( 8 )) goto L_06ce;
if (( C1->CMP2 ) == ( 0 )) goto L_06cf;
L_06ce:
IEXIT = C1->LABNO;
L_06cf:
// 6917 !
// 6918 P=PIN+C1_SP2
P = ((PIN)) + ((C1->SP2));
// 6919 P2=P; P1=PIN+C1_SP1
P2 = P;
P1 = ((PIN)) + ((C1->SP1));
// 6920 %IF C1_CMP1=8 %THEN %START
if (( C1->CMP1 ) != ( 8 )) goto L_06d0;
// 6921 ! CONDITIONAL RESOLUTION
// 6922 ! NB CRES BRANCHES ON FALSE!!
// 6923 P=P1
P = P1;
// 6924 %IF A(P+3)=4 %AND A(P+4)=1 %START
if (( A[((P)) + ((3))] ) != ( 4 )) goto L_06d1;
if (( A[((P)) + ((4))] ) != ( 1 )) goto L_06d1;
// 6925 P=P+5; CNAME(2,DR); ! LH STRING TO DR
P = ((P)) + ((5));
CNAME(2, 1);
// 6926 %IF A(P)=2 %THEN %START
if (( A[P] ) != ( 2 )) goto L_06d2;
// 6927 %IF TYPE#5 %THEN FAULT2(71,0,FROMAR2(P1+5)) %AND %RESULT=0
if (( TYPE ) == ( 5 )) goto L_06d3;
FAULT2(71, 0, FROMAR2(((P1)) + ((5))));
return 0;
L_06d3:
// 6928 P=P2
P = P2;
// 6929 CRES(IEXIT); ! FAILURES -> IEXIT
CRES(IEXIT);
// 6930 %IF IEXIT=FARLAB %THEN BITMASK=BITMASK!1 %ELSE BITMASK=BITMASK!2
if (( IEXIT ) != ( FARLAB )) goto L_06d4;
BITMASK = ((BITMASK)) | ((1));
goto L_06d5;
L_06d4:
BITMASK = ((BITMASK)) | ((2));
L_06d5:
// 6931 %IF C1_REV!!C1_TF=2 %THEN JUMP(15,FEXIT,B'11')
if (( ((C1->REV)) ^ ((C1->TF)) ) != ( 2 )) goto L_06d6;
JUMP(15, FEXIT, 3);
L_06d6:
// 6932 %RESULT=0
return 0;
// 6933 %FINISH
L_06d2:
// 6934 %FINISH
L_06d1:
// 6935 FAULT2(74,0,0)
FAULT2(74, 0, 0);
// 6936 %RESULT=0
return 0;
// 6937 %FINISH
L_06d0:
// 6938 %IF C1_CMP1>8 %THEN ->ADRCOMP
if (( C1->CMP1 ) <= ( 8 )) goto L_06d7;
goto U_0208;
L_06d7:
// 6939 MASK=FCOMP(C1_CMP1)
MASK = (FCOMP-1)[C1->CMP1];
// 6940 TE2=TSEXP(TEX2)
TE2 = TSEXP( &TEX2);
// 6941 ->STR %IF TYPE=5
if (( TYPE ) != ( 5 )) goto L_06d8;
goto U_0209;
L_06d8:
// 6942 ->ARITH %UNLESS TE2=1
if (( TE2 ) == ( 1 )) goto L_06d9;
goto U_020a;
L_06d9:
// 6943 P=P1; TE1=TSEXP(TEX1)
P = P1;
TE1 = TSEXP( &TEX1);
// 6944 ->STR %IF TYPE=5
if (( TYPE ) != ( 5 )) goto L_06da;
goto U_0209;
L_06da:
// 6945 ARITH: ! ARITHMETIC COMPARISIONS
U_020a:
// 6946 P=P1+3
P = ((P1)) + ((3));
// 6947 TORP(HEAD1,BOT1,NOPS); ! FIRST EXPRESSION TO REVERSE POL
TORP( &HEAD1, &BOT1, &NOPS);
// 6948 CMP=C1_CMP1
CMP = C1->CMP1;
// 6949 P=P2+3
P = ((P2)) + ((3));
// 6950 %IF C1_CMP2#0 %THEN %START; ! IF D-SIDED DEAL WITH MIDDLE
if (( C1->CMP2 ) == ( 0 )) goto L_06db;
// 6951 ACOMP(1,1); ! BRANCH IEXIT %IF FALSE
ACOMP(1, 1);
// 6952 %IF MASK=15 %THEN %RESULT=IEXIT
if (( MASK ) != ( 15 )) goto L_06dc;
return IEXIT;
L_06dc:
// 6953 JUMP(MASK,IEXIT,B'11')
JUMP(MASK, IEXIT, 3);
// 6954 P=P+5; ! TO THE THIRD EXPRSN
P = ((P)) + ((5));
// 6955 CMP=C1_CMP2; ! COMPARATOR NO 2
CMP = C1->CMP2;
// 6956 %FINISH
L_06db:
// 6957 !
// 6958 ACOMP(C1_REV!!C1_TF,0); ! SECOND OR ONLY COMPARISION
ACOMP(((C1->REV)) ^ ((C1->TF)), 0);
// 6959 %IF MASK=15 %THEN %RESULT=FEXIT
if (( MASK ) != ( 15 )) goto L_06dd;
return FEXIT;
L_06dd:
// 6960 JUMP(MASK,FEXIT,B'11')
JUMP(MASK, FEXIT, 3);
// 6961 %RESULT=0
return 0;
// 6962 STR: ! STRING COMPARISIONS
U_0209:
// 6963 ! SOME CARE IS NEEDED IN FREEING
// 6964 ! STRING WK-AREAS SET BY CSTREXP
// 6965 P=P1
P = P1;
// 6966 WA1=0; WA2=0; WA3=0
WA1 = 0;
WA2 = 0;
WA3 = 0;
// 6967 %IF C1_CMP2=0 %AND 7<=FCOMP(C1_CMP1)<=8 %AND A(P2+3)=4 %AND A(P2+4)=2 %AND A(P2+5)=16_35 %AND A(P2+10)=0 %AND A(P2+11)=2 %THEN %START
if (( C1->CMP2 ) != ( 0 )) goto L_06de;
if (( 7 ) > ( (FCOMP-1)[C1->CMP1] )) goto L_06de;
if (( (FCOMP-1)[C1->CMP1] ) > ( 8 )) goto L_06de;
if (( A[((P2)) + ((3))] ) != ( 4 )) goto L_06de;
if (( A[((P2)) + ((4))] ) != ( 2 )) goto L_06de;
if (( A[((P2)) + ((5))] ) != ( 53 )) goto L_06de;
if (( A[((P2)) + ((10))] ) != ( 0 )) goto L_06de;
if (( A[((P2)) + ((11))] ) != ( 2 )) goto L_06de;
// 6968 CSTREXP(0,DR)
CSTREXP(0, 1);
// 6969 MASK=FCOMP(C1_CMP1+14)
MASK = (FCOMP-1)[((C1->CMP1)) + ((14))];
// 6970 %IF C1_REV!!C1_TF=1 %THEN MASK=REVERSE(MASK)
if (( ((C1->REV)) ^ ((C1->TF)) ) != ( 1 )) goto L_06df;
MASK = REVERSE(MASK);
L_06df:
// 6971 JUMP(MASK,FEXIT,B'11')
JUMP(MASK, FEXIT, 3);
// 6972 %RESULT=0
return 0;
// 6973 %FINISH
L_06de:
// 6974 CSTREXP(16,ACCR); ! DO NOT FREE WK-AREA
CSTREXP(16, 0);
// 6975 WA1=VALUE; ! SAVE ADDRESS OF WK-AREA
WA1 = VALUE;
// 6976 CMP=C1_CMP1
CMP = C1->CMP1;
// 6977 P=P2
P = P2;
// 6978 !
// 6979 %IF C1_CMP2#0 %THEN %START; ! D-SIDED DEAL WITH MIDDLE
if (( C1->CMP2 ) == ( 0 )) goto L_06e0;
// 6980 SCOMP(1,1,IEXIT,WA2)
SCOMP(1, 1, IEXIT, &WA2);
// 6981 P=P+2; CMP=C1_CMP2
P = ((P)) + ((2));
CMP = C1->CMP2;
// 6982 %IF WA1#0 %THEN RETURN WSP(WA1,256) %AND WA1=0
if (( WA1 ) == ( 0 )) goto L_06e1;
RETURNWSP(WA1, 256);
WA1 = 0;
L_06e1:
// 6983 %FINISH
L_06e0:
// 6984 !
// 6985 SCOMP(0,C1_REV!!C1_TF,FEXIT,WA3)
SCOMP(0, ((C1->REV)) ^ ((C1->TF)), FEXIT, &WA3);
// 6986 %CYCLE CMP=ADDR(WA1),4,ADDR(WA3)
CMP = ((ADDR( &WA1))) - ((4));
L_06e2:
if (( CMP ) == ( ADDR( &WA3) )) goto L_06e3;
CMP = ((CMP)) + ((4));
// 6987 %IF INTEGER(CMP)#0 %THEN RETURN WSP(INTEGER(CMP),256)
if (( *INTEGER(CMP) ) == ( 0 )) goto L_06e5;
RETURNWSP( **INTEGER(CMP), 256);
L_06e5:
// 6988 %REPEAT
goto L_06e2;
L_06e3:
// 6989 %RESULT=0
return 0;
// 6990 ADRCOMP: ! ADRESS COMPARISONS
U_0208:
// 6991 ADCOMP(C1_REV!!C1_TF)
ADCOMP(((C1->REV)) ^ ((C1->TF)));
// 6992 JUMP(MASK,FEXIT,B'11')
JUMP(MASK, FEXIT, 3);
// 6993 %RESULT=0
return 0;
// 6994 %ROUTINE ADCOMP(%INTEGER TF)
void ADCOMP( int TF )
{
__label__ _imp_endofblock;
// 6995 !***********************************************************************
// 6996 !* COMPILES AN == OR ADDRESS COMPARISON WHICH CAN NOT BE *
// 6997 !* DOUBLESIDED. BETTER CODE COULD BE GENERATED FOR THE *
// 6998 !* MOST COMMON CASE IE POINTERNAME==VARIABLE *
// 6999 !************************************************************************
// 7000 %INTEGER TYPEP,PRECP,LHNAME,RHNAME,FNAME
int TYPEP;
int PRECP;
int LHNAME;
int RHNAME;
int FNAME;
// 7001 %RECORD(RD) R{(RD)
RD R;
// 7002 LHNAME=A(P1+5)<<8!A(P1+6)
LHNAME = ((((A[((P1)) + ((5))])) << ((8)))) | ((A[((P1)) + ((6))]));
// 7003 FNAME=RHNAME
FNAME = RHNAME;
// 7004 RHNAME=A(P2+5)<<8!A(P2+6)
RHNAME = ((((A[((P2)) + ((5))])) << ((8)))) | ((A[((P2)) + ((6))]));
// 7005 ->FLT %UNLESS A(P1+3)=4 %AND A(P1+4)=1
if (( A[((P1)) + ((3))] ) != ( 4 )) goto L_06e4;
if (( A[((P1)) + ((4))] ) == ( 1 )) goto L_06e6;
L_06e4:
goto U_0212;
L_06e6:
// 7006 P=P1+5; CNAME(4,ACCR)
P = ((P1)) + ((5));
CNAME(4, 0);
// 7007 ->FLT %UNLESS A(P)=2; ! NO REST OF EXPR
if (( A[P] ) == ( 2 )) goto L_06e7;
goto U_0212;
L_06e7:
// 7008 TYPEP=TYPE; PRECP=PREC
TYPEP = TYPE;
PRECP = PREC;
// 7009 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 7010 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 7011 R_PTYPE=1; R_XB=ACCR<<4
R.PTYPE = 1;
R.XB = ((0)) << ((4));
// 7012 R_FLAG=9
R.FLAG = 9;
// 7013 !
// 7014 FNAME=LHNAME
FNAME = LHNAME;
// 7015 ->FLT %UNLESS A(P2+3)=4 %AND A(P2+4)=1
if (( A[((P2)) + ((3))] ) != ( 4 )) goto L_06e8;
if (( A[((P2)) + ((4))] ) == ( 1 )) goto L_06e9;
L_06e8:
goto U_0212;
L_06e9:
// 7016 P=P2+5; CNAME(4,ACCR)
P = ((P2)) + ((5));
CNAME(4, 0);
// 7017 ->FLT %UNLESS A(P)=2; ! NO REST OF EXPR
if (( A[P] ) == ( 2 )) goto L_06ea;
goto U_0212;
L_06ea:
// 7018 FAULT2(83,LHNAME,RHNAME) %UNLESS TYPEP=TYPE %AND PRECP=PREC
if (( TYPEP ) != ( TYPE )) goto L_06eb;
if (( PRECP ) == ( PREC )) goto L_06ec;
L_06eb:
FAULT2(83, LHNAME, RHNAME);
L_06ec:
// 7019 PF1(ICP,0,TOS,0)
PF1(230, 0, 6, 0);
// 7020 %IF C1_CMP1=10 %THEN MASK=7 %ELSE MASK=8
if (( C1->CMP1 ) != ( 10 )) goto L_06ed;
MASK = 7;
goto L_06ee;
L_06ed:
MASK = 8;
L_06ee:
// 7021 %IF TF=1 %THEN MASK=REVERSE(MASK)
if (( TF ) != ( 1 )) goto L_06ef;
MASK = REVERSE(MASK);
L_06ef:
// 7022 %RETURN
return;
// 7023 FLT: REGISTER(ACCR)=0
U_0212:
REGISTER[0] = 0;
// 7024 FAULT2(80,0,FNAME)
FAULT2(80, 0, FNAME);
// 7025 MASK=7
MASK = 7;
// 7026 %END
return;
_imp_endofblock: ;
} // End of block ADCOMP at level 7
// 7027 %ROUTINE ACOMP(%INTEGER TF,DS)
void ACOMP( int TF, int DS )
{
__label__ _imp_endofblock;
// 7028 !***********************************************************************
// 7029 !* TYPE & PREC DEFINE THE EXPRSN IN REVERSE POLISH IN HEAD1 *
// 7030 !* THIS ROUTINE CONVERTS THE NEXT EXPRSN TO REVERSE POLISH AND *
// 7031 !* ADDS OPERATORS FOR TYPE CHANGING(IF REQ) CMPRSN AND JUMP *
// 7032 !***********************************************************************
// 7033 %INTEGER PRECP,TYPEP,REG
int PRECP;
int TYPEP;
int REG;
// 7034 PRECP=PTYPE>>4&15; TYPEP=TYPE
PRECP = (((int)(((unsigned int)(PTYPE)) >> ((4))))) & ((15));
TYPEP = TYPE;
// 7035 !
// 7036 ! ADD OPERATOR AT BOTTOM. EITHER COMPARE(31) OR DS COMPARE(32)
// 7037 !
// 7038 PUSH(HEAD2,31+DS,CMP,0)
PUSH( &HEAD2, ((31)) + ((DS)), CMP, 0);
// 7039 BOT2=HEAD2
BOT2 = HEAD2;
// 7040 NOPS=(NOPS+1)!1<<31; ! FLAG COMPARE
NOPS = ((((NOPS)) + ((1)))) | ((((1)) << ((31))));
// 7041 !
// 7042 ! CONVERT NEXT EXPRSN TO REVERSE POLISH AND TO THE SAME TYPE AS THE
// 7043 ! FIRST IF POSSIBLE. MODE=0 INTEGER IF POSSIBLE,=2 REAL, =3 LONGREAL
// 7044 !
// 7045 TORP(HEAD2,BOT2,NOPS)
TORP( &HEAD2, &BOT2, &NOPS);
// 7046 %IF TYPEP>TYPE %THEN TYPE=TYPEP
if (( TYPEP ) <= ( TYPE )) goto L_06f0;
TYPE = TYPEP;
L_06f0:
// 7047 ! CONCAT(HEAD1,HEAD2)
// 7048 ASLIST(BOT1)_LINK=HEAD2
ASLIST[BOT1].LINK = HEAD2;
// 7049 BOT1=BOT2; BOT2=0; HEAD2=0
BOT1 = BOT2;
BOT2 = 0;
HEAD2 = 0;
// 7050 EXPOP(HEAD1,-1,NOPS,256+16*PRECP+TYPE); ! PLANT THE CODE
EXPOP(HEAD1, (-(1)), NOPS, ((((256)) + ((((16)) * ((PRECP)))))) + ((TYPE)));
// 7051 ! CLEAR LIST(HEAD1)
// 7052 ASLIST(BOT1)_LINK=ASL
ASLIST[BOT1].LINK = ASL;
// 7053 ASL=HEAD1
ASL = HEAD1;
// 7054 HEAD1=0
HEAD1 = 0;
// 7055 %IF DS#0 %START
if (( DS ) == ( 0 )) goto L_06f1;
// 7056 PUSH(HEAD1,INTEGER(ADDR(EXPOPND)),EXPOPND_D,EXPOPND_XTRA)
PUSH( &HEAD1, **INTEGER(ADDR( &EXPOPND)), EXPOPND.D, EXPOPND.XTRA);
// 7057 BOT1=HEAD1
BOT1 = HEAD1;
// 7058 %IF EXPOPND_FLAG=9 %START
if (( EXPOPND.FLAG ) != ( 9 )) goto L_06f2;
// 7059 REG=EXPOPND_D>>4
REG = (int)(((unsigned int)(EXPOPND.D)) >> ((4)));
// 7060 REGISTER(REG)=1
REGISTER[REG] = 1;
// 7061 OLINK(REG)=ADDR(ASLIST(HEAD1))
OLINK[REG] = ADDR( &ASLIST[HEAD1]);
// 7062 %FINISH
L_06f2:
// 7063 %FINISH
L_06f1:
// 7064 %IF TF=1 %THEN MASK=REVERSE(MASK)
if (( TF ) != ( 1 )) goto L_06f3;
MASK = REVERSE(MASK);
L_06f3:
// 7065 %END
return;
_imp_endofblock: ;
} // End of block ACOMP at level 7
// 7066 %ROUTINE SCOMP(%INTEGER DS,TF,LAB,%INTEGERNAME WA)
void SCOMP( int DS, int TF, int LAB, int *WA )
{
__label__ _imp_endofblock;
// 7067 !***********************************************************************
// 7068 !* 1ST STRING IS DEFINED BY (ACCR) *
// 7069 !* THIS ROUTINE EVALUATES THE NEXT STRING EXPRS AND PERFORMS *
// 7070 !* THE COMPARISON & BRANCH. *
// 7071 !* DS=0 UNLESS THIS COMPARISON IS THE FIRST HALF OF A DBLE-SIDED *
// 7072 !***********************************************************************
// 7073 %INTEGER MASK
int MASK;
// 7074 %RECORD(RD) R{(RD)
RD R;
// 7075 !
// 7076 REGISTER(ACCR)=1
REGISTER[0] = 1;
// 7077 OLINK(ACCR)=ADDR(R)
OLINK[0] = ADDR( &R);
// 7078 R_PTYPE=1; R_XB=ACCR<<4; R_FLAG=9
R.PTYPE = 1;
R.XB = ((0)) << ((4));
R.FLAG = 9;
// 7079 MASK=FCOMP(CMP)
MASK = (FCOMP-1)[CMP];
// 7080 %IF TF=1 %THEN MASK=REVERSE(MASK); ! REVERSE MASK TO JMP IF FALS
if (( TF ) != ( 1 )) goto L_06f4;
MASK = REVERSE(MASK);
L_06f4:
// 7081 !
// 7082 CSTREXP(16,DR); ! SAVE WK-AREA
CSTREXP(16, 1);
// 7083 WA=VALUE
WA = VALUE;
// 7084 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 7085 %IF R_FLAG#9 %THEN PF1(LSD,0,TOS,0)
if (( R.FLAG ) == ( 9 )) goto L_06f5;
PF1(100, 0, 6, 0);
L_06f5:
// 7086 %IF DS#0 %THEN PF1(STD,0,TOS,0)
if (( DS ) == ( 0 )) goto L_06f6;
PF1(88, 0, 6, 0);
L_06f6:
// 7087 PSF1(INCA,0,1); PSF1(IAD,0,1)
PSF1(20, 0, 1);
PSF1(224, 0, 1);
// 7088 PF2(CPS,1,1,0,0,0)
PF2(164, 1, 1, 0, 0, 0);
// 7089 GRUSE(ACCR)=0; GRUSE(DR)=0
GRUSE[0] = 0;
GRUSE[1] = 0;
// 7090 !
// 7091 ! IF CC=8 MUST CHECK THAT ACC STRING IS EXHAUSTED OTHERWISE CHANGE CC
// 7092 ! TO GIVE RESULT ACC>DR. THIS IS BEST FIDDLED USING ISH.
// 7093 ! CAN SKIP THIS CHECK IF MASK IS SUCH THAT 2**3 &2**2 BITS SET THE SAME
// 7094 !
// 7095 %IF 0#MASK&16_C#16_C %THEN %START
if (( 0 ) == ( ((MASK)) & ((12)) )) goto L_06f7;
if (( ((MASK)) & ((12)) ) == ( 12 )) goto L_06f7;
// 7096 PF3(JCC,7,0,4)
PF3(2, 7, 0, 4);
// 7097 PSF1(USH,0,-32)
PSF1(200, 0, (-(32)));
// 7098 PSF1(ISH,0,-24)
PSF1(232, 0, (-(24)));
// 7099 %FINISH
L_06f7:
// 7100 %IF DS#0 %THEN PF1(LSD,0,TOS,0); ! DOES NOT CHANGE CC
if (( DS ) == ( 0 )) goto L_06f8;
PF1(100, 0, 6, 0);
L_06f8:
// 7101 JUMP(MASK,LAB,B'11')
JUMP(MASK, LAB, 3);
// 7102 %END
return;
_imp_endofblock: ;
} // End of block SCOMP at level 7
// 7103 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block CCOMP at level 6
// 7104 %ROUTINE JUMP(%INTEGER MASK,LAB,FLAGS)
void JUMP( int MASK, int LAB, int FLAGS )
{
__label__ _imp_endofblock;
// 7105 !***********************************************************************
// 7106 !* CALLS ENTER JUMP WHILE MAINTAINING BITMASK *
// 7107 !***********************************************************************
// 7108 %IF MASK=0 %THEN LAB UNUSED(LAB) %AND %RETURN
if (( MASK ) != ( 0 )) goto L_06f9;
LABUNUSED(LAB);
return;
L_06f9:
// 7109 ENTER JUMP(MASK,LAB,FLAGS)
ENTERJUMP(MASK, LAB, FLAGS);
// 7110 %IF LAB=FARLAB %THEN BITMASK=BITMASK!1 %ELSE BITMASK=BITMASK!2
if (( LAB ) != ( FARLAB )) goto L_06fa;
BITMASK = ((BITMASK)) | ((1));
goto L_06fb;
L_06fa:
BITMASK = ((BITMASK)) | ((2));
L_06fb:
// 7111 %END
return;
_imp_endofblock: ;
} // End of block JUMP at level 6
// 7112 %END; ! OF CCOND
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block CCOND at level 5
// 7113 %INTEGERFN REVERSE(%INTEGER MASK)
int REVERSE( int MASK )
{
__label__ _imp_endofblock;
// 7114 !***********************************************************************
// 7115 !* REVERSE THE MASK FOR A JCC(MASK<=15),JAT(>15) OR JAF(>31) *
// 7116 !***********************************************************************
// 7117 %IF MASK>15 %THEN MASK=MASK!!16_30 %ELSE MASK=MASK!!15
if (( MASK ) <= ( 15 )) goto L_06fc;
MASK = ((MASK)) ^ ((48));
goto L_06fd;
L_06fc:
MASK = ((MASK)) ^ ((15));
L_06fd:
// 7118 %RESULT=MASK
return MASK;
// 7119 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block REVERSE at level 5
// 7120 %INTEGERFN ENTER LAB(%INTEGER LAB,FLAGS)
int ENTERLAB( int LAB, int FLAGS )
{
__label__ _imp_endofblock;
// 7121 !***********************************************************************
// 7122 !* ENTER A NEW LABEL ON THE LABEL LIST FOR THE CURRENT LEVEL *
// 7123 !* 2**0 OF FLAGS = 1 CONDITIONAL ENTRY *
// 7124 !* 2**1 OF FLAGS = 1 UPDATE ENVIRONMENT *
// 7125 !* 2**2 OF FLAGS = 1 REPLACE ENV =0 MERGE ENV *
// 7126 !* THE LABEL LIST *
// 7127 !* S1 = USE BITS<<8 ! LABEL ADDR *
// 7128 !* S2 = ENVIRONMENT LIST << 16 ! UNFILLED JUMPS LIST *
// 7129 !* S3 = LAB NO - RESET TO FFFF WHEN USED FOR INTERNAL LABELS *
// 7130 !* RESULT = 1 LABEL ENTERED *
// 7131 !* RESULT = 0 CONDITIONAL LABEL NOT REQUIRED *
// 7132 !***********************************************************************
// 7133 %INTEGER CELL,AT,ENVHEAD,JUMPHEAD,INSTRN,OLDCELL,WORK
int CELL;
int AT;
int ENVHEAD;
int JUMPHEAD;
int INSTRN;
int OLDCELL;
int WORK;
// 7134 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 7135 %INTEGERNAME LHEAD
int *LHEAD;
// 7136 CELL=LABEL(LEVEL); OLDCELL=0
CELL = LABEL[LEVEL];
OLDCELL = 0;
// 7137 %WHILE CELL>0 %CYCLE
L_06fe:
if (( CELL ) <= ( 0 )) goto L_06ff;
// 7138 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 7139 %EXIT %IF LCELL_S3=LAB
if (( LCELL->S3 ) != ( LAB )) goto L_0701;
goto L_06ff;
L_0701:
// 7140 OLDCELL=CELL; CELL=LCELL_LINK
OLDCELL = CELL;
CELL = LCELL->LINK;
// 7141 %REPEAT
goto L_06fe;
L_06ff:
// 7142 !
// 7143 %IF CELL<=0 %THEN %START; ! LABEL NOT KNOWN
if (( CELL ) > ( 0 )) goto L_0702;
// 7144 %IF FLAGS&1=0 %THEN %START;! UNCONDITIONAL ENTRY
if (( ((FLAGS)) & ((1)) ) != ( 0 )) goto L_0703;
// 7145 PUSH(LABEL(LEVEL),CA,0,LAB)
PUSH( &LABEL[LEVEL], CA, 0, LAB);
// 7146 FORGET(-1)
FORGET((-(1)));
// 7147 %RESULT=1
return 1;
// 7148 %FINISH
L_0703:
// 7149 %RESULT=0
return 0;
// 7150 %FINISH
L_0702:
// 7151 !
// 7152 ! LABEL HAS BEEN REFERENCED - FILL IN ITS ADDRESS
// 7153 !
// 7154 %IF LCELL_S1&16_FFFFFF# 0 %THEN %START
if (( ((LCELL->S1)) & ((16777215)) ) == ( 0 )) goto L_0704;
// 7155 FAULT(2,LAB); ! LABEL SET TWICE
FAULT(2, LAB);
// 7156 %FINISH %ELSE %START
goto L_0705;
L_0704:
// 7157 LCELL_S1=16_1000000!CA
LCELL->S1 = ((16777216)) | ((CA));
// 7158 %FINISH
L_0705:
// 7159 !
// 7160 ! SORT OUT ENVIRONMENTS - AS DIRECTED BY FLAGS
// 7161 !
// 7162 JUMPHEAD=LCELL_S2
JUMPHEAD = LCELL->S2;
// 7163 ENVHEAD=JUMPHEAD>>16
ENVHEAD = (int)(((unsigned int)(JUMPHEAD)) >> ((16)));
// 7164 JUMPHEAD=JUMPHEAD&16_FFFF
JUMPHEAD = ((JUMPHEAD)) & ((65535));
// 7165 %IF FLAGS&2=0 %THEN %START
if (( ((FLAGS)) & ((2)) ) != ( 0 )) goto L_0706;
// 7166 FORGET(-1)
FORGET((-(1)));
// 7167 CLEAR LIST(ENVHEAD)
CLEARLIST( &ENVHEAD);
// 7168 %FINISH %ELSE %START
goto L_0707;
L_0706:
// 7169 REMEMBER %IF FLAGS&4=0
if (( ((FLAGS)) & ((4)) ) != ( 0 )) goto L_0708;
REMEMBER();
L_0708:
// 7170 RESTORE (ENVHEAD)
RESTORE(ENVHEAD);
// 7171 ENVHEAD=0
ENVHEAD = 0;
// 7172 MERGE INFO %IF FLAGS&4=0
if (( ((FLAGS)) & ((4)) ) != ( 0 )) goto L_0709;
MERGEINFO();
L_0709:
// 7173 %FINISH
L_0707:
// 7174 !
// 7175 ! NOW FILL JUMPS TO THIS LABEL - JUMP LIST FORMAT GIVEN IN 'ENTER JMP'
// 7176 !
// 7177 %WHILE JUMPHEAD#0 %CYCLE
L_070a:
if (( JUMPHEAD ) == ( 0 )) goto L_070b;
// 7178 POP(JUMPHEAD,AT,INSTRN,WORK)
POP( &JUMPHEAD, &AT, &INSTRN, &WORK);
// 7179 PLUG(1,AT,INSTRN!(CA-AT)//2,4)
PLUG(1, AT, ((INSTRN)) | ((((int)(((CA)) - ((AT)))) / ((int)(2)))), 4);
// 7180 %REPEAT
goto L_070a;
L_070b:
// 7181 LCELL_S2=0
LCELL->S2 = 0;
// 7182 %IF LAB> MAX ULAB %THEN %START
if (( LAB ) <= ( MAXULAB )) goto L_070d;
// 7183 %IF OLDCELL=0 %THEN LHEAD==LABEL(LEVEL) %ELSE LHEAD==ASLIST(OLDCELL)_LINK
if (( OLDCELL ) != ( 0 )) goto L_070e;
LHEAD = (&(LABEL[LEVEL]));
goto L_070f;
L_070e:
LHEAD = (&(ASLIST[OLDCELL].LINK));
L_070f:
// 7184 POP(LHEAD,AT,AT,AT)
POP(LHEAD, &AT, &AT, &AT);
// 7185 %FINISH
L_070d:
// 7186 %RESULT=1
return 1;
// 7187 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block ENTERLAB at level 5
// 7188 %ROUTINE ENTER JUMP(%INTEGER MASK,LAB,FLAGS)
void ENTERJUMP( int MASK, int LAB, int FLAGS )
{
__label__ _imp_endofblock;
// 7189 !***********************************************************************
// 7190 !* IF LAB HAS BEEN ENCOUNTERED THEN PLANT A JCC OTHERWISE ENTER *
// 7191 !* THE LABEL IN THE LABEL LIST AND ATTACH THE JUMP TO IT SO IT *
// 7192 !* CAN BE PLANTED WHEN THE LABEL IS FOUND *
// 7193 !* THE LABEL LIST IS DESCRIBED UNDER 'ENTER LAB' *
// 7194 !* THE JUMP SUB-LIST HAS THE FORM *
// 7195 !* S1= ADDR OF JUMP *
// 7196 !* S2=INSTRN *
// 7197 !* S3=LINE NO OF JUMP FOR DIAGNOSTICS *
// 7198 !* *
// 7199 !* FLAGS BITS SIGNIFY AS FOLLOWS *
// 7200 !* 2**0 =1 JUMP IS KNOWN TO BE SHORT *
// 7201 !* 2**1 =1 ENVIRONMENT MERGEING REQUIRED *
// 7202 !***********************************************************************
// 7203 %INTEGER AT,CELL,J,JJ,LABADDR,I,ENVHEAD,OLDENV,JCODE,INSTRN
int AT;
int CELL;
int J;
int JJ;
int LABADDR;
int I;
int ENVHEAD;
int OLDENV;
int JCODE;
int INSTRN;
// 7204 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 7205 ENVHEAD=0; AT=CA
ENVHEAD = 0;
AT = CA;
// 7206 %IF LAB<MAX ULAB %THEN FLAGS=FLAGS&16_FD;! NO MERGE
if (( LAB ) >= ( MAXULAB )) goto L_0710;
FLAGS = ((FLAGS)) & ((253));
L_0710:
// 7207 %IF LAB<21000 %THEN FLAGS=FLAGS&16_FE; ! SF OR USER LAB=LONG
if (( LAB ) >= ( 21000 )) goto L_0711;
FLAGS = ((FLAGS)) & ((254));
L_0711:
// 7208 CELL=LABEL(LEVEL)
CELL = LABEL[LEVEL];
// 7209 %WHILE CELL>0 %CYCLE
L_0712:
if (( CELL ) <= ( 0 )) goto L_0713;
// 7210 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 7211 %IF LAB=LCELL_S3 %THEN %EXIT
if (( LAB ) != ( LCELL->S3 )) goto L_0715;
goto L_0713;
L_0715:
// 7212 CELL=LCELL_LINK
CELL = LCELL->LINK;
// 7213 %REPEAT
goto L_0712;
L_0713:
// 7214 INSTRN=MASK
INSTRN = MASK;
// 7215 %IF INSTRN>>8=0 %THEN %START
if (( (int)(((unsigned int)(INSTRN)) >> ((8))) ) != ( 0 )) goto L_0716;
// 7216 JCODE=JCC
JCODE = 2;
// 7217 %IF MASK>=16 %THEN JCODE=JAT
if (( MASK ) < ( 16 )) goto L_0717;
JCODE = 4;
L_0717:
// 7218 %IF MASK>=32 %THEN JCODE=JAF
if (( MASK ) < ( 32 )) goto L_0718;
JCODE = 6;
L_0718:
// 7219 INSTRN=JCODE<<24!(MASK&15)<<21
INSTRN = ((((JCODE)) << ((24)))) | ((((((MASK)) & ((15)))) << ((21))));
// 7220 %IF MASK=15 %THEN INSTRN=JUNC<<24!3<<23
if (( MASK ) != ( 15 )) goto L_0719;
INSTRN = ((((26)) << ((24)))) | ((((3)) << ((23))));
L_0719:
// 7221 %FINISH
L_0716:
// 7222 -> FIRSTREF %IF CELL<=0
if (( CELL ) > ( 0 )) goto L_071a;
goto U_01ea;
L_071a:
// 7223 LABADDR=LCELL_S1&16_FFFFFF
LABADDR = ((LCELL->S1)) & ((16777215));
// 7224 -> NOT YET SET %IF LABADDR=0
if (( LABADDR ) != ( 0 )) goto L_071b;
goto U_01eb;
L_071b:
// 7225 LCELL_S1=LABADDR!16_1000000;! FLAG LABEL AS USED
LCELL->S1 = ((LABADDR)) | ((16777216));
// 7226 I=(LABADDR-CA)//2
I = ((int)(((LABADDR)) - ((CA)))) / ((int)(2));
// 7227 %IF MASK=15 %THEN PSF1(JUNC,0,I) %ELSE PCONST(INSTRN!(I&16_3FFFF))
if (( MASK ) != ( 15 )) goto L_071c;
PSF1(26, 0, I);
goto L_071d;
L_071c:
PCONST(((INSTRN)) | ((((I)) & ((262143)))));
L_071d:
// 7228 %RETURN
return;
// 7229 FIRSTREF: ! FIRST REFERENCE TO A NEW LABEL
U_01ea:
// 7230 %IF LAB>MAX ULAB %AND FLAGS&2#0 %THEN GET ENV(ENV HEAD)
if (( LAB ) <= ( MAXULAB )) goto L_071e;
if (( ((FLAGS)) & ((2)) ) == ( 0 )) goto L_071e;
GETENV( &ENVHEAD);
L_071e:
// 7231 PUSH(LABEL(LEVEL),16_1000000,ENVHEAD<<16,LAB)
PUSH( &LABEL[LEVEL], 16777216, ((ENVHEAD)) << ((16)), LAB);
// 7232 CELL=LABEL(LEVEL)
CELL = LABEL[LEVEL];
// 7233 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 7234 -> CODE
goto U_01ec;
// 7235 NOT YET SET: ! LABEL REFERENCED BEFORE
U_01eb:
// 7236 %IF LAB>MAX ULAB %AND FLAGS&2#0 %THEN %START
if (( LAB ) <= ( MAXULAB )) goto L_071f;
if (( ((FLAGS)) & ((2)) ) == ( 0 )) goto L_071f;
// 7237 I=LCELL_S2
I = LCELL->S2;
// 7238 OLDENV=I>>16
OLDENV = (int)(((unsigned int)(I)) >> ((16)));
// 7239 REDUCE ENV(OLD ENV)
REDUCEENV( &OLDENV);
// 7240 LCELL_S2=OLDENV<<16!I&16_FFFF
LCELL->S2 = ((((OLDENV)) << ((16)))) | ((((I)) & ((65535))));
// 7241 %FINISH
L_071f:
// 7242 CODE: ! ACTUALLY PLANT THE JUMP
U_01ec:
// 7243 J=LCELL_S2
J = LCELL->S2;
// 7244 JJ=J&16_FFFF
JJ = ((J)) & ((65535));
// 7245 PUSH(JJ,CA,INSTRN,LINE)
PUSH( &JJ, CA, INSTRN, LINE);
// 7246 LCELL_S2=J&16_FFFF0000!JJ
LCELL->S2 = ((((J)) & ((-65536)))) | ((JJ));
// 7247 PCONST(INSTRN)
PCONST(INSTRN);
// 7248 %END
return;
_imp_endofblock: ;
} // End of block ENTERJUMP at level 5
// 7249 %ROUTINE REMOVE LAB(%INTEGER LAB)
void REMOVELAB( int LAB )
{
__label__ _imp_endofblock;
// 7250 !***********************************************************************
// 7251 !* REMOVES A ALBEL FROM THE CURRENT LABEL LIST WHEN KNOWN TO *
// 7252 !* BE REDUNDANT. MAINLY USED FOR CYCLE LABELS *
// 7253 !***********************************************************************
// 7254 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 7255 %INTEGERNAME LHEAD
int *LHEAD;
// 7256 %INTEGER CELL,AT
int CELL;
int AT;
// 7257 LHEAD==LABEL(LEVEL); CELL=LHEAD
LHEAD = (&(LABEL[LEVEL]));
CELL = LHEAD;
// 7258 %WHILE CELL>0 %CYCLE
L_0720:
if (( CELL ) <= ( 0 )) goto L_0721;
// 7259 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 7260 %EXIT %IF LCELL_S3=LAB
if (( LCELL->S3 ) != ( LAB )) goto L_0723;
goto L_0721;
L_0723:
// 7261 LHEAD==LCELL_LINK
LHEAD = (&(LCELL->LINK));
// 7262 CELL=LHEAD
CELL = LHEAD;
// 7263 %REPEAT
goto L_0720;
L_0721:
// 7264 %IF CELL>0 %THEN POP(LHEAD,AT,AT,AT)
if (( CELL ) <= ( 0 )) goto L_0724;
POP(LHEAD, &AT, &AT, &AT);
L_0724:
// 7265 %END
return;
_imp_endofblock: ;
} // End of block REMOVELAB at level 5
// 7266 %ROUTINE MERGE INFO
void MERGEINFO( void )
{
__label__ _imp_endofblock;
// 7267 !***********************************************************************
// 7268 !* MERGE THE CURRENT STATUS OF THE REGISTERS WITH THE VALUES *
// 7269 !* AT THE START OF THE CONDITIONAL CLAUSE. THIS PERMITS THE *
// 7270 !* THE COMPILER TO REMEMBER UNCHANGED REGISTERS BUT NOT THOSE *
// 7271 !* WHICH DEPEND ON A PARTICULAR RUN TIME ROUTE BEING TAKEN *
// 7272 !***********************************************************************
// 7273 %INTEGER I
int I;
// 7274 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0725:
if (( I ) == ( 7 )) goto L_0726;
I = ((I)) + ((1));
// 7275 GRUSE(I)=0 %UNLESS SGRUSE(I)=GRUSE(I)&255 %AND SGRINF(I)=GRINF1(I)
if (( SGRUSE[I] ) != ( ((GRUSE[I])) & ((255)) )) goto L_06cb;
if (( SGRINF[I] ) == ( GRINF1[I] )) goto L_0728;
L_06cb:
GRUSE[I] = 0;
L_0728:
// 7276 %REPEAT
goto L_0725;
L_0726:
// 7277 %END
return;
_imp_endofblock: ;
} // End of block MERGEINFO at level 5
// 7278 %ROUTINE REMEMBER
void REMEMBER( void )
{
__label__ _imp_endofblock;
// 7279 %INTEGER I
int I;
// 7280 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0729:
if (( I ) == ( 7 )) goto L_072a;
I = ((I)) + ((1));
// 7281 SGRUSE(I)=GRUSE(I)&255
SGRUSE[I] = ((GRUSE[I])) & ((255));
// 7282 SGRINF(I)=GRINF1(I)
SGRINF[I] = GRINF1[I];
// 7283 %REPEAT
goto L_0729;
L_072a:
// 7284 %END
return;
_imp_endofblock: ;
} // End of block REMEMBER at level 5
// 7285 %ROUTINE CREATE AH(%INTEGER MODE)
void CREATEAH( int MODE )
{
__label__ _imp_endofblock;
// 7286 !***********************************************************************
// 7287 !* CREATE AN ARRAY HEAD IN TEMPORARY SPACE BY MODIFYING THE HEAD *
// 7288 !* THE HEAD AT AREA,ACCESS & DISP AS FOLOWS:- *
// 7289 !* MODE=0 (ARRAY MAPPING) ACC HAS ADDR(1ST ELEMENT) *
// 7290 !* MODE=1 (ARRAYS IN RECORDS) ACC HAS RELOCATION FACTOR *
// 7291 !***********************************************************************
// 7292 %INTEGER WK
int WK;
// 7293 GET WSP(WK,4)
GETWSP( &WK, 4);
// 7294 AREA=AREA CODE
AREA = AREACODE();
// 7295 %IF MODE=0 %THEN %START
if (( MODE ) != ( 0 )) goto L_072c;
// 7296 %IF COMPILER=1=J %AND TYPE<=2 %START
if (( COMPILER ) != ( 1 )) goto L_072d;
if (( 1 ) != ( J )) goto L_072d;
if (( TYPE ) > ( 2 )) goto L_072d;
// 7297 PF1(SLSS,2,AREA,DISP+8); ! LWB TO ACC
PF1(66, 2, AREA, ((DISP)) + ((8)));
// 7298 PSF1(IMY,0,-BYTES(PREC)) %UNLESS PREC=3
if (( PREC ) == ( 3 )) goto L_072e;
PSF1(234, 0, (-(BYTES[PREC])));
L_072e:
// 7299 PF1(IAD,0,TOS,0)
PF1(224, 0, 6, 0);
// 7300 GRUSE(DR)=0
GRUSE[1] = 0;
// 7301 %FINISH
L_072d:
// 7302 PSORLF1(LUH,ACCESS,AREA,DISP)
PSORLF1(106, ACCESS, AREA, DISP);
// 7303 %FINISH %ELSE %START
goto L_072f;
L_072c:
// 7304 PSF1(LUH,0,0)
PSF1(106, 0, 0);
// 7305 PSORLF1(IAD,ACCESS,AREA,DISP)
PSORLF1(224, ACCESS, AREA, DISP);
// 7306 %FINISH
L_072f:
// 7307 !
// 7308 PSF1(ST,1,WK); ! 1ST PART OF HEAD =DESC TO ARRAY
PSF1(72, 1, WK);
// 7309 PSORLF1(LSD,ACCESS,AREA,DISP+8)
PSORLF1(100, ACCESS, AREA, ((DISP)) + ((8)));
// 7310 PSF1(ST,1,WK+8); ! 2ND PART = DESCPTR TO DV
PSF1(72, 1, ((WK)) + ((8)));
// 7311 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 7312 ACCESS=0; AREA=LNB; DISP=WK
ACCESS = 0;
AREA = 2;
DISP = WK;
// 7313 %END
return;
_imp_endofblock: ;
} // End of block CREATEAH at level 5
// 7314 %ROUTINE CSNAME(%INTEGER Z,REG)
void CSNAME( int Z, int REG )
{
__label__ _imp_endofblock;
// 7315 !***********************************************************************
// 7316 !* COMPILE A SPECIAL NAME - PTYPE=10006 (=%ROUTINE %LABEL) *
// 7317 !* THEIR TRUE PTYPE IS IN GLOBAL ARRAY TSNAME. *
// 7318 !* SNINFO HAS A FOUR BYTE RECORD FOR EACH NAME (%BI FLAG,PTR, *
// 7319 !* %SI XTRA). THE TOP BITS OF FLAG CATEGORISE AS FOLLOWS:- *
// 7320 !* 2**7 SET FOR IMPLICITLY SPECIFIED CONSTRUCT A %SPEC *
// 7321 !* 2**6 SET FOR IOCP CALL *
// 7322 !* 2**5 SET FOR BUILT IN MAPPING FUNCTIONS *
// 7323 !* 2**4 SET IF AD-HOC CODE PLANTED BY THIS ROUTINE *
// 7324 !* 2**3 SET IF FIRST PARAMETER IS OF %NAME TYPE *
// 7325 !* 2**2-2**0 HOLD NUMBER OF PARAMS *
// 7326 !* *
// 7327 !* THE FULL SPECS ARE AS FOLLOWS:- *
// 7328 !* 0=%ROUTINE SELECT INPUT(%INTEGER STREAM) *
// 7329 !* 1=%ROUTINE SELECT OUTPUT(%INTEGER STREAM) *
// 7330 !* 2=%ROUTINE NEWLINE *
// 7331 !* 3=%ROUTINE SPACE *
// 7332 !* 4=%ROUTINE SKIP SYMBOL *
// 7333 !* 5=%ROUTINE READ STRINWG(%STRINGNAME S) *
// 7334 !* 6=%ROUTINE NEWLINES(%INTEGER N) *
// 7335 !* 7=%ROUTINE SPACES(%INTEGER N) *
// 7336 !* 8=%INTEGERFN NEXT SYMBOL *
// 7337 !* 9=%ROUTINE PRINT SYMBOL(%INTEGER SYMBOL) *
// 7338 !* 10=%ROUTINE READ SYMBOL(%NAME SYMBOL) *
// 7339 !* 11=%ROUTINE READ(%NAME NUMBER) *
// 7340 !* 12=%ROUTINE WRITE(%INTEGER VALUE,PLACES) *
// 7341 !* 13=%ROUTINE NEWPAGE *
// 7342 !* 14=%INTEGERFN ADDR(%NAME VARIABLE) *
// 7343 !* 15=%LONGREALFN ARCSIN(%LONGREAL X) *
// 7344 !* 16=%INTEGERFN INT(%LONGREAL X) *
// 7345 !* 17=%INTEGERFN INTPT(%LONRGREAL X) *
// 7346 !* 18=%LONGREALFN FRACPT(%LONGREAL X) *
// 7347 !* 19=%ROUTINE PRINT(%LONGREAL NUMBER,%INTEGER BEFORE,AFTER) *
// 7348 !* 20=%ROUTINE PRINTFL(%LONGREAL NUMBER,%INTEGER PLACES) *
// 7349 !* 21=%REALMAP REAL(%INTEGER VAR ADDR) *
// 7350 !* 22=%INTEGERMAP INTEGER(%INTEGER VAR ADDR) *
// 7351 !* 23=%LONGREALFN MOD(%LONGREAL X) *
// 7352 !* 24=%LONGREALFN ARCCOS(%LONGREAL X) *
// 7353 !* 25=%LONGREALFN SQRT(%LONGREAL X) *
// 7354 !* 26=%LONGREALFN LOG(%LONGREAL X) *
// 7355 !* 27=%LONGREALFN SIN(%LONGREAL X) *
// 7356 !* 28=%LONGREALFN COS(%LONGREAL X) *
// 7357 !* 29=%LONGREALFN TAN(%LONGREAL X) *
// 7358 !* 30=%LONGREALFN EXP(%LONGREAL X) *
// 7359 !* 31=%ROUTINE CLOSE STREAM(%INTEGER STREAM) *
// 7360 !* 32=%BYTEINTEGERMAP BYTE INTEGER(%INTEGER VAR ADDR) *
// 7361 !* 33=%INTEGERFN EVENTINF *
// 7362 !* 34=%LONGREALFN RADIUS(%LONGREAL X,Y) *
// 7363 !* 35=%LONGREALFN ARCTAN(%LONGREAL X,Y) *
// 7364 !* 36=%BYTEINTEGERMAP LENGTH(%STRINGNAME S) *
// 7365 !* 37=%ROUTINE PRINT STRING(%STRING(255) MESSAGE) *
// 7366 !* 38=%INTEGERFN NL *
// 7367 !* 39=%LONGREALMAP LONG REAL(%INTEGER VAR ADDR) *
// 7368 !* 40=%ROUTINE PRINT CH(%INTEGER CHARACTER) *
// 7369 !* 41=%ROUTINE READ CH(%NAME CHARACTER) *
// 7370 !* 42=%STRINGMAP STRING(%INTEGER VAR ADDR) *
// 7371 !* 43=%ROUTINE READ ITEM(%STRINGNAME ITEM) *
// 7372 !* 44=%STRING(1)%FN NEXT ITEM *
// 7373 !* 45=%BYTEINTEGERMAP CHARNO(%STRINGNAME STR,%INTEGER CHARREQD) *
// 7374 !* 46=%STRING(1)%FN TOSTRING(%INTEGER SYMBOL) *
// 7375 !* 47=%STRING(255)%FN FROMSTRING(%STRING(255)S,%INTEGER BEG,END) *
// 7376 !* 48=%RECORDMAP RECORD(%INTEGER REC ADDR) *
// 7377 !* 49=%ARRAYMAP ARRAY(%INTEGER A1ADDR,%ARRAYNAME FORMAT) *
// 7378 !* 50=%ROUTINE SETMARGINS(%INTEGER INOUT,LHM,RHM) *
// 7379 !* 51=%INTEGERFN IMOD(%INTEGER VALUE) *
// 7380 !* 52=%LONGREALFN PI *
// 7381 !* 53=%INTEGERFN EVENTLINE *
// 7382 !* 54=%LONGINTEGERMAP LONGINTEGER(%INTEGER ADR) *
// 7383 !* 55=%LONGLONGREALMAP LONGLONGREAL(%INTEGER ADR) *
// 7384 !* 56=%LONGINTGEREFN LENGTHENI(%INTEGER VAL) *
// 7385 !* 57=%LONGLONGREALFN LENGTHENR(%LONGREAL VAL) *
// 7386 !* 58=%INTEGERFN SHORTENI(%LONGINTEGER VAL) *
// 7387 !* 59=%LONGREALFN SHORTENR(%LONGLONGREAL VAL) *
// 7388 !* 60=%INTEGERFN NEXTCH *
// 7389 !* 61=%HALFINTEGERMAP HALFINTEGER(%INTEGER ADDR) *
// 7390 !* 62=%ROUTINE PPROFILE *
// 7391 !***********************************************************************
// 7392 %INTEGERFNSPEC OPTMAP
auto int OPTMAP( void );
// 7393 %SWITCH ADHOC(1:15)
static int ADHOC_idx;
static const void * /*SWITCH*/ ADHOC[(15)-(1)+1] = { &&ADHOC_1, &&ADHOC_2, &&ADHOC_3, &&ADHOC_4, &&ADHOC_5, &&ADHOC_6, &&ADHOC_7, &&ADHOC_8, &&ADHOC_9, &&ADHOC_10, &&ADHOC_11, &&ADHOC_12, &&ADHOC_13, &&ADHOC_14, &&ADHOC_15, };
// 7394 %CONSTINTEGERARRAY SNINFO(0:62)={%C
const int SNINFO[(62)-(0)+1] = { 1091043329, 1091108865, 1082785793, 1084227585, 1073807361, -2146631680, 285278209, 285278209, 268566564, 1090715649, 419627009, -2146238463, -2145714156, 1082916865, 419758116, -2147418110, 285474852, 285474852, -2147418107, -2146893818, -2147090425, 553648190, 553648190, 285605924, -2147418104, -2147418103, -2147418102, -2147418101, -2147418100, -2147418099, -2147418098, -2146107377, 553648190, 269287460, -2147287024, -2147287023, 419889214, 1090977793, 268959780, 553648190, 1090846721, 419627009, 553648190, 419627009, 268566564, 436666430, 285802532, -2146500590, 285900824, 302714880, -2145976301, 285605924, 269221924, 269287460, 553648190, 553648190, 286130212, 286130212, 286130212, 286130212, 268566564, 553648190, 269418497, };
// 7395 16_41080001,16_41090001,16_408A0001,16_40A00001,
// 7396 16_40010001,16_800D0000,16_11010001,16_11010001,
// 7397 16_10020024,16_41030001,16_19030001,16_80130001,
// 7398 16_801B0014,16_408C0001,16_19050024,16_80010002,
// 7399 16_11040024,16_11040024,16_80010005,16_80090006,
// 7400 16_80060007,16_2100003E,16_2100003E,16_11060024,
// 7401 16_80010008,16_80010009,16_8001000A,16_8001000B,
// 7402 16_8001000C,16_8001000D,16_8001000E,16_8015000F,
// 7403 16_2100003E,16_100D0024,16_80030010,16_80030011,
// 7404 16_1907003E,16_41070001,16_10080024,16_2100003E,
// 7405 16_41050001,16_19030001,16_2100003E,16_19030001,
// 7406 16_10020024,16_1A07003E,16_11090024,16_800F0012,
// 7407 16_110A8018,16_120B1000,16_80170013,16_11060024,
// 7408 16_100C0024,16_100D0024,16_2100003E(2),
// 7409 16_110E0024(4),
// 7410 16_10020024,16_2100003E,16_100F0001;
// 7411 %CONSTSTRING(11)%ARRAY SNXREFS(0:20)={%C
const _imp_string /*%string(11)*/ SNXREFS[(20)-(0)+1] = { _imp_str_literal("READSTRING"), _imp_str_literal("S#READ"), _imp_str_literal("S#IARCSIN"), _imp_str_literal("S#INT"), _imp_str_literal("S#INTPT"), _imp_str_literal("S#FRACPT"), _imp_str_literal("S#PRINT"), _imp_str_literal("S#PRINTFL"), _imp_str_literal("S#IARCCOS"), _imp_str_literal("S#ISQRT"), _imp_str_literal("S#ILOG"), _imp_str_literal("S#ISIN"), _imp_str_literal("S#ICOS"), _imp_str_literal("S#ITAN"), _imp_str_literal("S#IEXP"), _imp_str_literal("CLOSESTREAM"), _imp_str_literal("S#IRADIUS"), _imp_str_literal("S#IARCTAN"), _imp_str_literal("FROMSTRING"), _imp_str_literal("SETMARGINS"), _imp_str_literal("S#WRITE"), };
// 7412 "READSTRING", "S#READ", "S#IARCSIN", "S#INT",
// 7413 "S#INTPT" , "S#FRACPT", "S#PRINT" , "S#PRINTFL",
// 7414 "S#IARCCOS","S#ISQRT" , "S#ILOG" , "S#ISIN",
// 7415 "S#ICOS" , "S#ITAN" , "S#IEXP" , "CLOSESTREAM",
// 7416 "S#IRADIUS","S#IARCTAN","FROMSTRING","SETMARGINS",
// 7417 "S#WRITE" ;
// 7418 !
// 7419 ! SNPARAMS HOLDS NUMBER AND PTYPE OF FORMAL PARAMETER FOR IMPLICITLY
// 7420 ! SPECIFIED EXTERNAL ROUTINES. A POINTER IN SNINFO MEANS THAT NO
// 7421 ! DUPLICATES NEED TO BE RECORDED.
// 7422 !
// 7423 %CONSTINTEGERARRAY SNPARAMS(0:29)=0,
const int SNPARAMS[(29)-(0)+1] = { 0, 1, 98, 2, 98, 98, 2, 98, 81, 3, 98, 81, 81, 1, 1077, 3, 53, 81, 81, 1, 1024, 1, 81, 3, 81, 81, 81, 2, 81, 81, };
// 7424 1,16_62, 2,16_62,16_62, 2,16_62,16_51,
// 7425 3,16_62,16_51,16_51, 1,16_435, 3,16_35,16_51,16_51,
// 7426 1,16_400, 1,16_51, 3,16_51,16_51,16_51,
// 7427 2,16_51,16_51;
// 7428 !
// 7429 %ROUTINESPEC RTOS(%INTEGER REG)
auto void RTOS( int REG );
// 7430 %RECORD(RD) R{(RD)
RD R;
// 7431 %INTEGER ERRNO,FLAG,POINTER,WREG,PIN,SNNO,SNNAME,NAPS,SNPTYPE,JJ,XTRA,IOCPEP,B,D,SNINF,P0,OPHEAD
int ERRNO;
int FLAG;
int POINTER;
int WREG;
int PIN;
int SNNO;
int SNNAME;
int NAPS;
int SNPTYPE;
int JJ;
int XTRA;
int IOCPEP;
int B;
int D;
int SNINF;
int P0;
int OPHEAD;
// 7432 SNNAME=FROM AR2(P)
SNNAME = FROMAR2(P);
// 7433 SNNO=K; ! INDEX INTO SNINFO
SNNO = K;
// 7434 TESTAPP(NAPS); ! COUNT ACTUAL PARAMETERS
TESTAPP( &NAPS);
// 7435 PIN=P; P=P+2
PIN = P;
P = ((P)) + ((2));
// 7436 SNPTYPE=TSNAME(SNNO)
SNPTYPE = TSNAME[SNNO];
// 7437 SNINF=SNINFO(SNNO)
SNINF = SNINFO[SNNO];
// 7438 XTRA=SNINF&16_FFFF
XTRA = ((SNINF)) & ((65535));
// 7439 POINTER=(SNINF>>16)&255
POINTER = (((int)(((unsigned int)(SNINF)) >> ((16))))) & ((255));
// 7440 FLAG=SNINF>>24
FLAG = (int)(((unsigned int)(SNINF)) >> ((24)));
// 7441 !
// 7442 ! THE IMPLICITLY SPECIFIED ROUTINE ARE THE EASIEST OF ALL TO DEAL WITH.
// 7443 ! JUST SET UP THE EXTERNAL SPEC & PARAMETERS. THEN A RECURSIVE CALL
// 7444 ! OF CNAME THEN FINDS THE ROUTINE UNDER ITS TRUE COLOURS AND COMPILES
// 7445 ! THE CALL. ALL CALLS EXCEPT THE FIRST ARE DEALT WITH DIRECTLY BY CNAME.
// 7446 ! ALL NONTRIVIAL ROUTINES SHOULD BE DEALT WITH IN THIS MANNER
// 7447 ! XTRA HAS INDEX INTO ARRAY OF EXTERNAL NAMES SO THAT THESE
// 7448 ! CAN EASILY BE CHANGED.
// 7449 !
// 7450 %IF FLAG&16_80#0 %THEN %START
if (( ((FLAG)) & ((128)) ) == ( 0 )) goto L_0730;
// 7451 CXREF(SNXREFS(XTRA),PARMDYNAMIC,2,JJ);! JJ SET WITH REF DISPLACEMENT
CXREF(SNXREFS[XTRA], PARMDYNAMIC, 2, &JJ);
// 7452 %IF SNNO=26 %THEN LOGEPDISP=JJ
if (( SNNO ) != ( 26 )) goto L_0731;
LOGEPDISP = JJ;
L_0731:
// 7453 %IF SNNO=31 %THEN EXPEPDISP=JJ
if (( SNNO ) != ( 31 )) goto L_0732;
EXPEPDISP = JJ;
L_0732:
// 7454 OPHEAD=0; P0=SNPARAMS(POINTER)
OPHEAD = 0;
P0 = SNPARAMS[POINTER];
// 7455 K=OPHEAD; D=1
K = OPHEAD;
D = 1;
// 7456 %WHILE D<=P0 %CYCLE
L_0733:
if (( D ) > ( P0 )) goto L_0734;
// 7457 PTYPE=SNPARAMS(POINTER+D)
PTYPE = SNPARAMS[((POINTER)) + ((D))];
// 7458 UNPACK
UNPACK();
// 7459 %IF NAM=0 %THEN ACC=BYTES(PREC) %ELSE ACC=8
if (( NAM ) != ( 0 )) goto L_0736;
ACC = BYTES[PREC];
goto L_0737;
L_0736:
ACC = 8;
L_0737:
// 7460 %IF PTYPE=16_35 %THEN ACC=256;!STRING BY VALUE
if (( PTYPE ) != ( 53 )) goto L_0738;
ACC = 256;
L_0738:
// 7461 INSERTAT END(OPHEAD,PTYPE<<16,ACC<<16,0)
INSERTATEND( &OPHEAD, ((PTYPE)) << ((16)), ((ACC)) << ((16)), 0);
// 7462 D=D+1
D = ((D)) + ((1));
// 7463 %REPEAT
goto L_0733;
L_0734:
// 7464 I=1; J=14
I = 1;
J = 14;
// 7465 OLDI=0; PTYPE=SNPTYPE
OLDI = 0;
PTYPE = SNPTYPE;
// 7466 K=OPHEAD; KFORM=P0
K = OPHEAD;
KFORM = P0;
// 7467 REPLACETAG(SNNAME)
REPLACETAG(SNNAME);
// 7468 REPLACE2(TAGS(SNNAME),JJ); ! DIPLACEMENT INTO S2
REPLACE2(TAGS[SNNAME], JJ);
// 7469 P=PIN; CNAME(Z,REG); ! RECURSIVE CALL
P = PIN;
CNAME(Z, REG);
// 7470 NEST=REG
NEST = REG;
// 7471 P=P-1; %RETURN; ! DUPLICATES CHECK OF <ENAME>
P = ((P)) - ((1));
return;
// 7472 %FINISH
L_0730:
// 7473 !
// 7474 ! ALL ROUTINES EXCEPT THE IMPLICITS REQUIRE A CHECK THAT THE USE OF THE
// 7475 ! NAME IS LEGAL AND THAT THE CORRECT NO OF PARAMETERS(BOTTOM 2 BITS OF
// 7476 ! FLAG) HAS BEEN SUPPLIED. THE CHECK IS TRIVIAL - THE PROBLEM
// 7477 ! IS TO GET THE RIGHT ERROR NUMBER.
// 7478 ! XTRA HAS A BITMASK OF ALLOWED USES(IE ALLOWED Z VALUES)
// 7479 !
// 7480 %IF NAPS#FLAG&3 %THEN ERRNO=19 %AND ->ERREXIT
if (( NAPS ) == ( ((FLAG)) & ((3)) )) goto L_0739;
ERRNO = 19;
goto U_01f6;
L_0739:
// 7481 JJ=1<<Z
JJ = ((1)) << ((Z));
// 7482 %IF JJ&XTRA=0 %THEN %START; ! ILLEGAL USE
if (( ((JJ)) & ((XTRA)) ) != ( 0 )) goto L_073a;
// 7483 ERRNO=23
ERRNO = 23;
// 7484 %IF Z=0 %THEN ERRNO=17
if (( Z ) != ( 0 )) goto L_073b;
ERRNO = 17;
L_073b:
// 7485 %IF Z=1 %OR 3<=Z<=4 %THEN ERRNO=29
if (( Z ) == ( 1 )) goto L_0735;
if (( 3 ) > ( Z )) goto L_073c;
if (( Z ) > ( 4 )) goto L_073c;
L_0735:
ERRNO = 29;
L_073c:
// 7486 %IF XTRA&16_F000#0 %THEN ERRNO=84
if (( ((XTRA)) & ((61440)) ) == ( 0 )) goto L_073d;
ERRNO = 84;
L_073d:
// 7487 ->ERR EXIT
goto U_01f6;
// 7488 %FINISH
L_073a:
// 7489 !
// 7490 ! A NUMBER OF INPUT-OUTPUT ROUTINES ARE MAPPED ONTO CALLS OF IOCP.
// 7491 ! THIS ARRANGEMENT HAS THE ADVANTAGE OF REQUIRING ONL 1 EXTERNAL REF
// 7492 ! IN THE GLA BUT HAS THE DISADVANTAGE THAT THE I-O ROUTINES CAN NOT
// 7493 ! BE PASSED AS RT-TYPE PARAMETERS AS WELL AS REQUIRING MESSY CODE
// 7494 ! HEREABOUTS. SNINF_PTR HOLD EITHER:-
// 7495 ! 1) THE IOCP ENTRY POINT NO
// 7496 ! OR 2) THE SYMBOL TO BE OUTPUT WITH 2**7 BIT SET
// 7497 !
// 7498 ! THIS SECTION DEALS WITH SELECT INPUT,SELECT OUTPUT,NEWLINE,NEWPAGE
// 7499 ! SPACE,SKIP SYMBOL,PRINT SYMBOL,PRINT STRING
// 7500 ! AND PRINT CH
// 7501 !
// 7502 %IF FLAG&16_40#0 %THEN %START
if (( ((FLAG)) & ((64)) ) == ( 0 )) goto L_073e;
// 7503 IOCPEP=POINTER; B=ACCR
IOCPEP = POINTER;
B = 0;
// 7504 %IF FLAG&3#0 %THEN %START; ! RT HAS PARAMS
if (( ((FLAG)) & ((3)) ) == ( 0 )) goto L_073f;
// 7505 P=P+1
P = ((P)) + ((1));
// 7506 %IF SNNO=37 %THEN CSTREXP(0,DR) %AND B=DR %ELSE CSEXP(ACCR,16_51)
if (( SNNO ) != ( 37 )) goto L_0740;
CSTREXP(0, 1);
B = 1;
goto L_0741;
L_0740:
CSEXP(0, 81);
L_0741:
// 7507 %FINISH
L_073f:
// 7508 %IF IOCPEP>127 %THEN PSF1(LSS,0,IOCPEP&127) %AND IOCPEP=5
if (( IOCPEP ) <= ( 127 )) goto L_0742;
PSF1(98, 0, ((IOCPEP)) & ((127)));
IOCPEP = 5;
L_0742:
// 7509 %IF SNNO=4 %THEN PSF1(LSS,0,0);! SKIP SYMBOL FORCE ACS=1
if (( SNNO ) != ( 4 )) goto L_0743;
PSF1(98, 0, 0);
L_0743:
// 7510 CIOCP(IOCPEP,B); ! PLANT CALL OF IOCP
CIOCP(IOCPEP, B);
// 7511 P=P+1
P = ((P)) + ((1));
// 7512 ->OKEXIT
goto U_01f7;
// 7513 %FINISH
L_073e:
// 7514 !
// 7515 ! THE BUILT-IN MAPS (INTEGER ETC BUT NOT RECORD OR ARRAY)
// 7516 !
// 7517 %IF FLAG&16_20#0 %THEN %START
if (( ((FLAG)) & ((32)) ) == ( 0 )) goto L_0744;
// 7518 SNPTYPE=16_1C00+SNPTYPE; ! ADD MAP BITS
SNPTYPE = ((7168)) + ((SNPTYPE));
// 7519 %IF PARMOPT=0 %AND OPTMAP#0 %THEN ->OKEXIT
if (( PARMOPT ) != ( 0 )) goto L_0745;
if (( OPTMAP() ) == ( 0 )) goto L_0745;
goto U_01f7;
L_0745:
// 7520 %IF Z=1 %THEN BIMSTR=1; ! SPECIAL FLAG FOR STORE VIA MAP
if (( Z ) != ( 1 )) goto L_0746;
BIMSTR = 1;
L_0746:
// 7521 P=P+1
P = ((P)) + ((1));
// 7522 CSEXP(BREG,16_51); P=P+1
CSEXP(7, 81);
P = ((P)) + ((1));
// 7523 %IF Z=1 %THEN BIMSTR=0
if (( Z ) != ( 1 )) goto L_0747;
BIMSTR = 0;
L_0747:
// 7524 JJ=SNPTYPE>>4&15
JJ = (((int)(((unsigned int)(SNPTYPE)) >> ((4))))) & ((15));
// 7525 DISP=MAPDES(JJ)
DISP = MAPDES(JJ);
// 7526 AREA=PC; ACCESS=3
AREA = 4;
ACCESS = 3;
// 7527 OLDI=0; ! FOR CHECK IN == ASSGNMNT
OLDI = 0;
// 7528 ->OKEXIT
goto U_01f7;
// 7529 %FINISH
L_0744:
// 7530 !
// 7531 ! ADHOC CODING IS REQUIRED FOR THE REMAINING ROUTINES APART FROM
// 7532 ! A CHECK FOR NAMETYPE PARAMETERS. THE SWITCH NO IS KEPT IN POINTER
// 7533 !
// 7534 P=P+1
P = ((P)) + ((1));
// 7535 %IF FLAG&8#0 %AND(A(P+3)#4 %OR A(P+4)#1 %OR A(P+FROM AR2(P+1)+1)#2) %THEN ERRNO=22 %AND ->ERREXIT
if (( ((FLAG)) & ((8)) ) == ( 0 )) goto L_0748;
if (( A[((P)) + ((3))] ) != ( 4 )) goto L_072b;
if (( A[((P)) + ((4))] ) != ( 1 )) goto L_072b;
if (( A[((((P)) + ((FROMAR2(((P)) + ((1))))))) + ((1))] ) == ( 2 )) goto L_0748;
L_072b:
ERRNO = 22;
goto U_01f6;
L_0748:
// 7536 ->ADHOC(POINTER)
goto *(ADHOC-1)[POINTER]; /* Bounds=1:15 */
// 7537 ADHOC(1): ! NEWLINES(=6) & SPACES(=7)
ADHOC_1:
// 7538 CSEXP(ACCR,16_51); ! REPITITION NO TO ACC
CSEXP(0, 81);
// 7539 %IF SNNO=6 %THEN JJ=10 %ELSE JJ=32
if (( SNNO ) != ( 6 )) goto L_0749;
JJ = 10;
goto L_074a;
L_0749:
JJ = 32;
L_074a:
// 7540 PSF1(USH,0,8); ! SHIFT UP 8 PLACES
PSF1(200, 0, 8);
// 7541 PSF1(OR,0,JJ); ! OR SYMBOL
PSF1(140, 0, JJ);
// 7542 CIOCP(17,ACCR)
CIOCP(17, 0);
// 7543 P=P+1
P = ((P)) + ((1));
// 7544 ->OKEXIT
goto U_01f7;
// 7545 ADHOC(2): ! NEXTSYMBOL(=8) & NEXTITEM(=44)
ADHOC_2:
// 7546 ! ALSO NEXTCH(=60)
// 7547 GET IN ACC(ACCR,1,0,0,0); ! PRESERVE ANY INTERMEDIATES
GETINACC(0, 1, 0, 0, 0);
// 7548 %IF SNNO=60 %THEN JJ=18 %ELSE JJ=2
if (( SNNO ) != ( 60 )) goto L_074b;
JJ = 18;
goto L_074c;
L_074b:
JJ = 2;
L_074c:
// 7549 CIOCP(JJ,ACCR); ! LEAVES THE SYMBOL IN ACC
CIOCP(JJ, 0);
// 7550 %IF SNNO=44 %THEN %START
if (( SNNO ) != ( 44 )) goto L_074d;
// 7551 RTOS(BREG)
RTOS(7);
// 7552 SNPTYPE=16_1435
SNPTYPE = 5173;
// 7553 AREA=PC; ACCESS=3
AREA = 4;
ACCESS = 3;
// 7554 DISP=MAPDES(3)
DISP = MAPDES(3);
// 7555 %FINISH
L_074d:
// 7556 NEST=ACCR; ! CONVERT R1 TO STRING
NEST = 0;
// 7557 ->OKEXIT
goto U_01f7;
// 7558 ADHOC(3): ! READSYMBOL(=10),CH(=41)&ITEM(=43)
ADHOC_3:
// 7559 %IF SNNO=41 %THEN JJ=4 %ELSE JJ=1
if (( SNNO ) != ( 41 )) goto L_074e;
JJ = 4;
goto L_074f;
L_074e:
JJ = 1;
L_074f:
// 7560 PSF1(LSS,0,0)
PSF1(98, 0, 0);
// 7561 CIOCP(JJ,ACCR); ! SYMBOL OR CH TO GR1
CIOCP(JJ, 0);
// 7562 P=P+5
P = ((P)) + ((5));
// 7563 %IF SNNO=43 %THEN %START
if (( SNNO ) != ( 43 )) goto L_0750;
// 7564 TYPE=5; RTOS(ACCR)
TYPE = 5;
RTOS(0);
// 7565 PF1(LUH,0,PC,PARAM DES(3))
PF1(106, 0, 4, PARAMDES(3));
// 7566 %FINISH %ELSE %START
goto L_0751;
L_0750:
// 7567 REGISTER(ACCR)=1; TYPE=1
REGISTER[0] = 1;
TYPE = 1;
// 7568 %FINISH
L_0751:
// 7569 JJ=TYPE
JJ = TYPE;
// 7570 ASSIGN(6,P); ! BY '=' TO PARAMETER
ASSIGN(6, P);
// 7571 P=PIN+6+FROM AR2(PIN+4)
P = ((((PIN)) + ((6)))) + ((FROMAR2(((PIN)) + ((4)))));
// 7572 ->OKEXIT
goto U_01f7;
// 7573 ADHOC(4): ! INT(=16) AND INTPT (=17)
ADHOC_4:
// 7574 CSEXP(ACCR,16_62)
CSEXP(0, 98);
// 7575 %IF SNNO=16 %THEN PF1(RAD,0,PC,SPECIAL CONSTS(0));! RAD 0.5
if (( SNNO ) != ( 16 )) goto L_0752;
PF1(240, 0, 4, SPECIALCONSTS(0));
L_0752:
// 7576 %IF PARMOPT=0 %THEN PSF1(RSC,0,55) %AND PSF1(RSC,0,-55)
if (( PARMOPT ) != ( 0 )) goto L_0753;
PSF1(248, 0, 55);
PSF1(248, 0, (-(55)));
L_0753:
// 7577 %IF REGISTER(BREG)#0 %THEN BOOT OUT(BREG)
if (( REGISTER[7] ) == ( 0 )) goto L_0754;
BOOTOUT(7);
L_0754:
// 7578 PF1(FIX,0,BREG,0)
PF1(184, 0, 7, 0);
// 7579 PSF1(MYB,0,4)
PSF1(42, 0, 4);
// 7580 PSF1(CPB,0,-64)
PSF1(38, 0, (-(64)));
// 7581 PF3(JCC,10,0,3)
PF3(2, 10, 0, 3);
// 7582 PSF1(LB,0,-64)
PSF1(122, 0, (-(64)));
// 7583 PF1(ISH,0,BREG,0)
PF1(232, 0, 7, 0);
// 7584 PF1(STUH,0,BREG,0)
PF1(74, 0, 7, 0);
// 7585 GRUSE(ACCR)=0; GRUSE(BREG)=0
GRUSE[0] = 0;
GRUSE[7] = 0;
// 7586 NEST=ACCR
NEST = 0;
// 7587 P=P+1
P = ((P)) + ((1));
// 7588 ->OKEXIT
goto U_01f7;
// 7589 ADHOC(5): ! ADDR(=14)
ADHOC_5:
// 7590 P=P+5; CNAME(4,REG); ! FETCH ADDRESS MODE
P = ((P)) + ((5));
CNAME(4, REG);
// 7591 NEST=REG
NEST = REG;
// 7592 P=P+2; ->OKEXIT
P = ((P)) + ((2));
goto U_01f7;
// 7593 ADHOC(6): ! MOD(=23), IMOD(=51)
ADHOC_6:
// 7594 %IF SNNO=51 %THEN %START
if (( SNNO ) != ( 51 )) goto L_0755;
// 7595 JJ=16_51; B=5; D=IRSB
JJ = 81;
B = 5;
D = 228;
// 7596 XTRA=3; WREG=ACCR
XTRA = 3;
WREG = 0;
// 7597 %IF REG=BREG %START
if (( REG ) != ( 7 )) goto L_0756;
// 7598 B=13; D=SLB; XTRA=4; WREG=BREG
B = 13;
D = 82;
XTRA = 4;
WREG = 7;
// 7599 %FINISH
L_0756:
// 7600 %FINISH %ELSE %START
goto L_0757;
L_0755:
// 7601 JJ=16_62; B=1; D=RRSB
JJ = 98;
B = 1;
D = 244;
// 7602 XTRA=3; WREG=ACCR
XTRA = 3;
WREG = 0;
// 7603 %FINISH
L_0757:
// 7604 CSEXP(WREG,JJ); ! INTEGER OR LONGREAL MODE
CSEXP(WREG, JJ);
// 7605 PF3(JAT,B,0,XTRA); ! JUMP ACC >0
PF3(4, B, 0, XTRA);
// 7606 PSF1(D,0,0)
PSF1(D, 0, 0);
// 7607 %IF WREG=BREG %THEN PF1(SBB,0,TOS,0)
if (( WREG ) != ( 7 )) goto L_0758;
PF1(34, 0, 6, 0);
L_0758:
// 7608 GRUSE(WREG)=0
GRUSE[WREG] = 0;
// 7609 NEST=WREG
NEST = WREG;
// 7610 P=P+1
P = ((P)) + ((1));
// 7611 ->OKEXIT
goto U_01f7;
// 7612 ADHOC(7): ! CHARNO(=45) & LENGTH(=36)
ADHOC_7:
// 7613 P=P+5
P = ((P)) + ((5));
// 7614 %IF PARMARR#0 %AND SNNO=45 %THEN CNAME(Z,DR) %ELSE CNAME(4,BREG)
if (( PARMARR ) == ( 0 )) goto L_0759;
if (( SNNO ) != ( 45 )) goto L_0759;
CNAME(Z, 1);
goto L_075a;
L_0759:
CNAME(4, 7);
L_075a:
// 7615 ERRNO=22
ERRNO = 22;
// 7616 ->ERREXIT %UNLESS TYPE=5 %AND ROUT=0
if (( TYPE ) != ( 5 )) goto L_075b;
if (( ROUT ) == ( 0 )) goto L_075c;
L_075b:
goto U_01f6;
L_075c:
// 7617 P=P+2
P = ((P)) + ((2));
// 7618 %IF SNNO#36 %THEN %START
if (( SNNO ) == ( 36 )) goto L_075d;
// 7619 %IF PARMARR=0=PARMCHK %THEN %START
if (( PARMARR ) != ( 0 )) goto L_075e;
if (( 0 ) != ( PARMCHK )) goto L_075e;
// 7620 PF1(STB,0,TOS,0)
PF1(90, 0, 6, 0);
// 7621 CSEXP(BREG,16_51)
CSEXP(7, 81);
// 7622 PF1(ADB,0,TOS,0)
PF1(32, 0, 6, 0);
// 7623 %FINISH %ELSE %START; ! FRIG BND CHECK FOR PARM=ARR
goto L_075f;
L_075e:
// 7624 GET WSP(JJ,2)
GETWSP( &JJ, 2);
// 7625 %IF Z=2 %OR Z=5 %THEN B=INCA %ELSE B=MODD
if (( Z ) == ( 2 )) goto L_0760;
if (( Z ) != ( 5 )) goto L_0761;
L_0760:
B = 20;
goto L_0762;
L_0761:
B = 22;
L_0762:
// 7626 PSF1(B,0,1)
PSF1(B, 0, 1);
// 7627 PSF1(STD,1,JJ)
PSF1(88, 1, JJ);
// 7628 CSEXP(BREG,16_51)
CSEXP(7, 81);
// 7629 PSF1(LD,1,JJ)
PSF1(120, 1, JJ);
// 7630 PSF1(SBB,0,1)
PSF1(34, 0, 1);
// 7631 PF1(MODD,0,BREG,0)
PF1(22, 0, 7, 0);
// 7632 GRUSE(DR)=0
GRUSE[1] = 0;
// 7633 PSF1(ADB,1,JJ+4)
PSF1(32, 1, ((JJ)) + ((4)));
// 7634 %FINISH
L_075f:
// 7635 P=P+1
P = ((P)) + ((1));
// 7636 GRUSE(BREG)=0
GRUSE[7] = 0;
// 7637 %FINISH
L_075d:
// 7638 DISP=MAPDES(3)
DISP = MAPDES(3);
// 7639 AREA=PC; ACCESS=3
AREA = 4;
ACCESS = 3;
// 7640 STNAME=-1 %IF Z=1; ! CANT REMEBER NAME
if (( Z ) != ( 1 )) goto L_0763;
STNAME = (-(1));
L_0763:
// 7641 SNPTYPE=SNPTYPE+16_1C00
SNPTYPE = ((SNPTYPE)) + ((7168));
// 7642 ->OKEXIT
goto U_01f7;
// 7643 ADHOC(12): ! PI(=52)
ADHOC_12:
// 7644 ADHOC(8): ! NL(=38). THIS FN IS PICKED OFF
ADHOC_8:
// 7645 NEST=0; ! IN CSEXP.ONLY COMES HERE IN
NEST = 0;
// 7646 P=P+1
P = ((P)) + ((1));
// 7647 ->OKEXIT; ! ERROR EG NL=A+B
goto U_01f7;
// 7648 ADHOC(9): ! TOSTRING(=46)
ADHOC_9:
// 7649 CSEXP(ACCR,16_51); ! RET EXPSN
CSEXP(0, 81);
// 7650 P=P+1
P = ((P)) + ((1));
// 7651 RTOS(BREG)
RTOS(7);
// 7652 DISP=MAPDES(3)
DISP = MAPDES(3);
// 7653 AREA=PC; ACCESS=3
AREA = 4;
ACCESS = 3;
// 7654 SNPTYPE=SNPTYPE+16_1C00
SNPTYPE = ((SNPTYPE)) + ((7168));
// 7655 ->OKEXIT
goto U_01f7;
// 7656 ADHOC(10): ! RECORD(=48)
ADHOC_10:
// 7657 %IF RECTB=0 %THEN JJ=16_1800FFFF %AND STORECONST(RECTB,4,ADDR(JJ))
if (( RECTB ) != ( 0 )) goto L_0764;
JJ = 402718719;
STORECONST( &RECTB, 4, ADDR( &JJ));
L_0764:
// 7658 %IF REG=ACCR %THEN %START
if (( REG ) != ( 0 )) goto L_0765;
// 7659 CSEXP(ACCR,16_51)
CSEXP(0, 81);
// 7660 PF1(LUH,0,PC,RECTB)
PF1(106, 0, 4, RECTB);
// 7661 %FINISH %ELSE %START
goto L_0766;
L_0765:
// 7662 CSEXP(BREG,16_51)
CSEXP(7, 81);
// 7663 PF1(LDTB,0,PC,RECTB)
PF1(116, 0, 4, RECTB);
// 7664 PF1(LDA,0,BREG,0)
PF1(114, 0, 7, 0);
// 7665 %FINISH
L_0766:
// 7666 P=P+1
P = ((P)) + ((1));
// 7667 GRUSE(REG)=0
GRUSE[REG] = 0;
// 7668 OLDI=0; ACC=16_FFFF
OLDI = 0;
ACC = 65535;
// 7669 SNPTYPE=SNPTYPE+16_1C00; ! ADD MAP BITS
SNPTYPE = ((SNPTYPE)) + ((7168));
// 7670 ->OKEXIT
goto U_01f7;
// 7671 ADHOC(11): ! ARRAY(=49)
ADHOC_11:
// 7672 CSEXP(ACCR,16_51); ! ADDR(A(0)) TO ACCR
CSEXP(0, 81);
// 7673 ERRNO=22
ERRNO = 22;
// 7674 ->ERREXIT %UNLESS A(P+4)=4 %AND A(P+5)=1
if (( A[((P)) + ((4))] ) != ( 4 )) goto L_0767;
if (( A[((P)) + ((5))] ) == ( 1 )) goto L_0768;
L_0767:
goto U_01f6;
L_0768:
// 7675 REGISTER(ACCR)=1; OLINK(ACCR)=ADDR(R)
REGISTER[0] = 1;
OLINK[0] = ADDR( &R);
// 7676 R=0; R_PTYPE=16_51
R = 0;
R.PTYPE = 81;
// 7677 R_FLAG=9; R_XB=ACCR
R.FLAG = 9;
R.XB = 0;
// 7678 P=P+6; CNAME(12,0)
P = ((P)) + ((6));
CNAME(12, 0);
// 7679 %IF R_FLAG#9 %THEN PF1(LSS,0,TOS,0)
if (( R.FLAG ) == ( 9 )) goto L_0769;
PF1(98, 0, 6, 0);
L_0769:
// 7680 REGISTER(ACCR)=0
REGISTER[0] = 0;
// 7681 ->ERREXIT %UNLESS A(P)=2 %AND ARR>0
if (( A[P] ) != ( 2 )) goto L_076a;
if (( ARR ) > ( 0 )) goto L_076b;
L_076a:
goto U_01f6;
L_076b:
// 7682 P=P+2
P = ((P)) + ((2));
// 7683 CREATE AH(0)
CREATEAH(0);
// 7684 %RETURN
return;
// 7685 ADHOC(13): ! EVENTINF(=33) & EVENTLINE
ADHOC_13:
// 7686 D=ONINF(LEVEL)
D = ONINF[LEVEL];
// 7687 FAULT(16,SNNAME) %IF D=0
if (( D ) != ( 0 )) goto L_076c;
FAULT(16, SNNAME);
L_076c:
// 7688 D=D+4 %IF SNNO#33
if (( SNNO ) == ( 33 )) goto L_076d;
D = ((D)) + ((4));
L_076d:
// 7689 GET IN ACC(ACCR,1,0,LNB,D)
GETINACC(0, 1, 0, 2, D);
// 7690 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 7691 NEST=ACCR
NEST = 0;
// 7692 ->OKEXIT
goto U_01f7;
// 7693 ADHOC(14): ! LENGTHEN AND SHORTEN
ADHOC_14:
// 7694 D=(SNNO&3)*8
D = ((((SNNO)) & ((3)))) * ((8));
// 7695 CSEXP(ACCR,16_62517261>>D&255)
CSEXP(0, (((int)(((unsigned int)(1649504865)) >> ((D))))) & ((255)));
// 7696 P=P+1; NEST=ACCR
P = ((P)) + ((1));
NEST = 0;
// 7697 ->OKEXIT
goto U_01f7;
// 7698 ADHOC(15): ! PPROFILE(IGNORED UNLESS PARM SET)
ADHOC_15:
// 7699 PPJ(0,22) %UNLESS PARMPROF=0
if (( PARMPROF ) == ( 0 )) goto L_076e;
PPJ(0, 22);
L_076e:
// 7700 OKEXIT: ! NORMAL EXIT
U_01f7:
// 7701 PTYPE=SNPTYPE; UNPACK
PTYPE = SNPTYPE;
UNPACK();
// 7702 %RETURN
return;
// 7703 ERREXIT: ! ERROR EXIT
U_01f6:
// 7704 FAULT(ERRNO,SNNAME)
FAULT(ERRNO, SNNAME);
// 7705 BASE=0; DISP=0; ACCESS=0; AREA=0
BASE = 0;
DISP = 0;
ACCESS = 0;
AREA = 0;
// 7706 P=PIN+2; SKIP APP
P = ((PIN)) + ((2));
SKIPAPP();
// 7707 P=P-1; %RETURN
P = ((P)) - ((1));
return;
// 7708 %INTEGERFN OPTMAP
int OPTMAP( void )
{
__label__ _imp_endofblock;
// 7709 !***********************************************************************
// 7710 !* LOOK FOR EXPRESSION LIKE INTEGER(ADDR(X)) AND AVOID USING DR *
// 7711 !***********************************************************************
// 7712 %INTEGER VARNAME,REXP,PP,CVAL,OP,XYNB
int VARNAME;
int REXP;
int PP;
int CVAL;
int OP;
int XYNB;
// 7713 %IF 3<=Z<=4 %OR SNNO=42 %OR SNNO=32 %OR SNNO=61 %THEN %RESULT=0
if (( 3 ) > ( Z )) goto L_076f;
if (( Z ) <= ( 4 )) goto L_0770;
L_076f:
if (( SNNO ) == ( 42 )) goto L_0770;
if (( SNNO ) == ( 32 )) goto L_0770;
if (( SNNO ) != ( 61 )) goto L_0771;
L_0770:
return 0;
L_0771:
// 7714 PP=P+2; REXP=FROM AR2(PP)+PP; ! TO REST OF EXP
PP = ((P)) + ((2));
REXP = ((FROMAR2(PP))) + ((PP));
// 7715 VARNAME=FROM AR2(PP+4); ! SHOULD BE ADDR
VARNAME = FROMAR2(((PP)) + ((4)));
// 7716 %RESULT=0 %UNLESS A(PP+2)=4 %AND A(PP+3)=1
if (( A[((PP)) + ((2))] ) != ( 4 )) goto L_0772;
if (( A[((PP)) + ((3))] ) == ( 1 )) goto L_0773;
L_0772:
return 0;
L_0773:
// 7717 COPY TAG(VARNAME); ! CHECK IT WAS ADDR
COPYTAG(VARNAME);
// 7718 ->WASADR %IF PTYPE=SNPT %AND K=14 %AND A(PP+6)=1
if (( PTYPE ) != ( 4102 )) goto L_0774;
if (( K ) != ( 14 )) goto L_0774;
if (( A[((PP)) + ((6))] ) != ( 1 )) goto L_0774;
goto U_01fe;
L_0774:
// 7719 ->WASLOC %IF PTYPE&16_FBFF=16_51 %AND A(PP+6)=2=A(PP+7)
if (( ((PTYPE)) & ((64511)) ) != ( 81 )) goto L_0775;
if (( A[((PP)) + ((6))] ) != ( 2 )) goto L_0775;
if (( 2 ) != ( A[((PP)) + ((7))] )) goto L_0775;
goto U_01ff;
L_0775:
// 7720 %RESULT=0
return 0;
// 7721 WASADR: PP=PP+10
U_01fe:
PP = ((PP)) + ((10));
// 7722 %RESULT=0 %UNLESS A(PP)=4 %AND A(PP+1)=1 %AND A(PP+4)=2=A(PP+5) %AND A(PP+6)=2=A(PP+7) %AND A(PP+8)=2
if (( A[PP] ) != ( 4 )) goto L_0776;
if (( A[((PP)) + ((1))] ) != ( 1 )) goto L_0776;
if (( A[((PP)) + ((4))] ) != ( 2 )) goto L_0776;
if (( 2 ) != ( A[((PP)) + ((5))] )) goto L_0776;
if (( A[((PP)) + ((6))] ) != ( 2 )) goto L_0776;
if (( 2 ) != ( A[((PP)) + ((7))] )) goto L_0776;
if (( A[((PP)) + ((8))] ) == ( 2 )) goto L_0777;
L_0776:
return 0;
L_0777:
// 7723 VARNAME=FROM AR2(PP+2); COPY TAG(VARNAME)
VARNAME = FROMAR2(((PP)) + ((2)));
COPYTAG(VARNAME);
// 7724 %RESULT=0 %UNLESS PTYPE&16_FF0C=0
if (( ((PTYPE)) & ((65292)) ) == ( 0 )) goto L_0778;
return 0;
L_0778:
// 7725 %IF A(REXP)=2 %THEN P=REXP+2 %ELSE %START
if (( A[REXP] ) != ( 2 )) goto L_0779;
P = ((REXP)) + ((2));
goto L_077a;
L_0779:
// 7726 OP=A(REXP+1)
OP = A[((REXP)) + ((1))];
// 7727 %RESULT=0 %UNLESS 1<=OP<=2 %AND A(REXP+2)=2 %AND A(REXP+3)=16_41 %AND A(REXP+6)=2
if (( 1 ) > ( OP )) goto L_077b;
if (( OP ) > ( 2 )) goto L_077b;
if (( A[((REXP)) + ((2))] ) != ( 2 )) goto L_077b;
if (( A[((REXP)) + ((3))] ) != ( 65 )) goto L_077b;
if (( A[((REXP)) + ((6))] ) == ( 2 )) goto L_077c;
L_077b:
return 0;
L_077c:
// 7728 CVAL=FROM AR2(REXP+4)
CVAL = FROMAR2(((REXP)) + ((4)));
// 7729 %IF OP=1 %THEN K=K+CVAL %ELSE K=K-CVAL
if (( OP ) != ( 1 )) goto L_077d;
K = ((K)) + ((CVAL));
goto L_077e;
L_077d:
K = ((K)) - ((CVAL));
L_077e:
// 7730 %RESULT=0 %IF K<0
if (( K ) >= ( 0 )) goto L_077f;
return 0;
L_077f:
// 7731 P=REXP+8
P = ((REXP)) + ((8));
// 7732 %FINISH
L_077a:
// 7733 BASE=I
BASE = I;
// 7734 DISP=K; AREA=-1; ACCESS=0
DISP = K;
AREA = (-(1));
ACCESS = 0;
// 7735 AREA=AREA CODE
AREA = AREACODE();
// 7736 %RESULT=1
return 1;
// 7737
// 7738 WASLOC: ! FORM INTEGER(NAME+CONST)
U_01ff:
// 7739 CVAL=0
CVAL = 0;
// 7740 %IF A(REXP)=2 %THEN PP=REXP+2 %AND ->FETCH
if (( A[REXP] ) != ( 2 )) goto L_0780;
PP = ((REXP)) + ((2));
goto U_0200;
L_0780:
// 7741 %RESULT=0 %UNLESS A(REXP+1)=1 %AND A(REXP+2)=2
if (( A[((REXP)) + ((1))] ) != ( 1 )) goto L_0781;
if (( A[((REXP)) + ((2))] ) == ( 2 )) goto L_0782;
L_0781:
return 0;
L_0782:
// 7742 %IF A(REXP+3)=16_41 %AND A(REXP+6)=2 %THEN CVAL=FROM AR2(REXP+4) %AND PP=REXP+8 %AND ->FETCH
if (( A[((REXP)) + ((3))] ) != ( 65 )) goto L_0783;
if (( A[((REXP)) + ((6))] ) != ( 2 )) goto L_0783;
CVAL = FROMAR2(((REXP)) + ((4)));
PP = ((REXP)) + ((8));
goto U_0200;
L_0783:
// 7743 %IF A(REXP+3)=16_51 %AND A(REXP+8)=2 %THEN CVAL=FROM AR4(REXP+4) %AND PP=REXP+10 %AND ->FETCH
if (( A[((REXP)) + ((3))] ) != ( 81 )) goto L_0784;
if (( A[((REXP)) + ((8))] ) != ( 2 )) goto L_0784;
CVAL = FROMAR4(((REXP)) + ((4)));
PP = ((REXP)) + ((10));
goto U_0200;
L_0784:
// 7744 %RESULT=0
return 0;
// 7745 FETCH: %RESULT=0 %UNLESS CVAL&3=0 %AND CVAL>>20=0;! MAX FOR XNB+N
U_0200:
if (( ((CVAL)) & ((3)) ) != ( 0 )) goto L_0785;
if (( (int)(((unsigned int)(CVAL)) >> ((20))) ) == ( 0 )) goto L_0786;
L_0785:
return 0;
L_0786:
// 7746 XYNB=XORYNB(9,VARNAME)
XYNB = XORYNB(9, VARNAME);
// 7747 %UNLESS GRUSE(XYNB)=9 %AND GRINF1(XYNB)=VARNAME %START
if (( GRUSE[XYNB] ) != ( 9 )) goto L_0787;
if (( GRINF1[XYNB] ) == ( VARNAME )) goto L_0788;
L_0787:
// 7748 AREA=-1; BASE=I
AREA = (-(1));
BASE = I;
// 7749 PSORLF1(LDCODE(XYNB),2*NAM,AREA CODE,K)
PSORLF1(LDCODE[XYNB], ((2)) * ((NAM)), AREACODE(), K);
// 7750 GRUSE(XYNB)=9; GRINF1(XYNB)=VARNAME
GRUSE[XYNB] = 9;
GRINF1[XYNB] = VARNAME;
// 7751 %FINISH
L_0788:
// 7752 P=PP; AREA=XYNB
P = PP;
AREA = XYNB;
// 7753 ACCESS=0; DISP=CVAL
ACCESS = 0;
DISP = CVAL;
// 7754 %RESULT=1
return 1;
// 7755 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block OPTMAP at level 6
// 7756 %ROUTINE RTOS(%INTEGER REG)
void RTOS( int REG )
{
__label__ _imp_endofblock;
// 7757 !***********************************************************************
// 7758 !* PLANTS CODE TO CONVERT A SYMBOL IN ACC TO A ONE *
// 7759 !* CHARACTER STRING IN A TEMPORARARY VARIABLE. *
// 7760 !***********************************************************************
// 7761 %INTEGER KK
int KK;
// 7762 GET WSP(KK,1); ! GET 1 WORD WK AREA
GETWSP( &KK, 1);
// 7763 STRINGL=1; DISP=KK+2
STRINGL = 1;
DISP = ((KK)) + ((2));
// 7764 PF1(OR,0,0,256)
PF1(140, 0, 0, 256);
// 7765 PSF1(ST,1,KK)
PSF1(72, 1, KK);
// 7766 GET IN ACC(REG,1,0,LNB,PTR OFFSET(RBASE))
GETINACC(REG, 1, 0, 2, PTROFFSET(RBASE));
// 7767 %IF REG=BREG %THEN KK=ADB %ELSE KK=IAD
if (( REG ) != ( 7 )) goto L_0789;
KK = 32;
goto L_078a;
L_0789:
KK = 224;
L_078a:
// 7768 PSF1(KK,0,DISP)
PSF1(KK, 0, DISP);
// 7769 GRUSE(BREG)=0
GRUSE[7] = 0;
// 7770 %END
return;
_imp_endofblock: ;
} // End of block RTOS at level 6
// 7771 %END; ! OF ROUTINE CSNAME
return;
_imp_endofblock: ;
} // End of block CSNAME at level 5
// 7772 %ROUTINE CANAME(%INTEGER ARRP,BS,DP)
void CANAME( int ARRP, int BS, int DP )
{
__label__ _imp_endofblock;
// 7773 !***********************************************************************
// 7774 !* BS & DP DEFINE THE POSITION OF THE ARRAY HEAD *
// 7775 !* ARRP=1 FOR ARRAYS,2 FOR VECTORS,3 FOR ARRAYS IN RECORDS *
// 7776 !* BASIC DISP = DISPMNT OF A(0) FOR VECTORS OR ARRAYS IN RECORDS *
// 7777 !***********************************************************************
// 7778 %INTEGER HEAD1,HEAD2,HEAD3,NOPS,PTYPEP,KK,PP,JJ,SOLDI,TYPEP,ARRNAME,Q,PRECP,ELSIZE,NAMINF,BOT1,BOT2,BOT3,DVD,VMYOP
int HEAD1;
int HEAD2;
int HEAD3;
int NOPS;
int PTYPEP;
int KK;
int PP;
int JJ;
int SOLDI;
int TYPEP;
int ARRNAME;
int Q;
int PRECP;
int ELSIZE;
int NAMINF;
int BOT1;
int BOT2;
int BOT3;
int DVD;
int VMYOP;
// 7779 PP=P; TYPEP=TYPE
PP = P;
TYPEP = TYPE;
// 7780 JJ=J; PTYPEP=PTYPE; PRECP=PREC; SOLDI=OLDI
JJ = J;
PTYPEP = PTYPE;
PRECP = PREC;
SOLDI = OLDI;
// 7781 %IF TYPE<=2 %THEN ELSIZE=BYTES(PRECP) %ELSE ELSIZE=ACC
if (( TYPE ) > ( 2 )) goto L_078b;
ELSIZE = BYTES[PRECP];
goto L_078c;
L_078b:
ELSIZE = ACC;
L_078c:
// 7782 DVD=SNDISP; ! LOCATION OF DV IF CONSTANT
DVD = SNDISP;
// 7783 ARRNAME=FROM AR2(P); ! NAME OF ENTITY
ARRNAME = FROMAR2(P);
// 7784 NAMINF=TAGS(ARRNAME)
NAMINF = TAGS[ARRNAME];
// 7785 FAULT(29,ARRNAME) %IF ARR=3; ! ARRAYFORMAT USED AS ARRAY
if (( ARR ) != ( 3 )) goto L_078d;
FAULT(29, ARRNAME);
L_078d:
// 7786 NAMINF=-2 %AND DVD=0 %IF ARRP>2; ! ARRAYS IN RECORDS
if (( ARRP ) <= ( 2 )) goto L_078e;
NAMINF = (-(2));
DVD = 0;
L_078e:
// 7787 TEST APP(Q); ! COUNT NO OF SUBSCRIPTS
TESTAPP( &Q);
// 7788 !
// 7789 ! CHECK CORRECT NO OF SUBSCRIPTS PROVIDED. HOWEVER ENTITIES DECLARED
// 7790 ! AS %<TYPE>ARRAYNAME HAVE NO DIMENSION . THIS SECTION SETS THE
// 7791 ! DIMENSION FROM THE FIRST USE OF THE NAME.
// 7792 !
// 7793 %IF JJ=0 %THEN %START; ! 0 DIMENSIONS = NOT KNOWN
if (( JJ ) != ( 0 )) goto L_078f;
// 7794 REPLACE1(TCELL,FROM1(TCELL)!Q);! DIMSN IS BOTTOM 4 BITS OF TAG
REPLACE1(TCELL, ((FROM1(TCELL))) | ((Q)));
// 7795 JJ=Q
JJ = Q;
// 7796 %FINISH
L_078f:
// 7797 %IF JJ=Q#0 %THEN %START; ! IN LINE CODE
if (( JJ ) != ( Q )) goto L_0790;
if (( Q ) == ( 0 )) goto L_0790;
// 7798 !
// 7799 ! FOR IN-LINE CODE WE SET UP A CHAIN OF REVERSE POLISH OPERATIONS TO
// 7800 ! EVALUATE THE VARIOUS SUBSCRIPTS,MULTIPLY BY THE MULTIPLIERS AND
// 7801 ! ADD THEM TOGETHER.
// 7802 !
// 7803 NOPS=0;HEAD1=0;HEAD2=0;HEAD3=0;! CLEAR LISTHEADS
NOPS = 0;
HEAD1 = 0;
HEAD2 = 0;
HEAD3 = 0;
// 7804 BOT1=0; BOT3=0
BOT1 = 0;
BOT3 = 0;
// 7805 !
// 7806 ! NOW PROCESS THE SUBSCRIPTS CALLINR TORP TO CONVERT THE EXPRESSIONS
// 7807 ! TO REVERSE POLISH AND ADDING THE EXTRA OPERATIONS.
// 7808 !
// 7809 P=PP+3
P = ((PP)) + ((3));
// 7810 %CYCLE KK=1,1,JJ; ! THROUGH THE SUBSCRIPTS
KK = ((1)) - ((1));
L_0791:
if (( KK ) == ( JJ )) goto L_0792;
KK = ((KK)) + ((1));
// 7811 P=P+3; BOT2=0
P = ((P)) + ((3));
BOT2 = 0;
// 7812 TORP(HEAD2,BOT2,NOPS); ! SUBSCRIPT TO REVERSE POLISH
TORP( &HEAD2, &BOT2, &NOPS);
// 7813 P=P+1
P = ((P)) + ((1));
// 7814 !
// 7815 ! MULTIPLIERS ARE DOPE VECTOR ITEMS (OPTYPE=3)
// 7816 !
// 7817 ! N SUBSCRIPTS WILL REQUIRE (N-1) MULTIPLICATIONS AND ADDITIONS
// 7818 !
// 7819 NOPS=(NOPS+1)!1<<24; ! DVM AS '*'
NOPS = ((((NOPS)) + ((1)))) | ((((1)) << ((24))));
// 7820 PUSH(HEAD3,33,PTYPEP<<16!ARRNAME,ELSIZE);! DOPE VECTOR MULTIPLY
PUSH( &HEAD3, 33, ((((PTYPEP)) << ((16)))) | ((ARRNAME)), ELSIZE);
// 7821 BOT3=HEAD3 %IF BOT3=0
if (( BOT3 ) != ( 0 )) goto L_0794;
BOT3 = HEAD3;
L_0794:
// 7822 VMYOP=KK<<24!JJ<<16!DVD
VMYOP = ((((((KK)) << ((24)))) | ((((JJ)) << ((16)))))) | ((DVD));
// 7823 PUSH(HEAD3,1<<16,VMYOP,BS<<18!DP);! MULTIPLIER
PUSH( &HEAD3, ((1)) << ((16)), VMYOP, ((((BS)) << ((18)))) | ((DP)));
// 7824 %IF HEAD1=0 %THEN HEAD1=HEAD2 %ELSE ASLIST(BOT1)_LINK=HEAD2
if (( HEAD1 ) != ( 0 )) goto L_0795;
HEAD1 = HEAD2;
goto L_0796;
L_0795:
ASLIST[BOT1].LINK = HEAD2;
L_0796:
// 7825 BOT1=BOT2; HEAD2=0
BOT1 = BOT2;
HEAD2 = 0;
// 7826 %REPEAT
goto L_0791;
L_0792:
// 7827 !
// 7828 ! ADD OPERATORS TO THE BACK OF OPERANDS AND EVALUATE
// 7829 !
// 7830 ASLIST(BOT1)_LINK=HEAD3
ASLIST[BOT1].LINK = HEAD3;
// 7831 BOT1=BOT3
BOT1 = BOT3;
// 7832 EXPOP(HEAD1,BREG,NOPS,16_251); ! EVALUATE THE REVERSE POLISH LIST
EXPOP(HEAD1, 7, NOPS, 593);
// 7833 ! CONSTANT ACCEPTABLE AS RESULT
// 7834 ASLIST(BOT1)_LINK=ASL
ASLIST[BOT1].LINK = ASL;
// 7835 ASL=HEAD1
ASL = HEAD1;
// 7836 BASE=BS; DISP=DP; ACCESS=3; AREA=-1
BASE = BS;
DISP = DP;
ACCESS = 3;
AREA = (-(1));
// 7837 %IF EXPOPND_FLAG<=1 %START; ! EVALUATED TO CONSTANT
if (( EXPOPND.FLAG ) > ( 1 )) goto L_0797;
// 7838 NUMMOD=EXPOPND_D; ! VALUE OF CONSTANT
NUMMOD = EXPOPND.D;
// 7839 %IF NUMMOD<0 %THEN GETINACC(BREG,1,0,0,NUMMOD) %ELSE ACCESS=1; ! DESCPTR WITH CONST MODIFIER
if (( NUMMOD ) >= ( 0 )) goto L_0798;
GETINACC(7, 1, 0, 0, NUMMOD);
goto L_0799;
L_0798:
ACCESS = 1;
L_0799:
// 7840 %FINISH
L_0797:
// 7841 %FINISH %ELSE %START
goto L_079a;
L_0790:
// 7842 %IF JJ>Q %THEN FAULT2(20,JJ-Q,ARRNAME) %ELSE FAULT2(21,Q-JJ,ARRNAME)
if (( JJ ) <= ( Q )) goto L_079b;
FAULT2(20, ((JJ)) - ((Q)), ARRNAME);
goto L_079c;
L_079b:
FAULT2(21, ((Q)) - ((JJ)), ARRNAME);
L_079c:
// 7843 P=P+2; SKIP APP
P = ((P)) + ((2));
SKIPAPP();
// 7844 BASE=BS; DISP=0; ACCESS=3; AREA=-1
BASE = BS;
DISP = 0;
ACCESS = 3;
AREA = (-(1));
// 7845 %FINISH
L_079a:
// 7846 ACC=ELSIZE
ACC = ELSIZE;
// 7847 PTYPE=PTYPEP; UNPACK; J=JJ
PTYPE = PTYPEP;
UNPACK();
J = JJ;
// 7848 OLDI=SOLDI; ! FOR NAME==A(EL) VALIDATION
OLDI = SOLDI;
// 7849 %END; ! OF ROUTINE CANAME
return;
_imp_endofblock: ;
} // End of block CANAME at level 5
// 7850 %ROUTINE CNAME(%INTEGER Z, REG)
void CNAME( int Z, int REG )
{
__label__ _imp_endofblock;
// 7851 !***********************************************************************
// 7852 !* THIS IS THE MAIN ROUTINE FOR PROCESSING NAMES.CANAME,CSNAME *
// 7853 !* AND CRNAME ARE ONLY CALLED FROM HERE,THE NAME (AND ANY PARAMS *
// 7854 !* OR SUBNAMES) ARE ACCESSED BY P WHICH IS ADVANCED. *
// 7855 !* Z SPECIFIES ACTION AS FOLLOWS:- *
// 7856 !* Z=0 COMPILE A ROUTINE CALL *
// 7857 !* Z=1 SET ACCESS,AREA AND DISP FOR A 'STORE' OPERATION *
// 7858 !* Z=2 FETCH NAME TO 'REG' *
// 7859 !* Z=3 SET DESCRIPTOR IN REG FOR PASSING BY NAME *
// 7860 !* Z=4 SET 32 BIT ADDRESS OF NAME IN REG *
// 7861 !* Z=5 DELAYED FETCH IF NAME SIMPLE ELSE AS Z=2 *
// 7862 !* Z=6 STORE 'REG' (CONTAINS POINTER) INTO POINTER VARIABLE *
// 7863 !* Z=7->11 NOT NOW USED *
// 7864 !* Z=12 SET BASE AND DISP TO POINT TO ARRAYHEAD *
// 7865 !* Z=13 SET REG TO POINT TO 4 WORD ROUTINE DISCRIPTOR *
// 7866 !* (INTERNAL ROUTINES FIRST CREATE THE DISCRIPTOR) *
// 7867 !* Z=14 STORE 'REG' INTO A RECORD NAME VARIABLE *
// 7868 !* Z=15 SET 'REG' TO POINT TO A RECORD *
// 7869 !* Z=16 SET BASE AND DISP FOR RECORD *
// 7870 !* *
// 7871 !* REG (WHERE APPROPRIATE) IS SET AS FOLLOWS:- *
// 7872 !* >=0 A REGISTER *
// 7873 !* -1 MEANS CHOOSE ANY REGISTER *
// 7874 !* IF A REGISTER IS CHOSEN THEN NEST IS SET WITH CHOICE *
// 7875 !***********************************************************************
// 7876 %INTEGER JJ, JJJ, KK, RR, LEVELP, DISPP, NAMEP, PP, SAVESL, FNAME
int JJ;
int JJJ;
int KK;
int RR;
int LEVELP;
int DISPP;
int NAMEP;
int PP;
int SAVESL;
int FNAME;
// 7877 %SWITCH S, FUNNY(12:13), SW(0:8), MAP(0:3)
static int FUNNY_idx;
static const void * /*SWITCH*/ FUNNY[(13)-(12)+1] = { &&FUNNY_12, &&FUNNY_13, };
static int SW_idx;
static const void * /*SWITCH*/ SW[(8)-(0)+1] = { &&SW_0, &&SW_1, &&SW_2, &&SW_3, &&SW_4, &&SW_5, &&SW_6, &&SW_7, &&SW_8, };
static int MAP_idx;
static const void * /*SWITCH*/ MAP[(3)-(0)+1] = { &&MAP_0, &&MAP_1, &&MAP_2, &&MAP_3, };
// 7878 PP=P
PP = P;
// 7879 FNAME=A(P)<<8+A(P+1)
FNAME = ((((A[P])) << ((8)))) + ((A[((P)) + ((1))]));
// 7880 %IF Z=1 %OR Z=6 %THEN STNAME=FNAME
if (( Z ) == ( 1 )) goto L_079d;
if (( Z ) != ( 6 )) goto L_079e;
L_079d:
STNAME = FNAME;
L_079e:
// 7881 COPYTAG(FNAME)
COPYTAG(FNAME);
// 7882 %IF I=-1 %THEN %START
if (( I ) != ( (-(1)) )) goto L_079f;
// 7883 FAULT(16, FNAME)
FAULT(16, FNAME);
// 7884 I=RLEVEL; J=0; K=FNAME
I = RLEVEL;
J = 0;
K = FNAME;
// 7885 KFORM=0; SNDISP=0; ACC=4
KFORM = 0;
SNDISP = 0;
ACC = 4;
// 7886 PTYPE=7; STORE TAG(K, N)
PTYPE = 7;
STORETAG(K, N);
// 7887 K=N; N=N+4; COPYTAG(FNAME);! SET USE BITS!
K = N;
N = ((N)) + ((4));
COPYTAG(FNAME);
// 7888 %FINISH
L_079f:
// 7889 SAVESL=ACC
SAVESL = ACC;
// 7890 JJ=J; JJ=0 %IF JJ=15
JJ = J;
if (( JJ ) != ( 15 )) goto L_07a0;
JJ = 0;
L_07a0:
// 7891 NAMEP=FNAME
NAMEP = FNAME;
// 7892 LEVELP=I; DISPP=K
LEVELP = I;
DISPP = K;
// 7893 FAULT(29, FNAME) %IF LITL=1 %AND ROUT=0=NAM %AND (Z=1 %OR Z=3 %OR (Z=4 %AND TYPE<5 %AND ARR=0))
if (( LITL ) != ( 1 )) goto L_07a1;
if (( ROUT ) != ( 0 )) goto L_07a1;
if (( 0 ) != ( NAM )) goto L_07a1;
if (( Z ) == ( 1 )) goto L_07a2;
if (( Z ) == ( 3 )) goto L_07a2;
if (( Z ) != ( 4 )) goto L_07a1;
if (( TYPE ) >= ( 5 )) goto L_07a1;
if (( ARR ) != ( 0 )) goto L_07a1;
L_07a2:
FAULT(29, FNAME);
L_07a1:
// 7894 ->NOT SET %IF TYPE=7
if (( TYPE ) != ( 7 )) goto L_07a3;
goto U_01ec;
L_07a3:
// 7895 %IF (Z=0 %AND (ROUT#1 %OR 0#TYPE#6)) %OR (Z=13 %AND ROUT=0) %THEN FAULT2(27,0,FNAME) %AND ->NOT SET
if (( Z ) != ( 0 )) goto L_07a4;
if (( ROUT ) != ( 1 )) goto L_07a5;
if (( 0 ) == ( TYPE )) goto L_07a4;
if (( TYPE ) != ( 6 )) goto L_07a5;
L_07a4:
if (( Z ) != ( 13 )) goto L_07a6;
if (( ROUT ) != ( 0 )) goto L_07a6;
L_07a5:
FAULT2(27, 0, FNAME);
goto U_01ec;
L_07a6:
// 7896 ->FUNNY(Z) %IF Z>=10
if (( Z ) < ( 10 )) goto L_07a7;
goto *(FUNNY-12)[Z]; /* Bounds=12:13 */
L_07a7:
// 7897 ->RTCALL %IF ROUT=1
if (( ROUT ) != ( 1 )) goto L_07a8;
goto U_01ed;
L_07a8:
// 7898 ->SW(TYPE)
SW_idx = TYPE; if ((0 <= TYPE_idx) && (TYPE_idx <= 8)) goto *TYPE[TYPE_idx]; else {/*_imp_signal(6, TYPE_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index TYPE(%d) not in range 0:8 at %s:%d\n", TYPE_idx, _imp_current_file, _imp_current_line); exit(1); }
// 7899 SW(6):
SW_6:
// 7900 SW(4): !RECORD FORMAT NAME
SW_4:
// 7901 FAULT2(5, 0, FNAME)
FAULT2(5, 0, FNAME);
// 7902 SW(7):
SW_7:
// 7903 NOT SET: ! NAME NOT SET
U_01ec:
// 7904 NEST=0; BASE=I; DISP=K; ACCESS=0
NEST = 0;
BASE = I;
DISP = K;
ACCESS = 0;
// 7905 AREA=LNB; PTYPE=1; UNPACK
AREA = 2;
PTYPE = 1;
UNPACK();
// 7906 P=P+2; SKIP APP; ->CHKEN
P = ((P)) + ((2));
SKIPAPP();
goto U_01ee;
// 7907 FUNNY(12): ! SET BASE & DISP FOR ARRAYHEAD
FUNNY_12:
// 7908 ->SW(3) %IF TYPE=3 %AND (ARR=0 %OR A(P+2)=1)
if (( TYPE ) != ( 3 )) goto L_07a9;
if (( ARR ) == ( 0 )) goto L_07aa;
if (( A[((P)) + ((2))] ) != ( 1 )) goto L_07a9;
L_07aa:
SW_idx = 3; if ((0 <= SW_idx) && (SW_idx <= 8)) goto *SW[SW_idx]; else {/*_imp_signal(6, SW_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index SW(%d) not in range 0:8 at %s:%d\n", SW_idx, _imp_current_file, _imp_current_line); exit(1); }
L_07a9:
// 7909 %IF PTYPE=SNPT %THEN CSNAME(12,REG) %AND ->CHKEN
if (( PTYPE ) != ( 4102 )) goto L_07ab;
CSNAME(12, REG);
goto U_01ee;
L_07ab:
// 7910 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_07ac;
P = ((P)) + ((3));
goto L_07ad;
L_07ac:
NOAPP();
L_07ad:
// 7911 ACCESS=0; BASE=I; DISP=K; AREA=-1
ACCESS = 0;
BASE = I;
DISP = K;
AREA = (-(1));
// 7912 ADJUST HEAD:
U_01ef:
// 7913 %IF ARR=1=J %AND PARMARR=0=NAM %AND PARMCHK=0 %AND TYPE<=3 %START; ! ADJUST DESR TO 1ST ELMNT
if (( ARR ) != ( 1 )) goto L_07ae;
if (( 1 ) != ( J )) goto L_07ae;
if (( PARMARR ) != ( 0 )) goto L_07ae;
if (( 0 ) != ( NAM )) goto L_07ae;
if (( PARMCHK ) != ( 0 )) goto L_07ae;
if (( TYPE ) > ( 3 )) goto L_07ae;
// 7914 GET WSP(JJ,4)
GETWSP( &JJ, 4);
// 7915 GET IN ACC(ACCR,4,ACCESS,AREA CODE,DISP)
GETINACC(0, 4, ACCESS, AREACODE(), DISP);
// 7916 PSF1(ST,1,JJ)
PSF1(72, 1, JJ);
// 7917 GET IN ACC(BREG,1,2,LNB,JJ+8);
GETINACC(7, 1, 2, 2, ((JJ)) + ((8)));
// 7918 %IF TYPE=3 %THEN KK=ACC %ELSE KK=BYTES(PREC)
if (( TYPE ) != ( 3 )) goto L_07af;
KK = ACC;
goto L_07b0;
L_07af:
KK = BYTES[PREC];
L_07b0:
// 7919 PSF1(MYB,0,KK) %UNLESS KK=1
if (( KK ) == ( 1 )) goto L_07b1;
PSF1(42, 0, KK);
L_07b1:
// 7920 PSF1(LD,1,JJ)
PSF1(120, 1, JJ);
// 7921 PF1(INCA,0,BREG,0); ! ADJUST DESCRPTR
PF1(20, 0, 7, 0);
// 7922 PSF1(STD,1,JJ)
PSF1(88, 1, JJ);
// 7923 GRUSE(DR)=0; GRUSE(ACCR)=0
GRUSE[1] = 0;
GRUSE[0] = 0;
// 7924 GRUSE(BREG)=0; AREA=LNB; DISP=JJ
GRUSE[7] = 0;
AREA = 2;
DISP = JJ;
// 7925 %FINISH
L_07ae:
// 7926 ->CHKEN
goto U_01ee;
// 7927 S(12): ! ARRAYS IN RECORDS BY NAME
S_12:
// 7928 NAMEOP(1,ACCR,16,NAMEP); ! Z=STORE TO UPDATE BASE&DISP
NAMEOP(1, 0, 16, NAMEP);
// 7929 ->ADJUST HEAD
goto U_01ef;
// 7930 FUNNY(13): ! LOAD ADDR FOR RT-TYPE
FUNNY_13:
// 7931 %IF PTYPE=SNPT %THEN CSNAME(Z,REG) %AND P=P+1 %AND->CHKEN
if (( PTYPE ) != ( 4102 )) goto L_07b2;
CSNAME(Z, REG);
P = ((P)) + ((1));
goto U_01ee;
L_07b2:
// 7932 DISP=MIDCELL; BASE=I
DISP = MIDCELL;
BASE = I;
// 7933 %IF NAM&1#0 %THEN %START
if (( ((NAM)) & ((1)) ) == ( 0 )) goto L_07b3;
// 7934 AREA=-1
AREA = (-(1));
// 7935 GET IN ACC(REG,4,0,AREA CODE,DISP)
GETINACC(REG, 4, 0, AREACODE(), DISP);
// 7936 %FINISH %ELSE %START
goto L_07b4;
L_07b3:
// 7937 %IF J=14 %THEN %START; ! EXTERNAL ROUTINE PASSED
if (( J ) != ( 14 )) goto L_07b5;
// 7938 GET IN ACC(REG,2,0,0,0); ! ZERO ENVIRONMENT
GETINACC(REG, 2, 0, 0, 0);
// 7939 GET IN ACC(DR,2,0,SET XORYNB(-1,-1),DISP)
GETINACC(1, 2, 0, SETXORYNB((-(1)), (-(1))), DISP);
// 7940 ! PSF1(MODD,0,0); ! PROVOKE ESCAPE IF DYNAMIC
// 7941 %FINISH %ELSE %START
goto L_07b6;
L_07b5:
// 7942 %IF BASE=0 %AND CPRMODE=2 %START;! IN FILE OF RTS
if (( BASE ) != ( 0 )) goto L_07b7;
if (( CPRMODE ) != ( 2 )) goto L_07b7;
// 7943 PSF1(LD,1,12)
PSF1(120, 1, 12);
// 7944 PSF1(INCA,0,DISP) %UNLESS DISP=0
if (( DISP ) == ( 0 )) goto L_07b8;
PSF1(20, 0, DISP);
L_07b8:
// 7945 GET IN ACC(ACCR,2,0,0,0)
GETINACC(0, 2, 0, 0, 0);
// 7946 %FINISH %ELSE %START
goto L_07b9;
L_07b7:
// 7947 PSF1(JLK,0,1); ! GET PC TO TOS
PSF1(28, 0, 1);
// 7948 RTJUMP(LDA,ASLIST(TAGS(FNAME))_S2);! ADD N TO POINT @ ENTRY
RTJUMP(114, &ASLIST[TAGS[FNAME]].S2);
// 7949 PF1(INCA,0,TOS,0); ! AND TO DES REG
PF1(20, 0, 6, 0);
// 7950 JJ=16_E0000001
JJ = -536870911;
// 7951 STORE CONST(JJJ,4,ADDR(JJ))
STORECONST( &JJJ, 4, ADDR( &JJ));
// 7952 PF1(LDTB,0,PC,JJJ)
PF1(116, 0, 4, JJJ);
// 7953 GET IN ACC(ACCR,1,0,LNB,PTR OFFSET(BASE))
GETINACC(0, 1, 0, 2, PTROFFSET(BASE));
// 7954 JJ=M'IMP'
JJ = 4803920;
// 7955 STORE CONST(JJJ,4,ADDR(JJ))
STORECONST( &JJJ, 4, ADDR( &JJ));
// 7956 PF1(LUH,0,PC,JJJ); ! SPARE FIELD IN RT HDDR
PF1(106, 0, 4, JJJ);
// 7957 %FINISH
L_07b9:
// 7958 %FINISH
L_07b6:
// 7959 PF1(STD,0,TOS,0); ! DR TO TOP OF STACK
PF1(88, 0, 6, 0);
// 7960 PF1(LUH,0,TOS,0); ! AND TO TOP 64 BITS OF ACC
PF1(106, 0, 6, 0);
// 7961 GRUSE(DR)=0
GRUSE[1] = 0;
// 7962 %FINISH
L_07b4:
// 7963 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP; ->CHKEN
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_07ba;
P = ((P)) + ((3));
goto L_07bb;
L_07ba:
NOAPP();
L_07bb:
goto U_01ee;
// 7964 SW(3): ! RECORD
SW_3:
// 7965 CRNAME(Z, REG, 2*NAM, I, -1, K, NAMEP)
CRNAME(Z, REG, ((2)) * ((NAM)), I, (-(1)), K, &NAMEP);
// 7966 ->S(Z) %IF Z>=10
if (( Z ) < ( 10 )) goto L_07bc;
goto *(S-12)[Z]; /* Bounds=12:13 */
L_07bc:
// 7967 STNAME=NAMEP %IF Z=1 %OR Z=6
if (( Z ) == ( 1 )) goto L_07bd;
if (( Z ) != ( 6 )) goto L_07be;
L_07bd:
STNAME = NAMEP;
L_07be:
// 7968 ->STRINREC %IF TYPE=5 %AND Z#6
if (( TYPE ) != ( 5 )) goto L_07bf;
if (( Z ) == ( 6 )) goto L_07bf;
goto U_01f0;
L_07bf:
// 7969 ->NOT SET %IF TYPE=7
if (( TYPE ) != ( 7 )) goto L_07c0;
goto U_01ec;
L_07c0:
// 7970 NAMEOP(Z,REG,BYTES(PREC),NAMEP)
NAMEOP(Z, REG, BYTES[PREC], NAMEP);
// 7971 ->CHKEN
goto U_01ee;
// 7972 SW(5): ! TYPE =STRING
SW_5:
// 7973 !
// 7974 ! ALL STRING OPERATIONS ARE ON THE RELEVANT DESCRIPTOR. Z=2 &Z=5
// 7975 ! REQUIRE A CURRENT LENGTH(IE MODIFIED) DESCRIPTOR. OTHER OPERATIONS
// 7976 ! REQUIRE THE MAX LENGTH DESCRIPTOR (IE UNMODIFIED HEADER)
// 7977 !
// 7978 %IF Z=6 %THEN ->SW(1)
if (( Z ) != ( 6 )) goto L_07c1;
SW_idx = 1; if ((0 <= SW_idx) && (SW_idx <= 8)) goto *SW[SW_idx]; else {/*_imp_signal(6, SW_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index SW(%d) not in range 0:8 at %s:%d\n", SW_idx, _imp_current_file, _imp_current_line); exit(1); }
L_07c1:
// 7979 ->STRARR %IF ARR>=1
if (( ARR ) < ( 1 )) goto L_07c2;
goto U_01f1;
L_07c2:
// 7980 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_07c3;
P = ((P)) + ((3));
goto L_07c4;
L_07c3:
NOAPP();
L_07c4:
// 7981 BASE=I; ACCESS=2; AREA=-1; DISP=K
BASE = I;
ACCESS = 2;
AREA = (-(1));
DISP = K;
// 7982 SNINREC: %IF Z=1 %THEN Z=3; ! STRINGNAMES IN RECORDS
U_01f2:
if (( Z ) != ( 1 )) goto L_07c5;
Z = 3;
L_07c5:
// 7983 %IF Z=3 %OR Z=4 %THEN NAMEOP(Z,REG,8,-1) %AND ->CHKEN
if (( Z ) == ( 3 )) goto L_07c6;
if (( Z ) != ( 4 )) goto L_07c7;
L_07c6:
NAMEOP(Z, REG, 8, (-(1)));
goto U_01ee;
L_07c7:
// 7984 %IF ACCESS=2 %AND PARMCHK=0 %AND REGISTER(DR)=0 %START
if (( ACCESS ) != ( 2 )) goto L_07c8;
if (( PARMCHK ) != ( 0 )) goto L_07c8;
if (( REGISTER[1] ) != ( 0 )) goto L_07c8;
// 7985 PSORLF1(LDB,2,AREA CODE,DISP);! LOAD BND & DR IN 1 INSTRN
PSORLF1(118, 2, AREACODE(), DISP);
// 7986 GRUSE(DR)=0
GRUSE[1] = 0;
// 7987 %IF REG=ACCR %THEN COPY DR
if (( REG ) != ( 0 )) goto L_07c9;
COPYDR();
L_07c9:
// 7988 ->CHKEN
goto U_01ee;
// 7989 %FINISH
L_07c8:
// 7990 NAMEOP(3,DR,8,-1)
NAMEOP(3, 1, 8, (-(1)));
// 7991 MBND: %IF PARMCHK=1 %THEN TEST ASS(DR,5,8)
U_01f3:
if (( PARMCHK ) != ( 1 )) goto L_07ca;
TESTASS(1, 5, 8);
L_07ca:
// 7992 PF1(LDB,2,7,0); ! LBOUND FIRST BYTE=CURRENT L
PF1(118, 2, 7, 0);
// 7993 %IF REG=ACCR %THEN COPY DR
if (( REG ) != ( 0 )) goto L_07cb;
COPYDR();
L_07cb:
// 7994 ->CHKEN
goto U_01ee;
// 7995 STRARR: ! STRINGARRAYS & ARRAYNAMES
U_01f1:
// 7996 CANAME(ARR, I, K)
CANAME(ARR, I, K);
// 7997 NAMEP=-1
NAMEP = (-(1));
// 7998 %IF Z=1 %OR Z=6 %THEN STNAME=NAMEP
if (( Z ) == ( 1 )) goto L_07cc;
if (( Z ) != ( 6 )) goto L_07cd;
L_07cc:
STNAME = NAMEP;
L_07cd:
// 7999 SAINREC: ! STRING ARRAYS IN RECORDS
U_01f4:
// 8000 %IF Z=1 %OR Z=3 %THEN %START
if (( Z ) == ( 1 )) goto L_07ce;
if (( Z ) != ( 3 )) goto L_07cf;
L_07ce:
// 8001 %IF NAM=1 %THEN %START
if (( NAM ) != ( 1 )) goto L_07d0;
// 8002 GET IN ACC(DR,2,0,AREA CODE,DISP+8);! DV DR
GETINACC(1, 2, 0, AREACODE(), ((DISP)) + ((8)));
// 8003 ! CANAME WILL HAVE SET J=DIMEN
// 8004 ! FOR ALL CASES INCLUDING RECORDS
// 8005 PF1(SLB,1,0,1+3*(J-1)); ! STACK MODIFIER AND
PF1(82, 1, 0, ((1)) + ((((3)) * ((((J)) - ((1)))))));
// 8006 ! SET BREG TO STRING LENGTH
// 8007 %FINISH
L_07d0:
// 8008 GET IN ACC(DR,2,0,AREA CODE,DISP)%IF AREA#7;! ALREADY IN DR
if (( AREA ) == ( 7 )) goto L_07d1;
GETINACC(1, 2, 0, AREACODE(), DISP);
L_07d1:
// 8009 %IF NAM=1 %THEN %START
if (( NAM ) != ( 1 )) goto L_07d2;
// 8010 PF1(MODD,0,TOS,0)
PF1(22, 0, 6, 0);
// 8011 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 8012 %FINISH %ELSE %START
goto L_07d3;
L_07d2:
// 8013 %IF ACCESS=1 %THEN %START
if (( ACCESS ) != ( 1 )) goto L_07d4;
// 8014 PSF1(MODD,0,NUMMOD) %UNLESS NUMMOD=0
if (( NUMMOD ) == ( 0 )) goto L_07d5;
PSF1(22, 0, NUMMOD);
L_07d5:
// 8015 %FINISH %ELSE %START
goto L_07d6;
L_07d4:
// 8016 PF1(MODD,0,BREG,0) %IF ACCESS=3
if (( ACCESS ) != ( 3 )) goto L_07d7;
PF1(22, 0, 7, 0);
L_07d7:
// 8017 %FINISH
L_07d6:
// 8018 PSF1(LDB,0,ACC)
PSF1(118, 0, ACC);
// 8019 %FINISH
L_07d3:
// 8020 %IF REG=ACCR %THEN COPY DR
if (( REG ) != ( 0 )) goto L_07d8;
COPYDR();
L_07d8:
// 8021 ->CHKEN
goto U_01ee;
// 8022 %FINISH
L_07cf:
// 8023 %IF Z=4 %THEN NAMEOP(Z,REG,4,-1) %AND ->CHKEN
if (( Z ) != ( 4 )) goto L_07d9;
NAMEOP(Z, REG, 4, (-(1)));
goto U_01ee;
L_07d9:
// 8024 GET IN ACC(DR,2,0,AREA CODE,DISP) %UNLESS AREA=7
if (( AREA ) == ( 7 )) goto L_07da;
GETINACC(1, 2, 0, AREACODE(), DISP);
L_07da:
// 8025 %IF ACCESS=1 %THEN %START
if (( ACCESS ) != ( 1 )) goto L_07db;
// 8026 PSF1(MODD,0,NUMMOD) %UNLESS NUMMOD=0
if (( NUMMOD ) == ( 0 )) goto L_07dc;
PSF1(22, 0, NUMMOD);
L_07dc:
// 8027 %FINISH %ELSE %START
goto L_07dd;
L_07db:
// 8028 PF1(MODD,0,BREG,0) %IF ACCESS=3
if (( ACCESS ) != ( 3 )) goto L_07de;
PF1(22, 0, 7, 0);
L_07de:
// 8029 %FINISH
L_07dd:
// 8030 ->MBND
goto U_01f3;
// 8031 STRINREC: ! STRINGS IN RECORDS
U_01f0:
// 8032 ->SAINREC %IF ARR#0
if (( ARR ) == ( 0 )) goto L_07df;
goto U_01f4;
L_07df:
// 8033 ->SNINREC %IF NAM#0 %OR Z=4
if (( NAM ) != ( 0 )) goto L_07e0;
if (( Z ) != ( 4 )) goto L_07e1;
L_07e0:
goto U_01f2;
L_07e1:
// 8034 !
// 8035 ! STRINGS IN RECORDS HAVE NO HEADER AND ARE SPECIAL
// 8036 !
// 8037 NAMEOP(4,BREG,4,-1)
NAMEOP(4, 7, 4, (-(1)));
// 8038 PF1(LDTB,0,PC,PARAM DES(3))
PF1(116, 0, 4, PARAMDES(3));
// 8039 PF1(LDA,0,BREG,0)
PF1(114, 0, 7, 0);
// 8040 PSF1(LDB,0,ACC) %UNLESS Z=2 %AND PARMCHK=0
if (( Z ) != ( 2 )) goto L_07e2;
if (( PARMCHK ) == ( 0 )) goto L_07e3;
L_07e2:
PSF1(118, 0, ACC);
L_07e3:
// 8041 GRUSE(DR)=0
GRUSE[1] = 0;
// 8042 ->MBND %IF Z=2
if (( Z ) != ( 2 )) goto L_07e4;
goto U_01f3;
L_07e4:
// 8043 COPY DR %IF REG=ACCR
if (( REG ) != ( 0 )) goto L_07e5;
COPYDR();
L_07e5:
// 8044 ->CHKEN
goto U_01ee;
// 8045 !
// 8046 ! SECTION TO DEAL WITH ALL NAMES INVOLVING ROUTINE CALL
// 8047 !
// 8048 RTCALL: ! FIRST CHECK
U_01ed:
// 8049 %IF TYPE=0 %AND Z#0 %THEN FAULT(23, FNAME) %AND ->NOT SET
if (( TYPE ) != ( 0 )) goto L_07e6;
if (( Z ) == ( 0 )) goto L_07e6;
FAULT(23, FNAME);
goto U_01ec;
L_07e6:
// 8050 ! RT NAME IN EXPRSN
// 8051 %IF PTYPE=SNPT %THEN %START
if (( PTYPE ) != ( 4102 )) goto L_07e7;
// 8052 CSNAME(Z, REG); ! SPECIAL NAME
CSNAME(Z, REG);
// 8053 ->BIM %IF ROUT=1 %AND NAM>=1 %AND Z#0
if (( ROUT ) != ( 1 )) goto L_07e8;
if (( NAM ) < ( 1 )) goto L_07e8;
if (( Z ) == ( 0 )) goto L_07e8;
goto U_01f5;
L_07e8:
// 8054 %IF TYPE#0 %AND NEST=ACCR %THEN ->MVFNRES
if (( TYPE ) == ( 0 )) goto L_07e9;
if (( NEST ) != ( 0 )) goto L_07e9;
goto U_01f6;
L_07e9:
// 8055 ->CHKEN
goto U_01ee;
// 8056 %FINISH
L_07e7:
// 8057 CRCALL(FNAME); P=P+1; ! DEAL WITH PARAMS
CRCALL(FNAME);
P = ((P)) + ((1));
// 8058 ->CHKEN %IF PTYPE&15=0
if (( ((PTYPE)) & ((15)) ) != ( 0 )) goto L_07ea;
goto U_01ee;
L_07ea:
// 8059 ->UDM %IF NAM>1; ! MAPS
if (( NAM ) <= ( 1 )) goto L_07eb;
goto U_01f7;
L_07eb:
// 8060 %UNLESS Z=2 %OR Z=5 %THEN %START; ! FUNCTIONS
if (( Z ) == ( 2 )) goto L_07ec;
if (( Z ) == ( 5 )) goto L_07ec;
// 8061 FAULT(29, FNAME); BASE=0
FAULT(29, FNAME);
BASE = 0;
// 8062 ACCESS=0; DISP=0
ACCESS = 0;
DISP = 0;
// 8063 %FINISH
L_07ec:
// 8064 MVFNRES: %IF TYPE=5 %THEN %START; ! STRING FNS
U_01f6:
if (( TYPE ) != ( 5 )) goto L_07ed;
// 8065 %IF REG=DR %THEN PF1(ST,0,TOS,0) %AND PF1(LD,0,TOS,0)
if (( REG ) != ( 1 )) goto L_07ee;
PF1(72, 0, 6, 0);
PF1(120, 0, 6, 0);
L_07ee:
// 8066 %FINISH %ELSE %START
goto L_07ef;
L_07ed:
// 8067 %IF REG=BREG %THEN %START
if (( REG ) != ( 7 )) goto L_07f0;
// 8068 BOOT OUT(BREG) %IF REGISTER(BREG)#0
if (( REGISTER[7] ) == ( 0 )) goto L_07f1;
BOOTOUT(7);
L_07f1:
// 8069 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 8070 %FINISH
L_07f0:
// 8071 %FINISH
L_07ef:
// 8072 NEST=REG; ->CHKEN
NEST = REG;
goto U_01ee;
// 8073 UDM: ! USER DEFINED MAPS
U_01f7:
// 8074 PF1(ST,0,BREG,0); ! RETURN 32 BIT ADDR IN ACC
PF1(72, 0, 7, 0);
// 8075 DISP=MAPDES(PREC)
DISP = MAPDES(PREC);
// 8076 ACCESS=3; AREA=PC
ACCESS = 3;
AREA = 4;
// 8077 NAMEP=-1; STNAME=-1
NAMEP = (-(1));
STNAME = (-(1));
// 8078 BIM: ! BUILT IN MAPS
U_01f5:
// 8079 NAMEP=-1 %AND STNAME=-1 %UNLESS AREA=PC %AND ACCESS=3
if (( AREA ) != ( 4 )) goto L_07f2;
if (( ACCESS ) == ( 3 )) goto L_07f3;
L_07f2:
NAMEP = (-(1));
STNAME = (-(1));
L_07f3:
// 8080 ->CHKEN %IF TYPE=3; ! MAP RECORD USE VERY LIMITED
if (( TYPE ) != ( 3 )) goto L_07f4;
goto U_01ee;
L_07f4:
// 8081 %IF Z=3 %OR (TYPE=5 %AND Z#4) %START
if (( Z ) == ( 3 )) goto L_07f5;
if (( TYPE ) != ( 5 )) goto L_07f6;
if (( Z ) == ( 4 )) goto L_07f6;
L_07f5:
// 8082 PF1(LDTB,0,PC,DISP)
PF1(116, 0, 4, DISP);
// 8083 %IF TYPE=5 %AND (PARMCHK#0 %OR Z#2) %THEN PSF1(LDB,0,255)
if (( TYPE ) != ( 5 )) goto L_07f7;
if (( PARMCHK ) != ( 0 )) goto L_0793;
if (( Z ) == ( 2 )) goto L_07f7;
L_0793:
PSF1(118, 0, 255);
L_07f7:
// 8084 PF1(LDA,0,BREG,0)
PF1(114, 0, 7, 0);
// 8085 GRUSE(DR)=0
GRUSE[1] = 0;
// 8086 %FINISH %ELSE %START
goto L_07f8;
L_07f6:
// 8087 %IF GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF %AND 1<=Z<=2 %THEN AREA=7
if (( GRUSE[1] ) != ( 7 )) goto L_07f9;
if (( NAMEP ) <= ( 0 )) goto L_07f9;
if (( GRINF1[1] ) != ( ((NAMEP)) & ((65535)) )) goto L_07f9;
if (( 1 ) > ( Z )) goto L_07f9;
if (( Z ) > ( 2 )) goto L_07f9;
AREA = 7;
L_07f9:
// 8088 ! CHANGE TO(%DR+%B) FORM
// 8089 %FINISH
L_07f8:
// 8090 ! NAM=0
// 8091 KK=Z; KK=2 %IF Z=5
KK = Z;
if (( Z ) != ( 5 )) goto L_07fa;
KK = 2;
L_07fa:
// 8092 ->MAP(KK&3)
MAP_idx = ((KK)) & ((3)); if ((0 <= KK_idx) && (KK_idx <= 3)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:3 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8093 MAP(0): ! FETCH ADDRESS
MAP_0:
// 8094 %IF REG#BREG %THEN GET IN ACC(ACCR,1,0,BREG,0)
if (( REG ) == ( 7 )) goto L_07fb;
GETINACC(0, 1, 0, 7, 0);
L_07fb:
// 8095 ->CHKEN
goto U_01ee;
// 8096 MAP(1): ! STORE
MAP_1:
// 8097 ->CHKEN %UNLESS TYPE=5; ->MAP(3)
if (( TYPE ) == ( 5 )) goto L_07fc;
goto U_01ee;
L_07fc:
MAP_idx = 3; if ((0 <= MAP_idx) && (MAP_idx <= 3)) goto *MAP[MAP_idx]; else {/*_imp_signal(6, MAP_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index MAP(%d) not in range 0:3 at %s:%d\n", MAP_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8098 MAP(2): ! FETCH
MAP_2:
// 8099 %IF TYPE=5 %THEN ->MBND
if (( TYPE ) != ( 5 )) goto L_07fd;
goto U_01f3;
L_07fd:
// 8100 GET IN ACC(REG,BYTES(PREC)>>2,ACCESS,AREA,DISP)
GETINACC(REG, (int)(((unsigned int)(BYTES[PREC])) >> ((2))), ACCESS, AREA, DISP);
// 8101 %IF NAMEP>0 %THEN GRUSE(DR)=7 %AND GRINF1(DR)=NAMEP
if (( NAMEP ) <= ( 0 )) goto L_07fe;
GRUSE[1] = 7;
GRINF1[1] = NAMEP;
L_07fe:
// 8102 %IF PARMCHK=1 %AND PREC>=5 %THEN TEST ASS(REG,1,BYTES(PREC))
if (( PARMCHK ) != ( 1 )) goto L_07ff;
if (( PREC ) < ( 5 )) goto L_07ff;
TESTASS(REG, 1, BYTES[PREC]);
L_07ff:
// 8103 ->CHKEN
goto U_01ee;
// 8104 MAP(3): ! SET DESCRIPTOR
MAP_3:
// 8105 %IF TYPE=5 %THEN PF1(LDB,0,0,256)
if (( TYPE ) != ( 5 )) goto L_0800;
PF1(118, 0, 0, 256);
L_0800:
// 8106 COPY DR %UNLESS REG=DR
if (( REG ) == ( 1 )) goto L_0801;
COPYDR();
L_0801:
// 8107 ->CHKEN
goto U_01ee;
// 8108 SW(0): ! %NAME PARAMETERS NO TYPE
SW_0:
// 8109 ! ALLOW FETCH ADDR OPERATIONS
// 8110 ! AND SPECIAL FOR BUILTIN MAPS
// 8111 %UNLESS 3<=Z<=4 %THEN %START
if (( 3 ) > ( Z )) goto L_0802;
if (( Z ) <= ( 4 )) goto L_0803;
L_0802:
// 8112 FAULT2(90,0,FNAME); TYPE=1
FAULT2(90, 0, FNAME);
TYPE = 1;
// 8113 %FINISH
L_0803:
// 8114 SW(1): ! TYPE =INTEGER
SW_1:
// 8115 SW(2): ! TYPE=REAL
SW_2:
// 8116 %IF ARR=0 %OR (Z=6 %AND A(P+2)=2) %THEN %START
if (( ARR ) == ( 0 )) goto L_0804;
if (( Z ) != ( 6 )) goto L_0805;
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0805;
L_0804:
// 8117 BASE=I; ACCESS=2*NAM
BASE = I;
ACCESS = ((2)) * ((NAM));
// 8118 DISP=K; AREA=-1
DISP = K;
AREA = (-(1));
// 8119 %IF A(P+2)=2 %THEN P=P+3 %ELSE NO APP
if (( A[((P)) + ((2))] ) != ( 2 )) goto L_0806;
P = ((P)) + ((3));
goto L_0807;
L_0806:
NOAPP();
L_0807:
// 8120 %FINISH %ELSE %START
goto L_0808;
L_0805:
// 8121 CANAME(ARR, I, K)
CANAME(ARR, I, K);
// 8122 NAM=0
NAM = 0;
// 8123 %FINISH
L_0808:
// 8124 NAMEOP(Z,REG,BYTES(PREC),NAMEP)
NAMEOP(Z, REG, BYTES[PREC], NAMEP);
// 8125 ->CHKEN
goto U_01ee;
// 8126 !
// 8127 ! GENERAL FETCHING & STORING
// 8128 !SECTION
// 8129 !
// 8130 CHKEN: %WHILE A(P)=1 %CYCLE
U_01ee:
L_0809:
if (( A[P] ) != ( 1 )) goto L_080a;
// 8131 FAULT(69,FNAME)
FAULT(69, FNAME);
// 8132 P=P+3; SKIP APP
P = ((P)) + ((3));
SKIPAPP();
// 8133 %REPEAT
goto L_0809;
L_080a:
// 8134 P=P+1
P = ((P)) + ((1));
// 8135 %END
return;
SW_8:
fprintf(stderr, "%%SWITCH LABEL NOT SET - SW(%d): at line %s:%d", SW_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,SW_idx,_imp_current_line,"SWITCH LABEL NOT SET - SW";*/
S_13:
fprintf(stderr, "%%SWITCH LABEL NOT SET - S(%d): at line %s:%d", S_idx, _imp_current_file, _imp_current_line);
/*_imp_signal(?,S_idx,_imp_current_line,"SWITCH LABEL NOT SET - S";*/
_imp_endofblock: ;
} // End of block CNAME at level 5
// 8136
// 8137 %ROUTINE NAMEOP(%INTEGER Z, REG, SIZE, NAMEP)
void NAMEOP( int Z, int REG, int SIZE, int NAMEP )
{
__label__ _imp_endofblock;
// 8138 !***********************************************************************
// 8139 !* FETCH OR STORE REG FROM OR TO VARIABLE DEFINED BY AREA ACCESS *
// 8140 !* BASE AND DISP. *
// 8141 !***********************************************************************
// 8142 %SWITCH MOD(0:47)
static int MOD_idx;
static const void * /*SWITCH*/ MOD[(47)-(0)+1] = { &&MOD_0, &&MOD_1, &&MOD_2, &&MOD_3, &&MOD_4, &&MOD_5, &&MOD_6, &&MOD_7, &&MOD_8, &&MOD_9, &&MOD_10, &&MOD_11, &&MOD_12, &&MOD_13, &&MOD_14, &&MOD_15, &&MOD_16, &&MOD_17, &&MOD_18, &&MOD_19, &&MOD_20, &&MOD_21, &&MOD_22, &&MOD_23, &&MOD_24, &&MOD_25, &&MOD_26, &&MOD_27, &&MOD_28, &&MOD_29, &&MOD_30, &&MOD_31, &&MOD_32, &&MOD_33, &&MOD_34, &&MOD_35, &&MOD_36, &&MOD_37, &&MOD_38, &&MOD_39, &&MOD_40, &&MOD_41, &&MOD_42, &&MOD_43, &&MOD_44, &&MOD_45, &&MOD_46, &&MOD_47, };
// 8143 %INTEGERFNSPEC BASEREG(%INTEGER GRUSEVAL,GRINFVAL)
auto int BASEREG( int GRUSEVAL, int GRINFVAL );
// 8144 %INTEGER KK, JJJ, TOTHER, XYNB, JJ, OP1, OP2
int KK;
int JJJ;
int TOTHER;
int XYNB;
int JJ;
int OP1;
int OP2;
// 8145 KK=Z; KK=2 %IF Z=5
KK = Z;
if (( Z ) != ( 5 )) goto L_080c;
KK = 2;
L_080c:
// 8146 %IF Z=6 %THEN %START
if (( Z ) != ( 6 )) goto L_080d;
// 8147 FAULT2(82,0,NAMEP) %UNLESS NAM=1 %AND ROUT=0 %AND (ACCESS>=8 %OR ACCESS=2)
if (( NAM ) != ( 1 )) goto L_080e;
if (( ROUT ) != ( 0 )) goto L_080e;
if (( ACCESS ) >= ( 8 )) goto L_080f;
if (( ACCESS ) == ( 2 )) goto L_080f;
L_080e:
FAULT2(82, 0, NAMEP);
L_080f:
// 8148 KK=1; SIZE=8
KK = 1;
SIZE = 8;
// 8149 %IF ACCESS>=8 %THEN ACCESS=ACCESS-4 %ELSE ACCESS=0
if (( ACCESS ) < ( 8 )) goto L_0810;
ACCESS = ((ACCESS)) - ((4));
goto L_0811;
L_0810:
ACCESS = 0;
L_0811:
// 8150 %FINISH
L_080d:
// 8151 KK=KK&3
KK = ((KK)) & ((3));
// 8152 ->MOD(ACCESS<<2!KK)
MOD_idx = ((((ACCESS)) << ((2)))) | ((KK)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8153 !
// 8154
// 8155 ! AREA AND ACCESS
// 8156 !**** *** ******
// 8157 ! THESE VARIABLES DEFINE HOW TO ACCESS ANY IMP VARIABLE. AREA HAS THE
// 8158 ! THREE BIT AREA CODE FROM THE PRIMARY FORMAT INSTRN.(EG 6=TOS ETC)
// 8159 ! THE SPECIAL CASE AREA=-1 IS USED FOR ENTITIES IN STACK FRAME 'BASE'
// 8160 ! THE FN AREA CODE CONVERTS THIS CASE TO AREA=LNB OR AREA=XNB ARRANGING
// 8161 ! TO LOAD XNB IF NECESSARY.
// 8162
// 8163 ! ACCESS HAS TWO VERSIONS OF THE 2-BIT INDIRECTION CODE FROM PRIMARY
// 8164 ! FORMAT INSTRNS:-
// 8165 ! =0 VARIABLE DIRECTLY ADDRESSED IN 'AREA' BY 'DISP'
// 8166 ! =1 VARIABLE ADDRESSED BY DESCPTR AT AREA & DISP MODDED BY CONST NUMMOD
// 8167 ! =2 DESCRIPTOR TO VARIABLE DIRECTLY ADDRESS BY 'AREA' & 'DISP'
// 8168 ! =3 DESCRIPTOR AS IN =2 IS TO BE MODIFIED BY 'B'
// 8169 ! =4 VARIABLE 'XDISP' INTO RECORD DIRECTLY ADDRESSED BY 'AREA' & 'DISP'
// 8170 ! =5 VARIABLE 'XDISP' INTO RECORD ADDRESSED BY DR MODIFIED AS =1
// 8171 ! =6 VAR 'XDISP' INTO RECORD ADDRESSED BY DESCRIPTOR AT 'AREA' & 'DISP'
// 8172 ! =7 AS =6 BUT DESCRIPTOR MODIFIED BY B
// 8173 ! =8-11 AS 4-7 BUT THERE IS A DESCRIPTOR TO ITEM AT 'XDISP' INTO RECORD
// 8174
// 8175 ! THESE COVER ALL THE COMMON CASES. ITEMS LIKE ARRAYS IN RECORD ARRAYS
// 8176 ! NEED AN INTERMEDIATE DESCRIPTOR TO BE CALCULATED AND(USUALLY) STACKED
// 8177
// 8178 !
// 8179 ! NOTE THAT ACCESS=1 AS USED ON VARIABLES IS DIFFERENT FROM ACCESS=1
// 8180 ! AS USED IN ACTUAL PLANTING ROUTINES PF1 ETC. THE CODE ACCESS=1 NEEDS
// 8181 ! THE RELEVANT DESCRIPOR IN DR FIRST !
// 8182 !
// 8183 ! AREA=7 WITH ACCESS =2 OR 3 IS USED WHEN THE DESCRIPTOR IS ALREADY
// 8184 ! LOADED IN DR. THIS IS AWKARD ESPECIALLY ON THE GET 32 BIT ADDR
// 8185 ! CASE AND NEEDS PLANTING OF IMAGE STORE FORMAT INSTRNS
// 8186 !
// 8187 MOD(0): ! ACCESS=0 FETCH ADDRESS
MOD_0:
// 8188 %IF TYPE=3 %THEN GETINACC(REG,1,0,AREA CODE,DISP-4) %AND %RETURN
if (( TYPE ) != ( 3 )) goto L_0812;
GETINACC(REG, 1, 0, AREACODE(), ((DISP)) - ((4)));
return;
L_0812:
// 8189 GET IN ACC(REG,1,0,LNB,PTR OFFSET(BASE))
GETINACC(REG, 1, 0, 2, PTROFFSET(BASE));
// 8190 %IF REG=BREG %THEN JJJ=ADB %ELSE JJJ=IAD
if (( REG ) != ( 7 )) goto L_0813;
JJJ = 32;
goto L_0814;
L_0813:
JJJ = 224;
L_0814:
// 8191 PSF1(JJJ,0,DISP)
PSF1(JJJ, 0, DISP);
// 8192 %IF BIMSTR=1 %THEN NOTE ASSMENT(REG,3,NAMEP)
if (( BIMSTR ) != ( 1 )) goto L_0815;
NOTEASSMENT(REG, 3, NAMEP);
L_0815:
// 8193 %RETURN
return;
// 8194 MOD(1): ! ACCESS=0 STORE
MOD_1:
// 8195 %IF 1<=SIZE<=2 %THEN %START; ! BYTES & HALFS REQUIRE DESCRIPTOR
if (( 1 ) > ( SIZE )) goto L_0816;
if (( SIZE ) > ( 2 )) goto L_0816;
// 8196 PF1(LDTB,0,PC,MAP DES(SIZE+2)) %UNLESS GRUSE(DR)=SIZE+11
if (( GRUSE[1] ) == ( ((SIZE)) + ((11)) )) goto L_0817;
PF1(116, 0, 4, MAPDES(((SIZE)) + ((2))));
L_0817:
// 8197 PSF1(LDA,1,PTR OFFSET(BASE)) %UNLESS 12<=GRUSE(DR)<=13 %AND GRINF1(DR)=BASE
if (( 12 ) > ( GRUSE[1] )) goto L_0818;
if (( GRUSE[1] ) > ( 13 )) goto L_0818;
if (( GRINF1[1] ) == ( BASE )) goto L_0819;
L_0818:
PSF1(114, 1, PTROFFSET(BASE));
L_0819:
// 8198 GRUSE(DR)=SIZE+11; GRINF1(DR)=BASE
GRUSE[1] = ((SIZE)) + ((11));
GRINF1[1] = BASE;
// 8199 ACCESS=1; AREA=0
ACCESS = 1;
AREA = 0;
// 8200 %FINISH %ELSE AREA=AREA CODE
goto L_081a;
L_0816:
AREA = AREACODE();
L_081a:
// 8201 %RETURN
return;
// 8202 MOD(2): ! ACCESS=0 FETCH
MOD_2:
// 8203 %IF SIZE>2 %AND Z=5 %AND PARMCHK=0 %THEN NEST=-1 %AND %RETURN
if (( SIZE ) <= ( 2 )) goto L_081b;
if (( Z ) != ( 5 )) goto L_081b;
if (( PARMCHK ) != ( 0 )) goto L_081b;
NEST = (-(1));
return;
L_081b:
// 8204 MOD(10): ! ACCESS=2 FETCH
MOD_10:
// 8205 %IF GRUSE(REG)>=9 %AND NAMEP>0 %THEN %START
if (( GRUSE[REG] ) < ( 9 )) goto L_081c;
if (( NAMEP ) <= ( 0 )) goto L_081c;
// 8206 %IF (GRINF1(REG)=NAMEP %AND GRUSE(REG)&255=9) %OR (GRINF2(REG)=NAMEP %AND GRUSE(REG)>>16=9) %START
if (( GRINF1[REG] ) != ( NAMEP )) goto L_081d;
if (( ((GRUSE[REG])) & ((255)) ) == ( 9 )) goto L_081e;
L_081d:
if (( GRINF2[REG] ) != ( NAMEP )) goto L_081f;
if (( (int)(((unsigned int)(GRUSE[REG])) >> ((16))) ) != ( 9 )) goto L_081f;
L_081e:
// 8207 %IF REGISTER(REG)#0 %THEN BOOT OUT(REG)
if (( REGISTER[REG] ) == ( 0 )) goto L_0820;
BOOTOUT(REG);
L_0820:
// 8208 NEST=REG; %RETURN
NEST = REG;
return;
// 8209 %FINISH
L_081f:
// 8210 %FINISH
L_081c:
// 8211 TOTHER=REG!!7
TOTHER = ((REG)) ^ ((7));
// 8212 %IF GRUSE(TOTHER)>=9 %AND NAMEP>0 %START
if (( GRUSE[TOTHER] ) < ( 9 )) goto L_0821;
if (( NAMEP ) <= ( 0 )) goto L_0821;
// 8213 KK=GRINF1(TOTHER)
KK = GRINF1[TOTHER];
// 8214 %IF (KK=NAMEP %AND GRUSE(TOTHER)&255=9) %OR (GRINF2(TOTHER)=NAMEP %AND GRUSE(TOTHER)>>16=9) %START
if (( KK ) != ( NAMEP )) goto L_0822;
if (( ((GRUSE[TOTHER])) & ((255)) ) == ( 9 )) goto L_0823;
L_0822:
if (( GRINF2[TOTHER] ) != ( NAMEP )) goto L_0824;
if (( (int)(((unsigned int)(GRUSE[TOTHER])) >> ((16))) ) != ( 9 )) goto L_0824;
L_0823:
// 8215 %IF REG=BREG %AND REGISTER(BREG)=0 %START
if (( REG ) != ( 7 )) goto L_0825;
if (( REGISTER[7] ) != ( 0 )) goto L_0825;
// 8216 PF1(ST,0,BREG,0); ! ACC TO BRGE
PF1(72, 0, 7, 0);
// 8217 GRUSE(REG)=GRUSE(TOTHER)
GRUSE[REG] = GRUSE[TOTHER];
// 8218 GRINF1(REG)=GRINF1(TOTHER)
GRINF1[REG] = GRINF1[TOTHER];
// 8219 GRINF2(REG)=GRINF2(TOTHER)
GRINF2[REG] = GRINF2[TOTHER];
// 8220 NEST=REG
NEST = REG;
// 8221 %RETURN
return;
// 8222 %FINISH
L_0825:
// 8223 %IF REG=ACCR %AND Z=2 %THEN %START
if (( REG ) != ( 0 )) goto L_0826;
if (( Z ) != ( 2 )) goto L_0826;
// 8224 ACCESS=0; AREA=7
ACCESS = 0;
AREA = 7;
// 8225 SIZE=4; DISP=0
SIZE = 4;
DISP = 0;
// 8226 %FINISH
L_0826:
// 8227 %FINISH
L_0824:
// 8228 %FINISH
L_0821:
// 8229 %IF 1<=SIZE<=2 %AND ACCESS=0 %THEN %START; ! BYTES
if (( 1 ) > ( SIZE )) goto L_0827;
if (( SIZE ) > ( 2 )) goto L_0827;
if (( ACCESS ) != ( 0 )) goto L_0827;
// 8230 PF1(LDTB,0,PC,MAP DES(SIZE+2)) %UNLESS GRUSE(DR)=SIZE+11
if (( GRUSE[1] ) == ( ((SIZE)) + ((11)) )) goto L_0828;
PF1(116, 0, 4, MAPDES(((SIZE)) + ((2))));
L_0828:
// 8231 PSF1(LDA,1,PTR OFFSET(BASE)) %UNLESS 12<=GRUSE(DR)<=13 %AND GRINF1(DR)=BASE
if (( 12 ) > ( GRUSE[1] )) goto L_0829;
if (( GRUSE[1] ) > ( 13 )) goto L_0829;
if (( GRINF1[1] ) == ( BASE )) goto L_082a;
L_0829:
PSF1(114, 1, PTROFFSET(BASE));
L_082a:
// 8232 GRUSE(DR)=SIZE+11; GRINF1(DR)=BASE
GRUSE[1] = ((SIZE)) + ((11));
GRINF1[1] = BASE;
// 8233 %IF Z=5 %AND PARMCHK=0 %START
if (( Z ) != ( 5 )) goto L_082b;
if (( PARMCHK ) != ( 0 )) goto L_082b;
// 8234 ACCESS=1; AREA=0; NEST=-1; %RETURN
ACCESS = 1;
AREA = 0;
NEST = (-(1));
return;
// 8235 %FINISH
L_082b:
// 8236 GET IN ACC(REG,1,1,0,DISP)
GETINACC(REG, 1, 1, 0, DISP);
// 8237 %IF PARMCHK#0 %AND SIZE=2 %THEN TEST ASS(REG,TYPE,SIZE)
if (( PARMCHK ) == ( 0 )) goto L_082c;
if (( SIZE ) != ( 2 )) goto L_082c;
TESTASS(REG, TYPE, SIZE);
L_082c:
// 8238 NEST=REG; %RETURN
NEST = REG;
return;
// 8239 %FINISH
L_0827:
// 8240 MOD(14): ! ACCESS=3 FETCH
MOD_14:
// 8241 %IF ACCESS>=2 %AND(AREA=7 %OR (GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF)) %THEN AREA=7 %AND DISP=0 %ELSE AREA=AREA CODE
if (( ACCESS ) < ( 2 )) goto L_082d;
if (( AREA ) == ( 7 )) goto L_080b;
if (( GRUSE[1] ) != ( 7 )) goto L_082d;
if (( NAMEP ) <= ( 0 )) goto L_082d;
if (( GRINF1[1] ) != ( ((NAMEP)) & ((65535)) )) goto L_082d;
L_080b:
AREA = 7;
DISP = 0;
goto L_082e;
L_082d:
AREA = AREACODE();
L_082e:
// 8242 DRFETCH:
U_01e9:
// 8243 GET IN ACC(REG,SIZE>>2,ACCESS,AREA,DISP)
GETINACC(REG, (int)(((unsigned int)(SIZE)) >> ((2))), ACCESS, AREA, DISP);
// 8244 %IF PARMCHK=1 %AND SIZE#1 %THEN TEST ASS(REG,TYPE,SIZE)
if (( PARMCHK ) != ( 1 )) goto L_082f;
if (( SIZE ) == ( 1 )) goto L_082f;
TESTASS(REG, TYPE, SIZE);
L_082f:
// 8245 %IF (ACCESS=0 %OR ACCESS=2) %AND NAMEP>0 %THEN GRUSE(REG)=9 %AND GRINF1(REG)=NAMEP
if (( ACCESS ) == ( 0 )) goto L_0830;
if (( ACCESS ) != ( 2 )) goto L_0831;
L_0830:
if (( NAMEP ) <= ( 0 )) goto L_0831;
GRUSE[REG] = 9;
GRINF1[REG] = NAMEP;
L_0831:
// 8246 %IF ACCESS>=2 %AND NAMEP>0 %THEN GRUSE(DR)=7 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( ACCESS ) < ( 2 )) goto L_0832;
if (( NAMEP ) <= ( 0 )) goto L_0832;
GRUSE[1] = 7;
GRINF1[1] = ((NAMEP)) & ((65535));
L_0832:
// 8247 NEST=REG; %RETURN
NEST = REG;
return;
// 8248 MOD(3): ! ACCESS=0 SET DESCRIPTOR
MOD_3:
// 8249 ABORT %UNLESS REG=ACCR %OR REG=DR
if (( REG ) == ( 0 )) goto L_0833;
if (( REG ) == ( 1 )) goto L_0833;
ABORT();
L_0833:
// 8250 %IF TYPE=3 %THEN %START
if (( TYPE ) != ( 3 )) goto L_0834;
// 8251 GET IN ACC(REG,2,0,AREA CODE,DISP-8); ! PTR BEFORE START
GETINACC(REG, 2, 0, AREACODE(), ((DISP)) - ((8)));
// 8252 %RETURN
return;
// 8253 %FINISH %ELSE JJJ=PARAM DES(PREC)
L_0834:
JJJ = PARAMDES(PREC);
// 8254
// 8255 %IF REG=ACCR %THEN %START
if (( REG ) != ( 0 )) goto L_0835;
// 8256 GET IN ACC(REG,1,0,LNB,PTR OFFSET(BASE))
GETINACC(REG, 1, 0, 2, PTROFFSET(BASE));
// 8257 OP1=IAD; OP2=LUH
OP1 = 224;
OP2 = 106;
// 8258 %FINISH %ELSE %START
goto L_0836;
L_0835:
// 8259 PSF1(LDA,1,PTR OFFSET(BASE))
PSF1(114, 1, PTROFFSET(BASE));
// 8260 OP1=INCA; OP2=LDTB
OP1 = 20;
OP2 = 116;
// 8261 %FINISH
L_0836:
// 8262 PSF1(OP1,0,DISP)
PSF1(OP1, 0, DISP);
// 8263 PF1(OP2,0,PC,JJJ)
PF1(OP2, 0, 4, JJJ);
// 8264 GRUSE(REG)=0
GRUSE[REG] = 0;
// 8265 %RETURN
return;
// 8266 MOD(4): ! ACCESS=1 FETCH ADDRESS
MOD_4:
// 8267 JJ=NUMMOD
JJ = NUMMOD;
// 8268 JJ=JJ*BYTES(PREC) %IF PREC>4; ! HALF COME WITH BYTE MODIFIER
if (( PREC ) <= ( 4 )) goto L_0837;
JJ = ((JJ)) * ((BYTES[PREC]));
L_0837:
// 8269 ->MD20
goto U_01ea;
// 8270 MOD(20): ! ACCESS=5 FETCH ADDRESS
MOD_20:
// 8271 JJ=NUMMOD+XDISP
JJ = ((NUMMOD)) + ((XDISP));
// 8272 MD20: GET IN ACC(REG,1,0,AREA CODE,DISP+4);! BACK HALF OF DESCTR
U_01ea:
GETINACC(REG, 1, 0, AREACODE(), ((DISP)) + ((4)));
// 8273 %IF REG=ACCR %THEN OP1=IAD %ELSE OP1=ADB
if (( REG ) != ( 0 )) goto L_0838;
OP1 = 224;
goto L_0839;
L_0838:
OP1 = 32;
L_0839:
// 8274 PSF1(OP1,0,JJ) %UNLESS JJ=0
if (( JJ ) == ( 0 )) goto L_083a;
PSF1(OP1, 0, JJ);
L_083a:
// 8275 %RETURN
return;
// 8276 MOD(7): ! ACCESS=1 SET DESCRIPTOR
MOD_7:
// 8277 JJ=NUMMOD
JJ = NUMMOD;
// 8278 JJ=JJ*BYTES(PREC) %IF PREC>4; ! HALF COME WITH BYTE MODIFIER
if (( PREC ) <= ( 4 )) goto L_083b;
JJ = ((JJ)) * ((BYTES[PREC]));
L_083b:
// 8279 GET IN ACC(REG,2,0,AREA CODE,DISP);! DESCTR
GETINACC(REG, 2, 0, AREACODE(), DISP);
// 8280 %IF REG=ACCR %THEN OP1=IAD %ELSE OP1=INCA
if (( REG ) != ( 0 )) goto L_083c;
OP1 = 224;
goto L_083d;
L_083c:
OP1 = 20;
L_083d:
// 8281 PSF1(OP1,0,JJ) %UNLESS JJ=0
if (( JJ ) == ( 0 )) goto L_083e;
PSF1(OP1, 0, JJ);
L_083e:
// 8282 %RETURN
return;
// 8283 MOD(5): ! ACCESS=1 STORE
MOD_5:
// 8284 MOD(6): ! ACCESS=1 FETCH
MOD_6:
// 8285 %IF NUMMOD=0 %THEN ACCESS=2 %AND ->MOD(KK+8)
if (( NUMMOD ) != ( 0 )) goto L_083f;
ACCESS = 2;
MOD_idx = ((KK)) + ((8)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
L_083f:
// 8286
// 8287 %UNLESS GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF %THEN GET IN ACC(DR,2,0,AREA CODE,DISP)
if (( GRUSE[1] ) != ( 7 )) goto L_0840;
if (( NAMEP ) <= ( 0 )) goto L_0840;
if (( GRINF1[1] ) == ( ((NAMEP)) & ((65535)) )) goto L_0841;
L_0840:
GETINACC(1, 2, 0, AREACODE(), DISP);
L_0841:
// 8288 %IF NAMEP>0 %THEN GRUSE(DR)=7 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( NAMEP ) <= ( 0 )) goto L_0842;
GRUSE[1] = 7;
GRINF1[1] = ((NAMEP)) & ((65535));
L_0842:
// 8289 AREA=0; DISP=NUMMOD
AREA = 0;
DISP = NUMMOD;
// 8290 ->DRFETCH %IF Z=2
if (( Z ) != ( 2 )) goto L_0843;
goto U_01e9;
L_0843:
// 8291 %RETURN
return;
// 8292 MOD(12): ! ACCESS=3 FETCH ADDRESS
MOD_12:
// 8293 JJJ=BYTES(PREC)
JJJ = BYTES[PREC];
// 8294 !
// 8295 ! REMEMBER HALF INTEGERS READY SCALED BY VMY OR IN CANAME
// 8296 !
// 8297 PSF1(MYB,0,JJJ) %AND GRUSE(BREG)=0 %UNLESS JJJ=1 %OR PREC=4
if (( JJJ ) == ( 1 )) goto L_0844;
if (( PREC ) == ( 4 )) goto L_0844;
PSF1(42, 0, JJJ);
GRUSE[7] = 0;
L_0844:
// 8298 MD12: %IF REG=BREG %THEN %START
U_01eb:
if (( REG ) != ( 7 )) goto L_0845;
// 8299 %IF AREA=7 %START
if (( AREA ) != ( 7 )) goto L_0846;
// 8300 PF1(INCA,0,BREG,0)
PF1(20, 0, 7, 0);
// 8301 GRUSE(DR)=0
GRUSE[1] = 0;
// 8302 PF1(LB,2,0,11); ! DR BTM HALF TO B VIA IMAGE STORE INSTRUCTION
PF1(122, 2, 0, 11);
// 8303 %FINISH %ELSE PF1(ADB,0,AREA CODE,DISP+4)
goto L_0847;
L_0846:
PF1(32, 0, AREACODE(), ((DISP)) + ((4)));
L_0847:
// 8304 GRUSE(BREG)=0
GRUSE[7] = 0;
// 8305 %RETURN
return;
// 8306 %FINISH
L_0845:
// 8307 MOD(8): ! ACCESS=2 FETCH ADDRESS
MOD_8:
// 8308 %IF AREA=7 %THEN GET IN ACC(REG,1,2,0,11) %ELSE GET IN ACC(REG,1,0,AREA CODE,DISP+4)
if (( AREA ) != ( 7 )) goto L_0848;
GETINACC(REG, 1, 2, 0, 11);
goto L_0849;
L_0848:
GETINACC(REG, 1, 0, AREACODE(), ((DISP)) + ((4)));
L_0849:
// 8309 %IF ACCESS&3=3 %THEN PF1(IAD,0,BREG,0)
if (( ((ACCESS)) & ((3)) ) != ( 3 )) goto L_084a;
PF1(224, 0, 7, 0);
L_084a:
// 8310 %RETURN
return;
// 8311 MOD(9): ! ACCESS=2 STORE
MOD_9:
// 8312 MOD(13): ! ACCESS=3 STORE
MOD_13:
// 8313 %IF AREA=7 %THEN DISP=0 %AND %RETURN
if (( AREA ) != ( 7 )) goto L_084b;
DISP = 0;
return;
L_084b:
// 8314 %IF GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF %THEN AREA=7 %AND DISP=0 %ELSE AREA=AREA CODE
if (( GRUSE[1] ) != ( 7 )) goto L_084c;
if (( NAMEP ) <= ( 0 )) goto L_084c;
if (( GRINF1[1] ) != ( ((NAMEP)) & ((65535)) )) goto L_084c;
AREA = 7;
DISP = 0;
goto L_084d;
L_084c:
AREA = AREACODE();
L_084d:
// 8315 %RETURN
return;
// 8316 MOD(11): ! ACCESS=2 SET DESCRIPTOR
MOD_11:
// 8317 %IF AREA=7 %THEN %START
if (( AREA ) != ( 7 )) goto L_084e;
// 8318 COPY DR %UNLESS REG=DR
if (( REG ) == ( 1 )) goto L_084f;
COPYDR();
L_084f:
// 8319 %RETURN
return;
// 8320 %FINISH
L_084e:
// 8321 GET IN ACC(REG,2,0,AREA CODE,DISP)
GETINACC(REG, 2, 0, AREACODE(), DISP);
// 8322 %RETURN
return;
// 8323 MOD(15): ! ACCESS=3 SET DESCRIPTOR
MOD_15:
// 8324 GET IN ACC(DR,2,0,AREA CODE,DISP) %UNLESS AREA=7
if (( AREA ) == ( 7 )) goto L_0850;
GETINACC(1, 2, 0, AREACODE(), DISP);
L_0850:
// 8325 %IF PREC=4 %OR(TYPE=3 %AND PARMARR=0) %THEN JJ=INCA %ELSE JJ=MODD
if (( PREC ) == ( 4 )) goto L_0851;
if (( TYPE ) != ( 3 )) goto L_0852;
if (( PARMARR ) != ( 0 )) goto L_0852;
L_0851:
JJ = 20;
goto L_0853;
L_0852:
JJ = 22;
L_0853:
// 8326 PF1(JJ,0,BREG,0)
PF1(JJ, 0, 7, 0);
// 8327 %IF REG#DR %THEN COPY DR
if (( REG ) == ( 1 )) goto L_0854;
COPYDR();
L_0854:
// 8328 GRUSE(DR)=0
GRUSE[1] = 0;
// 8329 %RETURN
return;
// 8330 MOD(17): ! ACCESS=4 STORE
MOD_17:
// 8331 MOD(18): ! ACCESS=4 FETCH
MOD_18:
// 8332 %IF SIZE=1 %THEN DISP=DISP-8 %AND ->MD2526
if (( SIZE ) != ( 1 )) goto L_0855;
DISP = ((DISP)) - ((8));
goto U_01ec;
L_0855:
// 8333 DISP=DISP+XDISP
DISP = ((DISP)) + ((XDISP));
// 8334 ACCESS=0
ACCESS = 0;
// 8335 ->MOD(KK); ! REDUCES TO ACCESS=0
MOD_idx = KK; if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8336 MOD(36): ! ACCESS=9 FETCH ADDRESS
MOD_36:
// 8337 MOD(37): ! ACCESS=9 STORE
MOD_37:
// 8338 MOD(38): ! ACCESS=9 FETCH
MOD_38:
// 8339 MOD(39): ! ACCESS=9 SET DESCRIPTOR
MOD_39:
// 8340 XYNB=BASEREG(8,NAMEP&16_FFFF)
XYNB = BASEREG(8, ((NAMEP)) & ((65535)));
// 8341 DISP=NUMMOD+XDISP; AREA=XYNB
DISP = ((NUMMOD)) + ((XDISP));
AREA = XYNB;
// 8342 ACCESS=3; NAMEP=0
ACCESS = 3;
NAMEP = 0;
// 8343 ->MOD(KK+8); ! HAS REDUCED TO ACCESS=2
MOD_idx = ((KK)) + ((8)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8344 MOD(16): ! ACCESS=4 FETCH ADDRESS
MOD_16:
// 8345 DISP=DISP-8
DISP = ((DISP)) - ((8));
// 8346 MOD(24): ! ACCESS=6 FETCH ADDRESS
MOD_24:
// 8347 GET IN ACC(REG,1,0,AREA CODE,DISP+4)
GETINACC(REG, 1, 0, AREACODE(), ((DISP)) + ((4)));
// 8348 %IF REG=BREG %THEN KK=ADB %ELSE KK=IAD
if (( REG ) != ( 7 )) goto L_0856;
KK = 32;
goto L_0857;
L_0856:
KK = 224;
L_0857:
// 8349 PSF1(KK,0,XDISP) %UNLESS XDISP=0
if (( XDISP ) == ( 0 )) goto L_0858;
PSF1(KK, 0, XDISP);
L_0858:
// 8350 %RETURN
return;
// 8351 MD2526:
U_01ec:
// 8352 MOD(25): ! ACCESS=6 STORE
MOD_25:
// 8353 MOD(26): ! ACCESS=6 FETCH
MOD_26:
// 8354 %IF SIZE>2 %START
if (( SIZE ) <= ( 2 )) goto L_0859;
// 8355 XYNB=BASEREG(8,NAMEP&16_FFFF)
XYNB = BASEREG(8, ((NAMEP)) & ((65535)));
// 8356 AREA=XYNB; ACCESS=0
AREA = XYNB;
ACCESS = 0;
// 8357 DISP=XDISP; ->MOD(KK)
DISP = XDISP;
MOD_idx = KK; if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8358 %FINISH
L_0859:
// 8359 %IF SIZE=1 %THEN %START; ! SIZE = 1 FOR BYTES
if (( SIZE ) != ( 1 )) goto L_085a;
// 8360 PSORLF1(LD,0,AREA CODE,DISP) %UNLESS GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( GRUSE[1] ) != ( 7 )) goto L_085b;
if (( NAMEP ) <= ( 0 )) goto L_085b;
if (( GRINF1[1] ) == ( ((NAMEP)) & ((65535)) )) goto L_085c;
L_085b:
PSORLF1(120, 0, AREACODE(), DISP);
L_085c:
// 8361 %FINISH %ELSE %START; ! SIZE=2 FOR HALFS
goto L_085d;
L_085a:
// 8362 PF1(LDTB,0,PC,MAP DES(4)) %UNLESS GRUSE(DR)=13 %OR GRUSE(DR)=15
if (( GRUSE[1] ) == ( 13 )) goto L_085e;
if (( GRUSE[1] ) == ( 15 )) goto L_085e;
PF1(116, 0, 4, MAPDES(4));
L_085e:
// 8363 PSORLF1(LDA,0,AREA CODE,DISP+4) %UNLESS NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF %AND (GRUSE(DR)=7 %OR GRUSE(DR)=15)
if (( NAMEP ) <= ( 0 )) goto L_085f;
if (( GRINF1[1] ) != ( ((NAMEP)) & ((65535)) )) goto L_085f;
if (( GRUSE[1] ) == ( 7 )) goto L_0860;
if (( GRUSE[1] ) == ( 15 )) goto L_0860;
L_085f:
PSORLF1(114, 0, AREACODE(), ((DISP)) + ((4)));
L_0860:
// 8364 %FINISH
L_085d:
// 8365 GRUSE(DR)=0
GRUSE[1] = 0;
// 8366 %IF NAMEP>0 %THEN GRUSE(DR)=8*SIZE-1 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( NAMEP ) <= ( 0 )) goto L_0861;
GRUSE[1] = ((((8)) * ((SIZE)))) - ((1));
GRINF1[1] = ((NAMEP)) & ((65535));
L_0861:
// 8367 ACCESS=1; AREA=0
ACCESS = 1;
AREA = 0;
// 8368 DISP=XDISP
DISP = XDISP;
// 8369 %IF DISP=0 %AND ACCESS=1 %THEN AREA=7 %AND ACCESS=2
if (( DISP ) != ( 0 )) goto L_0862;
if (( ACCESS ) != ( 1 )) goto L_0862;
AREA = 7;
ACCESS = 2;
L_0862:
// 8370 ->DRFETCH %IF Z=2
if (( Z ) != ( 2 )) goto L_0863;
goto U_01e9;
L_0863:
// 8371 %RETURN
return;
// 8372 MOD(23): ! ACCESS=5 SET DESCRIPTOR
MOD_23:
// 8373 XDISP=NUMMOD+XDISP
XDISP = ((NUMMOD)) + ((XDISP));
// 8374 ->MD31
goto U_01ed;
// 8375 MOD(19): ! ACCESS=4 SET DESCRIPTOR
MOD_19:
// 8376 DISP=DISP-8
DISP = ((DISP)) - ((8));
// 8377 MOD(27): ! ACCESS=6 SET DESCRIPTOR
MOD_27:
// 8378 MOD(31): ! ACCESS=7 SET DESRCPTOR
MOD_31:
// 8379 MD31: GET IN ACC(DR,2,0,AREA CODE,DISP)
U_01ed:
GETINACC(1, 2, 0, AREACODE(), DISP);
// 8380 PSF1(INCA,0,XDISP) %UNLESS XDISP=0
if (( XDISP ) == ( 0 )) goto L_0864;
PSF1(20, 0, XDISP);
L_0864:
// 8381 PF1(INCA,0,BREG,0) %IF ACCESS=7
if (( ACCESS ) != ( 7 )) goto L_0865;
PF1(20, 0, 7, 0);
L_0865:
// 8382 %IF TYPE=3 %OR TYPE=5 %THEN PSORLF1(LDB,0,0,ACC) %ELSE PF1(LDTB,0,PC,PARAM DES(PREC))
if (( TYPE ) == ( 3 )) goto L_0866;
if (( TYPE ) != ( 5 )) goto L_0867;
L_0866:
PSORLF1(118, 0, 0, ACC);
goto L_0868;
L_0867:
PF1(116, 0, 4, PARAMDES(PREC));
L_0868:
// 8383 %IF REG#DR %THEN COPY DR
if (( REG ) == ( 1 )) goto L_0869;
COPYDR();
L_0869:
// 8384 %RETURN
return;
// 8385 MOD(28): ! ACCESS=7 FETCH ADDRESS
MOD_28:
// 8386 PSF1(ADB,0,XDISP) %AND GRUSE(BREG)=0 %UNLESS XDISP=0
if (( XDISP ) == ( 0 )) goto L_086a;
PSF1(32, 0, XDISP);
GRUSE[7] = 0;
L_086a:
// 8387 ACCESS=3; ->MD12
ACCESS = 3;
goto U_01eb;
// 8388 MOD(29): ! ACCESS=7 STORE
MOD_29:
// 8389 MOD(30): ! ACCESS=7 FETCH
MOD_30:
// 8390 MOD(21): ! ACCESS=5 STORE
MOD_21:
// 8391 MOD(22): ! ACCESS=5 FETCH
MOD_22:
// 8392 %IF 1<=SIZE<=2 %THEN %START
if (( 1 ) > ( SIZE )) goto L_086b;
if (( SIZE ) > ( 2 )) goto L_086b;
// 8393 %IF SIZE=1 %THEN %START
if (( SIZE ) != ( 1 )) goto L_086c;
// 8394 PSORLF1(LD,0,AREA CODE,DISP) %UNLESS GRUSE(DR)=7 %AND NAMEP>0 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( GRUSE[1] ) != ( 7 )) goto L_086d;
if (( NAMEP ) <= ( 0 )) goto L_086d;
if (( GRINF1[1] ) == ( ((NAMEP)) & ((65535)) )) goto L_086e;
L_086d:
PSORLF1(120, 0, AREACODE(), DISP);
L_086e:
// 8395 %FINISH %ELSE %START; ! SIZE=2 HALFS
goto L_086f;
L_086c:
// 8396 PSORLF1(LDA,0,AREA CODE,DISP+4) %UNLESS NAMEP>=0 %AND GRINF1(DR)=NAMEP&16_FFFF %AND (GRUSE(DR)=7 %OR GRUSE(DR)=15)
if (( NAMEP ) < ( 0 )) goto L_0870;
if (( GRINF1[1] ) != ( ((NAMEP)) & ((65535)) )) goto L_0870;
if (( GRUSE[1] ) == ( 7 )) goto L_0871;
if (( GRUSE[1] ) == ( 15 )) goto L_0871;
L_0870:
PSORLF1(114, 0, AREACODE(), ((DISP)) + ((4)));
L_0871:
// 8397 PF1(LDTB,0,PC,MAPDES(4)) %UNLESS GRUSE(DR)=13 %OR GRUSE(DR)=15
if (( GRUSE[1] ) == ( 13 )) goto L_0872;
if (( GRUSE[1] ) == ( 15 )) goto L_0872;
PF1(116, 0, 4, MAPDES(4));
L_0872:
// 8398 %FINISH
L_086f:
// 8399 GRUSE(DR)=0
GRUSE[1] = 0;
// 8400 %IF NAMEP>0 %THEN GRUSE(DR)=8*SIZE-1 %AND GRINF1(DR)=NAMEP&16_FFFF
if (( NAMEP ) <= ( 0 )) goto L_0873;
GRUSE[1] = ((((8)) * ((SIZE)))) - ((1));
GRINF1[1] = ((NAMEP)) & ((65535));
L_0873:
// 8401 %IF ACCESS=7 %START
if (( ACCESS ) != ( 7 )) goto L_0874;
// 8402 PSF1(ADB,0,XDISP) %IF XDISP#0
if (( XDISP ) == ( 0 )) goto L_0875;
PSF1(32, 0, XDISP);
L_0875:
// 8403 ACCESS=3; AREA=7
ACCESS = 3;
AREA = 7;
// 8404 DISP=0
DISP = 0;
// 8405 GRUSE(BREG)=0
GRUSE[7] = 0;
// 8406 %FINISH %ELSE %START; ! ACCESS = 5
goto L_0876;
L_0874:
// 8407 DISP=XDISP+NUMMOD
DISP = ((XDISP)) + ((NUMMOD));
// 8408 ACCESS=1; AREA=0
ACCESS = 1;
AREA = 0;
// 8409 %FINISH
L_0876:
// 8410 NAMEP=0
NAMEP = 0;
// 8411 ->DRFETCH %IF Z=2
if (( Z ) != ( 2 )) goto L_0877;
goto U_01e9;
L_0877:
// 8412 %RETURN
return;
// 8413 %FINISH
L_086b:
// 8414 %IF ACCESS=7 %START
if (( ACCESS ) != ( 7 )) goto L_0878;
// 8415 PSORLF1(ADB,0,AREA CODE,DISP+4)
PSORLF1(32, 0, AREACODE(), ((DISP)) + ((4)));
// 8416 GRUSE(BREG)=0
GRUSE[7] = 0;
// 8417 XYNB=XORYNB(0,0)
XYNB = XORYNB(0, 0);
// 8418 PF1(LDCODE(XYNB),0,BREG,0)
PF1(LDCODE[XYNB], 0, 7, 0);
// 8419 GRUSE(XYNB)=0
GRUSE[XYNB] = 0;
// 8420 DISP=XDISP
DISP = XDISP;
// 8421 %FINISH %ELSE %START; ! ACCESS=5
goto L_0879;
L_0878:
// 8422 XYNB=BASEREG(8,NAMEP&16_FFFF)
XYNB = BASEREG(8, ((NAMEP)) & ((65535)));
// 8423 DISP=NUMMOD+XDISP
DISP = ((NUMMOD)) + ((XDISP));
// 8424 %FINISH
L_0879:
// 8425 AREA=XYNB; ACCESS=0
AREA = XYNB;
ACCESS = 0;
// 8426 NAMEP=0
NAMEP = 0;
// 8427 ->MOD(KK)
MOD_idx = KK; if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8428 MOD(32): ! ACCESS=8 FETCH ADDRESS
MOD_32:
// 8429 MOD(33): ! ACCESS=8 STORE
MOD_33:
// 8430 MOD(34): ! ACCESS=8 FETCH
MOD_34:
// 8431 MOD(35): ! ACCESS=8 SET DESCRIPTOR
MOD_35:
// 8432 DISP=DISP+XDISP
DISP = ((DISP)) + ((XDISP));
// 8433 NAMEP=0
NAMEP = 0;
// 8434 ACCESS=2; ->MOD(KK+8)
ACCESS = 2;
MOD_idx = ((KK)) + ((8)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8435 MOD(40): ! ACCESS=10 FETCH ADDRESS
MOD_40:
// 8436 MOD(41): ! ACCESS=10 STORE
MOD_41:
// 8437 MOD(42): ! ACCESS=10 FETCH
MOD_42:
// 8438 MOD(43): ! ACCESS=10 SET DESCRIPTOR
MOD_43:
// 8439 XYNB=BASEREG(8,NAMEP&16_FFFF)
XYNB = BASEREG(8, ((NAMEP)) & ((65535)));
// 8440 AREA=XYNB; ACCESS=2; DISP=XDISP
AREA = XYNB;
ACCESS = 2;
DISP = XDISP;
// 8441 NAMEP=0
NAMEP = 0;
// 8442 ->MOD(KK+8)
MOD_idx = ((KK)) + ((8)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8443 MOD(44): ! ACCESS=11 FETCH ADDRESS
MOD_44:
// 8444 MOD(45): ! ACCESS=11 STORE
MOD_45:
// 8445 MOD(46): ! ACCESS=11 FETCH
MOD_46:
// 8446 MOD(47): ! ACCESS=11 SET DESCRIPTOR
MOD_47:
// 8447 PSORLF1(ADB,0,AREA CODE,DISP+4)
PSORLF1(32, 0, AREACODE(), ((DISP)) + ((4)));
// 8448 GRUSE(BREG)=0
GRUSE[7] = 0;
// 8449 XYNB=XORYNB(0,0)
XYNB = XORYNB(0, 0);
// 8450 PF1(LDCODE(XYNB),0,BREG,0)
PF1(LDCODE[XYNB], 0, 7, 0);
// 8451 GRUSE(XYNB)=0
GRUSE[XYNB] = 0;
// 8452 NAMEP=0; AREA=XYNB
NAMEP = 0;
AREA = XYNB;
// 8453 ACCESS=2; DISP=XDISP; ->MOD(KK+8)
ACCESS = 2;
DISP = XDISP;
MOD_idx = ((KK)) + ((8)); if ((0 <= KK_idx) && (KK_idx <= 47)) goto *KK[KK_idx]; else {/*_imp_signal(6, KK_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index KK(%d) not in range 0:47 at %s:%d\n", KK_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8454 %INTEGERFN BASEREG(%INTEGER GRUSEVAL,GRINFVAL)
int BASEREG( int GRUSEVAL, int GRINFVAL )
{
__label__ _imp_endofblock;
// 8455 !***********************************************************************
// 8456 !* SETS A BASE REGISTER FOR RECORD WHOSE POINTER IS AT AREA&DISP *
// 8457 !***********************************************************************
// 8458 %INTEGER XYNB
int XYNB;
// 8459 %IF NAMEP<=0 %THEN GRUSEVAL=0 %AND GRINFVAL=0
if (( NAMEP ) > ( 0 )) goto L_087a;
GRUSEVAL = 0;
GRINFVAL = 0;
L_087a:
// 8460 XYNB=XORYNB(GRUSEVAL,GRINFVAL)
XYNB = XORYNB(GRUSEVAL, GRINFVAL);
// 8461 PSORLF1(LDCODE(XYNB),0,AREA CODE,DISP+4) %UNLESS GRUSE(XYNB)=GRUSEVAL>0 %AND GRINF1(XYNB)=GRINFVAL
if (( GRUSE[XYNB] ) != ( GRUSEVAL )) goto L_087b;
if (( GRUSEVAL ) <= ( 0 )) goto L_087b;
if (( GRINF1[XYNB] ) == ( GRINFVAL )) goto L_087c;
L_087b:
PSORLF1(LDCODE[XYNB], 0, AREACODE(), ((DISP)) + ((4)));
L_087c:
// 8462 GRUSE(XYNB)=GRUSEVAL
GRUSE[XYNB] = GRUSEVAL;
// 8463 GRINF1(XYNB)=GRINFVAL
GRINF1[XYNB] = GRINFVAL;
// 8464 GRAT(XYNB)=CA
GRAT[XYNB] = CA;
// 8465 %RESULT=XYNB
return XYNB;
// 8466 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block BASEREG at level 6
// 8467 %END
return;
_imp_endofblock: ;
} // End of block NAMEOP at level 5
// 8468 %ROUTINE CRCALL(%INTEGER RTNAME)
void CRCALL( int RTNAME )
{
__label__ _imp_endofblock;
// 8469 !***********************************************************************
// 8470 !* COMPILE A ROUTINE OR FN CALL *
// 8471 !* THE PROCEDURE CONSIST OF THREE PARTS:- *
// 8472 !* A) PLANT THE PARAMETER (IF ANY) *
// 8473 !* B) ENTER THE ROUTINE OR FN *
// 8474 !* C) FORGET ANY REGISTERS WHICH HOLD ENTITIES THAT CAN BE *
// 8475 !* ALTERED BY THE CALLED PROCEDURE. *
// 8476 !***********************************************************************
// 8477 %SWITCH FPD(0:3)
static int FPD_idx;
static const void * /*SWITCH*/ FPD[(3)-(0)+1] = { &&FPD_0, &&FPD_1, &&FPD_2, &&FPD_3, };
// 8478 %INTEGER II,III,QQQ,DLINK,JJ,JJJ,NPARMS,PT,LP,PSIZE,TWSP,FPTR,TYPEP,PRECP,NAMP,TL,MOVEPTR,CLINK,RDISP
int II;
int III;
int QQQ;
int DLINK;
int JJ;
int JJJ;
int NPARMS;
int PT;
int LP;
int PSIZE;
int TWSP;
int FPTR;
int TYPEP;
int PRECP;
int NAMP;
int TL;
int MOVEPTR;
int CLINK;
int RDISP;
// 8479 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 8480 PT=PTYPE; JJJ=J; TL=OLDI
PT = PTYPE;
JJJ = J;
TL = OLDI;
// 8481 TWSP=0
TWSP = 0;
// 8482 LP=I; CLINK=K
LP = I;
CLINK = K;
// 8483 TYPEP=TYPE; PRECP=PREC; NAMP=NAM
TYPEP = TYPE;
PRECP = PREC;
NAMP = NAM;
// 8484 RDISP=MIDCELL
RDISP = MIDCELL;
// 8485 !
// 8486 ! NOW CHECK THAT THE RIGHT NUMBER OF PARAMETERS HAVE BEEN PROVIDED
// 8487 !
// 8488 TEST APP(NPARMS)
TESTAPP( &NPARMS);
// 8489 P=P+2
P = ((P)) + ((2));
// 8490 %IF KFORM#NPARMS %THEN %START
if (( KFORM ) == ( NPARMS )) goto L_087d;
// 8491 FAULT(19,RTNAME); ! WRONG NO OF PARAMETERS GIVEN
FAULT(19, RTNAME);
// 8492 SKIP APP; P=P-1
SKIPAPP();
P = ((P)) - ((1));
// 8493 %RETURN
return;
// 8494 %FINISH
L_087d:
// 8495 !
// 8496 SAVE IRS; ! STACK ANY IRS BEFORS ASF
SAVEIRS();
// 8497 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 8498 FPTR=20
FPTR = 20;
// 8499 ->FIRST PARM
goto U_01f2;
// 8500 !
// 8501 NEXT PARM:CLINK=LCELL_LINK
U_01f3:
CLINK = LCELL->LINK;
// 8502 FIRSTPARM:->ENTRY SEQ %IF CLINK=0; ! DEPART AT ONCE IF NO PARAMS
U_01f2:
if (( CLINK ) != ( 0 )) goto L_087e;
goto U_01f4;
L_087e:
// 8503 LCELL==ASLIST(CLINK)
LCELL = (&(ASLIST[CLINK]));
// 8504 PSIZE=LCELL_S2>>16
PSIZE = (int)(((unsigned int)(LCELL->S2)) >> ((16)));
// 8505 P=P+1
P = ((P)) + ((1));
// 8506 PTYPE=LCELL_S1>>16
PTYPE = (int)(((unsigned int)(LCELL->S1)) >> ((16)));
// 8507 UNPACK
UNPACK();
// 8508 II=TYPE;III=PREC
II = TYPE;
III = PREC;
// 8509 JJ=(NAM<<1!ARR)&3
JJ = ((((((NAM)) << ((1)))) | ((ARR)))) & ((3));
// 8510 %UNLESS (JJ=0 %AND ROUT=0) %OR (A(P+3)=4 %AND A(P+4)=1 %AND A(P+FROMAR2(P+1)+1)=2) %START
if (( JJ ) != ( 0 )) goto L_087f;
if (( ROUT ) == ( 0 )) goto L_0880;
L_087f:
if (( A[((P)) + ((3))] ) != ( 4 )) goto L_0881;
if (( A[((P)) + ((4))] ) != ( 1 )) goto L_0881;
if (( A[((((P)) + ((FROMAR2(((P)) + ((1))))))) + ((1))] ) == ( 2 )) goto L_0880;
L_0881:
// 8511 FAULT(22,0); SKIP EXP
FAULT(22, 0);
SKIPEXP();
// 8512 ->NEXT PARM
goto U_01f3;
// 8513 %FINISH
L_0880:
// 8514 !
// 8515 ! RT TYPE PARAMS, PASS 4 WORDS SET UP AS CODE DESC,DUMMY & ENVIRONMENT
// 8516 !
// 8517 %IF ROUT=1 %THEN %START
if (( ROUT ) != ( 1 )) goto L_0882;
// 8518 II=PTYPE; P=P+5
II = PTYPE;
P = ((P)) + ((5));
// 8519 CNAME(13,ACCR); ! SET UP 4 WDS IN ACC
CNAME(13, 0);
// 8520 FAULT(22,0) %IF II&255#PTYPE&255;! PREC&TYPE SIMILAR
if (( ((II)) & ((255)) ) == ( ((PTYPE)) & ((255)) )) goto L_0883;
FAULT(22, 0);
L_0883:
// 8521 P=P+1; MOVEPTR=16
P = ((P)) + ((1));
MOVEPTR = 16;
// 8522 ->STUFF
goto U_01f5;
// 8523 %FINISH
L_0882:
// 8524 ->FPD(JJ)
FPD_idx = JJ; if ((0 <= JJ_idx) && (JJ_idx <= 3)) goto *JJ[JJ_idx]; else {/*_imp_signal(6, JJ_idx, _imp_current_line)*/ fprintf(stderr, "%%SWITCH index JJ(%d) not in range 0:3 at %s:%d\n", JJ_idx, _imp_current_file, _imp_current_line); exit(1); }
// 8525 FPD(0): ! VALUE PARAMETERS
FPD_0:
// 8526 %IF TYPE=5 %THEN %START
if (( TYPE ) != ( 5 )) goto L_0884;
// 8527 CSTREXP(17,DR); ! TO WK AREA & KEEP WK AREA
CSTREXP(17, 1);
// 8528 PSF1(LDB,0,PSIZE)
PSF1(118, 0, PSIZE);
// 8529 %IF REGISTER(ACCR)=3 %THEN PF1(ST,0,TOS,0) %AND REGISTER(ACCR)=0
if (( REGISTER[0] ) != ( 3 )) goto L_0885;
PF1(72, 0, 6, 0);
REGISTER[0] = 0;
L_0885:
// 8530 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 8531 PUSH(TWSP,VALUE,268,0); ! RETURN WK AREA AT CALL
PUSH( &TWSP, VALUE, 268, 0);
// 8532 FPTR=FPTR+8; ->NEXT PARM
FPTR = ((FPTR)) + ((8));
goto U_01f3;
// 8533 %FINISH %ELSE %START
L_0884:
// 8534 %IF PREC=6 %THEN JJ=3 %ELSE JJ=TYPE
if (( PREC ) != ( 6 )) goto L_0886;
JJ = 3;
goto L_0887;
L_0886:
JJ = TYPE;
L_0887:
// 8535 CSEXP(ACCR,III<<4!II)
CSEXP(0, ((((III)) << ((4)))) | ((II)));
// 8536 MOVEPTR=((BYTES(III)+3)&(-4))
MOVEPTR = ((((BYTES[III])) + ((3)))) & (((-(4))));
// 8537 %FINISH
// 8538 ->STUFF
goto U_01f5;
// 8539 !
// 8540 FPD(2): ! NAME PARAMETERS
FPD_2:
// 8541 P=P+5
P = ((P)) + ((5));
// 8542 FNAME=FROM AR2(P)
FNAME = FROMAR2(P);
// 8543 COPY TAG(FNAME)
COPYTAG(FNAME);
// 8544 %IF II#0 %OR TYPE=0 %START
if (( II ) != ( 0 )) goto L_0888;
if (( TYPE ) != ( 0 )) goto L_0889;
L_0888:
// 8545 CNAME(3,ACCR)
CNAME(3, 0);
// 8546 FAULT(22,FNAME) %UNLESS II=TYPE %AND III=PREC
if (( II ) != ( TYPE )) goto L_088a;
if (( III ) == ( PREC )) goto L_088b;
L_088a:
FAULT(22, FNAME);
L_088b:
// 8547 %FINISH %ELSE %START
goto L_088c;
L_0889:
// 8548 CNAME(4,ACCR)
CNAME(4, 0);
// 8549 %IF TYPE<=2 %THEN JJ=PREC<<27!TYPE %ELSE JJ=16_1A<<24+ACC
if (( TYPE ) > ( 2 )) goto L_088d;
JJ = ((((PREC)) << ((27)))) | ((TYPE));
goto L_088e;
L_088d:
JJ = ((((26)) << ((24)))) + ((ACC));
L_088e:
// 8550 STORE CONST(III,4,ADDR(JJ))
STORECONST( &III, 4, ADDR( &JJ));
// 8551 PF1(LUH,0,PC,III)
PF1(106, 0, 4, III);
// 8552 %FINISH
L_088c:
// 8553 P=P+1; MOVEPTR=8
P = ((P)) + ((1));
MOVEPTR = 8;
// 8554 ->STUFF
goto U_01f5;
// 8555 !
// 8556 FPD(1):FPD(3): ! ARRAY NAME (&VALUE)
FPD_1:
FPD_3:
// 8557 !
// 8558 ! FOR ARRAYNAME PARAMETERS THE NO OF DIMENSIONS OF THE ARRAY IS
// 8559 ! DEDUCED FROM THE FIRST CALL AND STORED IN STREAM3 OF THE PARAMETER
// 8560 ! LIST. ON ANY SUBSEQUENT CALL ONLY ARRAYS OF THE SAME DIMENSION CAN
// 8561 ! BE PASSED
// 8562 !
// 8563 P=P+5
P = ((P)) + ((5));
// 8564 CNAME(12,ACCR)
CNAME(12, 0);
// 8565 GET IN ACC(ACCR,4,0,AREA CODE,DISP)
GETINACC(0, 4, 0, AREACODE(), DISP);
// 8566 P=P+1; MOVEPTR=16
P = ((P)) + ((1));
MOVEPTR = 16;
// 8567 FAULT(22,0) %AND ->STUFF %UNLESS 1<=ARR<=2 %AND II=TYPE %AND III=PREC
if (( 1 ) > ( ARR )) goto L_088f;
if (( ARR ) > ( 2 )) goto L_088f;
if (( II ) != ( TYPE )) goto L_088f;
if (( III ) == ( PREC )) goto L_0890;
L_088f:
FAULT(22, 0);
goto U_01f5;
L_0890:
// 8568 QQQ=FROM1(TCELL)&15; ! DIMENSION OF ACTUAL(IF KNOWN)
QQQ = ((FROM1(TCELL))) & ((15));
// 8569 JJ=LCELL_S1&15; ! DIMENSION OF FORMAL
JJ = ((LCELL->S1)) & ((15));
// 8570 %IF JJ=0 %THEN JJ=QQQ %AND LCELL_S1=LCELL_S1!JJ
if (( JJ ) != ( 0 )) goto L_0891;
JJ = QQQ;
LCELL->S1 = ((LCELL->S1)) | ((JJ));
L_0891:
// 8571 %IF QQQ=0 %THEN QQQ=JJ %AND REPLACE1(TCELL,FROM1(TCELL)!JJ)
if (( QQQ ) != ( 0 )) goto L_0892;
QQQ = JJ;
REPLACE1(TCELL, ((FROM1(TCELL))) | ((JJ)));
L_0892:
// 8572 FAULT(22,0) %UNLESS JJ=QQQ
if (( JJ ) == ( QQQ )) goto L_0893;
FAULT(22, 0);
L_0893:
// 8573 STUFF: REGISTER(ACCR)=3
U_01f5:
REGISTER[0] = 3;
// 8574 FPTR=FPTR+MOVEPTR
FPTR = ((FPTR)) + ((MOVEPTR));
// 8575 -> NEXT PARM
goto U_01f3;
// 8576 ENTRY SEQ: ! CODE FOR RT ENTRY
U_01f4:
// 8577 %IF REGISTER(ACCR)=3 %THEN PF1(ST,0,TOS,0) %AND REGISTER(ACCR)=0
if (( REGISTER[0] ) != ( 3 )) goto L_0894;
PF1(72, 0, 6, 0);
REGISTER[0] = 0;
L_0894:
// 8578 J=JJJ
J = JJJ;
// 8579 !
// 8580 ! RETURN ANY STRING WSPACE HERE. CAN BE UXED AGAIN FOR RESULT
// 8581 !
// 8582 %WHILE TWSP#0 %CYCLE
L_0895:
if (( TWSP ) == ( 0 )) goto L_0896;
// 8583 POP(TWSP,QQQ,JJ,III)
POP( &TWSP, &QQQ, &JJ, &III);
// 8584 RETURN WSP(QQQ,268)
RETURNWSP(QQQ, 268);
// 8585 %REPEAT
goto L_0895;
L_0896:
// 8586 !
// 8587 ! STRING FNS NEED A WORK AREA TO RETURN THEIR RESULTS
// 8588 !
// 8589 %IF TYPEP=5 %AND NAMP<=1 %THEN %START
if (( TYPEP ) != ( 5 )) goto L_0898;
if (( NAMP ) > ( 1 )) goto L_0898;
// 8590 GET WSP(QQQ,268)
GETWSP( &QQQ, 268);
// 8591 STRFNRES=QQQ; ! FOR CSTREXP TO USE
STRFNRES = QQQ;
// 8592 III=16_18000100; QQQ=QQQ+8
III = 402653440;
QQQ = ((QQQ)) + ((8));
// 8593 STORE CONST(JJ,8,ADDR(III))
STORECONST( &JJ, 8, ADDR( &III));
// 8594 PF1(LD,0,PC,JJ)
PF1(120, 0, 4, JJ);
// 8595 PSF1(INCA,1,PTR OFFSET(RBASE))
PSF1(20, 1, PTROFFSET(RBASE));
// 8596 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 8597 FPTR=FPTR+8
FPTR = ((FPTR)) + ((8));
// 8598 %FINISH
L_0898:
// 8599 !
// 8600 ! ORDINARY ROUTINES WILL AND RT PARAMS MAY REQUIRE AN EXTRA PARAMETER
// 8601 ! BEING LNB FOR THE LEVEL OF ROUTINE DECLARATION TO BE STACKED
// 8602 !
// 8603 %IF JJJ=14 %THEN %START; ! EXTERNAL
if (( JJJ ) != ( 14 )) goto L_0899;
// 8604 NMDECS(LEVEL)=NMDECS(LEVEL)!2
NMDECS[LEVEL] = ((NMDECS[LEVEL])) | ((2));
// 8605 II=SET XORYNB(-1,-1)
II = SETXORYNB((-(1)), (-(1)));
// 8606 PSF1(RALN,0,FPTR>>2)
PSF1(108, 0, (int)(((unsigned int)(FPTR)) >> ((2))));
// 8607 PF1(CALL,2,II,RDISP)
PF1(30, 2, II, RDISP);
// 8608 %FINISH %ELSE %START
goto L_089a;
L_0899:
// 8609 %IF NAMP&1=0 %THEN %START;! INTERNAL RT CALLS
if (( ((NAMP)) & ((1)) ) != ( 0 )) goto L_089b;
// 8610 %IF LP=0 %THEN %START
if (( LP ) != ( 0 )) goto L_089c;
// 8611 PSF1(LD,1,12)
PSF1(120, 1, 12);
// 8612 PSF1(INCA,0,RDISP) %UNLESS RDISP=0
if (( RDISP ) == ( 0 )) goto L_089d;
PSF1(20, 0, RDISP);
L_089d:
// 8613 PSF1(RALN,0,FPTR>>2)
PSF1(108, 0, (int)(((unsigned int)(FPTR)) >> ((2))));
// 8614 PF1(CALL,2,7,0)
PF1(30, 2, 7, 0);
// 8615 %FINISH %ELSE %START;! NORMAL INTERNAL CALL
goto L_089e;
L_089c:
// 8616 II=SET XORYNB(XNB,LP)
II = SETXORYNB(3, LP);
// 8617 PSF1(RALN,0,FPTR>>2)
PSF1(108, 0, (int)(((unsigned int)(FPTR)) >> ((2))));
// 8618 RT JUMP(CALL,ASLIST(TAGS(RTNAME))_S2)
RTJUMP(30, &ASLIST[TAGS[RTNAME]].S2);
// 8619 %FINISH
L_089e:
// 8620 %FINISH %ELSE %START
goto L_089f;
L_089b:
// 8621 AREA=-1; BASE=LP
AREA = (-(1));
BASE = LP;
// 8622 AREA=AREA CODE
AREA = AREACODE();
// 8623 GET IN ACC(DR,2,0,AREA,RDISP);! DESCR TO DR
GETINACC(1, 2, 0, AREA, RDISP);
// 8624 PSORLF1(LXN,0,AREA,RDISP+12);! XNB TO ENVIRONMENT
PSORLF1(126, 0, AREA, ((RDISP)) + ((12)));
// 8625 PSF1(RALN,0,FPTR>>2); ! RAISE FOR NORMAL PARAMS
PSF1(108, 0, (int)(((unsigned int)(FPTR)) >> ((2))));
// 8626 PF1(CALL,2,7,0) ;! AND ENTER VIA DESCRPTR IN DR
PF1(30, 2, 7, 0);
// 8627 %FINISH
L_089f:
// 8628 %FINISH
L_089a:
// 8629 FORGET(-1)
FORGET((-(1)));
// 8630 ROUT=1; TYPE=TYPEP; NAM=NAMP
ROUT = 1;
TYPE = TYPEP;
NAM = NAMP;
// 8631 PREC=PRECP; PTYPE=PT
PREC = PRECP;
PTYPE = PT;
// 8632 %END
return;
_imp_endofblock: ;
} // End of block CRCALL at level 5
// 8633 %ROUTINE RT JUMP(%INTEGER CODE,%INTEGERNAME LINK)
void RTJUMP( int CODE, int *LINK )
{
__label__ _imp_endofblock;
// 8634 !***********************************************************************
// 8635 !* PLANTS A CALL TO THE APPROPIATE ENTRY ADDRESS IN LINK *
// 8636 !* IF ROUTINE HAS BEEN SPECIFIED BUT NOT DESCRIBED THE JUMP CAN *
// 8637 !* NOT BE PLANTED AND IS LINKED INTO A LIST HEADED BY LINK *
// 8638 !* TO AWAIT FILLING (BY ' RHEAD ') WHEN THE BODY IS GIVEN. *
// 8639 !* THE FORMAT OF AN ENTRY IS :- *
// 8640 !* S1(32 BITS) = INSTRN TO BE PLANTED *
// 8641 !* S2(32 BITS) = ADDRESS OF JUMP TO BE FILLED *
// 8642 !* THE CODING ASSUMES I,J&OLDI ARE SET UP FOR THE CALLED ROUTINE *
// 8643 !***********************************************************************
// 8644 %INTEGER DP
int DP;
// 8645 %IF J=15 %THEN %START; ! RT BODY NOT GIVEN YET
if (( J ) != ( 15 )) goto L_08a0;
// 8646 PUSH(LINK,CODE<<24!3<<23,CA,0)
PUSH(LINK, ((((CODE)) << ((24)))) | ((((3)) << ((23)))), CA, 0);
// 8647 PF1(CODE,0,0,0)
PF1(CODE, 0, 0, 0);
// 8648 %FINISH %ELSE %START; ! BODY GIVEN AND ADDRESS KNOWN
goto L_08a1;
L_08a0:
// 8649 DP=LINK-CA
DP = ((LINK)) - ((CA));
// 8650 DP=DP//2 %IF CODE=CALL; ! CALL WORKS IN HALFWORDS!
if (( CODE ) != ( 30 )) goto L_08a2;
DP = ((int)(DP)) / ((int)(2));
L_08a2:
// 8651 PSF1(CODE,0,DP)
PSF1(CODE, 0, DP);
// 8652 %FINISH
L_08a1:
// 8653 %END
return;
_imp_endofblock: ;
} // End of block RTJUMP at level 5
// 8654 %INTEGERFN TSEXP(%INTEGERNAME VALUE)
int TSEXP( int *VALUE )
{
__label__ _imp_endofblock;
// 8655 %SWITCH SW(1:3)
static int SW_idx;
static const void * /*SWITCH*/ SW[(3)-(1)+1] = { &&SW_1, &&SW_2, &&SW_3, };
// 8656 %INTEGER PP,REXP,KK,SIGN,CT
int PP;
int REXP;
int KK;
int SIGN;
int CT;
// 8657 TYPE=1; PP=P
TYPE = 1;
PP = P;
// 8658 REXP=2-A(P+1+FROM AR2(P+1))
REXP = ((2)) - ((A[((((P)) + ((1)))) + ((FROMAR2(((P)) + ((1)))))]));
// 8659 P=P+3
P = ((P)) + ((3));
// 8660 SIGN=A(P)
SIGN = A[P];
// 8661 ->TYPED %UNLESS SIGN=4 %OR A(P+1)=2
if (( SIGN ) == ( 4 )) goto L_08a3;
if (( A[((P)) + ((1))] ) == ( 2 )) goto L_08a3;
goto U_01e3;
L_08a3:
// 8662 ->SW(A(P+1))
goto *(SW-1)[A[((P)) + ((1))]]; /* Bounds=1:3 */
// 8663 SW(1): ! NAME
SW_1:
// 8664 P=P+2; REDUCE TAG
P = ((P)) + ((2));
REDUCETAG();
// 8665 ->TYPED
goto U_01e3;
// 8666 SW(2): ! CONSTANT
SW_2:
// 8667 CT=A(P+2); TYPE=CT&7
CT = A[((P)) + ((2))];
TYPE = ((CT)) & ((7));
// 8668 ->TYPED %UNLESS CT=16_41 %AND SIGN#3
if (( CT ) != ( 65 )) goto L_0897;
if (( SIGN ) != ( 3 )) goto L_08a4;
L_0897:
goto U_01e3;
L_08a4:
// 8669 KK=FROMAR2(P+3)
KK = FROMAR2(((P)) + ((3)));
// 8670 %IF REXP#0 %AND A(P+6)=CONCOP %THEN TYPE=5 %AND ->TYPED
if (( REXP ) == ( 0 )) goto L_08a5;
if (( A[((P)) + ((6))] ) != ( 13 )) goto L_08a5;
TYPE = 5;
goto U_01e3;
L_08a5:
// 8671 ->TYPED %UNLESS REXP=0 %AND 0<=KK<=255
if (( REXP ) != ( 0 )) goto L_08a6;
if (( 0 ) > ( KK )) goto L_08a6;
if (( KK ) <= ( 255 )) goto L_08a7;
L_08a6:
goto U_01e3;
L_08a7:
// 8672 VALUE=KK
VALUE = KK;
// 8673 P=P+6
P = ((P)) + ((6));
// 8674 %IF SIGN#2 %THEN %RESULT=1
if (( SIGN ) == ( 2 )) goto L_08a8;
return 1;
L_08a8:
// 8675 VALUE=-VALUE; %RESULT=-1
VALUE = (-(VALUE));
return (-(1));
// 8676 SW(3): ! SUB EXPRN
SW_3:
// 8677 TYPED: P=PP; %RESULT=0
U_01e3:
P = PP;
return 0;
// 8678 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block TSEXP at level 5
// 8679 %ROUTINE SKIP EXP
void SKIPEXP( void )
{
__label__ _imp_endofblock;
// 8680 !***********************************************************************
// 8681 !* SKIPS OVER THE EXPRESSION POINTED AT BY P. USED FOR ERROR *
// 8682 !* RECOVERY AND TO EXTRACT INFORMATION ABOUT THE EXPRESSION. *
// 8683 !***********************************************************************
// 8684 %INTEGER OPTYPE, PIN, J
int OPTYPE;
int PIN;
int J;
// 8685 PIN=P
PIN = P;
// 8686 P=P+3; ! TO P<+'>
P = ((P)) + ((3));
// 8687 %CYCLE; ! DOWN THE LIST OF OPERATORS
L_08a9:
// 8688 OPTYPE=A(P+1); ! ALT OF P<OPERAND>
OPTYPE = A[((P)) + ((1))];
// 8689 P=P+2
P = ((P)) + ((2));
// 8690 %IF OPTYPE=0 %OR OPTYPE>3 %THEN ABORT
if (( OPTYPE ) == ( 0 )) goto L_08ac;
if (( OPTYPE ) <= ( 3 )) goto L_08ad;
L_08ac:
ABORT();
L_08ad:
// 8691 %IF OPTYPE=3 %THEN SKIP EXP; ! SUB EXPRESSIONS
if (( OPTYPE ) != ( 3 )) goto L_08ae;
SKIPEXP();
L_08ae:
// 8692 !
// 8693 %IF OPTYPE=2 %THEN %START; ! OPERAND IS A CONSTANT
if (( OPTYPE ) != ( 2 )) goto L_08af;
// 8694 J=A(P)&7; ! CONSTANT TYPE
J = ((A[P])) & ((7));
// 8695 %IF J=5 %THEN P=P+A(P+5)+6 %ELSE P=P+1+BYTES(A(P)>>4)
if (( J ) != ( 5 )) goto L_08b0;
P = ((((P)) + ((A[((P)) + ((5))])))) + ((6));
goto L_08b1;
L_08b0:
P = ((((P)) + ((1)))) + ((BYTES[(int)(((unsigned int)(A[P])) >> ((4)))]));
L_08b1:
// 8696 %FINISH
L_08af:
// 8697 !
// 8698 %IF OPTYPE=1 %THEN %START; ! NAME
if (( OPTYPE ) != ( 1 )) goto L_08b2;
// 8699 P=P-1
P = ((P)) - ((1));
// 8700 P=P+3 %AND SKIP APP %UNTIL A(P)=2 ;! TILL NO ENAME
L_08b3:
P = ((P)) + ((3));
SKIPAPP();
if (( A[P] ) == ( 2 )) goto L_08b4;
goto L_08b3;
L_08b4:
// 8701 P=P+1
P = ((P)) + ((1));
// 8702 %FINISH
L_08b2:
// 8703 !
// 8704 P=P+1
P = ((P)) + ((1));
// 8705 %IF A(P-1)=2 %THEN %EXIT; ! NO MORE REST OF EXP
if (( A[((P)) - ((1))] ) != ( 2 )) goto L_08b6;
goto L_08aa;
L_08b6:
// 8706 %REPEAT
goto L_08a9;
L_08aa:
// 8707 %END; ! OF ROUTINE SKIP EXP
return;
_imp_endofblock: ;
} // End of block SKIPEXP at level 5
// 8708 %ROUTINE SKIP APP
void SKIPAPP( void )
{
__label__ _imp_endofblock;
// 8709 !***********************************************************************
// 8710 !* SKIPS ACTUAL PARAMETER PART *
// 8711 !* P IS ON ALT OF P<APP> AT ENTRY *
// 8712 !***********************************************************************
// 8713 %INTEGER PIN
int PIN;
// 8714 PIN=P
PIN = P;
// 8715 P=P+1 %AND SKIP EXP %WHILE A(P)=1
L_08b7:
if (( A[P] ) != ( 1 )) goto L_08b8;
P = ((P)) + ((1));
SKIPEXP();
goto L_08b7;
L_08b8:
// 8716 P=P+1
P = ((P)) + ((1));
// 8717 %END
return;
_imp_endofblock: ;
} // End of block SKIPAPP at level 5
// 8718 %ROUTINE NO APP
void NOAPP( void )
{
__label__ _imp_endofblock;
// 8719 P=P+2
P = ((P)) + ((2));
// 8720 %IF A(P)=1 %THEN %START; ! <APP> PRESENT
if (( A[P] ) != ( 1 )) goto L_08ba;
// 8721 FAULT2(17,0,FROM AR2(P-2))
FAULT2(17, 0, FROMAR2(((P)) - ((2))));
// 8722 SKIP APP
SKIPAPP();
// 8723 %FINISH %ELSE P=P+1; ! P NOW POINTS TO ENAME
goto L_08bb;
L_08ba:
P = ((P)) + ((1));
L_08bb:
// 8724 %END
return;
_imp_endofblock: ;
} // End of block NOAPP at level 5
// 8725 %ROUTINE TEST APP(%INTEGERNAME NUM)
void TESTAPP( int *NUM )
{
__label__ _imp_endofblock;
// 8726 !***********************************************************************
// 8727 !* THIS ROUTINE COUNTS THE NUMBER OF ACTUAL PARAMETERS *
// 8728 !* WHICH IT RETURNS IN NUM. *
// 8729 !***********************************************************************
// 8730 %INTEGER PP, Q
int PP;
int Q;
// 8731 Q=0; PP=P; P=P+2; ! P ON NAME AT ENTRY
Q = 0;
PP = P;
P = ((P)) + ((2));
// 8732 %WHILE A(P)=1 %CYCLE; ! NO (MORE) PARAMETERS
L_08bc:
if (( A[P] ) != ( 1 )) goto L_08bd;
// 8733 P=P+1; Q=Q+1
P = ((P)) + ((1));
Q = ((Q)) + ((1));
// 8734 SKIP EXP
SKIPEXP();
// 8735 %REPEAT
goto L_08bc;
L_08bd:
// 8736 P=PP; NUM=Q
P = PP;
NUM = Q;
// 8737 %END
return;
_imp_endofblock: ;
} // End of block TESTAPP at level 5
// 8738 %ROUTINE TEST ASS(%INTEGER REG,TYPE,SIZE)
void TESTASS( int REG, int TYPE, int SIZE )
{
__label__ _imp_endofblock;
// 8739 !***********************************************************************
// 8740 !* TEST ACC OR B FOR THE UNASSIGNED PATTERN *
// 8741 !***********************************************************************
// 8742 %INTEGER OPCODE,A,D
int OPCODE;
int A;
int D;
// 8743 %IF TYPE=5 %THEN %START
if (( TYPE ) != ( 5 )) goto L_08bf;
// 8744 %RETURN %UNLESS REG=DR
if (( REG ) == ( 1 )) goto L_08c0;
return;
L_08c0:
// 8745 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 8746 PF2(SWEQ,1,1,0,0,UNASSPAT&255)
PF2(160, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 8747 %FINISH %ELSE %START
goto L_08c1;
L_08bf:
// 8748 %IF REG=BREG %THEN OPCODE=CPB %ELSE OPCODE=UCP
if (( REG ) != ( 7 )) goto L_08c2;
OPCODE = 38;
goto L_08c3;
L_08c2:
OPCODE = 198;
L_08c3:
// 8749 %IF SIZE=16 %THEN PF1(STUH,0,TOS,0)
if (( SIZE ) != ( 16 )) goto L_08c4;
PF1(74, 0, 6, 0);
L_08c4:
// 8750 %IF SIZE=2 %THEN A=0 %AND D=UNASSPAT>>16 %ELSE A=PC %AND D=PLABS(1)
if (( SIZE ) != ( 2 )) goto L_08c5;
A = 0;
D = (int)(((unsigned int)(-2122219135)) >> ((16)));
goto L_08c6;
L_08c5:
A = 4;
D = PLABS[1];
L_08c6:
// 8751 PF1(OPCODE,0,A,D)
PF1(OPCODE, 0, A, D);
// 8752 %IF SIZE=16 %THEN PF1(LUH,0,TOS,0)
if (( SIZE ) != ( 16 )) goto L_08c7;
PF1(106, 0, 6, 0);
L_08c7:
// 8753 %FINISH
L_08c1:
// 8754 PPJ(8,5); ! BE ERROR ROUTINE 5
PPJ(8, 5);
// 8755 %IF TYPE=5 %THEN PF1(LD,0,TOS,0)
if (( TYPE ) != ( 5 )) goto L_08c8;
PF1(120, 0, 6, 0);
L_08c8:
// 8756 %END
return;
_imp_endofblock: ;
} // End of block TESTASS at level 5
// 8757 %ROUTINE GET WSP(%INTEGERNAME PLACE,%INTEGER SIZE)
void GETWSP( int *PLACE, int SIZE )
{
__label__ _imp_endofblock;
// 8758 !***********************************************************************
// 8759 !* FIND OR CREATE A TEMPORARY VARIABLE OF 'SIZE' WORDS *
// 8760 !***********************************************************************
// 8761 %INTEGER J,K,L
int J;
int K;
int L;
// 8762 %IF SIZE>4 %THEN SIZE=0
if (( SIZE ) <= ( 4 )) goto L_08c9;
SIZE = 0;
L_08c9:
// 8763 POP(AVL WSP(SIZE,LEVEL),J,K,L)
POP/* BAD FORM %array (11) - NOT CALLABLE!*/ // 8764 %IF K<=0 %THEN %START; ! MUST CREATE TEMPORARY
if (( K ) > ( 0 )) goto L_08ca;
// 8765 %IF SIZE>1 %THEN ODD ALIGN
if (( SIZE ) <= ( 1 )) goto L_08cb;
ODDALIGN();
L_08cb:
// 8766 K=N
K = N;
// 8767 %IF SIZE=0 %THEN N=N+268 %ELSE N=N+SIZE<<2
if (( SIZE ) != ( 0 )) goto L_08cc;
N = ((N)) + ((268));
goto L_08cd;
L_08cc:
N = ((N)) + ((((SIZE)) << ((2))));
L_08cd:
// 8768 %FINISH
L_08ca:
// 8769 PLACE=K
PLACE = K;
// 8770 PUSH(TWSPHEAD,K,SIZE,0) %UNLESS SIZE=0
if (( SIZE ) == ( 0 )) goto L_08ce;
PUSH( &TWSPHEAD, K, SIZE, 0);
L_08ce:
// 8771 %END
return;
_imp_endofblock: ;
} // End of block GETWSP at level 5
// 8772 %ROUTINE RETURN WSP(%INTEGER PLACE,SIZE)
void RETURNWSP( int PLACE, int SIZE )
{
__label__ _imp_endofblock;
// 8773 %IF SIZE>4 %THEN SIZE=0
if (( SIZE ) <= ( 4 )) goto L_08cf;
SIZE = 0;
L_08cf:
// 8774 %IF PLACE<511 %THEN PUSH(AVL WSP(SIZE,LEVEL),0,PLACE,0) %ELSE INSERT AT END(AVL WSP(SIZE,LEVEL),0,PLACE,0)
if (( PLACE ) >= ( 511 )) goto L_08d0;
PUSH/* BAD FORM %array (11) - NOT CALLABLE!*/goto L_08d1;
L_08d0:
INSERTATEND/* BAD FORM %array (11) - NOT CALLABLE!*/L_08d1:
// 8775 %END
return;
_imp_endofblock: ;
} // End of block RETURNWSP at level 5
// 8776 %ROUTINE SETLINE
void SETLINE( void )
{
__label__ _imp_endofblock;
// 8777 !***********************************************************************
// 8778 !* UPDATE THE STATEMENT NO *
// 8779 !***********************************************************************
// 8780 %INTEGER XYNB,I,LDI,STI,REG
int XYNB;
int I;
int LDI;
int STI;
int REG;
// 8781 LDI=LSS; STI=ST; REG=ACCR
LDI = 98;
STI = 72;
REG = 0;
// 8782 %IF PARMDBUG!PARMPROF=0 %AND GRUSE(ACCR)#0 %AND (GRUSE(BREG)=0 %OR GRUSE(BREG)=5) %START
if (( ((PARMDBUG)) | ((PARMPROF)) ) != ( 0 )) goto L_08d2;
if (( GRUSE[0] ) == ( 0 )) goto L_08d2;
if (( GRUSE[7] ) == ( 0 )) goto L_08be;
if (( GRUSE[7] ) != ( 5 )) goto L_08d2;
L_08be:
// 8783 LDI=LB; STI=STB; REG=BREG
LDI = 122;
STI = 90;
REG = 7;
// 8784 %FINISH
L_08d2:
// 8785 PSF1(LDI,0,LINE) %IF PARMLINE!PARMDBUG#0
if (( ((PARMLINE)) | ((PARMDBUG)) ) == ( 0 )) goto L_08d3;
PSF1(LDI, 0, LINE);
L_08d3:
// 8786 %IF PARMLINE=1 %THEN %START
if (( PARMLINE ) != ( 1 )) goto L_08d4;
// 8787 PSF1(STI, 1, DIAGINF(LEVEL))
PSF1(STI, 1, DIAGINF[LEVEL]);
// 8788 GRUSE(REG)=5; GRINF1(REG)=LINE
GRUSE[REG] = 5;
GRINF1[REG] = LINE;
// 8789 %FINISH
L_08d4:
// 8790 %IF PARMDBUG#0 %THEN PPJ(0,3)
if (( PARMDBUG ) == ( 0 )) goto L_08d5;
PPJ(0, 3);
L_08d5:
// 8791 %IF PARMPROF#0 %THEN %START
if (( PARMPROF ) == ( 0 )) goto L_08d6;
// 8792 XYNB=SET XORYNB(-1,0); ! TO PLT
XYNB = SETXORYNB((-(1)), 0);
// 8793 PSF1(LSS,0,1)
PSF1(98, 0, 1);
// 8794 I=PARMPROF+8+4*LINE
I = ((((PARMPROF)) + ((8)))) + ((((4)) * ((LINE))));
// 8795 PF1(IAD,0,XYNB,I)
PF1(224, 0, XYNB, I);
// 8796 PF1(ST,0,XYNB,I)
PF1(72, 0, XYNB, I);
// 8797 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 8798 %FINISH
L_08d6:
// 8799 %END
return;
_imp_endofblock: ;
} // End of block SETLINE at level 5
// 8800 %ROUTINE FORGET(%INTEGER REG)
void FORGET( int REG )
{
__label__ _imp_endofblock;
// 8801 %INTEGER L,U
int L;
int U;
// 8802 L=REG; U=L
L = REG;
U = L;
// 8803 %IF L<0 %THEN L=0 %AND U=7
if (( L ) >= ( 0 )) goto L_08d7;
L = 0;
U = 7;
L_08d7:
// 8804 %CYCLE REG=L,1,U
REG = ((L)) - ((1));
L_08d8:
if (( REG ) == ( U )) goto L_08d9;
REG = ((REG)) + ((1));
// 8805 %IF REGISTER(REG)>= 0 %THEN GRUSE(REG)=0 %AND GRINF1(REG)=0
if (( REGISTER[REG] ) < ( 0 )) goto L_08db;
GRUSE[REG] = 0;
GRINF1[REG] = 0;
L_08db:
// 8806 %REPEAT
goto L_08d8;
L_08d9:
// 8807 %END
return;
_imp_endofblock: ;
} // End of block FORGET at level 5
// 8808 %ROUTINE SAVE IRS
void SAVEIRS( void )
{
__label__ _imp_endofblock;
// 8809 !***********************************************************************
// 8810 !* DUMP ACC AND-OR B ONTO THE STACK. USED BEFORE CALLING FNS *
// 8811 !* IN EXPRESSIONS. *
// 8812 !***********************************************************************
// 8813 ABORT %IF REGISTER(ACCR)=1=REGISTER(BREG)
if (( REGISTER[0] ) != ( 1 )) goto L_08dc;
if (( 1 ) != ( REGISTER[7] )) goto L_08dc;
ABORT();
L_08dc:
// 8814 %IF REGISTER(ACCR)>=1 %THEN BOOT OUT(ACCR)
if (( REGISTER[0] ) < ( 1 )) goto L_08dd;
BOOTOUT(0);
L_08dd:
// 8815 %IF REGISTER(BREG)>=1 %THEN BOOT OUT(BREG)
if (( REGISTER[7] ) < ( 1 )) goto L_08de;
BOOTOUT(7);
L_08de:
// 8816 %IF REGISTER(DR)>=1 %THEN BOOT OUT(DR)
if (( REGISTER[1] ) < ( 1 )) goto L_08df;
BOOTOUT(1);
L_08df:
// 8817 %END
return;
_imp_endofblock: ;
} // End of block SAVEIRS at level 5
// 8818 %ROUTINE BOOT OUT(%INTEGER REG)
void BOOTOUT( int REG )
{
__label__ _imp_endofblock;
// 8819 !***********************************************************************
// 8820 !* REMOVE TEMPORARIES FROM REG INTO LOCAL OR ONTO STACK *
// 8821 !* IT IS VITAL THAT ACC IS STACKED FIRST BEFORE B OR DR *
// 8822 !* OTHERWISE MIXUPS OCCUR WHEN PASSING MULTI-DIMENSION ARRAY *
// 8823 !* ELEMENTS WITH FNS AS SUBSCRIPTS AS VALUE SCALARS *
// 8824 !***********************************************************************
// 8825 %CONSTBYTEINTEGERARRAY BOOTCODE(0:7)=16_48,16_58,16_5C,0(4),16_5A;
const unsigned char BOOTCODE[(7)-(0)+1] = { 72, 88, 92, 0, 0, 0, 0, 90, };
// 8826 %INTEGER CODE
int CODE;
// 8827 %RECORD(RD)%NAME R{(RD)
RD *R;
// 8828 CODE=BOOTCODE(REG)
CODE = BOOTCODE[REG];
// 8829 ABORT %UNLESS 1<=REGISTER(REG)<=3 %AND CODE#0
if (( 1 ) > ( REGISTER[REG] )) goto L_08da;
if (( REGISTER[REG] ) > ( 3 )) goto L_08da;
if (( CODE ) != ( 0 )) goto L_08e0;
L_08da:
ABORT();
L_08e0:
// 8830 R==RECORD(OLINK(REG))
R = * /*(recfm)*/ RECORD(OLINK[REG]);
// 8831 %IF REGISTER(REG)=2 %THEN %START
if (( REGISTER[REG] ) != ( 2 )) goto L_08e1;
// 8832 %IF R_D=0 %THEN GET WSP(R_D,BYTES(R_PTYPE>>4)>>2)
if (( R->D ) != ( 0 )) goto L_08e2;
GETWSP( &R->D, (int)(((unsigned int)(BYTES[(int)(((unsigned int)(R->PTYPE)) >> ((4)))])) >> ((2))));
L_08e2:
// 8833 PSF1(CODE,1,R_D)
PSF1(CODE, 1, R->D);
// 8834 %FINISH %ELSE %START
goto L_08e3;
L_08e1:
// 8835 %IF REG#ACCR %AND(REGISTER(ACCR)=1 %OR REGISTER(ACCR)=3) %THEN BOOT OUT(ACCR)
if (( REG ) == ( 0 )) goto L_08e4;
if (( REGISTER[0] ) == ( 1 )) goto L_08e5;
if (( REGISTER[0] ) != ( 3 )) goto L_08e4;
L_08e5:
BOOTOUT(0);
L_08e4:
// 8836 PF1(CODE,0,TOS,0)
PF1(CODE, 0, 6, 0);
// 8837 %FINISH
L_08e3:
// 8838 CHANGE RD(REG)
CHANGERD(REG);
// 8839 REGISTER(REG)=0
REGISTER[REG] = 0;
// 8840 %END
return;
_imp_endofblock: ;
} // End of block BOOTOUT at level 5
// 8841 %ROUTINE COPY DR
void COPYDR( void )
{
__label__ _imp_endofblock;
// 8842 !***********************************************************************
// 8843 !* COPY THE DR TO ACC SAVING ANYTHING IN ACC *
// 8844 !***********************************************************************
// 8845 %IF REGISTER (ACCR)#0 %THEN BOOT OUT(ACCR)
if (( REGISTER[0] ) == ( 0 )) goto L_08e6;
BOOTOUT(0);
L_08e6:
// 8846 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 8847 GRUSE(ACCR)=0
GRUSE[0] = 0;
// 8848 %END
return;
_imp_endofblock: ;
} // End of block COPYDR at level 5
// 8849 %ROUTINE CHANGE RD(%INTEGER REG)
void CHANGERD( int REG )
{
__label__ _imp_endofblock;
// 8850 !***********************************************************************
// 8851 !* CHANGE A RESULT DESCRIPTOR WHEN OPERAND IS STACKED *
// 8852 !***********************************************************************
// 8853 %RECORD(RD)%NAME OPND{(RD)
RD *OPND;
// 8854 ABORT %UNLESS 1<=REGISTER(REG)<=3;! I-R OR PARAM
if (( 1 ) > ( REGISTER[REG] )) goto L_08e7;
if (( REGISTER[REG] ) <= ( 3 )) goto L_08e8;
L_08e7:
ABORT();
L_08e8:
// 8855 OPND==RECORD(OLINK(REG))
OPND = * /*(recfm)*/ RECORD(OLINK[REG]);
// 8856 %IF REGISTER(REG)=1 %THEN %START; ! CHANGE RESULT DESCRIPTOR
if (( REGISTER[REG] ) != ( 1 )) goto L_08e9;
// 8857 ABORT %UNLESS OPND_FLAG=9 %AND OPND_XB>>4=REG
if (( OPND->FLAG ) != ( 9 )) goto L_08ea;
if (( (int)(((unsigned int)(OPND->XB)) >> ((4))) ) == ( REG )) goto L_08eb;
L_08ea:
ABORT();
L_08eb:
// 8858 OPND_FLAG=8; ! CHANGE TO 'STACKED'
OPND->FLAG = 8;
// 8859 OPND_XB=TOS<<4
OPND->XB = ((6)) << ((4));
// 8860 %FINISH
L_08e9:
// 8861 %IF REGISTER(REG)=2 %START
if (( REGISTER[REG] ) != ( 2 )) goto L_08ec;
// 8862 OPND_FLAG=7; OPND_XB=LNB<<4
OPND->FLAG = 7;
OPND->XB = ((2)) << ((4));
// 8863 %FINISH
L_08ec:
// 8864 %END
return;
_imp_endofblock: ;
} // End of block CHANGERD at level 5
// 8865 %ROUTINE STORE TAG(%INTEGER KK, SLINK)
void STORETAG( int KK, int SLINK )
{
__label__ _imp_endofblock;
// 8866 %INTEGER Q, QQ, QQQ, I, TCELL
int Q;
int QQ;
int QQQ;
int I;
int TCELL;
// 8867 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 8868 TCELL=TAGS(KK)
TCELL = TAGS[KK];
// 8869 Q=PTYPE<<16!LEVEL<<8!RBASE<<4!J
Q = ((((((((PTYPE)) << ((16)))) | ((((LEVEL)) << ((8)))))) | ((((RBASE)) << ((4)))))) | ((J));
// 8870 ! ABORT %UNLESS (KFORM!ACC)>>16=0
// 8871 QQQ=SLINK<<16!KFORM
QQQ = ((((SLINK)) << ((16)))) | ((KFORM));
// 8872 QQ=SNDISP<<16!ACC
QQ = ((((SNDISP)) << ((16)))) | ((ACC));
// 8873 %IF FROM1(TCELL)>>8&63=LEVEL %THEN %START
if (( (((int)(((unsigned int)(FROM1(TCELL))) >> ((8))))) & ((63)) ) != ( LEVEL )) goto L_08ed;
// 8874 FAULT(7,KK)
FAULT(7, KK);
// 8875 Q=FROM1(TCELL)&16_C000!Q;! COPY USED BITS ACCROSS
Q = ((((FROM1(TCELL))) & ((49152)))) | ((Q));
// 8876 REPLACE123(TCELL,Q,QQ,QQQ)
REPLACE123(TCELL, Q, QQ, QQQ);
// 8877 %FINISH %ELSE %START
goto L_08ee;
L_08ed:
// 8878 I=ASL; %IF I=0 %THEN I=MORE SPACE
I = ASL;
if (( I ) != ( 0 )) goto L_08ef;
I = MORESPACE();
L_08ef:
// 8879 LCELL==ASLIST(I)
LCELL = (&(ASLIST[I]));
// 8880 ASL=LCELL_LINK
ASL = LCELL->LINK;
// 8881 LCELL_LINK=TAGS(KK)!NAMES(LEVEL)<<18
LCELL->LINK = ((TAGS[KK])) | ((((NAMES[LEVEL])) << ((18))));
// 8882 LCELL_S1=Q; LCELL_S2=QQ; LCELL_S3=QQQ
LCELL->S1 = Q;
LCELL->S2 = QQ;
LCELL->S3 = QQQ;
// 8883 TAGS(KK)=I
TAGS[KK] = I;
// 8884 NAMES(LEVEL)=KK
NAMES[LEVEL] = KK;
// 8885 %FINISH
L_08ee:
// 8886 %END
return;
_imp_endofblock: ;
} // End of block STORETAG at level 5
// 8887 %ROUTINE COPY TAG(%INTEGER KK)
void COPYTAG( int KK )
{
__label__ _imp_endofblock;
// 8888 %INTEGER QQQ
int QQQ;
// 8889 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 8890 TCELL=TAGS(KK)
TCELL = TAGS[KK];
// 8891 %IF TCELL=0 %THEN %START; ! NAME NOT SET
if (( TCELL ) != ( 0 )) goto L_08f0;
// 8892 TYPE=7; PTYPE=16_57; PREC=5
TYPE = 7;
PTYPE = 87;
PREC = 5;
// 8893 ROUT=0; NAM=0; ARR=0; LITL=0; ACC=4
ROUT = 0;
NAM = 0;
ARR = 0;
LITL = 0;
ACC = 4;
// 8894 I=-1; J=-1; K=-1; OLDI=-1
I = (-(1));
J = (-(1));
K = (-(1));
OLDI = (-(1));
// 8895 %FINISH %ELSE %START
goto L_08f1;
L_08f0:
// 8896 LCELL==ASLIST(TCELL)
LCELL = (&(ASLIST[TCELL]));
// 8897 KK=LCELL_S1
KK = LCELL->S1;
// 8898 LCELL_S1=KK!16_8000
LCELL->S1 = ((KK)) | ((32768));
// 8899 MIDCELL=LCELL_S2
MIDCELL = LCELL->S2;
// 8900 QQQ=LCELL_S3
QQQ = LCELL->S3;
// 8901 PTYPE=KK>>16; USEBITS=KK>>14&3
PTYPE = (int)(((unsigned int)(KK)) >> ((16)));
USEBITS = (((int)(((unsigned int)(KK)) >> ((14))))) & ((3));
// 8902 OLDI=KK>>8&63; I=KK>>4&15; J=KK&15
OLDI = (((int)(((unsigned int)(KK)) >> ((8))))) & ((63));
I = (((int)(((unsigned int)(KK)) >> ((4))))) & ((15));
J = ((KK)) & ((15));
// 8903 SNDISP=MIDCELL&16_FFFF0000//16_10000
SNDISP = ((int)(((MIDCELL)) & ((-65536)))) / ((int)(65536));
// 8904 ACC=MIDCELL&16_FFFF
ACC = ((MIDCELL)) & ((65535));
// 8905 K=QQQ>>16
K = (int)(((unsigned int)(QQQ)) >> ((16)));
// 8906 KFORM=QQQ&16_FFFF
KFORM = ((QQQ)) & ((65535));
// 8907 LITL=PTYPE>>14
LITL = (int)(((unsigned int)(PTYPE)) >> ((14)));
// 8908 ROUT=PTYPE>>12&3
ROUT = (((int)(((unsigned int)(PTYPE)) >> ((12))))) & ((3));
// 8909 NAM=PTYPE>>10&3
NAM = (((int)(((unsigned int)(PTYPE)) >> ((10))))) & ((3));
// 8910 ARR=PTYPE>>8&3
ARR = (((int)(((unsigned int)(PTYPE)) >> ((8))))) & ((3));
// 8911 PREC=PTYPE>>4&15
PREC = (((int)(((unsigned int)(PTYPE)) >> ((4))))) & ((15));
// 8912 TYPE=PTYPE&15
TYPE = ((PTYPE)) & ((15));
// 8913 %FINISH
L_08f1:
// 8914 %END
return;
_imp_endofblock: ;
} // End of block COPYTAG at level 5
// 8915 %ROUTINE REDUCE TAG
void REDUCETAG( void )
{
__label__ _imp_endofblock;
// 8916 !***********************************************************************
// 8917 !* AS COPY TAG FOR NAME AT A(P) EXCEPT:- *
// 8918 !* 1) SPECIAL NAMES HAVE THEIR CORRECT PREC & TYPE SUBSTITUTED *
// 8919 !* 2) RECORD ELEMENTS HAVE THE SUBNAME PARTICULARS RETURNED *
// 8920 !***********************************************************************
// 8921 %INTEGER SUBS,QQ,PP
int SUBS;
int QQ;
int PP;
// 8922 COPY TAG(FROMAR2(P))
COPYTAG(FROMAR2(P));
// 8923 %IF PTYPE=SNPT %THEN %START
if (( PTYPE ) != ( 4102 )) goto L_08f2;
// 8924 PTYPE=TSNAME(K); UNPACK
PTYPE = TSNAME[K];
UNPACK();
// 8925 ROUT=1
ROUT = 1;
// 8926 %FINISH; ! TO AVOID CHECKING PARAMS
L_08f2:
// 8927 %IF TYPE=3 %THEN %START
if (( TYPE ) != ( 3 )) goto L_08f3;
// 8928 PP=P; QQ=COPY RECORD TAG(SUBS); P=PP
PP = P;
QQ = COPYRECORDTAG( &SUBS);
P = PP;
// 8929 %FINISH
L_08f3:
// 8930 %END
return;
_imp_endofblock: ;
} // End of block REDUCETAG at level 5
// 8931 %ROUTINE REPLACE TAG(%INTEGER KK)
void REPLACETAG( int KK )
{
__label__ _imp_endofblock;
// 8932 %INTEGER P, Q
int P;
int Q;
// 8933 P=TAGS(KK)
P = TAGS[KK];
// 8934 Q=PTYPE<<16!USEBITS<<14!OLDI<<8!I<<4!J
Q = ((((((((((PTYPE)) << ((16)))) | ((((USEBITS)) << ((14)))))) | ((((OLDI)) << ((8)))))) | ((((I)) << ((4)))))) | ((J));
// 8935 REPLACE 1(P, Q)
REPLACE1(P, Q);
// 8936 REPLACE3(P, K<<16!KFORM)
REPLACE3(P, ((((K)) << ((16)))) | ((KFORM)));
// 8937 %END
return;
_imp_endofblock: ;
} // End of block REPLACETAG at level 5
// 8938 ! LAYOUT OF PTYPE
// 8939 ! ****** ** *****
// 8940 ! PTYPE REQUIRES 16 BITS TO DEFINE A VARIABLE AND CAN BE REGARDED AS
// 8941 ! AS TWO BYTEINTEGERS:=
// 8942 ! UPPER ONE(UPTYPE):= LITL<<6!ROUT<<4!NAM<<2!ARR
// 8943 ! LOWER ONE(PTYPE) :=PREC<<4!TYPE
// 8944 ! OFTEN (EG IN EXPOP) ONLY THE LOWER PART IS REQUIRED AS FUNCTIONS
// 8945 ! ETC ARE PREFETCHED AND STACKED.
// 8946 ! LITL:= 1=CONST,2=EXTERNAL,3=EXTRINSIC(OR DYNAMIC), 0=NONE OF THESE
// 8947 ! ROUT:= 1 FOR ROUTINE OR FN OR MAP, =0 NONE OF THESE
// 8948 ! NAM := 2 FOR MAPS AND 'REFREFS',=1 FOR NAMES ,=0 DIRECTLY ADDRESSED
// 8949 ! ARR :=1 FOR ARRAYS =0 SCALARS
// 8950 ! PREC IS DESCRIPTOR SIZE CODE FOR EACH PRECISION:-
// 8951 ! :=0 BITS,=3 BYTES, =5 WORDS, =6 D-WRDS, =7,QUAD WRDS
// 8952 ! TYPE:= THE VARIABLE TYPE
// 8953 ! :=0 (TYPE GENERAL),=1 INTEGER, =2 REAL, =3 RECORD
// 8954 ! :=4 (RECORDFORMAT),=5 STRING, =6 LABEL/SWITCH. =7 NOT SET
// 8955 !
// 8956 %ROUTINE UNPACK
void UNPACK( void )
{
__label__ _imp_endofblock;
// 8957 LITL=PTYPE>>14
LITL = (int)(((unsigned int)(PTYPE)) >> ((14)));
// 8958 ROUT=PTYPE>>12&3
ROUT = (((int)(((unsigned int)(PTYPE)) >> ((12))))) & ((3));
// 8959 NAM=PTYPE>>10&3
NAM = (((int)(((unsigned int)(PTYPE)) >> ((10))))) & ((3));
// 8960 ARR=PTYPE>>8&3
ARR = (((int)(((unsigned int)(PTYPE)) >> ((8))))) & ((3));
// 8961 PREC=PTYPE>>4&15
PREC = (((int)(((unsigned int)(PTYPE)) >> ((4))))) & ((15));
// 8962 TYPE=PTYPE&15
TYPE = ((PTYPE)) & ((15));
// 8963 %END
return;
_imp_endofblock: ;
} // End of block UNPACK at level 5
// 8964 %ROUTINE PACK(%INTEGERNAME PTYPE)
void PACK( int *PTYPE )
{
__label__ _imp_endofblock;
// 8965 PTYPE=((((LITL<<2!ROUT)<<2!NAM)<<2!ARR)<<4!PREC)<<4!TYPE
PTYPE = ((((((((((((((((((((LITL)) << ((2)))) | ((ROUT)))) << ((2)))) | ((NAM)))) << ((2)))) | ((ARR)))) << ((4)))) | ((PREC)))) << ((4)))) | ((TYPE));
// 8966 %END
return;
_imp_endofblock: ;
} // End of block PACK at level 5
// 8967 %ROUTINE PPJ(%INTEGER MASK,N)
void PPJ( int MASK, int N )
{
__label__ _imp_endofblock;
// 8968 !***********************************************************************
// 8969 !* PLANT A 'JCC MASK,PERMENTRY(N)' *
// 8970 !* IF MASK=0 THEN PLANT A JLK *
// 8971 !* IF MASK=-1 THEN PLANT A CALL TO PERM *
// 8972 !***********************************************************************
// 8973 %INTEGER VAL, INSTRN, CODE, J
int VAL;
int INSTRN;
int CODE;
int J;
// 8974 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 8975 %IF MASK=0 %THEN CODE=JLK %ELSE CODE=CALL
if (( MASK ) != ( 0 )) goto L_08f4;
CODE = 28;
goto L_08f5;
L_08f4:
CODE = 30;
L_08f5:
// 8976 %IF MASK>0 %THEN CODE=JCC
if (( MASK ) <= ( 0 )) goto L_08f6;
CODE = 2;
L_08f6:
// 8977 %IF MASK>=16 %THEN CODE=JAT
if (( MASK ) < ( 16 )) goto L_08f7;
CODE = 4;
L_08f7:
// 8978 %IF MASK>=32 %THEN CODE=JAF
if (( MASK ) < ( 32 )) goto L_08f8;
CODE = 6;
L_08f8:
// 8979 VAL=PLABS(N)
VAL = PLABS[N];
// 8980 %IF MASK<=0 %THEN INSTRN=CODE<<24!3<<23 %ELSE INSTRN=CODE<<24!(MASK&15)<<21
if (( MASK ) > ( 0 )) goto L_08f9;
INSTRN = ((((CODE)) << ((24)))) | ((((3)) << ((23))));
goto L_08fa;
L_08f9:
INSTRN = ((((CODE)) << ((24)))) | ((((((MASK)) & ((15)))) << ((21))));
L_08fa:
// 8981 %IF VAL>0 %THEN INSTRN=INSTRN!((VAL-CA)//2)&16_3FFFF %ELSESTART
if (( VAL ) <= ( 0 )) goto L_08fb;
INSTRN = ((INSTRN)) | ((((((int)(((VAL)) - ((CA)))) / ((int)(2)))) & ((262143))));
goto L_08fc;
L_08fb:
// 8982 LCELL==ASLIST(PLINK(N))
LCELL = (&(ASLIST[PLINK[N]]));
// 8983 J=INSTRN!CA; ! ONLY 18 BITS NEEDED FOR CA
J = ((INSTRN)) | ((CA));
// 8984 %IF LCELL_S3#0 %THEN PUSH(PLINK(N),J,0,0) %ELSE %START
if (( LCELL->S3 ) == ( 0 )) goto L_08fd;
PUSH( &PLINK[N], J, 0, 0);
goto L_08fe;
L_08fd:
// 8985 %IF LCELL_S2=0 %THEN LCELL_S2=J %ELSE LCELL_S3=J
if (( LCELL->S2 ) != ( 0 )) goto L_08ff;
LCELL->S2 = J;
goto L_0900;
L_08ff:
LCELL->S3 = J;
L_0900:
// 8986 %FINISH
L_08fe:
// 8987 %FINISH
L_08fc:
// 8988 PCONST(INSTRN)
PCONST(INSTRN);
// 8989 FORGET(-1) %IF MASK<=0
if (( MASK ) > ( 0 )) goto L_0901;
FORGET((-(1)));
L_0901:
// 8990 %END
return;
_imp_endofblock: ;
} // End of block PPJ at level 5
// 8991 %INTEGERFN SET XORYNB(%INTEGER WHICH,RLEV)
int SETXORYNB( int WHICH, int RLEV )
{
__label__ _imp_endofblock;
// 8992 !***********************************************************************
// 8993 !* SET EXTRA NAME BASE TO ADDRESS ROUTINE LEVEL 'RLEV' *
// 8994 !* RLEV=0 FOR OWNS, =-1 FOR THE PLT THESE ARE THE SAME! BUT CODED*
// 8995 !* SEPARATELY SO THAT THEY CAN BE SEPARATED IF NECESSARY *
// 8996 !***********************************************************************
// 8997 %INTEGER USE,INF,OFFSET
int USE;
int INF;
int OFFSET;
// 8998 ABORT %UNLESS -1<=RLEV<=RLEVEL
if (( (-(1)) ) > ( RLEV )) goto L_0902;
if (( RLEV ) <= ( RLEVEL )) goto L_0903;
L_0902:
ABORT();
L_0903:
// 8999 %IF RLEV<=0 %THEN USE=3 %AND INF=0 %ELSE USE=4 %AND INF=RLEV
if (( RLEV ) > ( 0 )) goto L_0904;
USE = 3;
INF = 0;
goto L_0905;
L_0904:
USE = 4;
INF = RLEV;
L_0905:
// 9000 %IF WHICH<=0 %THEN WHICH=XORYNB(USE,INF)
if (( WHICH ) > ( 0 )) goto L_0906;
WHICH = XORYNB(USE, INF);
L_0906:
// 9001 %IF GRUSE(WHICH)=USE %AND GRINF1(WHICH)=INF %THEN GRAT(WHICH)=CA %AND %RESULT=WHICH
if (( GRUSE[WHICH] ) != ( USE )) goto L_0907;
if (( GRINF1[WHICH] ) != ( INF )) goto L_0907;
GRAT[WHICH] = CA;
return WHICH;
L_0907:
// 9002 OFFSET=PTR OFFSET(RLEV)
OFFSET = PTROFFSET(RLEV);
// 9003 PSF1(LDCODE(WHICH),1,OFFSET)
PSF1(LDCODE[WHICH], 1, OFFSET);
// 9004 GRUSE(WHICH)=USE; GRINF1(WHICH)=INF; GRAT(WHICH)=CA
GRUSE[WHICH] = USE;
GRINF1[WHICH] = INF;
GRAT[WHICH] = CA;
// 9005 %RESULT=WHICH
return WHICH;
// 9006 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block SETXORYNB at level 5
// 9007 %INTEGERFN XORYNB(%INTEGER USE,INF)
int XORYNB( int USE, int INF )
{
__label__ _imp_endofblock;
// 9008 !***********************************************************************
// 9009 !* CHECKS IF XNB OR YNB SET UP. IF NOT DECIDES WHICH TO OVERWRITE *
// 9010 !***********************************************************************
// 9011 %IF GRUSE(XNB)=USE %AND GRINF1(XNB)=INF %THEN GRAT(XNB)=CA %AND %RESULT=XNB
if (( GRUSE[3] ) != ( USE )) goto L_0908;
if (( GRINF1[3] ) != ( INF )) goto L_0908;
GRAT[3] = CA;
return 3;
L_0908:
// 9012 %IF GRUSE(CTB)=USE %AND GRINF1(CTB)=INF %THEN GRAT(CTB)=CA %AND %RESULT=CTB
if (( GRUSE[5] ) != ( USE )) goto L_0909;
if (( GRINF1[5] ) != ( INF )) goto L_0909;
GRAT[5] = CA;
return 5;
L_0909:
// 9013 %IF GRUSE(XNB)!GRUSE(CTB)=0 %THEN %START;! BOTH REGS ARE FREE
if (( ((GRUSE[3])) | ((GRUSE[5])) ) != ( 0 )) goto L_090a;
// 9014 %IF USE=3 %THEN %RESULT=CTB
if (( USE ) != ( 3 )) goto L_090b;
return 5;
L_090b:
// 9015 %RESULT=XNB
return 3;
// 9016 %FINISH
L_090a:
// 9017 !
// 9018 ! IF ONLY ONE FREE THEN NO PROBLEM
// 9019 %IF GRUSE(XNB)=0 %THEN %RESULT=XNB
if (( GRUSE[3] ) != ( 0 )) goto L_090c;
return 3;
L_090c:
// 9020 %IF GRUSE(CTB)=0 %THEN %RESULT=CTB
if (( GRUSE[5] ) != ( 0 )) goto L_090d;
return 5;
L_090d:
// 9021 !
// 9022 ! BOTH ARE IN USE. THIS IS WORTH CAREFUL CONSIDERATION AND EXPERIMENT
// 9023 ! A VALUE TABLE MAY BE USE AS MAY LOOK AHEAD. CURRENTLY TRY LRU
// 9024 !
// 9025 %IF GRAT(XNB)<GRAT(CTB) %THEN %RESULT=XNB
if (( GRAT[3] ) >= ( GRAT[5] )) goto L_090e;
return 3;
L_090e:
// 9026 %RESULT=CTB
return 5;
// 9027 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block XORYNB at level 5
// 9028 %ROUTINE ODDALIGN
void ODDALIGN( void )
{
__label__ _imp_endofblock;
// 9029 !***********************************************************************
// 9030 !* SETS N TO ODD WORD BOUNDARY. SINCE PRECALL ALSO SETS SF TO ODD *
// 9031 !* WORD BOUNDARY THIS MEANS 64 BIT QUANTITIES ARE 64 BIT ALIGNED *
// 9032 !* AND CAN BE REFERNCED IN A SINGL CORE CYCLE *
// 9033 !***********************************************************************
// 9034 %IF N&7=0 %THEN RETURN WSP(N,1) %AND N=N+4
if (( ((N)) & ((7)) ) != ( 0 )) goto L_090f;
RETURNWSP(N, 1);
N = ((N)) + ((4));
L_090f:
// 9035 %END
return;
_imp_endofblock: ;
} // End of block ODDALIGN at level 5
// 9036 %INTEGERFN PTROFFSET(%INTEGER RLEV)
int PTROFFSET( int RLEV )
{
__label__ _imp_endofblock;
// 9037 !***********************************************************************
// 9038 !* RETURNS OFFSET FROM LNB OF RELEVANT ITEM IN THE CURRENT DISPLAY *
// 9039 !* WHICH ENABLES TEXTTUAL LEVEL 'RLEV' TO BE ADDRESSED *
// 9040 !* A FUNCTION IS USED TO ALLOW CHANGES IN THE DISPLAY FORMAT *
// 9041 !***********************************************************************
// 9042 %IF RLEV<=0 %THEN %RESULT=16
if (( RLEV ) > ( 0 )) goto L_0910;
return 16;
L_0910:
// 9043 %RESULT=DISPLAY(RLEVEL)+(RLEV-1)<<2
return ((DISPLAY[RLEVEL])) + ((((((RLEV)) - ((1)))) << ((2))));
// 9044 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block PTROFFSET at level 5
// 9045 %INTEGERFN AREA CODE
int AREACODE( void )
{
__label__ _imp_endofblock;
// 9046 !***********************************************************************
// 9047 !* RETURNS THE AREA CODE FOR ROUTINE LEVEL 'BASE' LOADING *
// 9048 !* XNB WHERE THIS IS NEEDED *
// 9049 !***********************************************************************
// 9050 %IF AREA<0 %THEN %START
if (( AREA ) >= ( 0 )) goto L_0911;
// 9051 %IF BASE=RBASE %THEN AREA=LNB %AND %RESULT=LNB;! LOCAL LEVEL
if (( BASE ) != ( RBASE )) goto L_0912;
AREA = 2;
return 2;
L_0912:
// 9052 AREA=SET XORYNB(-1,BASE)
AREA = SETXORYNB((-(1)), BASE);
// 9053 %FINISH
L_0911:
// 9054 %RESULT=AREA
return AREA;
// 9055 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block AREACODE at level 5
// 9056 %INTEGERFN AREA CODE2(%INTEGER BS)
int AREACODE2( int BS )
{
__label__ _imp_endofblock;
// 9057 !***********************************************************************
// 9058 !* A VERSION OF AREA CODE WITHOUT SIDE EFFECTS ! *
// 9059 !***********************************************************************
// 9060 %IF BS=RBASE %THEN %RESULT=LNB
if (( BS ) != ( RBASE )) goto L_0913;
return 2;
L_0913:
// 9061 %RESULT=SET XORYNB(-1,BS)
return SETXORYNB((-(1)), BS);
// 9062 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block AREACODE2 at level 5
// 9063 %ROUTINE GET IN ACC(%INTEGER REG,SIZE,ACCESS,AREA,DISP)
void GETINACC( int REG, int SIZE, int ACCESS, int AREA, int DISP )
{
__label__ _imp_endofblock;
// 9064 !***********************************************************************
// 9065 !* LOADS THE REGISTER SPECIFIED ARRANGING FOR AUTOMATIC *
// 9066 !* STACKING WHEN THIS IS NEEDED *
// 9067 !* IT IS VITAL THAT ACC IS STACKED FIRST BEFORE B OR DR *
// 9068 !* OTHERWISE MIXUPS OCCUR WHEN PASSING MULTI-DIMENSION ARRAY *
// 9069 !* ELEMENTS WITH FNS AS SUBSCRIPTS AS VALUE SCALARS *
// 9070 !***********************************************************************
// 9071 %INTEGER OPCODE
int OPCODE;
// 9072 SIZE=1 %IF SIZE=0; ! BITS ABD BYTES!
if (( SIZE ) != ( 0 )) goto L_0914;
SIZE = 1;
L_0914:
// 9073 ! ABORT %UNLESS REG=ACCR %OR(REG=DR %AND SIZE=2) %OR (REG=BREG %AND SIZE=1)
// 9074 %IF REG=DR %THEN OPCODE=LD %ELSE %START
if (( REG ) != ( 1 )) goto L_0915;
OPCODE = 120;
goto L_0916;
L_0915:
// 9075 %IF REG=BREG %THEN OPCODE=LB %ELSE OPCODE=LSS+SIZE&6
if (( REG ) != ( 7 )) goto L_0917;
OPCODE = 122;
goto L_0918;
L_0917:
OPCODE = ((98)) + ((((SIZE)) & ((6))));
L_0918:
// 9076 %FINISH
L_0916:
// 9077 !
// 9078 %IF REGISTER(REG)>=1 %THEN %START
if (( REGISTER[REG] ) < ( 1 )) goto L_0919;
// 9079 %IF REGISTER(REG)=2 %OR(ACCESS=2 %AND AREA=0)%THEN BOOT OUT(REG) %ELSE %START; ! CANNOT SLSS ISN ON ALL MCS
if (( REGISTER[REG] ) == ( 2 )) goto L_091a;
if (( ACCESS ) != ( 2 )) goto L_091b;
if (( AREA ) != ( 0 )) goto L_091b;
L_091a:
BOOTOUT(REG);
goto L_091c;
L_091b:
// 9080 %IF REG#ACCR %AND(REGISTER(ACCR)=1 %OR REGISTER(ACCR)=3) %THEN BOOT OUT(ACCR)
if (( REG ) == ( 0 )) goto L_091d;
if (( REGISTER[0] ) == ( 1 )) goto L_08b5;
if (( REGISTER[0] ) != ( 3 )) goto L_091d;
L_08b5:
BOOTOUT(0);
L_091d:
// 9081 CHANGE RD(REG)
CHANGERD(REG);
// 9082 REGISTER(REG)=0
REGISTER[REG] = 0;
// 9083 %IF REG=ACCR %THEN OPCODE=OPCODE-32 %ELSE OPCODE=OPCODE-40
if (( REG ) != ( 0 )) goto L_091e;
OPCODE = ((OPCODE)) - ((32));
goto L_091f;
L_091e:
OPCODE = ((OPCODE)) - ((40));
L_091f:
// 9084 %FINISH
L_091c:
// 9085 %FINISH
L_0919:
// 9086 PSORLF1(OPCODE,ACCESS,AREA,DISP)
PSORLF1(OPCODE, ACCESS, AREA, DISP);
// 9087 %IF ACCESS>=2 %AND 0#AREA#7 %THEN GRUSE(DR)=0
if (( ACCESS ) < ( 2 )) goto L_0920;
if (( 0 ) == ( AREA )) goto L_0920;
if (( AREA ) == ( 7 )) goto L_0920;
GRUSE[1] = 0;
L_0920:
// 9088 GRUSE(REG)=0
GRUSE[REG] = 0;
// 9089 %END
return;
_imp_endofblock: ;
} // End of block GETINACC at level 5
// 9090 %ROUTINE NOTE ASSMENT(%INTEGER REG, ASSOP, VAR)
void NOTEASSMENT( int REG, int ASSOP, int VAR )
{
__label__ _imp_endofblock;
// 9091 !***********************************************************************
// 9092 !* NOTES THE ASSIGNMENT TO SCALAR 'VAR'. THIS INVOLVES REMOVING *
// 9093 !* OLD COPIES FROM REGISTERS TO AVOID CONFUSING OLD AND NEW VALUE*
// 9094 !* ASSOP =1 FOR'==',=2 FOR '=',=3 FOR '<-' *
// 9095 !***********************************************************************
// 9096 %CONSTINTEGER EEMASK=B'100011110000000';! MASK OF USES RELEVANT TO ==
// 9097 %CONSTINTEGER EMASK=B'100011000000000';! MASK OF USES RELEVANT TO =
// 9098 %CONSTINTEGER NREGS=5
// 9099 %CONSTINTEGER REGS=16*16*16*16*CTB+16*16*16*XNB+16*16*ACCR+16*BREG+DR
// 9100 %INTEGER I,USE1,USE2,II
int I;
int USE1;
int USE2;
int II;
// 9101 %RETURN %IF VAR<=0
if (( VAR ) > ( 0 )) goto L_0921;
return;
L_0921:
// 9102 %IF ASSOP=1 %THEN %START
if (( ASSOP ) != ( 1 )) goto L_0922;
// 9103 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0923:
if (( I ) == ( 7 )) goto L_0924;
I = ((I)) + ((1));
// 9104 USE1=GRUSE(I); USE2=USE1>>16; USE1=USE1&255
USE1 = GRUSE[I];
USE2 = (int)(((unsigned int)(USE1)) >> ((16)));
USE1 = ((USE1)) & ((255));
// 9105 %IF EEMASK&1<<USE2#0 %AND (GRINF2(I)&16_FFFF=VAR %OR GRINF2(I)>>16=VAR) %THEN GRUSE(I)=USE1 %AND USE2=0
if (( ((18304)) & ((((1)) << ((USE2)))) ) == ( 0 )) goto L_0926;
if (( ((GRINF2[I])) & ((65535)) ) == ( VAR )) goto L_0927;
if (( (int)(((unsigned int)(GRINF2[I])) >> ((16))) ) != ( VAR )) goto L_0926;
L_0927:
GRUSE[I] = USE1;
USE2 = 0;
L_0926:
// 9106 %IF EEMASK&1<<USE1#0 %AND (GRINF1(I)&16_FFFF=VAR %OR GRINF1(I)>>16=VAR) %THEN GRUSE(I)=USE2 %AND GRINF1(I)=GRINF2(I)
if (( ((18304)) & ((((1)) << ((USE1)))) ) == ( 0 )) goto L_0928;
if (( ((GRINF1[I])) & ((65535)) ) == ( VAR )) goto L_0929;
if (( (int)(((unsigned int)(GRINF1[I])) >> ((16))) ) != ( VAR )) goto L_0928;
L_0929:
GRUSE[I] = USE2;
GRINF1[I] = GRINF2[I];
L_0928:
// 9107 %REPEAT
goto L_0923;
L_0924:
// 9108 GRUSE(REG)=7
GRUSE[REG] = 7;
// 9109 GRINF1(REG)=VAR
GRINF1[REG] = VAR;
// 9110 %FINISH %ELSE %START
goto L_092a;
L_0922:
// 9111 %CYCLE II=0,4,4*(NREGS-1)
II = ((0)) - ((4));
L_092b:
if (( II ) == ( ((4)) * ((((5)) - ((1)))) )) goto L_092c;
II = ((II)) + ((4));
// 9112 I=REGS>>II&15
I = (((int)(((unsigned int)(340081)) >> ((II))))) & ((15));
// 9113 USE1=GRUSE(I); USE2=USE1>>16; USE1=USE1&255
USE1 = GRUSE[I];
USE2 = (int)(((unsigned int)(USE1)) >> ((16)));
USE1 = ((USE1)) & ((255));
// 9114 %IF EMASK&1<<USE2#0 %AND (GRINF2(I)&16_FFFF=VAR %OR GRINF2(I)>>16=VAR %OR GRINF2(I)=VAR) %THEN GRUSE(I)=USE1 %AND USE2=0
if (( ((17920)) & ((((1)) << ((USE2)))) ) == ( 0 )) goto L_092e;
if (( ((GRINF2[I])) & ((65535)) ) == ( VAR )) goto L_092f;
if (( (int)(((unsigned int)(GRINF2[I])) >> ((16))) ) == ( VAR )) goto L_092f;
if (( GRINF2[I] ) != ( VAR )) goto L_092e;
L_092f:
GRUSE[I] = USE1;
USE2 = 0;
L_092e:
// 9115 %IF EMASK&1<<USE1#0 %AND (GRINF1(I)&16_FFFF=VAR %OR GRINF1(I)>>16=VAR %OR GRINF1(I)=VAR) %THEN GRUSE(I)=USE2 %AND GRINF1(I)=GRINF2(I)
if (( ((17920)) & ((((1)) << ((USE1)))) ) == ( 0 )) goto L_0930;
if (( ((GRINF1[I])) & ((65535)) ) == ( VAR )) goto L_0931;
if (( (int)(((unsigned int)(GRINF1[I])) >> ((16))) ) == ( VAR )) goto L_0931;
if (( GRINF1[I] ) != ( VAR )) goto L_0930;
L_0931:
GRUSE[I] = USE2;
GRINF1[I] = GRINF2[I];
L_0930:
// 9116 !
// 9117 ! ALL THE FOREGOING CONDITIONS ARE NOT AS SILLY AS THEY SEEM. MUST
// 9118 ! BEAR IN MIND THAT BOTH GRINF&VAR MAY BE RECORD ELEMENTS DEFINED
// 9119 ! BY ALL 32 BITS OF INF AS WELL AS MODIFIED SCALARS WHEN THE NAME
// 9120 ! ONLY TAKES 16 BITS
// 9121 !
// 9122 %REPEAT
goto L_092b;
L_092c:
// 9123 %IF ASSOP=2 %AND VAR>0 %START
if (( ASSOP ) != ( 2 )) goto L_0932;
if (( VAR ) <= ( 0 )) goto L_0932;
// 9124 USE1=GRUSE(REG)
USE1 = GRUSE[REG];
// 9125 %IF 5<=USE1&255<=6 %START; ! ASSIGN CONST TO VAR
if (( 5 ) > ( ((USE1)) & ((255)) )) goto L_0933;
if (( ((USE1)) & ((255)) ) > ( 6 )) goto L_0933;
// 9126 GRUSE(REG)=USE1&255!(9<<16)
GRUSE[REG] = ((((USE1)) & ((255)))) | ((((9)) << ((16))));
// 9127 GRINF2(REG)=VAR
GRINF2[REG] = VAR;
// 9128 %FINISH %ELSE %START; ! ASSIGN VAR OR EXP TO VAR
goto L_0934;
L_0933:
// 9129 GRUSE(REG)=USE1<<16!9
GRUSE[REG] = ((((USE1)) << ((16)))) | ((9));
// 9130 GRINF2(REG)=GRINF1(REG); ! PREVIOUS USE BECOMES 2NDRY
GRINF2[REG] = GRINF1[REG];
// 9131 GRINF1(REG)=VAR
GRINF1[REG] = VAR;
// 9132 %FINISH
L_0934:
// 9133 %FINISH
L_0932:
// 9134 %FINISH
L_092a:
// 9135 %END
return;
_imp_endofblock: ;
} // End of block NOTEASSMENT at level 5
// 9136 %END; ! OF ROUTINE CSS
return;
_imp_endofblock: ;
} // End of block CSS at level 4
// 9137 !*DELSTART
// 9138 %ROUTINE PRINTUSE
void PRINTUSE( void )
{
__label__ _imp_endofblock;
// 9139 !***********************************************************************
// 9140 !* UP TO TWO USES ARE REMEMBERED INFO IN GRINF1 & GRINF2 *
// 9141 !* BOTTOM HALF OF GRUSE RELATES TO INF1 TOP HALF TO INF2 *
// 9142 !* THE MEANS CLEARING GRUSE TO FORGETS THE REG COMPLETELY *
// 9143 !* ARRAY REGISTER KEEPS THE CLAIM STATUS AND GRAT THE LAST USE *
// 9144 !***********************************************************************
// 9145 %CONSTSTRING(3)%ARRAY REGS(0:7)="ACC"," DR","LNB","XNB",
const _imp_string /*%string(3)*/ REGS[(7)-(0)+1] = { _imp_str_literal("ACC"), _imp_str_literal(" DR"), _imp_str_literal("LNB"), _imp_str_literal("XNB"), _imp_str_literal(" PC"), _imp_str_literal("CTB"), _imp_str_literal("TOS"), _imp_str_literal(" B"), };
// 9146 " PC","CTB","TOS"," B";
// 9147 %CONSTSTRING(15)%ARRAY USES(0:15) =" NOT KNOWN "," I-RESULT ",
const _imp_string /*%string(15)*/ USES[(15)-(0)+1] = { _imp_str_literal(" NOT KNOWN "), _imp_str_literal(" I-RESULT "), _imp_str_literal(" TEMPORARY "), _imp_str_literal(" PLTBASE "), _imp_str_literal(" NAMEBASE "), _imp_str_literal(" LIT CONST "), _imp_str_literal(" TAB CONST "), _imp_str_literal(" DESC FOR "), _imp_str_literal(" RECD BASE "), _imp_str_literal(" LOCAL VAR "), _imp_str_literal(" NAME+CNST "), _imp_str_literal(" AUXSTPTR- "), _imp_str_literal(" BYTE DES "), _imp_str_literal(" HALF DES "), _imp_str_literal(" VMY RES "), _imp_str_literal(" REC HDES "), };
// 9148 " TEMPORARY "," PLTBASE ",
// 9149 " NAMEBASE "," LIT CONST ",
// 9150 " TAB CONST "," DESC FOR ",
// 9151 " RECD BASE "," LOCAL VAR ",
// 9152 " NAME+CNST "," AUXSTPTR- ",
// 9153 " BYTE DES "," HALF DES ",
// 9154 " VMY RES "," REC HDES ";
// 9155 %CONSTSTRING(11)%ARRAY STATE(-1:3)={%C
const _imp_string /*%string(11)*/ STATE[(3)-(-1)+1] = { _imp_str_literal(" LOCKED "), _imp_str_literal(" FREE "), _imp_str_literal(" I-RESULT "), _imp_str_literal(" TEMPORARY "), _imp_str_literal(" RT-PARAM "), };
// 9156 " LOCKED "," FREE ",
// 9157 " I-RESULT "," TEMPORARY ",
// 9158 " RT-PARAM ";
// 9159 %ROUTINESPEC OUT(%INTEGER USE,INF)
auto void OUT( int USE, int INF );
// 9160 %INTEGER I,USE,INF
int I;
int USE;
int INF;
// 9161 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0935:
if (( I ) == ( 7 )) goto L_0936;
I = ((I)) + ((1));
// 9162 %IF REGISTER(I)!GRUSE(I)#0 %START
if (( ((REGISTER[I])) | ((GRUSE[I])) ) == ( 0 )) goto L_0938;
// 9163 USE=GRUSE(I)
USE = GRUSE[I];
// 9164 PRINTSTRING(REGS(I).STATE(REGISTER(I)))
PRINTSTRING(_imp_strcat((&(REGS[I])), (STATE+1)[REGISTER[I]]));
// 9165 OUT(USE&255,GRINF1(I))
OUT(((USE)) & ((255)), GRINF1[I]);
// 9166 %IF USE>>16#0 %THEN PRINTSTRING(" ALSO ") %AND OUT(USE>>16,GRINF2(I))
if (( (int)(((unsigned int)(USE)) >> ((16))) ) == ( 0 )) goto L_0939;
PRINTSTRING(_imp_str_literal(" ALSO "));
OUT((int)(((unsigned int)(USE)) >> ((16))), GRINF2[I]);
L_0939:
// 9167 NEWLINE
NEWLINE();
// 9168 %FINISH
L_0938:
// 9169 %REPEAT
goto L_0935;
L_0936:
// 9170 %RETURN
return;
// 9171 %ROUTINE OUT(%INTEGER USE,INF)
void OUT( int USE, int INF )
{
__label__ _imp_endofblock;
// 9172 %CONSTINTEGER LNMASK=B'1100011110000000'
// 9173 %CONSTINTEGER UNMASK=B'0100001110000000'
// 9174 PRINTSTRING(" USE = ".USES(USE))
PRINTSTRING(_imp_strcat((&(_imp_str_literal(" USE = "))), USES[USE]));
// 9175 %IF LNMASK&1<<USE#0 %THEN PRINTSTRING(PRINTNAME(INF&16_FFFF)) %ELSE WRITE(INF,1)
if (( ((51072)) & ((((1)) << ((USE)))) ) == ( 0 )) goto L_093a;
PRINTSTRING(PRINTNAME(((INF)) & ((65535))));
goto L_093b;
L_093a:
WRITE(INF, 1);
L_093b:
// 9176 %IF USE=10 %THEN PRINTSYMBOL('+') %AND WRITE(INF>>16,1)
if (( USE ) != ( 10 )) goto L_093c;
PRINTSYMBOL(43);
WRITE((int)(((unsigned int)(INF)) >> ((16))), 1);
L_093c:
// 9177 %IF UNMASK&1<<USE#0 %AND INF>>16#0 %THEN PRINTSTRING(" MODBY") %AND PRINTSTRING(PRINTNAME(INF>>16))
if (( ((17280)) & ((((1)) << ((USE)))) ) == ( 0 )) goto L_093d;
if (( (int)(((unsigned int)(INF)) >> ((16))) ) == ( 0 )) goto L_093d;
PRINTSTRING(_imp_str_literal(" MODBY"));
PRINTSTRING(PRINTNAME((int)(((unsigned int)(INF)) >> ((16)))));
L_093d:
// 9178 %END
return;
_imp_endofblock: ;
} // End of block OUT at level 5
// 9179 %END
return;
_imp_endofblock: ;
} // End of block PRINTUSE at level 4
// 9180 !*DELEND
// 9181 %ROUTINE ABORT
void ABORT( void )
{
__label__ _imp_endofblock;
// 9182 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\n**************** ABORT******************** ABORT *******"));
// 9183 **************** ABORT******************** ABORT *******")
// 9184 !*DELSTART
// 9185 NCODE(ADDR(CODE(0)), ADDR(CODE(PPCURR)), CABUF) %UNLESS CA=CABUF
if (( CA ) == ( CABUF )) goto L_093e;
NCODE(ADDR( &CODE[0]), ADDR( &CODE[PPCURR]), CABUF);
L_093e:
// 9186 PRINT USE
PRINTUSE();
// 9187 !*DELEND
// 9188 %MONITOR
_imp_monitor(0, _imp_current_line, _imp_current_file, __PRETTY_FUNCTION__);
// 9189 %STOP
exit(0);
// 9190 %END
return;
_imp_endofblock: ;
} // End of block ABORT at level 4
// 9191 %ROUTINE EPILOGUE
void EPILOGUE( void )
{
__label__ _imp_endofblock;
// 9192 !***********************************************************************
// 9193 !* PLANT ANY SUBROUINES THAT HAVE BEEN REQUIRED DURING *
// 9194 !* THE CODE GENERATION PHASE *
// 9195 !***********************************************************************
// 9196 %INTEGER D,J
int D;
int J;
// 9197 %ROUTINESPEC FILL(%INTEGER LAB)
auto void FILL( int LAB );
// 9198 %IF PLINK(15)=0 %THEN ->P16
if (( PLINK[15] ) != ( 0 )) goto L_093f;
goto U_015b;
L_093f:
// 9199 ABORT
ABORT();
// 9200 P16:
U_015b:
// 9201 !
// 9202 ! STRING RESOLUTION SUBROUTINE
// 9203 ! THIS IS ENTERED VIA A CALL INSTRN AND HAS 3 PARAMETERS
// 9204 ! P1(LNB+5) = RESD A CURRENT LENGTH DESCRIPTOR POINTING AT THE FIRST BYTE
// 9205 ! OF THE STRING BEING RESOLVED
// 9206 ! P2(LNB+7) = STD A MAX LENGTH DESCRIPTOR TO THE STRING IN WHICH ANY
// 9207 ! FRAGMENT IS TO BE STORED
// 9208 ! P3(LNB+9) - EXPD A CURRENT LENGTH DESCRIPTOR POINTING AT THE
// 9209 ! LENGTH BYTE OF STRING TO BE SEARCHED FOR
// 9210 !
// 9211 ! IF RESOLUTION IS SUCCESSFULL CC IS SET TO 0 AND AN UPDATED VERSION
// 9212 ! OF RESD IS RETURNED IN THE ACC IN CASE THERE ARE FURTHER RESLNS
// 9213 !
// 9214 ! CODE IS AS FOLLOWS:-
// 9215 !
// 9216 ! LXN (LNB+0) OLD LNB
// 9217 ! LD (XNB+3) PLT DESCRIPTOR
// 9218 ! LDB 0 ZERO BOUND FOR MDIAG
// 9219 ! STD (LNB+3) STANDARD PLACE
// 9220 ! ASF 4 GRAB 2 TEMPORARIES
// 9221 ! LD (LNB+5) RESULT IF NULL ROUTE TAKEN
// 9222 ! SLD (LNB+9) EXPD
// 9223 ! LB 0
// 9224 ! JAT 11,LNULL JUMP IF EXP NULL
// 9225 ! INCA 1 TO FIRST CHAR
// 9226 ! LB @DR FIRST CHAR INTO B
// 9227 ! STD (LNB+11) TEMP1
// 9228 ! LSS (LNB+5) TYPE&BND OF RESD
// 9229 ! AND XIFF
// 9230 ! JAT 4,RESFAIL RESD IS NULL &EXPD NOT NULL
// 9231 ! LD (LNB+5) RESD TO DR
// 9232 !AGN SWNE L=DR SEARCH FOR FIRST CHAR
// 9233 ! JCC 8,RESFAIL NOT FOUND
// 9234 ! STD (LNB+13) SAVE IN TEMP 2
// 9235 ! CYD 0
// 9236 ! LD (LNB+11) EXP DESCRIPTOR FOR COMPARISON
// 9237 ! CPS L=DR,FILLER=FF CHECK REST OF EXPRSN
// 9238 ! JCC 8,L2 RESLN HAS SUCCEEDED
// 9239 ! LD (LNB+13) RESUME SCANNING
// 9240 ! SWEQ L=1 ADVANCE BY 1 AVOIDING MODD
// 9241 ! J AGN
// 9242 !
// 9243 ! RESOLUTION COMPLETE. ARRANGE TO STORE FRAGMENT WITHOUT ANY FILLER CHARS
// 9244 ! SO S->S.(T).Z WORKS OK AND ALLOWING STD TO BE NULL
// 9245 !
// 9246 !L2 SLSS (LNB+5) STORE UPDATED DES & GET BND
// 9247 ! ISB (LNB+13) GIVE LENGTH OF FRAGMENT
// 9248 ! ST B
// 9249 ! LSS (LNB+7) LENGTH OF STD
// 9250 ! JAF 4,*+6 ! ZERO FOR NO 1ST PART RESLN
// 9251 ! LSS 1
// 9252 ! AND X1FF
// 9253 ! ICP B
// 9254 ! JCC 12,RESFAIL
// 9255 !LNULL LD (LNB+7) STD TO DR
// 9256 ! JAT 11,L3 STD NULL DONT SET LENGTH
// 9257 ! LSD (LNB+5) ORIGINIAL STRING
// 9258 ! MVL L=1 SET LENGTH BYTE FROM B
// 9259 ! LDB B TO STORE CHARS
// 9260 ! MV L=DR,FILLER=16_80 ASSIGN
// 9261 !L3 LD TOS RESULT AND SET CC=0
// 9262 ! CYD 0
// 9263 ! EXIT
// 9264 !RESFAIL MPSR 16_24 SET CC=1
// 9265 ! EXIT
// 9266 %IF PLINK(16)=0 %THEN ->P17
if (( PLINK[16] ) != ( 0 )) goto L_0940;
goto U_015c;
L_0940:
// 9267 FILL(16)
FILL(16);
// 9268 PSF1(LXN,1,0)
PSF1(126, 1, 0);
// 9269 PF1(LD,0,XNB,12)
PF1(120, 0, 3, 12);
// 9270 PSF1(LDB,0,0)
PSF1(118, 0, 0);
// 9271 PSF1(STD,1,12)
PSF1(88, 1, 12);
// 9272 PSF1(ASF,0,4)
PSF1(110, 0, 4);
// 9273 PSF1(LD,1,20)
PSF1(120, 1, 20);
// 9274 PSF1(SLD,1,36)
PSF1(80, 1, 36);
// 9275 PSF1(LB,0,0)
PSF1(122, 0, 0);
// 9276 PF3(JAT,11,0,16_24)
PF3(4, 11, 0, 36);
// 9277 PSF1(INCA,0,1)
PSF1(20, 0, 1);
// 9278 PF1(LB,2,7,0)
PF1(122, 2, 7, 0);
// 9279 PSF1(STD,1,44)
PSF1(88, 1, 44);
// 9280 PSF1(LSS,1,20)
PSF1(98, 1, 20);
// 9281 PF1(AND,0,0,16_1FF)
PF1(138, 0, 0, 511);
// 9282 PF3(JAT,4,0,16_27)
PF3(4, 4, 0, 39);
// 9283 PSF1(LD,1,23)
PSF1(120, 1, 23);
// 9284 PF2(SWNE,1,0,0,0,0)
PF2(162, 1, 0, 0, 0, 0);
// 9285 PF3(JCC,8,0,16_23)
PF3(2, 8, 0, 35);
// 9286 PSF1(STD,1,52)
PSF1(88, 1, 52);
// 9287 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9288 PSF1(LD,1,44)
PSF1(120, 1, 44);
// 9289 PF2(CPS,1,1,0,0,16_FF)
PF2(164, 1, 1, 0, 0, 255);
// 9290 PF3(JCC,8,0,5)
PF3(2, 8, 0, 5);
// 9291 PSF1(LD,1,52)
PSF1(120, 1, 52);
// 9292 PF2(SWEQ,0,0,0,0,0)
PF2(160, 0, 0, 0, 0, 0);
// 9293 PSF1(JUNC,0,-12)
PSF1(26, 0, (-(12)));
// 9294 PSF1(SLSS,1,20)
PSF1(66, 1, 20);
// 9295 PSF1(ISB,1,52)
PSF1(226, 1, 52);
// 9296 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 9297 PSF1(LSS,1,28)
PSF1(98, 1, 28);
// 9298 PF3(JAF,4,0,3)
PF3(6, 4, 0, 3);
// 9299 PSF1(LSS,0,1)
PSF1(98, 0, 1);
// 9300 PF1(AND,0,0,16_1FF)
PF1(138, 0, 0, 511);
// 9301 PF1(ICP,0,BREG,0)
PF1(230, 0, 7, 0);
// 9302 PF3(JCC,12,0,13)
PF3(2, 12, 0, 13);
// 9303 PSF1(LD,1,28)
PSF1(120, 1, 28);
// 9304 PF3(JAT,11,0,7)
PF3(4, 11, 0, 7);
// 9305 PSF1(LSD,1,20)
PSF1(100, 1, 20);
// 9306 PF2(MVL,0,0,0,0,0)
PF2(176, 0, 0, 0, 0, 0);
// 9307 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 9308 PF2(MV,1,1,0,0,UNASSPAT&255)
PF2(178, 1, 1, 0, 0, ((-2122219135)) & ((255)));
// 9309 PF1(LD,0,TOS,0)
PF1(120, 0, 6, 0);
// 9310 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9311 PSF1(EXIT,0,-16_40)
PSF1(56, 0, (-(64)));
// 9312 PSF1(MPSR,0,16_24)
PSF1(50, 0, 36);
// 9313 PSF1(EXIT,0,-16_40)
PSF1(56, 0, (-(64)));
// 9314 P17:
U_015c:
// 9315 !
// 9316 ! EVALUATE X**Y
// 9317 ! ******** ****
// 9318 ! Y IS IN ACC X IS STACKED BELOW THE LINK(UNAVOIDABLE)
// 9319 ! FAULT(21) IS GIVEN IF X<0 OR (X=0 AND Y<=0)
// 9320 ! REPEATED MULTIPLICATION IS USED IF Y>0 AND FRACPT(Y)=0
// 9321 ! OTHERWISE RESULT=EXP(Y*LOG(Y))
// 9322 !
// 9323 ! LB TOS SWOP RETURN ADDRESS & X
// 9324 ! LD TOS X TO DR
// 9325 ! STB TOS
// 9326 ! STD TOS
// 9327 ! SLSD TOS X TO ACC Y TO TOS
// 9328 ! JAT 2,EXPERR ERROR IF X<0
// 9329 ! JAF 0,TRYMULT JUMP X#0
// 9330 ! SLSD TOS STACK X & GET Y
// 9331 ! JAF 1.EXPERR Y<=0
// 9332 ! LSD TOS X (=0) =RESULT TO ACC
// 9333 ! J TOS RETURN
// 9334 !TRYMULT X IS IN ACC & Y STACKED
// 9335 ! SLSD TOS Y TO ACC AND X STACKED
// 9336 ! ST TOS Y STACKED
// 9337 ! JAT 2,NONINT Y IS NEGATAIVE
// 9338 ! RSC 55
// 9339 ! RSC -55
// 9340 ! FIX B FIX PINCHED FROM ICL ALGOL
// 9341 ! MYB 4
// 9342 ! CPB -64
// 9343 ! JCC 10,*+3
// 9344 ! LB -64
// 9345 ! ISH B
// 9346 ! STUH B ACC TO 1 WORD
// 9347 ! JCC 7,NONINT JUMP IF TRUNCATION
// 9348 ! ASF -2 LOSE Y OF STACK
// 9349 ! ST B INTEGER VERSION OF Y TO B
// 9350 ! LSS 1
// 9351 ! FLT 0
// 9352 ! JAF 12,MUL JUMP IF B#0
// 9353 ! ASF -2 LOSE X OFF STACK
// 9354 ! J TOS X**0 =1
// 9355 !AGN STD TOS STACK ANOTHER COPY OF X
// 9356 !MUL RMY TOS
// 9357 ! DEBJ AGN REPEATED MULTIPLICATION
// 9358 ! J TOS
// 9359 !NONINT Y IS STACKED OVER X
// 9360 ! LSD TOS
// 9361 ! SLSD TOS
// 9362 ! PRCL 4
// 9363 ! ST TOS
// 9364 ! LXN (LNB+4)
// 9365 ! RALN 7
// 9366 ! CALL ((XNB+LOGEPDISP)
// 9367 ! RMY TOS
// 9368 ! PRCL 4
// 9369 ! ST TOS
// 9370 ! LXN (LNB+4) TO PLT
// 9371 ! RALN 7
// 9372 ! CALL ((XNB+EXPEPDISP)) CALL EXP
// 9373 ! J TOS
// 9374 !EXPERR J ERROR RT NO 7
// 9375 !
// 9376 %IF PLINK(17)=0 %THEN ->P18
if (( PLINK[17] ) != ( 0 )) goto L_0941;
goto U_015d;
L_0941:
// 9377 FILL(17)
FILL(17);
// 9378 %IF LOGEPDISP=0 %THEN CXREF("S#ILOG",PARMDYNAMIC,2,LOGEPDISP)
if (( LOGEPDISP ) != ( 0 )) goto L_0942;
CXREF(_imp_str_literal("S#ILOG"), PARMDYNAMIC, 2, &LOGEPDISP);
L_0942:
// 9379 %IF EXPEPDISP=0 %THEN CXREF("S#IEXP",PARMDYNAMIC,2,EXPEPDISP)
if (( EXPEPDISP ) != ( 0 )) goto L_0943;
CXREF(_imp_str_literal("S#IEXP"), PARMDYNAMIC, 2, &EXPEPDISP);
L_0943:
// 9380 PF1(LB,0,TOS,0)
PF1(122, 0, 6, 0);
// 9381 PF1(LD,0,TOS,0)
PF1(120, 0, 6, 0);
// 9382 PF1(STB,0,TOS,0)
PF1(90, 0, 6, 0);
// 9383 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 9384 PF1(SLSD,0,TOS,0)
PF1(68, 0, 6, 0);
// 9385 PF3(JAT,2,0,16_35)
PF3(4, 2, 0, 53);
// 9386 PF3(JAF,0,0,7)
PF3(6, 0, 0, 7);
// 9387 PF1(SLSD,0,TOS,0)
PF1(68, 0, 6, 0);
// 9388 PF3(JAF,1,0,16_30)
PF3(6, 1, 0, 48);
// 9389 PF1(LSD,0,TOS,0)
PF1(100, 0, 6, 0);
// 9390 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9391 PF1(SLSD,0,TOS,0)
PF1(68, 0, 6, 0);
// 9392 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 9393 PF3(JAT,2,0,26)
PF3(4, 2, 0, 26);
// 9394 PSF1(RSC,0,55)
PSF1(248, 0, 55);
// 9395 PSF1(RSC,0,-55)
PSF1(248, 0, (-(55)));
// 9396 PF1(FIX,0,BREG,0)
PF1(184, 0, 7, 0);
// 9397 PSF1(MYB,0,4)
PSF1(42, 0, 4);
// 9398 PSF1(CPB,0,-64)
PSF1(38, 0, (-(64)));
// 9399 PF3(JCC,10,0,3)
PF3(2, 10, 0, 3);
// 9400 PSF1(LB,0,-64)
PSF1(122, 0, (-(64)));
// 9401 PF1(ISH,0,BREG,0)
PF1(232, 0, 7, 0);
// 9402 PF1(STUH,0,BREG,0)
PF1(74, 0, 7, 0);
// 9403 PF3(JCC,7,0,14)
PF3(2, 7, 0, 14);
// 9404 PSF1(ASF,0,-2)
PSF1(110, 0, (-(2)));
// 9405 PF1(ST,0,BREG,0)
PF1(72, 0, 7, 0);
// 9406 PSF1(LSS,0,1)
PSF1(98, 0, 1);
// 9407 PSF1(FLT,0,0)
PSF1(168, 0, 0);
// 9408 PF3(JAF,12,0,5)
PF3(6, 12, 0, 5);
// 9409 PSF1(ASF,0,-2)
PSF1(110, 0, (-(2)));
// 9410 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9411 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 9412 PF1(RMY,0,TOS,0)
PF1(250, 0, 6, 0);
// 9413 PSF1(DEBJ,0,-2)
PSF1(36, 0, (-(2)));
// 9414 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9415 PF1(LSD,0,TOS,0)
PF1(100, 0, 6, 0);
// 9416 PF1(SLSD,0,TOS,0)
PF1(68, 0, 6, 0);
// 9417 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 9418 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 9419 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 9420 PSF1(RALN,0,7)
PSF1(108, 0, 7);
// 9421 PF1(CALL,2,XNB,LOGEPDISP)
PF1(30, 2, 3, LOGEPDISP);
// 9422 PF1(RMY,0,TOS,0)
PF1(250, 0, 6, 0);
// 9423 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 9424 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 9425 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 9426 PSF1(RALN,0,7)
PSF1(108, 0, 7);
// 9427 PF1(CALL,2,XNB,EXPEPDISP)
PF1(30, 2, 3, EXPEPDISP);
// 9428 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9429 PF1(JUNC,0,0,(PLABS(7)-CA)//2)
PF1(26, 0, 0, ((int)(((PLABS[7])) - ((CA)))) / ((int)(2)));
// 9430 P18:
U_015d:
// 9431 !
// 9432 ! MAPPED STRING ASSIGNMENT CHECK. CHECKING MODE ONLY. MUST MOVE ONLY
// 9433 ! CURRENT LENGTH INTO MAPPED STRINGS BUT MUST NOT OMIT THE CAPACITY
// 9434 ! CHECK. ACC & DR SET FOR MV
// 9435 !
// 9436 ! ST TOS SAVE ACC DESRPTR
// 9437 ! AND 16_1FF00000000 GET CURRENT LENGTH
// 9438 ! STUH B INTO BREG
// 9439 ! LSD TOS RESTORE ACC
// 9440 ! STD TOS SAVE DR DESCRPTR
// 9441 ! SBB 1
// 9442 ! JAF 13,*+3
// 9443 ! MODD B PROVOKE FAILURE IF RELEVANT
// 9444 ! ADB 1
// 9445 ! LD TOS
// 9446 ! LDB B BOUND=CURRENT L +1(FOR LBYTE)
// 9447 ! J TOS
// 9448 !
// 9449 %IF PLINK(18)=0 %THEN ->P19
if (( PLINK[18] ) != ( 0 )) goto L_0944;
goto U_015e;
L_0944:
// 9450 CNOP(0,8)
CNOP(0, 8);
// 9451 D=CA
D = CA;
// 9452 PCONST(511)
PCONST(511);
// 9453 PCONST(0); ! XFF00000000
PCONST(0);
// 9454 FILL(18)
FILL(18);
// 9455 PF1(ST,0,TOS,0)
PF1(72, 0, 6, 0);
// 9456 PF1(AND,0,PC,D)
PF1(138, 0, 4, D);
// 9457 PF1(STUH,0,BREG,0)
PF1(74, 0, 7, 0);
// 9458 PF1(LSD,0,TOS,0)
PF1(100, 0, 6, 0);
// 9459 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 9460 PSF1(SBB,0,1)
PSF1(34, 0, 1);
// 9461 PF3(JAF,13,0,3)
PF3(6, 13, 0, 3);
// 9462 PF1(MODD,0,BREG,0)
PF1(22, 0, 7, 0);
// 9463 PSF1(ADB,0,1)
PSF1(32, 0, 1);
// 9464 PF1(LD,0,TOS,0)
PF1(120, 0, 6, 0);
// 9465 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 9466 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9467 P19:
U_015e:
// 9468 ! CONCATENATION ONE
// 9469 ! COPY THE FIRST STRING INTO THE WORK AREA
// 9470 ! B HAS REL DISP OF THE WORK AREA FROM LNB
// 9471 ! DR HAS CURRENT LENGTH DESCRIPTOR OF FIRST STRING
// 9472 ! RESULT IS A CURRENT LENGTH DESCRIPTOR TO WORK AREA IN DR AND ACC
// 9473 !
// 9474 ! STLN TOS
// 9475 ! ADB TOS
// 9476 ! LXN B XNB TO WORK AREA
// 9477 ! SLB @DR CURRENT LENGTH TO B
// 9478 ! STB (%XNB+2) INTO LENGTH BYTE OF WK AREA
// 9479 ! INCA 1 DR PAST LENGTH BYTE
// 9480 ! CYD 0 BECOMES SOURCE STRING
// 9481 ! LD =16_180000FF0000000C
// 9482 ! INCA TOS DESCRIPTOR TO WK STRING
// 9483 ! STD (%XNB+0) STORED FOR LATER
// 9484 ! LDB B ADJUSTED SO NO FILLING
// 9485 ! MV L=DR THE MOVE
// 9486 ! LD (%XNB+0) SET UP DR WITH RESULT
// 9487 ! LDB B CURRENT LENGTH AS BOUND
// 9488 ! INCA -1 TO POINT AT LENGTH BYTE
// 9489 ! CYD 0 TO ACC AS WELL
// 9490 ! J TOS RETURN
// 9491 %IF PLINK(19)!PLINK(20)=0 %THEN ->P21
if (( ((PLINK[19])) | ((PLINK[20])) ) != ( 0 )) goto L_0945;
goto U_015f;
L_0945:
// 9492 CNOP(0,8); ! DOUBLE WORD ALLIGN
CNOP(0, 8);
// 9493 D=CA
D = CA;
// 9494 PCONST(16_180000FF); PCONST(12)
PCONST(402653439);
PCONST(12);
// 9495 FILL(19)
FILL(19);
// 9496 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 9497 PF1(ADB,0,TOS,0)
PF1(32, 0, 6, 0);
// 9498 PF1(LXN,0,BREG,0)
PF1(126, 0, 7, 0);
// 9499 PF1(SLB,2,7,0)
PF1(82, 2, 7, 0);
// 9500 PF1(STB,0,XNB,8)
PF1(90, 0, 3, 8);
// 9501 PSF1(INCA,0,1)
PSF1(20, 0, 1);
// 9502 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9503 PF1(LD,0,PC,D)
PF1(120, 0, 4, D);
// 9504 PF1(INCA,0,TOS,0)
PF1(20, 0, 6, 0);
// 9505 PF1(STD,0,XNB,0)
PF1(88, 0, 3, 0);
// 9506 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 9507 PF2(MV,1,0,0,0,0)
PF2(178, 1, 0, 0, 0, 0);
// 9508 PF1(LD,0,XNB,0)
PF1(120, 0, 3, 0);
// 9509 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 9510 PSF1(INCA,0,-1)
PSF1(20, 0, (-(1)));
// 9511 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9512 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9513 !
// 9514 ! CONCATENATION TWO
// 9515 ! ADD THE SECOND AND SUBSEQUENT STRINGS TO THE FIRST
// 9516 ! PARAMETERS AND RESULTS AS CONCATENATION ONE
// 9517 !
// 9518 ! STLN TOS
// 9519 ! ADB TOS
// 9520 ! LXN B XNB TO WORK AREA
// 9521 ! LB @DR CURRENT LENGTH TO B
// 9522 ! STB TOS KEEP FOR THE MOVE
// 9523 ! ADB (%XNB+2) ADD OLD LENGTH
// 9524 ! INCA 1 PAST LENGTH BYTE
// 9525 ! CYD 0 BECOMES SOURCE STRING
// 9526 ! LD (%XNB+0) GET DESCRIPTOR TO WK STRING
// 9527 ! MODD (%XNB+2) MOVE ON PAST FIRST STRING
// 9528 ! LDB TOS TO MOVE RIGHT AMOUNT
// 9529 ! MV L=DR
// 9530 ! STB (%XNB+2) UP DATE WK STRING LENGTH
// 9531 ! CPB 255
// 9532 ! JCC 2,CAPACITY EXCEEDED
// 9533 ! LD (%XNB+0) SET UP DR WITH RESULT
// 9534 ! LDB B CURRENT LENGTH AS BOUND
// 9535 ! INCA -1 TO POINT AT LENGTH BYTE
// 9536 ! CYD 0 TO ACC AS WELL
// 9537 ! J TOS RETURN
// 9538 %IF PLINK(20)=0 %THEN ->P21
if (( PLINK[20] ) != ( 0 )) goto L_0946;
goto U_015f;
L_0946:
// 9539 FILL(20)
FILL(20);
// 9540 PF1(STLN,0,TOS,0)
PF1(92, 0, 6, 0);
// 9541 PF1(ADB,0,TOS,0)
PF1(32, 0, 6, 0);
// 9542 PF1(LXN,0,BREG,0)
PF1(126, 0, 7, 0);
// 9543 PF1(LB,2,7,0)
PF1(122, 2, 7, 0);
// 9544 PF1(STB,0,TOS,0)
PF1(90, 0, 6, 0);
// 9545 PF1(ADB,0,XNB,8)
PF1(32, 0, 3, 8);
// 9546 PSF1(INCA,0,1)
PSF1(20, 0, 1);
// 9547 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9548 PF1(LD,0,XNB,0)
PF1(120, 0, 3, 0);
// 9549 PF1(MODD,0,XNB,8)
PF1(22, 0, 3, 8);
// 9550 PF1(LDB,0,TOS,0)
PF1(118, 0, 6, 0);
// 9551 PF2(MV,1,0,0,0,0)
PF2(178, 1, 0, 0, 0, 0);
// 9552 PF1(STB,0,XNB,8)
PF1(90, 0, 3, 8);
// 9553 PF1(CPB,0,0,255)
PF1(38, 0, 0, 255);
// 9554 PF3(JCC,2,0,(PLABS(9)-CA)//2)
PF3(2, 2, 0, ((int)(((PLABS[9])) - ((CA)))) / ((int)(2)));
// 9555 PF1(LD,0,XNB,0)
PF1(120, 0, 3, 0);
// 9556 PF1(LDB,0,BREG,0)
PF1(118, 0, 7, 0);
// 9557 PSF1(INCA,0,-1)
PSF1(20, 0, (-(1)));
// 9558 PSF1(CYD,0,0)
PSF1(18, 0, 0);
// 9559 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9560 P21:
U_015f:
// 9561 !
// 9562 ! THE STOP SEQUENCE
// 9563 ! CALL %SYSTEMROUTINE STOP(NO PARAMETERS)
// 9564 !
// 9565 !STOP1 PRCL 4
// 9566 ! LXN (LNB+4)
// 9567 ! RALN 5
// 9568 ! CALL ((XNB+STOPEPDISP)) ! **PLEASE DONT COME BACK**
// 9569 !
// 9570 %IF PLINK(21)=0 %THEN ->P22
if (( PLINK[21] ) != ( 0 )) goto L_0947;
goto U_0160;
L_0947:
// 9571 FILL(21)
FILL(21);
// 9572 CXREF("S#STOP",PARMDYNAMIC,2,J)
CXREF(_imp_str_literal("S#STOP"), PARMDYNAMIC, 2, &J);
// 9573 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 9574 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 9575 PSF1(RALN,0,5)
PSF1(108, 0, 5);
// 9576 PF1(CALL,2,XNB,J)
PF1(30, 2, 3, J);
// 9577 PF1(16_4E,0,0,16_B00B); ! IDLE B00B
PF1(78, 0, 0, 45067);
// 9578 P22:
U_0160:
// 9579 !
// 9580 ! PRINTPROFILE
// 9581 !
// 9582 %IF PLINK(22)=0 %THEN ->P23
if (( PLINK[22] ) != ( 0 )) goto L_0948;
goto U_0161;
L_0948:
// 9583 FILL(22)
FILL(22);
// 9584 CXREF("S#PPROFILE",PARMDYNAMIC,2,J)
CXREF(_imp_str_literal("S#PPROFILE"), PARMDYNAMIC, 2, &J);
// 9585 PSF1(PRCL,0,4)
PSF1(24, 0, 4);
// 9586 PSF1(LXN,1,16)
PSF1(126, 1, 16);
// 9587 PF1(LDRL,0,XNB,PARMPROF)
PF1(112, 0, 3, PARMPROF);
// 9588 PF1(STD,0,TOS,0)
PF1(88, 0, 6, 0);
// 9589 PSF1(RALN,0,7)
PSF1(108, 0, 7);
// 9590 PF1(CALL,2,XNB,J)
PF1(30, 2, 3, J);
// 9591 PF1(JUNC,0,TOS,0)
PF1(26, 0, 6, 0);
// 9592 P23:
U_0161:
// 9593 %RETURN
return;
// 9594 %ROUTINE FILL(%INTEGER LAB)
void FILL( int LAB )
{
__label__ _imp_endofblock;
// 9595 !***********************************************************************
// 9596 !* FILL JUMPS TO THIS LAB WITH JUMP TO CURRENT ADDRESS *
// 9597 !***********************************************************************
// 9598 %INTEGER AT,INSTRN,I,J
int AT;
int INSTRN;
int I;
int J;
// 9599 %INTEGERARRAY A(0:2)
int A[(2)-(0)+1];
// 9600 %WHILE PLINK(LAB)#0 %CYCLE
L_0949:
if (( PLINK[LAB] ) == ( 0 )) goto L_094a;
// 9601 POP(PLINK(LAB),A(0),A(1),A(2))
POP( &PLINK[LAB], &A[0], &A[1], &A[2]);
// 9602 %CYCLE I=0,1,2
I = ((0)) - ((1));
L_094c:
if (( I ) == ( 2 )) goto L_094d;
I = ((I)) + ((1));
// 9603 INSTRN=A(I)
INSTRN = A[I];
// 9604 %IF INSTRN#0 %THEN %START
if (( INSTRN ) == ( 0 )) goto L_094f;
// 9605 AT=INSTRN&16_3FFFF
AT = ((INSTRN)) & ((262143));
// 9606 INSTRN=INSTRN&16_FFC00000
INSTRN = ((INSTRN)) & ((-4194304));
// 9607 INSTRN=INSTRN!(CA-AT)>>1
INSTRN = ((INSTRN)) | (((int)(((unsigned int)(((CA)) - ((AT)))) >> ((1)))));
// 9608 PLUG(1,AT,INSTRN,4)
PLUG(1, AT, INSTRN, 4);
// 9609 %FINISH
L_094f:
// 9610 %REPEAT
goto L_094c;
L_094d:
// 9611 %REPEAT
goto L_0949;
L_094a:
// 9612 PLABS(LAB)=CA
PLABS[LAB] = CA;
// 9613 %END
return;
_imp_endofblock: ;
} // End of block FILL at level 5
// 9614 %END
return;
_imp_endofblock: ;
} // End of block EPILOGUE at level 4
// 9615 %ROUTINE DUMP CONSTS
void DUMPCONSTS( void )
{
__label__ _imp_endofblock;
// 9616 !***********************************************************************
// 9617 !* OUTPUT THE CONSTANT TABLE AND MAKE ANY RELEVANT RELOCATIONS *
// 9618 !***********************************************************************
// 9619 %ROUTINESPEC DOIT(%INTEGER VAL)
auto void DOIT( int VAL );
// 9620 %ROUTINESPEC FILL(%INTEGER CREFHEAD)
auto void FILL( int CREFHEAD );
// 9621 %INTEGER I,J,K,DISP,SIZE,BASE
int I;
int J;
int K;
int DISP;
int SIZE;
int BASE;
// 9622 BASE=0
BASE = 0;
// 9623 SIZE=CONSTPTR-BASE
SIZE = ((CONSTPTR)) - ((BASE));
// 9624 %IF SIZE<=0 %THEN %RETURN
if (( SIZE ) > ( 0 )) goto L_0950;
return;
L_0950:
// 9625 CNOP(0,8) %UNLESS CA&7=0
if (( ((CA)) & ((7)) ) == ( 0 )) goto L_0951;
CNOP(0, 8);
L_0951:
// 9626 CODE OUT
CODEOUT();
// 9627 LPUT(1,SIZE*4,CA,ADDR(CTABLE_val(BASE)))
LPUT(1, ((SIZE)) * ((4)), CA, ADDR( &/* No array bound info found for: */CTABLE->VAL[BASE]));
// 9628 !*DELSTART
// 9629 %IF DCOMP#0 %START
if (( DCOMP ) == ( 0 )) goto L_0952;
// 9630 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\nCONSTANT TABLE"));
// 9631 CONSTANT TABLE")
// 9632 I=BASE
I = BASE;
// 9633 %CYCLE
L_0953:
// 9634 NEWLINE
NEWLINE();
// 9635 PRHEX(CA+4*(I-BASE),5)
PRHEX(((CA)) + ((((4)) * ((((I)) - ((BASE)))))), 5);
// 9636 %CYCLE J=0,1,7
J = ((0)) - ((1));
L_0956:
if (( J ) == ( 7 )) goto L_0957;
J = ((J)) + ((1));
// 9637 SPACES(2)
SPACES(2);
// 9638 PRHEX(CTABLE_val(I+J),8)
PRHEX(/* No array bound info found for: */CTABLE->VAL[((I)) + ((J))], 8);
// 9639 %REPEAT
goto L_0956;
L_0957:
// 9640 SPACE
SPACE();
// 9641 %CYCLE J=0,1,31
J = ((0)) - ((1));
L_0959:
if (( J ) == ( 31 )) goto L_095a;
J = ((J)) + ((1));
// 9642 K=BYTEINTEGER(ADDR(CTABLE_val(I))+J)
K = *BYTEINTEGER(((ADDR( &/* No array bound info found for: */CTABLE->VAL[I]))) + ((J)));
// 9643 %IF K<31 %OR K>95 %THEN K=32
if (( K ) < ( 31 )) goto L_0491;
if (( K ) <= ( 95 )) goto L_095c;
L_0491:
K = 32;
L_095c:
// 9644 PRINT SYMBOL(K)
PRINTSYMBOL(K);
// 9645 %REPEAT
goto L_0959;
L_095a:
// 9646 I=I+8
I = ((I)) + ((8));
// 9647 %EXIT %IF I>=CONSTPTR
if (( I ) < ( CONSTPTR )) goto L_095d;
goto L_0954;
L_095d:
// 9648 %REPEAT
goto L_0953;
L_0954:
// 9649 %FINISH
L_0952:
// 9650 !*DELEND
// 9651 !
// 9652 FILL(CREFHEAD)
FILL(CREFHEAD);
// 9653 SIZE=(SIZE+1)&(-2)
SIZE = ((((SIZE)) + ((1)))) & (((-(2))));
// 9654 CA=CA+4*SIZE
CA = ((CA)) + ((((4)) * ((SIZE))));
// 9655 CABUF=CA
CABUF = CA;
// 9656 %RETURN
return;
// 9657 %ROUTINE FILL(%INTEGER CREFHEAD)
void FILL( int CREFHEAD )
{
__label__ _imp_endofblock;
// 9658 DISP=(CA-4*BASE)//2; ! RELOCATION FACTOR
DISP = ((int)(((CA)) - ((((4)) * ((BASE)))))) / ((int)(2));
// 9659 %WHILE CREFHEAD#0 %CYCLE
L_095e:
if (( CREFHEAD ) == ( 0 )) goto L_095f;
// 9660 POP(CREFHEAD,I,J,K)
POP( &CREFHEAD, &I, &J, &K);
// 9661 DOIT(I)
DOIT(I);
// 9662 %IF J#0 %THEN DOIT(J)
if (( J ) == ( 0 )) goto L_0961;
DOIT(J);
L_0961:
// 9663 %IF K#0 %THEN DOIT(K)
if (( K ) == ( 0 )) goto L_0962;
DOIT(K);
L_0962:
// 9664 %REPEAT
goto L_095e;
L_095f:
// 9665 %END
return;
_imp_endofblock: ;
} // End of block FILL at level 5
// 9666 %ROUTINE DOIT(%INTEGER VAL)
void DOIT( int VAL )
{
__label__ _imp_endofblock;
// 9667 !***********************************************************************
// 9668 !* IF VAL +VE THEN VAL IS CODE ADDRESS FOR LPUT(18) UPDATE *
// 9669 !* IF VAL -VE IT IS GLAWRDADDRR<<16!CTABLE WRD ADDR *
// 9670 !* THE GLA WORD IS TO RELOCATED BY HEAD OF CODE(ALREADY DONE) *
// 9671 !* HOWEVER THE GLAWORD NEEDS UPDATING FROM REL CTABLE TO REL CODE *
// 9672 !***********************************************************************
// 9673 %INTEGER I,J
int I;
int J;
// 9674 %IF VAL>0 %THEN LPUT(18,0,VAL,DISP) %ELSE %START
if (( VAL ) <= ( 0 )) goto L_0963;
LPUT(18, 0, VAL, DISP);
goto L_0964;
L_0963:
// 9675 I=(VAL>>16&16_7FFF)<<2; ! GLA BYTE ADDRESS
I = (((((int)(((unsigned int)(VAL)) >> ((16))))) & ((32767)))) << ((2));
// 9676 J=4*(VAL&16_FFFF)+CA; ! CTABLE ENTRY REL HD OF CODE
J = ((((4)) * ((((VAL)) & ((65535)))))) + ((CA));
// 9677 PLUG(2,I,J,4); ! UPDATE THE GLA WORD
PLUG(2, I, J, 4);
// 9678 %FINISH
L_0964:
// 9679 %END
return;
_imp_endofblock: ;
} // End of block DOIT at level 5
// 9680 %END
return;
_imp_endofblock: ;
} // End of block DUMPCONSTS at level 4
// 9681 %END; ! OF SUBBLOCK CONTAINING PASS2
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_3_LEVEL_2_ at level 3
// 9682
// 9683 %STRING(255)%FN MESSAGE(%INTEGER N)
_imp_string /*%string(255)*/ MESSAGE( int N )
{
__label__ _imp_endofblock;
// 9684 !***********************************************************************
// 9685 !* OUTPUTS AN ERROR MESSAGE STORED IN A COMPRESSED FORMAT *
// 9686 !* 1 %REPEAT is not required *
// 9687 !* 2 Label & has already been set in this block *
// 9688 !* 4 Switch & has not been declared *
// 9689 !* 5 Switch name & in expression or assignment *
// 9690 !* 6 Switch label &(#) set a second time *
// 9691 !* 7 Name & has already been declared *
// 9692 !* 8 Routine or fn & has more parameters than specified *
// 9693 !* 9 Parameter # of & differs in type from specification *
// 9694 !* 10 Routine or fn & has fewer parameters than specified *
// 9695 !* 11 Label & referenced at line # has not been set *
// 9696 !* 12 %CYCLE at line # has two control clauses *
// 9697 !* 13 %REPEAT for %CYCLE at line # is missing *
// 9698 !* 14 TOO MANY ENDS *
// 9699 !* 15 MISSING ENDS *
// 9700 !* 16 Name & has not been declared *
// 9701 !* 17 Name & does not require parameters or subscripts *
// 9702 !* 19 WRONG NO OF PARAMETERS *
// 9703 !* 20 # too few subscripts provided for array & *
// 9704 !* 21 # too many subscripts provided for array & *
// 9705 !* 22 ACTUAL PARAMETERS NOT AS SPEC *
// 9706 !* 23 ROUTINE NAME IN EXPRSSN *
// 9707 !* 24 REAL IN INTEGER EXPRSSN *
// 9708 !* 26 # is not a valid %EVENT number *
// 9709 !* 27 & is not a routine name *
// 9710 !* 28 Routine or fn & has specification but no body *
// 9711 !* 29 LHS NOT DESTNTN *
// 9712 !* 30 %RETURN outwith routine body *
// 9713 !* 31 %RESULT outwith fn or map body *
// 9714 !* 32 INVALID ASSEMBLER *
// 9715 !* 33 INVALID NAME IN ASSEMBLER *
// 9716 !* 34 TOO MANY LEVELS *
// 9717 !* 37 TOO MANY DIMENSIONS *
// 9718 !* 38 Array & has upper bound # less than lower bound *
// 9719 !* 40 DECLN MISPLACED *
// 9720 !* 41 Constant cannot be evaluated at compile time *
// 9721 !* 44 ILLEGAL CONST *
// 9722 !* 45 WRONG NO OF CONST *
// 9723 !* 46 & is declared as invalid type %EXTRINSIC %NAME *
// 9724 !* 47 %ELSE already given at line # *
// 9725 !* 48 %ELSE invalid after %ON %EVENT *
// 9726 !* 49 Attempt to initialise %EXTRINSIC or %FORMAT & *
// 9727 !* 50 Subscript of # is outwith the bounds of & *
// 9728 !* 51 %FINISH is not required *
// 9729 !* 52 %REPEAT instead of %FINISH for %START at line # *
// 9730 !* 53 %FINISH for %START at line # is missing *
// 9731 !* 54 %EXIT outwith %CYCLE %REPEAT body *
// 9732 !* 55 %CONTINUE outwith %CYCLE %REPEAT body *
// 9733 !* 56 ENDOFFILE OUT OF CONTEXT *
// 9734 !* 57 BEGIN MISSING *
// 9735 !* 58 CONTROL STMNT MISPLACED *
// 9736 !* 59 %FINISH instead of %REPEAT for %CYCLE at line # *
// 9737 !* 61 Name & has already been used in this %FORMAT *
// 9738 !* 62 NOT FORMAT NAME *
// 9739 !* 63 RECORD SPEC ERROR *
// 9740 !* 64 SUBNAME MISSING *
// 9741 !* 65 SUBNAME NOT IN FORMAT *
// 9742 !* 66 Expression assigned to record & *
// 9743 !* 67 Records && and & have different formats *
// 9744 !* 69 SUBNAME OUT OF CONTEXT *
// 9745 !* 70 ILLEGAL STRING DECLN *
// 9746 !* 71 & is not a String varaible *
// 9747 !* 72 Arithmetic operator in a String expression *
// 9748 !* 73 Arithmetic constant in a String expression *
// 9749 !* 74 Resolution is not the correct format *
// 9750 !* 75 String expression contains a sub expression *
// 9751 !* 76 String variable & in arithmetic expression *
// 9752 !* 77 String constant in arithmetic expression *
// 9753 !* 78 String operator '.' in arithmetic expression *
// 9754 !* 80 Pointer variable & compared with expression *
// 9755 !* 81 Pointer variable & equivalenced to expression *
// 9756 !* 82 & is not a pointer name *
// 9757 !* 83 && and & are not equivalent in type *
// 9758 !* 84 RECORD OUT OF CONTEXT *
// 9759 !* 86 Global pointer && equivalenced to local & *
// 9760 !* 90 Untyped name & used as variable *
// 9761 !* 91 %FOR control variable & not integer *
// 9762 !* 92 %FOR clause has zero step *
// 9763 !* 93 %FOR clause has noninteger number of traverses *
// 9764 !* 101 SOURCE LINE TOO LONG *
// 9765 !* 102 WORKFILE TOO SMALL *
// 9766 !* 103 NAMES TOO LONG *
// 9767 !* 104 TOO MANY NAMES *
// 9768 !* 105 TOO MANY LEVELS *
// 9769 !* 106 STRING CONST TOO LONG *
// 9770 !* 107 COMPILER TABLES FULL *
// 9771 !* 202 Name & not used *
// 9772 !* 203 Label & not used *
// 9773 !* 204 Global %FOR control variable & *
// 9774 !* 205 Name & not addressable *
// 9775 !* 255 SEE IMP MANUAL *
// 9776 !***********************************************************************
// 9777 %CONSTBYTEINTEGERARRAY OUTTT(0:63)='?','A','B','C','D','E','F','G',
const unsigned char OUTTT[(63)-(0)+1] = { 63, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 38, 45, 47, 39, 40, 41, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 46, 37, 35, 63, 63, };
// 9778 'H','I','J','K','L','M','N',
// 9779 'O','P','Q','R','S','T','U',
// 9780 'V','W','X','Y','Z','&','-',
// 9781 '/','''','(',')',
// 9782 'a','b','c','d','e','f','g',
// 9783 'h','i','j','k','l','m','n',
// 9784 'o','p','q','r','s','t','u',
// 9785 'v','w','x','y','z','.','%',
// 9786 '#','?'(2)
// 9787 %CONSTINTEGER WORDMAX= 584,DEFAULT= 580
// 9788 {%CONST}%own{HALF}%INTEGERARRAY WORD(0:WORDMAX)=0,{%C
static int WORD[(584)-(0)+1] = { 0, 1, 32769, 32771, 32772, 32773, 2, 32775, 32776, 32777, 32778, 32780, 32781, 32782, 32783, 32784, 4, 32785, 32776, 32777, 32772, 32780, 32787, 5, 32785, 32789, 32776, 32782, 32790, 32792, 32793, 6, 32785, 32795, 32796, 32781, 32797, 32798, 32800, 7, 32801, 32776, 32777, 32778, 32780, 32787, 8, 32802, 32792, 32804, 32776, 32777, 32805, 32806, 32808, 32809, 9, 32811, 32813, 32814, 32776, 32815, 32782, 32817, 32818, 32819, 10, 32802, 32792, 32804, 32776, 32777, 32822, 32806, 32808, 32809, 11, 32775, 32776, 32823, 32825, 32826, 32813, 32777, 32772, 32780, 32781, 12, 32827, 32825, 32826, 32813, 32777, 32829, 32830, 32832, 13, 32769, 32834, 32827, 32825, 32826, 32813, 32771, 32835, 14, 32837, 32838, 32839, 15, 32840, 32839, 16, 32801, 32776, 32777, 32772, 32780, 32787, 17, 32801, 32776, 32842, 32772, 32843, 32806, 32792, 32845, 19, 32847, 32848, 32849, 32850, 20, 32813, 32852, 32853, 32845, 32854, 32834, 32856, 32776, 21, 32813, 32852, 32857, 32845, 32854, 32834, 32856, 32776, 22, 32858, 32850, 32860, 32861, 32862, 23, 32863, 32865, 32866, 32867, 24, 32869, 32866, 32870, 32867, 26, 32813, 32771, 32772, 32797, 32872, 32873, 32875, 27, 32776, 32771, 32772, 32797, 32877, 32789, 28, 32802, 32792, 32804, 32776, 32777, 32819, 32879, 32880, 32881, 29, 32882, 32860, 32883, 30, 32885, 32887, 32877, 32881, 31, 32889, 32887, 32804, 32792, 32891, 32881, 32, 32892, 32894, 33, 32892, 32865, 32866, 32894, 34, 32837, 32838, 32896, 37, 32837, 32838, 32898, 38, 32900, 32776, 32777, 32901, 32902, 32813, 32903, 32808, 32904, 32902, 40, 32905, 32906, 41, 32908, 32910, 32912, 32913, 32825, 32915, 32800, 44, 32917, 32919, 45, 32847, 32848, 32849, 32919, 46, 32776, 32771, 32787, 32920, 32921, 32817, 32923, 32925, 47, 32926, 32778, 32927, 32825, 32826, 32813, 48, 32926, 32921, 32928, 32929, 32873, 49, 32930, 32932, 32933, 32923, 32792, 32935, 32776, 50, 32937, 32814, 32813, 32771, 32887, 32939, 32940, 32814, 32776, 51, 32942, 32771, 32772, 32773, 52, 32769, 32944, 32814, 32942, 32834, 32946, 32825, 32826, 32813, 53, 32942, 32834, 32946, 32825, 32826, 32813, 32771, 32835, 54, 32948, 32887, 32827, 32769, 32881, 55, 32949, 32887, 32827, 32769, 32881, 56, 32951, 32953, 32849, 32954, 57, 32956, 32840, 58, 32957, 32959, 32906, 59, 32942, 32944, 32814, 32769, 32834, 32827, 32825, 32826, 32813, 61, 32801, 32776, 32777, 32778, 32780, 32960, 32782, 32783, 32935, 62, 32860, 32961, 32865, 63, 32963, 32862, 32965, 64, 32966, 32840, 65, 32966, 32860, 32866, 32961, 66, 32968, 32970, 32932, 32972, 32776, 67, 32974, 32976, 32977, 32776, 32978, 32979, 32981, 69, 32966, 32953, 32849, 32954, 70, 32917, 32983, 32905, 71, 32776, 32771, 32772, 32797, 32985, 32987, 72, 32989, 32991, 32782, 32797, 32985, 32790, 73, 32989, 32993, 32782, 32797, 32985, 32790, 74, 32995, 32771, 32772, 32939, 32997, 32999, 75, 32985, 32790, 33001, 32797, 33003, 32790, 76, 32985, 33004, 32776, 32782, 33006, 32790, 77, 32985, 32993, 32782, 33006, 32790, 78, 32985, 32991, 33008, 32782, 33006, 32790, 80, 33009, 33004, 32776, 33011, 33013, 32790, 81, 33009, 33004, 32776, 33014, 32932, 32790, 82, 32776, 32771, 32772, 32797, 33017, 32789, 83, 32976, 32977, 32776, 33019, 32772, 33020, 32782, 32817, 84, 32963, 32953, 32849, 32954, 86, 33022, 33017, 32976, 33014, 32932, 33024, 32776, 91, 33025, 32830, 33004, 32776, 32772, 33026, 92, 33025, 33028, 32777, 33030, 33031, 93, 33025, 33028, 32777, 33032, 32875, 32814, 33034, 90, 33036, 32789, 32776, 32960, 32920, 33004, 8, 33038, 101, 33041, 33043, 32837, 33044, 102, 33045, 32837, 33047, 103, 33048, 32837, 33044, 104, 32837, 32838, 33048, 105, 32837, 32838, 32896, 106, 32983, 32919, 32837, 33044, 107, 33049, 33051, 33053, 202, 32801, 32776, 32772, 32960, 203, 32775, 32776, 32772, 32960, 204, 33022, 33025, 32830, 33004, 32776, 205, 32801, 32776, 32772, 33054, 255, 33057, 33058, 33059, 0, };
// 9789 1, 32769, 32771, 32772, 32773, 2, 32775, 32776,
// 9790 32777, 32778, 32780, 32781, 32782, 32783, 32784, 4,
// 9791 32785, 32776, 32777, 32772, 32780, 32787, 5, 32785,
// 9792 32789, 32776, 32782, 32790, 32792, 32793, 6, 32785,
// 9793 32795, 32796, 32781, 32797, 32798, 32800, 7, 32801,
// 9794 32776, 32777, 32778, 32780, 32787, 8, 32802, 32792,
// 9795 32804, 32776, 32777, 32805, 32806, 32808, 32809, 9,
// 9796 32811, 32813, 32814, 32776, 32815, 32782, 32817, 32818,
// 9797 32819, 10, 32802, 32792, 32804, 32776, 32777, 32822,
// 9798 32806, 32808, 32809, 11, 32775, 32776, 32823, 32825,
// 9799 32826, 32813, 32777, 32772, 32780, 32781, 12, 32827,
// 9800 32825, 32826, 32813, 32777, 32829, 32830, 32832, 13,
// 9801 32769, 32834, 32827, 32825, 32826, 32813, 32771, 32835,
// 9802 14, 32837, 32838, 32839, 15, 32840, 32839, 16,
// 9803 32801, 32776, 32777, 32772, 32780, 32787, 17, 32801,
// 9804 32776, 32842, 32772, 32843, 32806, 32792, 32845, 19,
// 9805 32847, 32848, 32849, 32850, 20, 32813, 32852, 32853,
// 9806 32845, 32854, 32834, 32856, 32776, 21, 32813, 32852,
// 9807 32857, 32845, 32854, 32834, 32856, 32776, 22, 32858,
// 9808 32850, 32860, 32861, 32862, 23, 32863, 32865, 32866,
// 9809 32867, 24, 32869, 32866, 32870, 32867, 26, 32813,
// 9810 32771, 32772, 32797, 32872, 32873, 32875, 27, 32776,
// 9811 32771, 32772, 32797, 32877, 32789, 28, 32802, 32792,
// 9812 32804, 32776, 32777, 32819, 32879, 32880, 32881, 29,
// 9813 32882, 32860, 32883, 30, 32885, 32887, 32877, 32881,
// 9814 31, 32889, 32887, 32804, 32792, 32891, 32881, 32,
// 9815 32892, 32894, 33, 32892, 32865, 32866, 32894, 34,
// 9816 32837, 32838, 32896, 37, 32837, 32838, 32898, 38,
// 9817 32900, 32776, 32777, 32901, 32902, 32813, 32903, 32808,
// 9818 32904, 32902, 40, 32905, 32906, 41, 32908, 32910,
// 9819 32912, 32913, 32825, 32915, 32800, 44, 32917, 32919,
// 9820 45, 32847, 32848, 32849, 32919, 46, 32776, 32771,
// 9821 32787, 32920, 32921, 32817, 32923, 32925, 47, 32926,
// 9822 32778, 32927, 32825, 32826, 32813, 48, 32926, 32921,
// 9823 32928, 32929, 32873, 49, 32930, 32932, 32933, 32923,
// 9824 32792, 32935, 32776, 50, 32937, 32814, 32813, 32771,
// 9825 32887, 32939, 32940, 32814, 32776, 51, 32942, 32771,
// 9826 32772, 32773, 52, 32769, 32944, 32814, 32942, 32834,
// 9827 32946, 32825, 32826, 32813, 53, 32942, 32834, 32946,
// 9828 32825, 32826, 32813, 32771, 32835, 54, 32948, 32887,
// 9829 32827, 32769, 32881, 55, 32949, 32887, 32827, 32769,
// 9830 32881, 56, 32951, 32953, 32849, 32954, 57, 32956,
// 9831 32840, 58, 32957, 32959, 32906, 59, 32942, 32944,
// 9832 32814, 32769, 32834, 32827, 32825, 32826, 32813, 61,
// 9833 32801, 32776, 32777, 32778, 32780, 32960, 32782, 32783,
// 9834 32935, 62, 32860, 32961, 32865, 63, 32963, 32862,
// 9835 32965, 64, 32966, 32840, 65, 32966, 32860, 32866,
// 9836 32961, 66, 32968, 32970, 32932, 32972, 32776, 67,
// 9837 32974, 32976, 32977, 32776, 32978, 32979, 32981, 69,
// 9838 32966, 32953, 32849, 32954, 70, 32917, 32983, 32905,
// 9839 71, 32776, 32771, 32772, 32797, 32985, 32987, 72,
// 9840 32989, 32991, 32782, 32797, 32985, 32790, 73, 32989,
// 9841 32993, 32782, 32797, 32985, 32790, 74, 32995, 32771,
// 9842 32772, 32939, 32997, 32999, 75, 32985, 32790, 33001,
// 9843 32797, 33003, 32790, 76, 32985, 33004, 32776, 32782,
// 9844 33006, 32790, 77, 32985, 32993, 32782, 33006, 32790,
// 9845 78, 32985, 32991, 33008, 32782, 33006, 32790, 80,
// 9846 33009, 33004, 32776, 33011, 33013, 32790, 81, 33009,
// 9847 33004, 32776, 33014, 32932, 32790, 82, 32776, 32771,
// 9848 32772, 32797, 33017, 32789, 83, 32976, 32977, 32776,
// 9849 33019, 32772, 33020, 32782, 32817, 84, 32963, 32953,
// 9850 32849, 32954, 86, 33022, 33017, 32976, 33014, 32932,
// 9851 33024, 32776, 91, 33025, 32830, 33004, 32776, 32772,
// 9852 33026, 92, 33025, 33028, 32777, 33030, 33031, 93,
// 9853 33025, 33028, 32777, 33032, 32875, 32814, 33034, 90,
// 9854 33036, 32789, 32776, 32960, 32920, 33004, 8, 33038,
// 9855 101, 33041, 33043, 32837, 33044, 102, 33045, 32837,
// 9856 33047, 103, 33048, 32837, 33044, 104, 32837, 32838,
// 9857 33048, 105, 32837, 32838, 32896, 106, 32983, 32919,
// 9858 32837, 33044, 107, 33049, 33051, 33053, 202, 32801,
// 9859 32776, 32772, 32960, 203, 32775, 32776, 32772, 32960,
// 9860 204, 33022, 33025, 32830, 33004, 32776, 205, 32801,
// 9861 32776, 32772, 33054, 255, 33057, 33058, 33059, 0
// 9862
// 9863 %CONSTINTEGERARRAY LETT(0: 292)=0,{%C
const int LETT[(292)-(0)+1] = { 0, 2022746123, 44040192, 1402470400, 1568571392, 1697528531, 1697415168, 420238040, 905969664, 1359896576, 1130779331, 1237843968, 1160558336, 1731100672, 1399848960, 1766144384, 1164308950, 666712647, 1342177280, 1227650627, 1697415168, 1561178752, 1271273803, 1738356700, 1603272704, 1134458063, 1567405928, 1493979864, 922726400, 1107296256, 1730967517, 1207959552, 1766699648, 487436928, 629062227, 1562902528, 1299185664, 1535005312, 1628328155, 1269086566, 1766078208, 1736749523, 1296871936, 554586331, 1269086464, 2046820352, 1596981248, 1229771595, 1704460288, 1775112832, 1301673600, 1736749523, 1296855273, 1400750080, 1294922468, 1697436389, 1265922760, 1134559232, 1498272384, 2015043993, 167772160, 1774051328, 1199430245, 1600126976, 1197751015, 1268252672, 1300119552, 1531869651, 1563951104, 679075840, 436849792, 175147392, 441084307, 473432064, 1232910720, 1697528531, 1697120256, 1739348423, 1699617382, 781313806, 477626368, 506462208, 537542811, 178301222, 1769857024, 1294917632, 1637219155, 1227653120, 1133924594, 1527635072, 35293827, 402653184, 477790208, 43515904, 645964160, 612018707, 472383488, 470393472, 309329920, 180488487, 644874240, 606610944, 309494415, 177209344, 1829606600, 2016068253, 671088640, 1571664203, 1677721600, 1702804051, 1562902528, 1169063936, 1568145408, 1165794432, 407003136, 136997405, 678428672, 2022746667, 611319808, 1605278675, 1765801984, 2022746539, 413138944, 1527644160, 309510297, 304087040, 43672219, 73443584, 405455513, 637534208, 139043485, 642377510, 60182770, 1803948772, 1165932360, 1496217984, 1501491940, 136865308, 441083929, 35168768, 125688297, 1131839488, 1192089439, 1744830464, 1160249344, 1270101611, 1134866944, 1199421523, 1495793664, 308380303, 39845888, 108644776, 1134034944, 1400295641, 1394606080, 2016086565, 309486726, 2020615818, 2015988106, 1330565852, 1127650020, 2021244928, 61248219, 1637875712, 1769472000, 1400191571, 1130707402, 2016536859, 44040192, 665606599, 1699617280, 1766105088, 1165932361, 1711276032, 2016487187, 641728512, 1400273483, 1126170624, 2023391397, 671088640, 2016085160, 2014963497, 309502592, 175146893, 206144128, 514490368, 108644875, 815792128, 69788828, 108644901, 509607936, 648128296, 1805431296, 209340035, 671088640, 606627749, 134217728, 177358756, 648562435, 438829056, 197531979, 1738356700, 1134458063, 1563197440, 1697413093, 1207959552, 623671269, 1234698240, 920125440, 1131708416, 1359925888, 1229771595, 1697503744, 1300125379, 1771569152, 648168605, 234881024, 665212125, 1308622848, 1829654739, 1164222464, 60111441, 1529779398, 1602533699, 1769881600, 1199430121, 1131839488, 623802329, 1805989852, 1199462731, 1201668096, 1300125379, 1744830464, 1199430211, 1400266752, 1739341824, 1829655747, 1164222464, 1133853265, 1529779398, 1037811712, 561854313, 1267728384, 1199421507, 1697415168, 1867420672, 1267643629, 1130673991, 1260388352, 1635596137, 1267728384, 1133813760, 1267643629, 1130674024, 258339139, 1476395008, 1501327576, 2016536832, 1400279759, 1267728384, 1197751015, 1241513984, 1965971328, 1738848256, 1568527581, 1764553444, 1771322187, 1704769920, 729193697, 1260388352, 35686667, 647504147, 407538816, 645572871, 167772160, 407487104, 410633088, 779765133, 308322304, 644359704, 470393510, 108636179, 405422080, 671630859, 637534208, 212436480, 1126472011, 1738289497, 1241513984, 640196608, 308936704, 436849283, 402653184, };
// 9864 16_7890A80B,16_02A00000,16_53980000,16_5D7E8000,
// 9865 16_652E3AD3,16_652C8000,16_190C52D8,16_36000000,
// 9866 16_510E6000,16_436652C3,16_49C80000,16_452CB700,
// 9867 16_672E8000,16_53700000,16_69453980,16_4565F1D6,
// 9868 16_27BD3A47,16_50000000,16_492C7643,16_652C8000,
// 9869 16_5D0DB280,16_4BC6194B,16_679D37DC,16_5F900000,
// 9870 16_439E74CF,16_5D6CB768,16_590C52D8,16_36FFB000,
// 9871 16_42000000,16_672C77DD,16_48000000,16_694DB280,
// 9872 16_1D0DB280,16_257EBA53,16_5D280000,16_4D700000,
// 9873 16_5B7E5280,16_610E50DB,16_4BA4B966,16_69443700,
// 9874 16_6784B1D3,16_4D4CB200,16_210E50DB,16_4BA4B900,
// 9875 16_7A000000,16_5F300000,16_494CD34B,16_65980000,
// 9876 16_69CE1280,16_4D95F680,16_6784B1D3,16_4D4C70E9,
// 9877 16_537DC000,16_4D2EF2E4,16_652CD2E5,16_4B7472C8,
// 9878 16_43A00000,16_594DD280,16_781B2199,16_0A000000,
// 9879 16_69BDE000,16_477DDA65,16_5F600000,16_47643AE7,
// 9880 16_4B980000,16_4D7E4000,16_5B4E79D3,16_5D380000,
// 9881 16_2879E000,16_1A09CC80,16_0A708980,16_1A4A6993,
// 9882 16_1C380000,16_497CB980,16_652E3AD3,16_65280000,
// 9883 16_67AC59C7,16_654E1A66,16_2E91E70E,16_1C780000,
// 9884 16_1E300000,16_200A409B,16_0AA0A926,16_697DE000,
// 9885 16_4D2EE000,16_6195FB53,16_492C8000,16_439650F2,
// 9886 16_5B0DDC80,16_021A8A83,16_18000000,16_1C7A8000,
// 9887 16_02980000,16_2680A180,16_247AAA13,16_1C280000,
// 9888 16_1C09A280,16_12700000,16_0AC20927,16_26700000,
// 9889 16_24282600,16_1272828F,16_0A900000,16_6D0D94C8,
// 9890 16_782AC29D,16_28000000,16_5DADB14B,16_64000000,
// 9891 16_657EBA53,16_5D280000,16_45AE8000,16_5D780000,
// 9892 16_457C9C80,16_18426000,16_082A6A1D,16_28700000,
// 9893 16_7890AA2B,16_24700000,16_5FAE9BD3,16_69400000,
// 9894 16_7890A9AB,16_18A00000,16_5B0E0000,16_1272C099,
// 9895 16_12200000,16_029A629B,16_0460A900,16_182AC299,
// 9896 16_26000000,16_0849A29D,16_2649E726,16_039650F2,
// 9897 16_6B8612E4,16_457EB748,16_592E7980,16_597EF2E4,
// 9898 16_0828661C,16_1A4A6819,16_0218A200,16_077DD9E9,
// 9899 16_43768000,16_470DD75F,16_68000000,16_45280000,
// 9900 16_4BB4366B,16_43A4B200,16_477DB853,16_59280000,
// 9901 16_1261828F,16_02600000,16_0679C9A8,16_43980000,
// 9902 16_5376D0D9,16_53200000,16_782B0A25,16_12726486,
// 9903 16_7870268A,16_7829898A,16_4F4ED2DC,16_433692E4,
// 9904 16_7879C000,16_03A692DB,16_61A00000,16_69780000,
// 9905 16_53753A53,16_436539CA,16_7831E91B,16_02A00000,
// 9906 16_27AC59C7,16_654E1A00,16_6944A000,16_457EB749,
// 9907 16_66000000,16_78312713,16_26400000,16_53767A4B,
// 9908 16_43200000,16_789A80A5,16_28000000,16_782B04A8,
// 9909 16_7819E729,16_1272A280,16_0A70878D,16_0C498280,
// 9910 16_1EAA8000,16_0679CA0B,16_30A00000,16_0428E49C,
// 9911 16_0679CA25,16_1E600000,16_26A1A728,16_6B9CB200,
// 9912 16_0C7A4683,16_28000000,16_242867A5,16_08000000,
// 9913 16_0A9247A4,16_26A84703,16_1A280000,16_0BC6194B,
// 9914 16_679D37DC,16_439E74CF,16_5D2C8000,16_652C77E5,
// 9915 16_48000000,16_252C77E5,16_49980000,16_36D80000,
// 9916 16_43748000,16_510ED280,16_494CD34B,16_652DDA00,
// 9917 16_4D7E56C3,16_69980000,16_26A2449D,16_0E000000,
// 9918 16_27A654DD,16_4E000000,16_6D0E50D3,16_4564A000,
// 9919 16_03953A51,16_5B2E94C6,16_5F84B943,16_697E4000,
// 9920 16_477DD9E9,16_43768000,16_252E77D9,16_6BA537DC,
// 9921 16_477E594B,16_47A00000,16_4D7E56C3,16_68000000,
// 9922 16_477DDA43,16_53766000,16_67AC4000,16_6D0E54C3,
// 9923 16_4564A000,16_43953A51,16_5B2E94C6,16_3DDBC000,
// 9924 16_217D3769,16_4B900000,16_477DB843,16_652C8000,
// 9925 16_6F4E9400,16_4B8EB4ED,16_4364B747,16_4B200000,
// 9926 16_617D3769,16_4B900000,16_4394A000,16_4B8EB4ED,
// 9927 16_4364B768,16_0F65F143,16_58000000,16_597C70D8,
// 9928 16_7831E900,16_537692CF,16_4B900000,16_47643AE7,
// 9929 16_4A000000,16_752E5780,16_67A4B800,16_5D7DD4DD,
// 9930 16_692CF2E4,16_69943B4B,16_659CB980,16_2B769CE1,
// 9931 16_4B200000,16_0220890B,16_26982113,16_184A8C80,
// 9932 16_267AA907,16_0A000000,16_1849C280,16_1879C380,
// 9933 16_2E7A458D,16_1260A000,16_26682618,16_1C09A2A6,
// 9934 16_0679A813,16_182A4000,16_2808460B,16_26000000,
// 9935 16_0CA98600,16_4324994B,16_679C3159,16_4A000000,
// 9936 16_2628A000,16_126A0000,16_1A09CA83,16_18000000
// 9937
// 9938 %INTEGER I,J,K,M,Q,S
int I;
int J;
int K;
int M;
int Q;
int S;
// 9939 %STRING(70)OMESS
_imp_string /*%string(70)*/ OMESS;
// 9940 OMESS=" "
OMESS = _imp_str_literal(" ");
// 9941 %CYCLE I=1,1,WORDMAX-1
I = ((1)) - ((1));
L_0965:
if (( I ) == ( ((584)) - ((1)) )) goto L_0966;
I = ((I)) + ((1));
// 9942 ->FOUND %IF N=WORD(I)
if (( N ) != ( WORD[I] )) goto L_0968;
goto U_0124;
L_0968:
// 9943 %REPEAT
goto L_0965;
L_0966:
// 9944 I=DEFAULT
I = 580;
// 9945 FOUND:
U_0124:
// 9946 J=1
J = 1;
// 9947 %CYCLE
L_0969:
// 9948 K=WORD(I+J)
K = WORD[((I)) + ((J))];
// 9949 %IF K&16_8000=0 %THEN %EXIT
if (( ((K)) & ((32768)) ) != ( 0 )) goto L_096c;
goto L_096a;
L_096c:
// 9950 K=K!!16_8000
K = ((K)) ^ ((32768));
// 9951 OMESS=OMESS." " %UNLESS J=1
if (( J ) == ( 1 )) goto L_096d;
OMESS = _imp_strcat((&(OMESS)), _imp_str_literal(" "));
L_096d:
// 9952 {%UNTIL M&1=0} %CYCLE
L_096e:
// 9953 M=LETT(K); S=25
M = LETT[K];
S = 25;
// 9954 {%UNTIL S<0} %CYCLE
L_0971:
// 9955 Q=M>>S&63;
Q = (((int)(((unsigned int)(M)) >> ((S))))) & ((63));
// 9956 %IF Q\=0 %THEN OMESS=OMESS.TOSTRING(OUTTT(Q))
if (( Q ) == ( 0 )) goto L_0974;
OMESS = _imp_strcat((&(OMESS)), TOSTRING(OUTTT[Q]));
L_0974:
// 9957 S=S-6
S = ((S)) - ((6));
// 9958 %REPEAT %UNTIL S<0
if (( S ) < ( 0 )) goto L_0972;
goto L_0971;
L_0972:
// 9959 K=K+1
K = ((K)) + ((1));
// 9960 %REPEAT %UNTIL M&1=0
if (( ((M)) & ((1)) ) == ( 0 )) goto L_096f;
goto L_096e;
L_096f:
// 9961 J=J+1
J = ((J)) + ((1));
// 9962 %REPEAT
goto L_0969;
L_096a:
// 9963 %RESULT=OMESS
return OMESS;
// 9964 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block MESSAGE at level 3
// 9965 %STRING(16)%FN SWRITE(%INTEGER VALUE, PLACES)
_imp_string /*%string(16)*/ SWRITE( int VALUE, int PLACES )
{
__label__ _imp_endofblock;
// 9966 %result = ITOS(VALUE,PLACES) {ITOS available in new Imp2021 but not earlier Imp77}
return ITOS(VALUE, PLACES);
// 9967 {This block was NOT guarded by conditional compilation test "%IF USE IMP=YES %THEN %START" ...}
// 9968 !%STRING (16) S
// 9969 !%INTEGER D0, D1, D2, D3, L
// 9970 ! PLACES=PLACES&15
// 9971 ! *LSS_VALUE; *CDEC_0
// 9972 ! *LD_S; *INCA_1; *STD_%TOS
// 9973 ! *CPB_%B; ! SET CC=0
// 9974 ! *SUPK_%L=15,0,32; ! UNPACK & SPACE FILL
// 9975 ! *STD_D2; *JCC_8,<WASZERO>
// 9976 ! *LD_%TOS; *STD_D0; ! FOR SIGN INSERTION
// 9977 ! *LD_%TOS
// 9978 ! *MVL_%L=15,63,0; ! FORCE ISO ZONE CODES
// 9979 ! %IF VALUE<0 %THEN BYTEINTEGER(D1)='-'
// 9980 ! L=D3-D1
// 9981 !OUT: %IF PLACES>=L %THEN L=PLACES+1
// 9982 ! D3=D3-L-1
// 9983 ! BYTEINTEGER(D3)=L
// 9984 ! %RESULT=STRING(D3)
// 9985 !WASZERO:
// 9986 ! BYTEINTEGER(D3-1)='0'
// 9987 ! L=2; ->OUT
// 9988 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block SWRITE at level 3
// 9989 %ROUTINE FAULT2(%INTEGER N, DATA, IDENT)
void FAULT2( int N, int DATA, int IDENT )
{
__label__ _imp_endofblock;
// 9990 !***********************************************************************
// 9991 !* SETS UP AN ERROR MESSAGE AND SHOVES IT OUT ONTO THE LISTING *
// 9992 !* AN ALSO OPTIONALLY TO THE TERMINAL *
// 9993 !***********************************************************************
// 9994 %INTEGER I, J, T
int I;
int J;
int T;
// 9995 %STRING(255)MESS1,MESS2,WK1,WK2
_imp_string /*%string(255)*/ MESS1;
_imp_string /*%string(255)*/ MESS2;
_imp_string /*%string(255)*/ WK1;
_imp_string /*%string(255)*/ WK2;
// 9996 !*DELSTART
// 9997 %MONITOR %IF FAULTY<=1 %AND (SMAP#0 %OR DCOMP#0)
if (( FAULTY ) > ( 1 )) goto L_0975;
if (( SMAP ) != ( 0 )) goto L_096b;
if (( DCOMP ) == ( 0 )) goto L_0975;
L_096b:
_imp_monitor(0, _imp_current_line, _imp_current_file, __PRETTY_FUNCTION__);
L_0975:
// 9998 !*DELEND
// 9999 MESS1=""; MESS2=""
MESS1 = _imp_str_literal("");
MESS2 = _imp_str_literal("");
// 10000 FAULTY=FAULTY+1
FAULTY = ((FAULTY)) + ((1));
// 10001 %IF N=100 %THEN %START; ! SYNTAX FAULTS ARE SPECIAL
if (( N ) != ( 100 )) goto L_0976;
// 10002 MESS1="
MESS1 = _imp_strcat((&(_imp_strcat((&(_imp_str_literal("\n* Failed to analyse line "))), SWRITE(LINE, 2)))), _imp_str_literal("\n "));
// 10003 * Failed to analyse line ".SWRITE(LINE,2)."
// 10004 "
// 10005 %IF LINE#OLDLINE %THEN MESS1=MESS1."Text mode failure - erroneos source line not available
if (( LINE ) == ( OLDLINE )) goto L_0977;
MESS1 = _imp_strcat((&(MESS1)), _imp_str_literal("Text mode failure - erroneos source line not available\n"));
goto L_0978;
L_0977:
// 10006 " %ELSE %START
// 10007 J=0; S=0; T=0
J = 0;
S = 0;
T = 0;
// 10008 {%UNTIL (J=';' %AND Q>QMAX) %OR Q=LENGTH} %CYCLE
L_0979:
// 10009 I=J; J=BYTEINTEGER(DATA+Q);! DATA HAS ADDR(CC(0))
I = J;
J = *BYTEINTEGER(((DATA)) + ((Q)));
// 10010 %IF J>128 %AND I<128 %THEN MESS2=MESS2." %" %AND T=T+2
if (( J ) <= ( 128 )) goto L_097c;
if (( I ) >= ( 128 )) goto L_097c;
MESS2 = _imp_strcat((&(MESS2)), _imp_str_literal(" %"));
T = ((T)) + ((2));
L_097c:
// 10011 %IF I>128 %AND J<128 %THEN MESS2=MESS2." " %AND T=T+1
if (( I ) <= ( 128 )) goto L_097d;
if (( J ) >= ( 128 )) goto L_097d;
MESS2 = _imp_strcat((&(MESS2)), _imp_str_literal(" "));
T = ((T)) + ((1));
L_097d:
// 10012 MESS2=MESS2.TOSTRING(J)
MESS2 = _imp_strcat((&(MESS2)), TOSTRING(J));
// 10013 T=T+1
T = ((T)) + ((1));
// 10014 %IF Q=QMAX %THEN S=T
if (( Q ) != ( QMAX )) goto L_097e;
S = T;
L_097e:
// 10015 Q=Q+1
Q = ((Q)) + ((1));
// 10016 %EXIT %IF T>=250
if (( T ) < ( 250 )) goto L_097f;
goto L_097a;
L_097f:
// 10017 %REPEAT %UNTIL (J=';' %AND Q>QMAX) %OR Q=LENGTH
if (( J ) != ( 59 )) goto L_097b;
if (( Q ) > ( QMAX )) goto L_097a;
L_097b:
if (( Q ) == ( LENGTH )) goto L_097a;
goto L_0979;
L_097a:
// 10018 %IF Q=QMAX %THEN S=T
if (( Q ) != ( QMAX )) goto L_0980;
S = T;
L_0980:
// 10019 %FINISH
L_0978:
// 10020 %FINISH %ELSE %START
goto L_0981;
L_0976:
// 10021 MESS1="
MESS1 = _imp_strcat((&(_imp_strcat((&(_imp_str_literal("\n*"))), SWRITE(LINE, 4)))), _imp_str_literal(" "));
// 10022 *".SWRITE(LINE, 4)." "
// 10023 PARMOPT=1
PARMOPT = 1;
// 10024 INHCODE=1 %IF PARMLET=0; ! STOP GENERATING CODE
if (( PARMLET ) != ( 0 )) goto L_0982;
INHCODE = 1;
L_0982:
// 10025 MESS1=MESS1."FAULT".SWRITE(N,2)
MESS1 = _imp_strcat((&(_imp_strcat((&(MESS1)), _imp_str_literal("FAULT")))), SWRITE(N, 2));
// 10026 MESS2=MESSAGE(N)
MESS2 = MESSAGE(N);
// 10027 %IF MESS2->WK1.("##").WK2 %THEN MESS2=WK1.SWRITE(IDENT,1).WK2
if (_imp_resolve(MESS2, (&(WK1)), _imp_str_literal("##"), (&(WK2)))) goto L_0983;
MESS2 = _imp_strcat((&(_imp_strcat((&(WK1)), SWRITE(IDENT, 1)))), WK2);
L_0983:
// 10028 %IF MESS2->WK1.("#").WK2 %THEN MESS2=WK1.SWRITE(DATA,1).WK2
if (_imp_resolve(MESS2, (&(WK1)), _imp_str_literal("#"), (&(WK2)))) goto L_0984;
MESS2 = _imp_strcat((&(_imp_strcat((&(WK1)), SWRITE(DATA, 1)))), WK2);
L_0984:
// 10029 %IF MESS2->WK1.("&&").WK2 %THEN MESS2=WK1.PRINTNAME(DATA).WK2
if (_imp_resolve(MESS2, (&(WK1)), _imp_str_literal("&&"), (&(WK2)))) goto L_0985;
MESS2 = _imp_strcat((&(_imp_strcat((&(WK1)), PRINTNAME(DATA)))), WK2);
L_0985:
// 10030 %IF MESS2->WK1.("&").WK2 %THEN MESS2=WK1.PRINTNAME(IDENT).WK2
if (_imp_resolve(MESS2, (&(WK1)), _imp_str_literal("&"), (&(WK2)))) goto L_0986;
MESS2 = _imp_strcat((&(_imp_strcat((&(WK1)), PRINTNAME(IDENT)))), WK2);
L_0986:
// 10031 %IF N>100 %THEN MESS2=MESS2." Disaster"
if (( N ) <= ( 100 )) goto L_0987;
MESS2 = _imp_strcat((&(MESS2)), _imp_str_literal(" Disaster"));
L_0987:
// 10032 %FINISH
L_0981:
// 10033 %CYCLE I=2,-1,1
I = ((2)) - (((-(1))));
L_0988:
if (( I ) == ( 1 )) goto L_0989;
I = ((I)) + (((-(1))));
// 10034 SELECT OUTPUT(TTOPUT) %IF I=1
if (( I ) != ( 1 )) goto L_098b;
SELECTOUTPUT(TTOPUT);
L_098b:
// 10035 PRINTSTRING(MESS1)
PRINTSTRING(MESS1);
// 10036 PRINTSTRING(MESS2) %IF MESS2#""
if (_imp_strcmp(MESS2, _imp_str_literal("")) == 0) goto L_098c;
PRINTSTRING(MESS2);
L_098c:
// 10037 %IF N=100 %AND S<115 %THEN %START
if (( N ) != ( 100 )) goto L_098d;
if (( S ) >= ( 115 )) goto L_098d;
// 10038 NEWLINE; SPACES(S+4); PRINTSYMBOL('!')
NEWLINE();
SPACES(((S)) + ((4)));
PRINTSYMBOL(33);
// 10039 %FINISH
L_098d:
// 10040 NEWLINE
NEWLINE();
// 10041 SELECT OUTPUT(82) %IF I=1
if (( I ) != ( 1 )) goto L_098e;
SELECTOUTPUT(82);
L_098e:
// 10042 %EXIT %IF TTOPUT<=0
if (( TTOPUT ) > ( 0 )) goto L_098f;
goto L_0989;
L_098f:
// 10043 %REPEAT
goto L_0988;
L_0989:
// 10044 %IF N>100 %THEN %MONITOR %AND %STOP
if (( N ) <= ( 100 )) goto L_0990;
_imp_monitor(0, _imp_current_line, _imp_current_file, __PRETTY_FUNCTION__);
exit(0);
L_0990:
// 10045 %END
return;
_imp_endofblock: ;
} // End of block FAULT2 at level 3
// 10046 %ROUTINE FAULT(%INTEGER N,FNAME)
void FAULT( int N, int FNAME )
{
__label__ _imp_endofblock;
// 10047 FAULT2(N,FNAME,FNAME)
FAULT2(N, FNAME, FNAME);
// 10048 %END
return;
_imp_endofblock: ;
} // End of block FAULT at level 3
// 10049 %ROUTINE WARN(%INTEGER N,V)
void WARN( int N, int V )
{
__label__ _imp_endofblock;
// 10050 %STRING(30) T; %STRING(120) S
_imp_string /*%string(30)*/ T;
_imp_string /*%string(120)*/ S;
// 10051 S=MESSAGE(N+200)
S = MESSAGE(((N)) + ((200)));
// 10052 %IF S->S.("&").T %THEN S=S.PRINTNAME(V).T
if (_imp_resolve(S, (&(S)), _imp_str_literal("&"), (&(T)))) goto L_0991;
S = _imp_strcat((&(_imp_strcat((&(S)), PRINTNAME(V)))), T);
L_0991:
// 10053 PRINTSTRING("
PRINTSTRING(_imp_strcat((&(_imp_strcat((&(_imp_strcat((&(_imp_str_literal("\n? Warning :- "))), S))), _imp_str_literal(" at line No")))), SWRITE(LINE, 1)));
// 10054 ? Warning :- ".S." at line No".SWRITE(LINE,1))
// 10055 NEWLINE
NEWLINE();
// 10056 %END
return;
_imp_endofblock: ;
} // End of block WARN at level 3
// 10057 ! THE NEXT 4 ROUTINES CAN BE
// 10058 !MACROISED USING MVC
// 10059 !
// 10060 %ROUTINE TOAR2(%INTEGER PTR,VALUE)
void TOAR2( int PTR, int VALUE )
{
__label__ _imp_endofblock;
// 10061 ! %IF USE IMP=YES %THEN %START
// 10062 A(PTR+1)<-VALUE
A[((PTR)) + ((1))] = VALUE;
// 10063 A(PTR)<-VALUE>>8
A[PTR] = (int)(((unsigned int)(VALUE)) >> ((8)));
// 10064 ! %FINISH %ELSE %START
// 10065 ! *LSS_VALUE
// 10066 ! *LDTB_16_58000002
// 10067 ! *LDA_A+4
// 10068 ! *INCA_PTR
// 10069 ! *ST_(%DR)
// 10070 ! %FINISH
// 10071 %END
return;
_imp_endofblock: ;
} // End of block TOAR2 at level 3
// 10072 %ROUTINE TOAR4(%INTEGER PTR, VALUE)
void TOAR4( int PTR, int VALUE )
{
__label__ _imp_endofblock;
// 10073 %INTEGER I
int I;
// 10074 ! %IF USE IMP=YES %THEN %START
// 10075 %CYCLE I=0,1,3
I = ((0)) - ((1));
L_0992:
if (( I ) == ( 3 )) goto L_0993;
I = ((I)) + ((1));
// 10076 A(PTR+I)=BYTE INTEGER(ADDR(VALUE)+I)
A[((PTR)) + ((I))] = *BYTEINTEGER(((ADDR( &VALUE))) + ((I)));
// 10077 %REPEAT
goto L_0992;
L_0993:
// 10078 ! %FINISH %ELSE %START
// 10079 ! *LSS_VALUE
// 10080 ! *LDTB_16_58000004
// 10081 ! *LDA_A+4
// 10082 ! *INCA_PTR
// 10083 ! *ST_(%DR)
// 10084 ! %FINISH
// 10085 %END
return;
_imp_endofblock: ;
} // End of block TOAR4 at level 3
// 10086 %ROUTINE TOAR8(%INTEGER PTR, %LONGREAL VALUE)
void TOAR8( int PTR, double VALUE )
{
__label__ _imp_endofblock;
// 10087 %INTEGER I
int I;
// 10088 ! %IF USE IMP=YES %THEN %START
// 10089 %CYCLE I=0,1,7
I = ((0)) - ((1));
L_0995:
if (( I ) == ( 7 )) goto L_0996;
I = ((I)) + ((1));
// 10090 A(PTR+I)=BYTE INTEGER(ADDR(VALUE)+I)
A[((PTR)) + ((I))] = *BYTEINTEGER(((ADDR( &VALUE))) + ((I)));
// 10091 %REPEAT
goto L_0995;
L_0996:
// 10092 ! %FINISH %ELSE %START
// 10093 ! *LSD_VALUE
// 10094 ! *LDTB_16_58000008
// 10095 ! *LDA_A+4
// 10096 ! *INCA_PTR
// 10097 ! *ST_(%DR)
// 10098 ! %FINISH
// 10099 %END
return;
_imp_endofblock: ;
} // End of block TOAR8 at level 3
// 10100 %INTEGERFN FROMAR2(%INTEGER PTR)
int FROMAR2( int PTR )
{
__label__ _imp_endofblock;
// 10101 ! %IF USE IMP=YES %THEN %start
// 10102 %RESULT=A(PTR)<<8!A(PTR+1)
return ((((A[PTR])) << ((8)))) | ((A[((PTR)) + ((1))]));
// 10103 ! %finish%ELSE%START
// 10104 ! *LDTB_16_58000002
// 10105 ! *LDA_A+4
// 10106 ! *INCA_PTR
// 10107 ! *LSS_(%DR)
// 10108 ! *EXIT_-64
// 10109 ! %FINISH
// 10110 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FROMAR2 at level 3
// 10111 %INTEGERFN FROMAR4(%INTEGER PTR)
int FROMAR4( int PTR )
{
__label__ _imp_endofblock;
// 10112 ! %IF USE IMP=YES %THEN %START
// 10113 %RESULT=A(PTR)<<24!A(PTR+1)<<16!A(PTR+2)<<8!A(PTR+3)
return ((((((((A[PTR])) << ((24)))) | ((((A[((PTR)) + ((1))])) << ((16)))))) | ((((A[((PTR)) + ((2))])) << ((8)))))) | ((A[((PTR)) + ((3))]));
// 10114 ! %FINISH %ELSE %START
// 10115 ! *LDTB_16_58000004
// 10116 ! *LDA_A+4
// 10117 ! *INCA_PTR
// 10118 ! *LSS_(%DR)
// 10119 ! *EXIT_-64
// 10120 ! %FINISH
// 10121 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FROMAR4 at level 3
// 10122 %STRING(255)%FN PRINTNAME(%INTEGER N)
_imp_string /*%string(255)*/ PRINTNAME( int N )
{
__label__ _imp_endofblock;
// 10123 %INTEGER V, K
int V;
int K;
// 10124 %STRING(255)S
_imp_string /*%string(255)*/ S;
// 10125 V=WORD(N)
V = WORD[N];
// 10126 K=BYTE INTEGER(DICTBASE+V)
K = *BYTEINTEGER(((DICTBASE)) + ((V)));
// 10127 %IF K=0 %THEN S="???" %ELSE S=STRING(DICTBASE+V)
if (( K ) != ( 0 )) goto L_0998;
S = _imp_str_literal("???");
goto L_0999;
L_0998:
S = *STRING(((DICTBASE)) + ((V)));
L_0999:
// 10128 %RESULT=S
return S;
// 10129 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block PRINTNAME at level 3
// 10130 !*DELSTART
// 10131 %ROUTINE PRHEX(%INTEGER VALUE, PLACES)
void PRHEX( int VALUE, int PLACES )
{
__label__ _imp_endofblock;
// 10132 %CONSTBYTEINTEGERARRAY HEX(0:15)='0','1','2','3','4',
const unsigned char HEX[(15)-(0)+1] = { 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 65, 66, 67, 68, 69, 70, };
// 10133 '5','6','7','8','9','A','B','C','D','E','F'
// 10134 %INTEGER I
int I;
// 10135 %CYCLE I=PLACES<<2-4, -4, 0
I = ((((((PLACES)) << ((2)))) - ((4)))) - (((-(4))));
L_099a:
if (( I ) == ( 0 )) goto L_099b;
I = ((I)) + (((-(4))));
// 10136 PRINT SYMBOL(HEX(VALUE>>I&15))
PRINTSYMBOL(HEX[(((int)(((unsigned int)(VALUE)) >> ((I))))) & ((15))]);
// 10137 %REPEAT
goto L_099a;
L_099b:
// 10138 %END
return;
_imp_endofblock: ;
} // End of block PRHEX at level 3
// 10139 %ROUTINE PRINT LIST(%INTEGER HEAD)
void PRINTLIST( int HEAD )
{
__label__ _imp_endofblock;
// 10140 %INTEGER I,J,K
int I;
int J;
int K;
// 10141 PRINTSTRING("
PRINTSTRING(_imp_str_literal("\nPRINT OF LIST "));
// 10142 PRINT OF LIST ")
// 10143 WRITE(HEAD,2)
WRITE(HEAD, 2);
// 10144 NEWLINE
NEWLINE();
// 10145 %WHILE HEAD#0 %CYCLE
L_099d:
if (( HEAD ) == ( 0 )) goto L_099e;
// 10146 FROM123(HEAD,I,J,K)
FROM123(HEAD, &I, &J, &K);
// 10147 WRITE(HEAD,3)
WRITE(HEAD, 3);
// 10148 SPACES(3)
SPACES(3);
// 10149 PRHEX(I,8)
PRHEX(I, 8);
// 10150 SPACES(3)
SPACES(3);
// 10151 PRHEX(J,8)
PRHEX(J, 8);
// 10152 SPACES(3)
SPACES(3);
// 10153 PRHEX(K,8)
PRHEX(K, 8);
// 10154 NEWLINE
NEWLINE();
// 10155 MLINK(HEAD)
MLINK( &HEAD);
// 10156 HEAD=HEAD&16_FFFF; ! EXTRA LINK IN TAGS LIST!!
HEAD = ((HEAD)) & ((65535));
// 10157 %REPEAT
goto L_099d;
L_099e:
// 10158 %END
return;
_imp_endofblock: ;
} // End of block PRINTLIST at level 3
// 10159 !
// 10160 %ROUTINE CHECK ASL
void CHECKASL( void )
{
__label__ _imp_endofblock;
// 10161 !***********************************************************************
// 10162 !* CHECK ASL AND PRINT NO OF FREE CELLS. DEBUGGING SERVICE ONLY *
// 10163 !***********************************************************************
// 10164 %INTEGER N,Q
int N;
int Q;
// 10165 Q=ASL; N=0
Q = ASL;
N = 0;
// 10166 %WHILE Q#0 %CYCLE
L_09a0:
if (( Q ) == ( 0 )) goto L_09a1;
// 10167 N=N+1
N = ((N)) + ((1));
// 10168 Q=ASLIST(Q)_LINK
Q = ASLIST[Q].LINK;
// 10169 %REPEAT
goto L_09a0;
L_09a1:
// 10170 NEWLINE
NEWLINE();
// 10171 PRINTSTRING("FREE CELLS AFTER LINE ")
PRINTSTRING(_imp_str_literal("FREE CELLS AFTER LINE "));
// 10172 WRITE(LINE,3)
WRITE(LINE, 3);
// 10173 PRINTSYMBOL('=')
PRINTSYMBOL(61);
// 10174 WRITE(N,3)
WRITE(N, 3);
// 10175 %END
return;
_imp_endofblock: ;
} // End of block CHECKASL at level 3
// 10176 !*DELEND
// 10177 %INTEGERFN MORE SPACE
int MORESPACE( void )
{
__label__ _imp_endofblock;
// 10178 !***********************************************************************
// 10179 !* FORMATS UP SOME MORE OF THE ASL *
// 10180 !***********************************************************************
// 10181 %INTEGER I,N,CL,AMOUNT
int I;
int N;
int CL;
int AMOUNT;
// 10182 N=ASL CUR BTM-1
N = ((ASLCURBTM)) - ((1));
// 10183 AMOUNT=(NNAMES+1)>>3; ! EIGHTTH OF NNAMES
AMOUNT = (int)(((unsigned int)(((NNAMES)) + ((1)))) >> ((3)));
// 10184 I=ASL CUR BTM-((CONST PTR+8)>>2);! GAP BETWEEN CONSTS &ASL
I = ((ASLCURBTM)) - (((int)(((unsigned int)(((CONSTPTR)) + ((8)))) >> ((2)))));
// 10185 %IF I>>1<AMOUNT %THEN AMOUNT=I>>1 %AND ASL WARN=1;! HALF THE GAP MAX
if (( (int)(((unsigned int)(I)) >> ((1))) ) >= ( AMOUNT )) goto L_09a3;
AMOUNT = (int)(((unsigned int)(I)) >> ((1)));
ASLWARN = 1;
L_09a3:
// 10186 %IF AMOUNT<20 %THEN AMOUNT=0
if (( AMOUNT ) >= ( 20 )) goto L_09a4;
AMOUNT = 0;
L_09a4:
// 10187 ASL CUR BTM=ASL CUR BTM-AMOUNT
ASLCURBTM = ((ASLCURBTM)) - ((AMOUNT));
// 10188 %IF ASL CUR BTM<=1 %THEN ASL CUR BTM=1
if (( ASLCURBTM ) > ( 1 )) goto L_09a5;
ASLCURBTM = 1;
L_09a5:
// 10189 CL=4*ASL CUR BTM-8
CL = ((((4)) * ((ASLCURBTM)))) - ((8));
// 10190 %IF ASL CUR BTM>=N %OR CONST PTR>CL %THEN %START
if (( ASLCURBTM ) >= ( N )) goto L_09a2;
if (( CONSTPTR ) <= ( CL )) goto L_09a6;
L_09a2:
// 10191 ASL CUR BTM=N+1; ! AS YOU WERE
ASLCURBTM = ((N)) + ((1));
// 10192 %CYCLE I=12,-1,1
I = ((12)) - (((-(1))));
L_09a7:
if (( I ) == ( 1 )) goto L_09a8;
I = ((I)) + (((-(1))));
// 10193 %IF DVHEADS(I)#0 %THEN CLEAR LIST(DVHEADS(I))
if (( DVHEADS[I] ) == ( 0 )) goto L_09aa;
CLEARLIST( &DVHEADS[I]);
L_09aa:
// 10194 %REPEAT
goto L_09a7;
L_09a8:
// 10195 %IF ASL#0 %THEN %RESULT=ASL
if (( ASL ) == ( 0 )) goto L_09ab;
return ASL;
L_09ab:
// 10196 FAULT(107,0)
FAULT(107, 0);
// 10197 %FINISH %ELSE CONST LIMIT=CL; ! NEW VALUE WITH BIGGER ASL
goto L_09ac;
L_09a6:
CONSTLIMIT = CL;
L_09ac:
// 10198 %CYCLE I=ASL CUR BTM,1,N-1
I = ((ASLCURBTM)) - ((1));
L_09ad:
if (( I ) == ( ((N)) - ((1)) )) goto L_09ae;
I = ((I)) + ((1));
// 10199 ASLIST(I+1)_LINK=I
ASLIST[((I)) + ((1))].LINK = I;
// 10200 %REPEAT
goto L_09ad;
L_09ae:
// 10201 ASLIST(ASL CUR BTM)_LINK=0
ASLIST[ASLCURBTM].LINK = 0;
// 10202 ASL=N; %RESULT=N
ASL = N;
return N;
// 10203 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block MORESPACE at level 3
// 10204 !%INTEGERFN NEW CELL
// 10205 !***********************************************************************
// 10206 !* PROVIDE A NEW LIST PROCESSING CELL. CRAPOUT IF NONE AVAILABLE *
// 10207 !***********************************************************************
// 10208 !%INTEGER I
// 10209 ! %IF ASL=0 %THEN ASL=MORE SPACE
// 10210 ! I=ASL
// 10211 ! ASL=ASLIST(ASL)_LINK
// 10212 ! ASLIST(I)_LINK=0
// 10213 ! %RESULT =I
// 10214 !%END
// 10215 %ROUTINE PUSH(%INTEGERNAME CELL, %INTEGER S1, S2, S3)
void PUSH( int *CELL, int S1, int S2, int S3 )
{
__label__ _imp_endofblock;
// 10216 !***********************************************************************
// 10217 !* PUSH A CELL CONTAINING THE 3 STREAMS OF INFORMATION GIVEN *
// 10218 !* ONTO THE TOP OF THE LIST POINTED AT BY CELL. *
// 10219 !***********************************************************************
// 10220 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10221 %INTEGER I
int I;
// 10222 I=ASL
I = ASL;
// 10223 %IF I=0 %THEN I=MORE SPACE
if (( I ) != ( 0 )) goto L_09b0;
I = MORESPACE();
L_09b0:
// 10224 ! %IF USE IMP=YES %THEN %START
// 10225 LCELL==ASLIST(I)
LCELL = (&(ASLIST[I]));
// 10226 ASL=LCELL_LINK
ASL = LCELL->LINK;
// 10227 LCELL_LINK=CELL
LCELL->LINK = CELL;
// 10228 CELL=I
CELL = I;
// 10229 LCELL_S1=S1
LCELL->S1 = S1;
// 10230 LCELL_S2=S2
LCELL->S2 = S2;
// 10231 LCELL_S3=S3
LCELL->S3 = S3;
// 10232 ! %FINISH %ELSE %START
// 10233 ! *LB_I
// 10234 ! *MYB_16
// 10235 ! *ADB_ASLIST+4
// 10236 ! *LCT_%B
// 10237 ! *LSS_(%CTB+3)
// 10238 ! *ST_ASL
// 10239 ! *LB_I
// 10240 ! *LSS_(CELL)
// 10241 ! *STB_(%DR)
// 10242 ! *LUH_S3
// 10243 ! *LUH_S1
// 10244 ! *ST_(%CTB+0)
// 10245 ! %FINISH
// 10246 %END
return;
_imp_endofblock: ;
} // End of block PUSH at level 3
// 10247 %ROUTINE POP(%INTEGERNAME CELL, S1, S2, S3)
void POP( int *CELL, int *S1, int *S2, int *S3 )
{
__label__ _imp_endofblock;
// 10248 !***********************************************************************
// 10249 !* COPY THE INFORMATION FROM THE TOP CELL OF LIST 'CELL' INTO *
// 10250 !* S1,S2&S3 AND THEN POP THE LIST UP 1 CELL. EMPTYLIST GIVE -1S*
// 10251 !***********************************************************************
// 10252 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10253 %INTEGER I
int I;
// 10254 ! %IF USE IMP=YES %THEN %START
// 10255 I=CELL
I = CELL;
// 10256 LCELL==ASLIST(I)
LCELL = (&(ASLIST[I]));
// 10257 S1=LCELL_S1
S1 = LCELL->S1;
// 10258 S2=LCELL_S2
S2 = LCELL->S2;
// 10259 S3=LCELL_S3
S3 = LCELL->S3;
// 10260 %IF I# 0 %THEN %START
if (( I ) == ( 0 )) goto L_09b1;
// 10261 CELL=LCELL_LINK
CELL = LCELL->LINK;
// 10262 LCELL_LINK=ASL
LCELL->LINK = ASL;
// 10263 ASL=I
ASL = I;
// 10264 %FINISH
L_09b1:
// 10265 ! %FINISH %ELSE %START
// 10266 ! *LB_(CELL)
// 10267 ! *STB_I
// 10268 ! *MYB_16
// 10269 ! *ADB_ASLIST+4
// 10270 ! *LCT_%B
// 10271 ! *LSD_(%CTB+0)
// 10272 ! *STUH_(S1)
// 10273 ! *LB_I
// 10274 ! *ST_(S2)
// 10275 ! *LSD_(%CTB+2)
// 10276 ! *STUH_(S3)
// 10277 ! *JAT_12,<END>
// 10278 ! *ST_(CELL)
// 10279 ! *LSS_ASL
// 10280 ! *ST_(%CTB+3)
// 10281 ! *STB_ASL
// 10282 !END:
// 10283 ! %FINISH
// 10284 %END
return;
_imp_endofblock: ;
} // End of block POP at level 3
// 10285 %ROUTINE REPLACE1(%INTEGER CELL, S1)
void REPLACE1( int CELL, int S1 )
{
__label__ _imp_endofblock;
// 10286 ASLIST(CELL)_S1=S1
ASLIST[CELL].S1 = S1;
// 10287 %END
return;
_imp_endofblock: ;
} // End of block REPLACE1 at level 3
// 10288 %ROUTINE REPLACE2(%INTEGER CELL, S2)
void REPLACE2( int CELL, int S2 )
{
__label__ _imp_endofblock;
// 10289 ASLIST(CELL)_S2=S2
ASLIST[CELL].S2 = S2;
// 10290 %END
return;
_imp_endofblock: ;
} // End of block REPLACE2 at level 3
// 10291 %ROUTINE REPLACE3(%INTEGER CELL, S3)
void REPLACE3( int CELL, int S3 )
{
__label__ _imp_endofblock;
// 10292 ASLIST(CELL)_S3=S3
ASLIST[CELL].S3 = S3;
// 10293 %END
return;
_imp_endofblock: ;
} // End of block REPLACE3 at level 3
// 10294 %ROUTINE BINSERT(%INTEGERNAME TOP,BOT,%INTEGER S1,S2,S3)
void BINSERT( int *TOP, int *BOT, int S1, int S2, int S3 )
{
__label__ _imp_endofblock;
// 10295 !***********************************************************************
// 10296 !* INSERT A CELL AT THE BOTTOM OF A LIST *
// 10297 !* UPDATING TOP AND BOTTOM POINTERS APPROPIATELY *
// 10298 !***********************************************************************
// 10299 %INTEGER I,J
int I;
int J;
// 10300 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10301 I=ASL
I = ASL;
// 10302 %IF I=0 %THEN I=MORE SPACE
if (( I ) != ( 0 )) goto L_09b2;
I = MORESPACE();
L_09b2:
// 10303 LCELL==ASLIST(I)
LCELL = (&(ASLIST[I]));
// 10304 ASL=LCELL_LINK
ASL = LCELL->LINK;
// 10305 LCELL_S1=S1; LCELL_S2=S2
LCELL->S1 = S1;
LCELL->S2 = S2;
// 10306 LCELL_S3=S3; LCELL_LINK=0
LCELL->S3 = S3;
LCELL->LINK = 0;
// 10307 J=BOT
J = BOT;
// 10308 %IF J=0 %THEN BOT=I %AND TOP=BOT %ELSE %START
if (( J ) != ( 0 )) goto L_09b3;
BOT = I;
TOP = BOT;
goto L_09b4;
L_09b3:
// 10309 ASLIST(J)_LINK=I
ASLIST[J].LINK = I;
// 10310 BOT=I
BOT = I;
// 10311 %FINISH
L_09b4:
// 10312 %END
return;
_imp_endofblock: ;
} // End of block BINSERT at level 3
// 10313 %ROUTINE INSERT AT END(%INTEGERNAME CELL, %INTEGER S1, S2, S3)
void INSERTATEND( int *CELL, int S1, int S2, int S3 )
{
__label__ _imp_endofblock;
// 10314 !***********************************************************************
// 10315 !* ADD A CELL TO THE BOTTOM OF THE LIST HEADED BY 'CELL' *
// 10316 !***********************************************************************
// 10317 %INTEGER I,J,N
int I;
int J;
int N;
// 10318 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10319 I=CELL; J=I
I = CELL;
J = I;
// 10320 %WHILE I#0 %CYCLE
L_09b5:
if (( I ) == ( 0 )) goto L_09b6;
// 10321 J=I
J = I;
// 10322 I=ASLIST(J)_LINK
I = ASLIST[J].LINK;
// 10323 %REPEAT
goto L_09b5;
L_09b6:
// 10324 N=ASL
N = ASL;
// 10325 %IF N=0 %THEN N=MORE SPACE
if (( N ) != ( 0 )) goto L_09b8;
N = MORESPACE();
L_09b8:
// 10326 LCELL==ASLIST(N)
LCELL = (&(ASLIST[N]));
// 10327 ASL=LCELL_LINK
ASL = LCELL->LINK;
// 10328 %IF J=0 %THEN CELL=N %ELSE ASLIST(J)_LINK=N
if (( J ) != ( 0 )) goto L_09b9;
CELL = N;
goto L_09ba;
L_09b9:
ASLIST[J].LINK = N;
L_09ba:
// 10329 LCELL_S1=S1
LCELL->S1 = S1;
// 10330 LCELL_S2=S2
LCELL->S2 = S2;
// 10331 LCELL_S3=S3
LCELL->S3 = S3;
// 10332 LCELL_LINK=0
LCELL->LINK = 0;
// 10333 %END
return;
_imp_endofblock: ;
} // End of block INSERTATEND at level 3
// 10334 %ROUTINE REPLACE123(%INTEGER CELL,S1,S2,S3)
void REPLACE123( int CELL, int S1, int S2, int S3 )
{
__label__ _imp_endofblock;
// 10335 ASLIST(CELL)_S1=S1
ASLIST[CELL].S1 = S1;
// 10336 ASLIST(CELL)_S2=S2
ASLIST[CELL].S2 = S2;
// 10337 ASLIST(CELL)_S3=S3
ASLIST[CELL].S3 = S3;
// 10338 %END
return;
_imp_endofblock: ;
} // End of block REPLACE123 at level 3
// 10339 %ROUTINE MLINK(%INTEGERNAME CELL)
void MLINK( int *CELL )
{
__label__ _imp_endofblock;
// 10340 CELL=ASLIST(CELL)_LINK
CELL = ASLIST[CELL].LINK;
// 10341 %END
return;
_imp_endofblock: ;
} // End of block MLINK at level 3
// 10342 %INTEGERFN FIND(%INTEGER LAB, LIST)
int FIND( int LAB, int LIST )
{
__label__ _imp_endofblock;
// 10343 !***********************************************************************
// 10344 !* THIS FUNCTION SEARCHES LIST 'LIST' FOR LAB IN STREAM2 AND *
// 10345 !* RETURNS THE CORRESPONDING CELL NO.IT USED FOR MORE THAN *
// 10346 !* SCANNING LABEL LISTS. *
// 10347 !***********************************************************************
// 10348 %WHILE LIST#0 %CYCLE
L_09bb:
if (( LIST ) == ( 0 )) goto L_09bc;
// 10349 %RESULT=LIST %IF LAB=ASLIST(LIST)_S2
if (( LAB ) != ( ASLIST[LIST].S2 )) goto L_09be;
return LIST;
L_09be:
// 10350 LIST=ASLIST(LIST)_LINK
LIST = ASLIST[LIST].LINK;
// 10351 %REPEAT
goto L_09bb;
L_09bc:
// 10352 %RESULT=-1
return (-(1));
// 10353 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FIND at level 3
// 10354 %ROUTINE FROM123(%INTEGER CELL, %INTEGERNAME S1, S2, S3)
void FROM123( int CELL, int *S1, int *S2, int *S3 )
{
__label__ _imp_endofblock;
// 10355 !***********************************************************************
// 10356 !* ALL THE FROMS RETURN INFO FROM CELLS OF A LIST WITHOUT *
// 10357 !* AFFECTING THE LIST IN ANY WAY. *
// 10358 !***********************************************************************
// 10359 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10360 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 10361 S1=LCELL_S1
S1 = LCELL->S1;
// 10362 S2=LCELL_S2
S2 = LCELL->S2;
// 10363 S3=LCELL_S3
S3 = LCELL->S3;
// 10364 %END
return;
_imp_endofblock: ;
} // End of block FROM123 at level 3
// 10365 %ROUTINE FROM12(%INTEGER CELL, %INTEGERNAME S1, S2)
void FROM12( int CELL, int *S1, int *S2 )
{
__label__ _imp_endofblock;
// 10366 %RECORD(LISTF)%NAME LCELL{(LISTF)
LISTF *LCELL;
// 10367 LCELL==ASLIST(CELL)
LCELL = (&(ASLIST[CELL]));
// 10368 S1=LCELL_S1
S1 = LCELL->S1;
// 10369 S2=LCELL_S2
S2 = LCELL->S2;
// 10370 %END
return;
_imp_endofblock: ;
} // End of block FROM12 at level 3
// 10371 %INTEGERFN FROM1(%INTEGER CELL)
int FROM1( int CELL )
{
__label__ _imp_endofblock;
// 10372 %RESULT =ASLIST(CELL)_S1
return ASLIST[CELL].S1;
// 10373 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FROM1 at level 3
// 10374 %INTEGERFN FROM2(%INTEGER CELL)
int FROM2( int CELL )
{
__label__ _imp_endofblock;
// 10375 %RESULT =ASLIST(CELL)_S2
return ASLIST[CELL].S2;
// 10376 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FROM2 at level 3
// 10377 %INTEGERFN FROM3(%INTEGER CELL)
int FROM3( int CELL )
{
__label__ _imp_endofblock;
// 10378 %RESULT =ASLIST(CELL)_S3
return ASLIST[CELL].S3;
// 10379 %END
if (_imp_current_line == 0 || _imp_current_file == NULL || *_imp_current_file == '\0') {
fprintf(stderr, "%%RESULT missing in %s in file %s:%d\n", __PRETTY_FUNCTION__, __FILE__, __LINE__);
/*_imp_signal(?, ?, __LINE__);*/
} else {
fprintf(stderr, "%%RESULT missing in %s at line %s:%d\n", __PRETTY_FUNCTION__, _imp_current_file, _imp_current_line);
/*_imp_signal(?, ?, _imp_current_line);*/
}
exit(1);
_imp_endofblock: ;
} // End of block FROM3 at level 3
// 10380 %ROUTINE CLEAR LIST(%INTEGERNAME OPHEAD)
void CLEARLIST( int *OPHEAD )
{
__label__ _imp_endofblock;
// 10381 !***********************************************************************
// 10382 !* THROW AWAY A COMPLETE LIST (MAY BE NULL!) *
// 10383 !***********************************************************************
// 10384 %INTEGER I, J
int I;
int J;
// 10385 I=OPHEAD; J=I
I = OPHEAD;
J = I;
// 10386 %WHILE I#0 %CYCLE
L_09bf:
if (( I ) == ( 0 )) goto L_09c0;
// 10387 J=I
J = I;
// 10388 I=ASLIST(J)_LINK
I = ASLIST[J].LINK;
// 10389 %REPEAT
goto L_09bf;
L_09c0:
// 10390 %IF J#0 %START
if (( J ) == ( 0 )) goto L_09c2;
// 10391 ASLIST(J)_LINK=ASL
ASLIST[J].LINK = ASL;
// 10392 ASL=OPHEAD; OPHEAD=0
ASL = OPHEAD;
OPHEAD = 0;
// 10393 %FINISH
L_09c2:
// 10394 %END
return;
_imp_endofblock: ;
} // End of block CLEARLIST at level 3
// 10395 !%ROUTINE CONCAT(%INTEGERNAME LIST1, LIST2)
// 10396 !!***********************************************************************
// 10397 !!* ADDS LIST2 TO BOTTOM OF LIST1 *
// 10398 !!***********************************************************************
// 10399 !%INTEGER I,J
// 10400 ! I=LIST1
// 10401 ! J=I
// 10402 ! %WHILE I#0 %THEN J=I %AND I=ASLIST(J)_LINK
// 10403 ! %IF J=0 %THEN LIST1=LIST2 %ELSE ASLIST(J)_LINK=LIST2
// 10404 ! LIST2=0
// 10405 !%END; ! AN ERROR PUTS CELL TWICE ONTO
// 10406 ! FREE LIST - CATASTROPHIC!
// 10407 %end
goto _imp_endofblock;
_imp_endofblock: ;
} // End of block _BLOCK_1_LEVEL_1_ at level 2
// 10408 %ENDOFPROGRAM
return 0;
_imp_endofblock: ;
} // End of block _imp_main at level 1
// End of file