#line 1
#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %const %integer USE MC = 0,
// 2+ INCLUDE DELSTART = 0
// 3
// 4 %BEGIN
#line 4 "test-new/imp918s.imp"
int main(int argc, char **argv) { /*%begin*/
#line 4 "test-new/imp918s.imp"
_imp_initialise(argc, argv);
// 5 {%TRUSTEDPROGRAM}
// 6 %INTEGER I,J,K
#line 6 "test-new/imp918s.imp"
int I;
#line 6 "test-new/imp918s.imp"
int J;
#line 6 "test-new/imp918s.imp"
int K;
// 7 !%if INCLUDE DELSTART = 1 %start
// 8 %CONSTBYTEINTEGERARRAY OPC(0:120)=0,
#line 8 "test-new/imp918s.imp"
const unsigned char OPC[121] = {
0, 8, 9, 16, 17, 18, 19, 32, 33, 34, 35, 48, 49, 50, 51, 36, 52, 0, 69, 70, 71,
84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 104, 105, 106, 107, 108, 109, 110, 111, 120,
121, 122, 123, 124, 125, 126, 127, 0, 112, 96, 80, 78, 79, 76, 75, 74, 73, 72, 68, 67, 66,
65, 64, 0, 144, 152, 134, 135, 0, 145, 146, 148, 149, 150, 151, 156, 158, 157, 159, 130, 132, 133,
0, 136, 137, 138, 139, 140, 141, 142, 143, 0, 208, 209, 210, 212, 213, 214, 215, 216, 220, 221, 222,
223, 211, 0, 241, 242, 243, 248, 249, 250, 251, 252, 253, 0, 10, 4, 128};
// 9+ 8,9,X'10',X'11',X'12',
// 10+ X'13',X'20',X'21',X'22',X'23',
// 11+ X'30',X'31',X'32',X'33',X'24',
// 12+ X'34',0,X'45',X'46',X'47',
// 13+ X'54',X'55',X'56',X'57',X'58',X'59',X'5A',X'5B',X'5C',
// 14+ X'5D',X'5E',X'5F',X'68',X'69',X'6A',
// 15+ X'6B',X'6C',X'6D',X'6E',X'6F',
// 16+ X'78',X'79',X'7A',X'7B',X'7C',
// 17+ X'7D',X'7E',X'7F',0,X'70',
// 18+ X'60',X'50',X'4E',X'4F',X'4C',
// 19+ X'4B',X'4A',X'49',X'48',X'44',
// 20+ X'43',X'42',X'41',X'40',0,
// 21+ X'90',X'98',X'86',X'87',0,
// 22+ X'91',X'92',X'94',X'95',X'96',
// 23+ X'97',X'9C',X'9E',X'9D',X'9F',
// 24+ X'82',X'84',X'85',0,X'88',
// 25+ X'89',X'8A',X'8B',X'8C',X'8D',
// 26+ X'8E',X'8F',0,X'D0',X'D1',
// 27+ X'D2',X'D4',X'D5',X'D6',X'D7',
// 28+ X'D8',X'DC',X'DD',X'DE',X'DF',
// 29+ X'D3',0,X'F1',X'F2',X'F3',
// 30+ X'F8',X'F9',X'FA',X'FB',X'FC',
// 31+ X'FD',0,10,4,X'80';
// 32 %CONSTINTEGERARRAY NEM(0:120)=M'CNOP',
#line 32 "test-new/imp918s.imp"
const int NEM[121] = {1129205584, 5460811, 4805451, 19536, 19534, 19540, 19523, 5001284, 5000772,
5002308, 4997956, 5001285, 5000773, 5002309, 4997957, 18500, 18501, 0,
4342092, 4342612, 16963, 78, 17228, 79, 88, 76, 67,
65, 83, 77, 68, 16716, 21324, 19524, 17220, 16708,
21316, 19780, 17476, 16727, 21335, 19525, 17221, 16709, 21317,
19781, 17477, 16725, 21333, 0, 5461061, 5461060, 21332, 4412996,
4412994, 19784, 21320, 16712, 17224, 19528, 17752, 18755, 5461059,
19521, 5461064, 0, 5461069, 19533, 4347976, 1113082949, 0, 21581,
5068361, 20041, 4410441, 20297, 22601, 5456982, 4736086, 5522518, 4410179,
20547, 5722692, 5391428, 0, 5460556, 5459020, 5460545, 5459009, 1397900364,
1397507148, 1397900353, 1397507137, 0, 5460816, 5068366, 5068355, 20035, 4410435,
20291, 22595, 5002064, 21586, 5526100, 17732, 1162104139, 5068378, 0,
5068367, 1346454347, 1431195723, 5914960, 17232, 16720, 21328, 19792, 17488,
0, 5461571, 5460045, 4801612};
// 33+ M'SSK',M'ISK',M'LP',M'LN',M'LT',
// 34+ M'LC',M'LPD',M'LND',M'LTD',M'LCD',
// 35+ M'LPE',M'LNE',M'LTE',M'LCE',M'HD',
// 36+ M'HE',0,M'BAL',M'BCT',M'BC',
// 37+ 'N',M'CL','O','X','L','C','A','S','M','D',
// 38+ M'AL',M'SL',M'LD',M'CD',M'AD',
// 39+ M'SD',M'MD',M'DD',M'AW',M'SW',
// 40+ M'LE',M'CE',M'AE',M'SE',M'ME',
// 41+ M'DE',M'AU',M'SU',0,M'STE',
// 42+ M'STD',M'ST',M'CVD',M'CVB',M'MH',
// 43+ M'SH',M'AH',M'CH',M'LH',M'EX',
// 44+ M'IC',M'STC',M'LA',M'STH',0,
// 45+ M'STM',M'LM',M'BXH',M'BXLE',0,
// 46+ M'TM',M'MVI',M'NI',M'CLI',M'OI',
// 47+ M'XI',M'SDV',M'HDV',M'TDV',M'CKC',
// 48+ M'PC',M'WRD',M'RDD',0,M'SRL',
// 49+ M'SLL',M'SRA',M'SLA',M'SRDL',M'SLDL',
// 50+ M'SRDA',M'SLDA',0,M'SSP',M'MVN',
// 51+ M'MVC',M'NC',M'CLC',M'OC',M'XC',
// 52+ M'LSP',M'TR',M'TRT',M'ED',M'EDMK',
// 53+ M'MVZ',0,M'MVO',M'PACK',M'UNPK',
// 54+ M'ZAP',M'CP',M'AP',M'SP',M'MP',
// 55+ M'DP',0,M'SVC',M'SPM',M'IDL';
// 56 %CONSTBYTEINTEGERARRAY HASHALT(0:218)=20(33),6,
#line 56 "test-new/imp918s.imp"
const unsigned char HASHALT[219] = {[0 ... 32] = 20,
6,
[34 ... 44] = 20,
1,
[46 ... 47] = 20,
[48 ... 57] = 4,
[58 ... 64] = 20,
[65 ... 90] = 1,
[91 ... 192] = 20,
20,
7,
2,
9,
1,
13,
20,
20,
5,
20,
20,
7,
1,
20,
17,
[208 ... 211] = 1,
20,
5,
20,
6,
[216 ... 218] = 20};
// 57+ 20(11),1,20(2),4(10),20(7),1(26),20(102),
// 58+ 20,7,2,9,1,13,20,20,5,20,20,7,1,20,17,1(4),20,5,20,6,20(3);
// 59 !%finish
// 60 %OWNINTEGERARRAY FIXED GLA(0:28)=0,
#line 60 "test-new/imp918s.imp"
static int FIXEDGLA[29] = {
0, 805306368, [2 ... 3] = 0, -1, 0, 255, [7 ... 11] = 0, 1091567616, 0, -2147483648,
16777215, [16 ... 17] = 0, 1308622848, 0, -4, -8, [22 ... 25] = 0, -2147483648, 105456464, 1163021633};
// 61+ X'30000000',0(2),-1,0,255,0(5),
// 62+ X'41100000',0,X'80000000',X'FFFFFF',0(2),
// 63+ X'4E000000',0,-4,-8,0(4),X'80000000',X'6492350',M'ERMA';
// 64 %CONSTSHORTINTEGERARRAY TSNAME (0:53)=10000(8),
#line 64 "test-new/imp918s.imp"
const short int TSNAME[54] = {[0 ... 7] = 10000,
10001,
[9 ... 13] = 10000,
10001,
10032,
[16 ... 17] = 10001,
10032,
[19 ... 20] = 10000,
2,
1,
32,
[24 ... 30] = 10032,
10000,
11,
21,
[34 ... 35] = 10032,
11,
10000,
1,
32,
[40 ... 41] = 10000,
5,
10000,
10005,
11,
5,
10005,
3,
0,
10000,
1,
2,
10001};
// 65+ 10001,10000(5),10001,10032,10001(2),10032,
// 66+ 10000(2),2,1,32,10032(7),10000,11,21,10032(2),11,10000,
// 67+ 1,32,10000(2),5,10000,10005,11,5,10005,3,0,10000,1,2,
// 68+ 10001;
// 69 %CONSTBYTEINTEGERARRAY BYTES(0:7)=4,1,2,8,4,1,2,8;
#line 69 "test-new/imp918s.imp"
const unsigned char BYTES[8] = {4, 1, 2, 8, 4, 1, 2, 8};
// 70 %CONSTBYTEINTEGERARRAY GRMAP(0:14)=0,1,2,3,15,16,18,20,22,
#line 70 "test-new/imp918s.imp"
const unsigned char GRMAP[15] = {0, 1, 2, 3, 15, 16, 18, 20, 22, 4, 5, 6, 7, 8, 14};
// 71+ 4,5,6,7,8,14;
// 72 %CONSTBYTEINTEGERARRAY PRECEDENCE (1:12)=0,3,3,3,3,4,4,4,4,5,5,5;
#line 72 "test-new/imp918s.imp"
const unsigned char PRECEDENCE[12] = {0, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5};
// 73 %OWNBYTEINTEGERARRAY TRTABS (0:1283)=128(39),
#line 73 "test-new/imp918s.imp"
static unsigned char TRTABS[1284] = {[0 ... 38] = 128,
1,
[40 ... 47] = 255,
[48 ... 57] = 0,
[58 ... 64] = 255,
[65 ... 90] = 0,
[91 ... 96] = 255,
[97 ... 122] = 255,
[123 ... 255] = 255,
[256 ... 289] = 28,
8,
28,
8,
[293 ... 294] = 28,
12,
[296 ... 301] = 28,
4,
28,
[304 ... 313] = 0,
[314 ... 321] = 28,
24,
[323 ... 330] = 28,
32,
28,
20,
[334 ... 337] = 28,
36,
[339 ... 343] = 28,
16,
[345 ... 511] = 28,
[512 ... 520] = 0,
1,
[522 ... 570] = 0,
2,
[572 ... 767] = 0,
[768 ... 777] = 0,
12,
[779 ... 799] = 0,
8,
[801 ... 804] = 20,
16,
20,
4,
[808 ... 832] = 20,
[833 ... 858] = 24,
[859 ... 890] = 20,
0,
20,
0,
28,
0,
0,
[897 ... 906] = 0,
12,
[908 ... 928] = 0,
0,
[930 ... 933] = 20,
16,
20,
4,
[937 ... 961] = 20,
[962 ... 987] = 24,
[988 ... 1019] = 20,
0,
20,
0,
28,
0,
0,
[1026 ... 1035] = 128,
12,
[1037 ... 1057] = 128,
8,
[1059 ... 1062] = 20,
16,
20,
4,
[1066 ... 1090] = 20,
[1091 ... 1116] = 0,
[1117 ... 1148] = 20,
20,
20,
20,
28,
[1153 ... 1154] = 128,
[1155 ... 1186] = 128,
8,
0,
4,
0,
0,
16,
0,
4,
[1195 ... 1219] = 0,
[1220 ... 1245] = 0,
[1246 ... 1277] = 0,
0,
0,
0,
28,
128,
128};
// 74+ 1,255(8),0(10),255(7),0(26),255(6),255(26),255(133),
// 75+ 28(34),8,28,8,28(2),12,28(6),4,28,0(10),
// 76+ 28(8),24,28(8),32,28,20,28(4),36,28(5),16,28(167),
// 77+ 0(9),1,0(49),2,0(196),
// 78+ 0(10),12,0(21),8,20(4),16,20,4,
// 79+ 20(25),24(26),20(32),0,20,0,28,0,0,
// 80+ 0(10),12,0(21),0,20(4),16,20,4 ,
// 81+ 20(25),24(26),20(32),0,20,0,28,0,0,
// 82+ 128(10),12,128(21),8,20(4),16,20,4,
// 83+ 20(25),0(26),20(32),20,20,20,28,128(2),
// 84+ 128(32),8,0,4,0,0,16,0,4,
// 85+ 0(25),0(26),0(32),0,0,0,28,128,128
// 86 %COMMENT TABLE 1 FOR NAMES --2 FOR CONSTS -- 3 FOR TEXT
// 87 %COMMENT LAST 129 =TABLE FOR READ LINE KEY AS FOLLOWS.
// 88 %COMMENT 0=ILLEGAL,4='''',8=SP,12=NL,16=%,20=NONALPHA,24=ALPHA
// 89 %OWNBYTEINTEGERARRAY TYPEFLAG(1:6)=1,2,
#line 89 "test-new/imp918s.imp"
static unsigned char TYPEFLAG[6] = {1, 2, 9, 17, 26, 5};
// 90+ B'1001',B'10001',B'11010',5;
// 91 %OWNSHORTINTEGERARRAY WARNINGS(0:30)
#line 91 "test-new/imp918s.imp"
static short int WARNINGS[31];
// 92 %OWNINTEGER MASK1=X'0F0F0F0F'
#line 92 "test-new/imp918s.imp"
static int MASK1 = 252645135;
// 93 %OWNINTEGER MASK2=X'0F0F0F0F'
#line 93 "test-new/imp918s.imp"
static int MASK2 = 252645135;
// 94 %OWNINTEGER PI1=X'413243F6', PI2=X'A8885A31'
#line 94 "test-new/imp918s.imp"
static int PI1 = 1093813238;
#line 94 "test-new/imp918s.imp"
static int PI2 = -1467459023;
// 95 %CONSTINTEGER RELEASE=9,VERSION=18
// 96 %CONSTSHORTINTEGER MAXLEVELS=11
// 97 %CONSTSHORTINTEGER PTBASE=256
// 98 %CONSTSHORTINTEGER SNPT=10006; ! SPECIALNAME PTYPE
// 99 %CONSTINTEGER CODER=12
// 100 %CONSTINTEGER WSPR =11
// 101 %CONSTINTEGER GLA =13
// 102 %OWNINTEGER HH1=X'0047002F',HH2=X'00610035'
#line 102 "test-new/imp918s.imp"
static int HH1 = 4653103;
#line 102 "test-new/imp918s.imp"
static int HH2 = 6357045;
// 103 !
// 104 ! THE FOLLOWING FUNNY WORDS ARE CYCLE CONTROL WORDS FOR SEARCHING THE
// 105 ! LIST OF FREE REGISTERS. THE TOP HALF IS INC(SIGNED) AND THE BOTTOM
// 106 ! TWO BYTES ARE START AND FINISH RESPECTIVELY
// 107 !
// 108 %CONSTINTEGER GR0 =X'10F1E'; ! 15,1,14
// 109 %CONSTINTEGER GR1 =X'1010F'; ! 1,1,15
// 110 %CONSTINTEGER FR0 =X'FFFE1610';! 6,-2,0
// 111 %CONSTINTEGER ADDREG=X'FFFF0E01';! 14,-1,1
// 112 %CONSTINTEGER SAFE =X'FFFF0E04';! 14,-1,4
// 113 %CONSTINTEGER CLMABL=X'1050E'; ! 5,1,14
// 114 %SHORTINTEGER CCSIZE,ARSIZE,DSIZE,DUMMY FORMAT
#line 114 "test-new/imp918s.imp"
short int CCSIZE;
#line 114 "test-new/imp918s.imp"
short int ARSIZE;
#line 114 "test-new/imp918s.imp"
short int DSIZE;
#line 114 "test-new/imp918s.imp"
short int DUMMYFORMAT;
// 115 %INTEGER ASL,NNAMES,FLAG,GLAFLAG
#line 115 "test-new/imp918s.imp"
int ASL;
#line 115 "test-new/imp918s.imp"
int NNAMES;
#line 115 "test-new/imp918s.imp"
int FLAG;
#line 115 "test-new/imp918s.imp"
int GLAFLAG;
// 116 %INTEGER CABUF,PPCURR,LCA,OLDLINE,LINE,LENGTH,LENGTHP, %C
#line 116 "test-new/imp918s.imp"
int CABUF;
#line 116 "test-new/imp918s.imp"
int PPCURR;
#line 116 "test-new/imp918s.imp"
int LCA;
#line 116 "test-new/imp918s.imp"
int OLDLINE;
#line 116 "test-new/imp918s.imp"
int LINE;
#line 116 "test-new/imp918s.imp"
int LENGTH;
#line 116 "test-new/imp918s.imp"
int LENGTHP;
#line 116 "test-new/imp918s.imp"
int N0;
#line 116 "test-new/imp918s.imp"
int NUM;
#line 116 "test-new/imp918s.imp"
int SNUM;
#line 116 "test-new/imp918s.imp"
int RLEVEL;
#line 116 "test-new/imp918s.imp"
int NMAX;
#line 116 "test-new/imp918s.imp"
int LOPCODE;
#line 116 "test-new/imp918s.imp"
int CONSTPTR;
#line 116 "test-new/imp918s.imp"
int PLABEL;
#line 116 "test-new/imp918s.imp"
int LEVEL;
#line 116 "test-new/imp918s.imp"
int CA;
#line 116 "test-new/imp918s.imp"
int MARKER1;
#line 116 "test-new/imp918s.imp"
int MARKER2;
#line 116 "test-new/imp918s.imp"
int LABSET;
#line 116 "test-new/imp918s.imp"
int CCSTATE;
#line 116 "test-new/imp918s.imp"
int CYCLENUM;
#line 116 "test-new/imp918s.imp"
int CSAVED;
#line 116 "test-new/imp918s.imp"
int CURCYCVAR;
#line 116 "test-new/imp918s.imp"
int CYCREGS;
#line 116 "test-new/imp918s.imp"
int CYCBITS;
#line 116 "test-new/imp918s.imp"
int CYCASS;
// 117+ N0,NUM,SNUM,RLEVEL,NMAX,LOPCODE,CONSTPTR, %C
// 118+ PLABEL,LEVEL,CA,MARKER1,MARKER2,LABSET,CCSTATE, %C
// 119+ CYCLE NUM,CSAVED,CUR CYC VAR,CYC REGS,CYC BITS,CYC ASS
// 120 !
// 121 %BYTEINTEGER FFLAG,CHECKS,SBFLAG,LAST INST,FAULTY,MONE, %C
#line 121 "test-new/imp918s.imp"
unsigned char FFLAG;
#line 121 "test-new/imp918s.imp"
unsigned char CHECKS;
#line 121 "test-new/imp918s.imp"
unsigned char SBFLAG;
#line 121 "test-new/imp918s.imp"
unsigned char LASTINST;
#line 121 "test-new/imp918s.imp"
unsigned char FAULTY;
#line 121 "test-new/imp918s.imp"
unsigned char MONE;
#line 121 "test-new/imp918s.imp"
unsigned char HIT;
#line 121 "test-new/imp918s.imp"
unsigned char LET;
#line 121 "test-new/imp918s.imp"
unsigned char DIAGS2;
#line 121 "test-new/imp918s.imp"
unsigned char LIST;
#line 121 "test-new/imp918s.imp"
unsigned char ALLLONG;
#line 121 "test-new/imp918s.imp"
unsigned char INHCODE;
#line 121 "test-new/imp918s.imp"
unsigned char LINENOS;
#line 121 "test-new/imp918s.imp"
unsigned char DIAGS1;
#line 121 "test-new/imp918s.imp"
unsigned char IMPS;
#line 121 "test-new/imp918s.imp"
unsigned char CHECKSP;
#line 121 "test-new/imp918s.imp"
unsigned char CTYPE;
#line 121 "test-new/imp918s.imp"
unsigned char DCOMP;
#line 121 "test-new/imp918s.imp"
unsigned char COMPILER;
#line 121 "test-new/imp918s.imp"
unsigned char CPRMODE;
#line 121 "test-new/imp918s.imp"
unsigned char UNASS;
#line 121 "test-new/imp918s.imp"
unsigned char PRINTMAP;
#line 121 "test-new/imp918s.imp"
unsigned char BFFLAG;
#line 121 "test-new/imp918s.imp"
unsigned char NMDECS;
// 122+ HIT,LET,DIAGS2,LIST,ALLLONG,INHCODE,LINENOS, %C
// 123+ DIAGS1,IMPS,CHECKSP,CTYPE,DCOMP,COMPILER,CPRMODE, %C
// 124+ UNASS,PRINTMAP,BFFLAG,NMDECS
// 125 !
// 126 %LONGREAL CVALUE,IMAX
#line 126 "test-new/imp918s.imp"
double CVALUE;
#line 126 "test-new/imp918s.imp"
double IMAX;
// 127 %INTEGER MASK,RBASE,SFLABEL,NEXT,N,MAX ULAB,GSAVED,CODEBASE, %C
#line 127 "test-new/imp918s.imp"
int MASK;
#line 127 "test-new/imp918s.imp"
int RBASE;
#line 127 "test-new/imp918s.imp"
int SFLABEL;
#line 127 "test-new/imp918s.imp"
int NEXT;
#line 127 "test-new/imp918s.imp"
int N;
#line 127 "test-new/imp918s.imp"
int MAXULAB;
#line 127 "test-new/imp918s.imp"
int GSAVED;
#line 127 "test-new/imp918s.imp"
int CODEBASE;
#line 127 "test-new/imp918s.imp"
int P;
#line 127 "test-new/imp918s.imp"
int Q;
#line 127 "test-new/imp918s.imp"
int R;
#line 127 "test-new/imp918s.imp"
int S;
#line 127 "test-new/imp918s.imp"
int TTOPUT;
#line 127 "test-new/imp918s.imp"
int U;
#line 127 "test-new/imp918s.imp"
int V;
#line 127 "test-new/imp918s.imp"
int NEST;
#line 127 "test-new/imp918s.imp"
int FNAME;
#line 127 "test-new/imp918s.imp"
int NOTUSED;
#line 127 "test-new/imp918s.imp"
int FILEPTR;
#line 127 "test-new/imp918s.imp"
int FILEEND;
#line 127 "test-new/imp918s.imp"
int SSTL;
#line 127 "test-new/imp918s.imp"
int QMAX;
#line 127 "test-new/imp918s.imp"
int STMTS;
#line 127 "test-new/imp918s.imp"
int MAINEP1;
#line 127 "test-new/imp918s.imp"
int MAINEP2;
#line 127 "test-new/imp918s.imp"
int MAINEP3;
#line 127 "test-new/imp918s.imp"
int GLACA;
#line 127 "test-new/imp918s.imp"
int GLACURR;
#line 127 "test-new/imp918s.imp"
int GLACABUF;
#line 127 "test-new/imp918s.imp"
int CYCBASE;
#line 127 "test-new/imp918s.imp"
int CYCADDR;
// 128+ P,Q,R,S,TTOPUT,U,V,NEST,FNAME,NOT USED,FILEPTR, %C
// 129+ FILE END,SSTL,QMAX,STMTS,MAINEP1,MAINEP2,MAINEP3, %C
// 130+ GLACA,GLACURR,GLACABUF,CYC BASE,CYC ADDR
// 131 !
// 132 %SHORTINTEGER RELHEAD,EPLINK,LEVELINF,DVHEAD,GLAHOLES, %C
#line 132 "test-new/imp918s.imp"
short int RELHEAD;
#line 132 "test-new/imp918s.imp"
short int EPLINK;
#line 132 "test-new/imp918s.imp"
short int LEVELINF;
#line 132 "test-new/imp918s.imp"
short int DVHEAD;
#line 132 "test-new/imp918s.imp"
short int GLAHOLES;
#line 132 "test-new/imp918s.imp"
short int CONSTL2;
#line 132 "test-new/imp918s.imp"
short int CONSTL4;
#line 132 "test-new/imp918s.imp"
short int CONSTL6;
#line 132 "test-new/imp918s.imp"
short int CONSTL8;
#line 132 "test-new/imp918s.imp"
short int RNEXT;
// 133+ CONSTL2,CONSTL4,CONSTL6,CONSTL8,RNEXT
// 134 !
// 135 ! THIS IS THE LIMIT OF INITIALISATION OF SCALARS TO ZERO
// 136 !
// 137 %INTEGER QUICK,MARGIN,IOCP1,IOCP2,IOCP3,XLABEL,IMPMON1, %C
#line 137 "test-new/imp918s.imp"
int QUICK;
#line 137 "test-new/imp918s.imp"
int MARGIN;
#line 137 "test-new/imp918s.imp"
int IOCP1;
#line 137 "test-new/imp918s.imp"
int IOCP2;
#line 137 "test-new/imp918s.imp"
int IOCP3;
#line 137 "test-new/imp918s.imp"
int XLABEL;
#line 137 "test-new/imp918s.imp"
int IMPMON1;
#line 137 "test-new/imp918s.imp"
int IMPMON2;
#line 137 "test-new/imp918s.imp"
int IMPMON3;
#line 137 "test-new/imp918s.imp"
int STMTSHELD;
#line 137 "test-new/imp918s.imp"
int STOPSTM;
#line 137 "test-new/imp918s.imp"
int TOPPTR;
#line 137 "test-new/imp918s.imp"
int PREV3CL;
#line 137 "test-new/imp918s.imp"
int FILEADDR;
// 138+ IMPMON2,IMPMON3,STMTSHELD,STOPSTM,TOPPTR,PREV3CL,FILEADDR
// 139 %SHORTINTEGERARRAY STPTRS (1:15)
#line 139 "test-new/imp918s.imp"
short int STPTRS[15];
#line 139 "test-new/imp918s.imp"
auto void FETCHAR(void);
#line 139 "test-new/imp918s.imp"
auto void STOREAR(int *SUCCESS);
// 140 %ROUTINESPEC FETCH AR
// 141 %ROUTINESPEC STORE AR(%INTEGERNAME I)
// 142 %INTEGERARRAY REGISTER,GRUSE,GRINF,GRAT(0:22)
#line 142 "test-new/imp918s.imp"
int REGISTER[23];
#line 142 "test-new/imp918s.imp"
int GRUSE[23];
#line 142 "test-new/imp918s.imp"
int GRINF[23];
#line 142 "test-new/imp918s.imp"
int GRAT[23];
// 143 %SHORTINTEGERARRAY A(-7:800)
#line 143 "test-new/imp918s.imp"
short int A[808];
// 144 %INTEGERARRAY SET(0:11)
#line 144 "test-new/imp918s.imp"
int SET[12];
// 145 %SHORTINTEGERARRAY CYCLE,LABEL,SBR,L,M,NAMES(0:11)
#line 145 "test-new/imp918s.imp"
short int CYCLE[12];
#line 145 "test-new/imp918s.imp"
short int LABEL[12];
#line 145 "test-new/imp918s.imp"
short int SBR[12];
#line 145 "test-new/imp918s.imp"
short int L[12];
#line 145 "test-new/imp918s.imp"
short int M[12];
#line 145 "test-new/imp918s.imp"
short int NAMES[12];
// 146 %SHORTINTEGERARRAY AVLWSP(0:7,0:MAXLEVELS)
#line 146 "test-new/imp918s.imp"
short int AVLWSP[8][12];
// 147 %INTEGERARRAY UVARREG(5:14)
#line 147 "test-new/imp918s.imp"
int UVARREG[10];
// 148 %RECORDFORMAT OPTFORM(%BYTEINTEGER COUNT,TYPE,%INTEGER BITS,%C
#line 148 "test-new/imp918s.imp"
struct OPTFORM {
union {
struct {
#line 148 "test-new/imp918s.imp"
unsigned char COUNT;
#line 148 "test-new/imp918s.imp"
unsigned char TYPE;
#line 148 "test-new/imp918s.imp"
int BITS;
#line 148 "test-new/imp918s.imp"
int PTYPE;
#line 148 "test-new/imp918s.imp"
int XTRA;
#line 148 "test-new/imp918s.imp"
};
};
};
// 149+ PTYPE,XTRA)
// 150 %RECORD(OPTFORM)%ARRAY OPTINF(0:25)
#line 150 "test-new/imp918s.imp"
struct OPTFORM OPTINF[26];
// 151 %INTEGER OPTPTR
#line 151 "test-new/imp918s.imp"
int OPTPTR;
// 152 %BYTEINTEGERARRAY GLABUF,CODE(0:268)
#line 152 "test-new/imp918s.imp"
unsigned char GLABUF[269];
#line 152 "test-new/imp918s.imp"
unsigned char CODE[269];
// 153 %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER N)
#line 153 "test-new/imp918s.imp"
extern int *COMREG(int N)
#line 153 "test-new/imp918s.imp"
;
// 154 !*INSERT
// 155 %BEGIN
#line 155 "test-new/imp918s.imp"
{ /*%begin*/
// 156 {%SHORTROUTINE}
// 157 %INTEGER FREE,TOTAL
#line 157 "test-new/imp918s.imp"
int FREE;
#line 157 "test-new/imp918s.imp"
int TOTAL;
// 158 ! BLOCK TO ALLOCATE AVAILABLE STACK SPACE TO THE MAIN ARRAYS
// 159 FILE ADDR=COMREG(46)
#line 159 "test-new/imp918s.imp"
FILEADDR = *COMREG(46);
// 160 %IF FILE ADDR#0 %THEN %START; ! ON EMAS
#line 160 "test-new/imp918s.imp"
if (FILEADDR == 0) goto L_0001;
// 161 TOTAL=INTEGER(FILEADDR); NNAMES=255
#line 161 "test-new/imp918s.imp"
TOTAL = *_imp_INTEGER(FILEADDR);
#line 161 "test-new/imp918s.imp"
NNAMES = 255;
// 162 %IF TOTAL>8000 %THEN NNAMES=511
#line 162 "test-new/imp918s.imp"
if (TOTAL <= 8000) goto L_0002;
#line 162 "test-new/imp918s.imp"
NNAMES = 511;
#line 162 "test-new/imp918s.imp"
L_0002:;
// 163 %IF TOTAL>32000 %THEN NNAMES=1023
#line 163 "test-new/imp918s.imp"
if (TOTAL <= 32000) goto L_0003;
#line 163 "test-new/imp918s.imp"
NNAMES = 1023;
#line 163 "test-new/imp918s.imp"
L_0003:;
// 164 %IF TOTAL>409600 %OR COMREG(27)&8#0 %THEN NNAMES=2047
#line 164 "test-new/imp918s.imp"
if (TOTAL > 409600) goto L_0004;
#line 164 "test-new/imp918s.imp"
if (*COMREG(27) & 8 == 0) goto L_0005;
#line 164 "test-new/imp918s.imp"
L_0004:;
#line 164 "test-new/imp918s.imp"
NNAMES = 2047;
#line 164 "test-new/imp918s.imp"
L_0005:;
// 165 DSIZE=7*NNAMES; ASL=DSIZE<<2
#line 165 "test-new/imp918s.imp"
DSIZE = 7 * NNAMES;
#line 165 "test-new/imp918s.imp"
ASL = DSIZE << 2;
// 166 CCSIZE=100+NNAMES; ->Label2
#line 166 "test-new/imp918s.imp"
CCSIZE = 100 + NNAMES;
#line 166 "test-new/imp918s.imp"
goto U_1000;
// 167 %FINISH
#line 167 "test-new/imp918s.imp"
L_0001:;
// 168 FREE=COMREG(1)-ADDR(TOTAL)-6000; ! ON IBM 370
#line 168 "test-new/imp918s.imp"
FREE = *COMREG(1) - _imp_ADDR(/*?*/ &TOTAL) - 6000;
// 169 %CYCLE I=2,1,4;
#line 169 "test-new/imp918s.imp"
// %for I = 2, 1, 4 %cycle
#line 169 "test-new/imp918s.imp"
{
int _control, _initial = 2, _increment = 1, _final = 4;
#line 169 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 2, 1, 4");
_control = I = _initial - _increment;
#line 169 "test-new/imp918s.imp"
L_0006:
#line 169 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 169 "test-new/imp918s.imp"
if (I == _final) goto L_0007;
#line 169 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 170 ; ! ALLOWS 255,511,1023 OR 2047 NAMES
#line 170 "test-new/imp918s.imp"
NNAMES = 128 * (_imp_IEXP(2, I)) - 1;
// 170 NNAMES=128*2^^I-1
// 171 DSIZE=7*NNAMES
#line 171 "test-new/imp918s.imp"
DSIZE = 7 * NNAMES;
// 172 ASL=DSIZE<<2
#line 172 "test-new/imp918s.imp"
ASL = DSIZE << 2;
// 173 CCSIZE=250+100*I
#line 173 "test-new/imp918s.imp"
CCSIZE = 250 + 100 * I;
// 174 TOTAL=CCSIZE+ASL+DSIZE<<1
#line 174 "test-new/imp918s.imp"
TOTAL = CCSIZE + ASL + (DSIZE << 1);
// 175 ->Label1 %IF TOTAL>FREE
#line 175 "test-new/imp918s.imp"
if (TOTAL <= FREE) goto L_0009;
#line 175 "test-new/imp918s.imp"
goto U_1001;
#line 175 "test-new/imp918s.imp"
L_0009:;
// 176 %REPEAT
#line 176 "test-new/imp918s.imp"
goto L_0006;
#line 176 "test-new/imp918s.imp"
}
#line 176 "test-new/imp918s.imp"
L_0007:;
// 177 ->Label2
#line 177 "test-new/imp918s.imp"
goto U_1000;
// 178 Label1: CCSIZE=CCSIZE-100
#line 178 "test-new/imp918s.imp"
U_1001:;
#line 178 "test-new/imp918s.imp"
CCSIZE = CCSIZE - 100;
// 179 NNAMES=NNAMES>>1
#line 179 "test-new/imp918s.imp"
NNAMES = (unsigned int)NNAMES >> 1;
// 180 ASL=(ASL>>1+(FREE-CCSIZE-DSIZE))//2;! HALF 'EXTRA' SPACE TO ASL
#line 180 "test-new/imp918s.imp"
ASL = ((long)(((unsigned int)ASL >> 1) + (FREE - CCSIZE - DSIZE)) / (long)2);
// 181 DSIZE=DSIZE>>1
#line 181 "test-new/imp918s.imp"
DSIZE = (unsigned int)DSIZE >> 1;
// 182 Label2: ASL=32760%IF ASL>32760
#line 182 "test-new/imp918s.imp"
U_1000:;
#line 182 "test-new/imp918s.imp"
if (ASL <= 32760) goto L_000A;
#line 182 "test-new/imp918s.imp"
ASL = 32760;
#line 182 "test-new/imp918s.imp"
L_000A:;
// 183 ASL=ASL&X'FFFFFFF0'
#line 183 "test-new/imp918s.imp"
ASL = ASL & -16;
// 184 %END
#line 184 "test-new/imp918s.imp"
goto end_1000;
#line 184 "test-new/imp918s.imp"
end_1000:;
#line 184 "test-new/imp918s.imp"
}
// 185 %BYTEINTEGERARRAY CC(0:CCSIZE+10), %C
#line 185 "test-new/imp918s.imp"
unsigned char CC[CCSIZE + 10 + 1];
#line 185 "test-new/imp918s.imp"
unsigned char ASLIST[ASL + 32 + 1];
#line 185 "test-new/imp918s.imp"
unsigned char LETT[DSIZE + 20 + 1];
// 186+ ASLIST(0:ASL+32),LETT(0:DSIZE+20)
// 187 %SHORTINTEGERARRAY WORD,TAGS(0:NNAMES)
#line 187 "test-new/imp918s.imp"
short int WORD[NNAMES + 1];
#line 187 "test-new/imp918s.imp"
short int TAGS[NNAMES + 1];
// 188 %SYSTEMROUTINESPEC IOCP(%INTEGER A,B)
#line 188 "test-new/imp918s.imp"
extern void IOCP(int A, int B);
#line 188 "test-new/imp918s.imp"
auto void CODEOUT(void);
#line 188 "test-new/imp918s.imp"
auto void CNOP(int I, int J);
#line 188 "test-new/imp918s.imp"
auto void PCONST(int WORD);
#line 188 "test-new/imp918s.imp"
auto void PSI(int OPCODE, int J, int B, int D);
#line 188 "test-new/imp918s.imp"
auto void PSS(int OPCODE, int N, int B1, int D1, int B2, int D2);
#line 188 "test-new/imp918s.imp"
auto void PRX(int OPCODE, int R1, int R2, int B, int D);
#line 188 "test-new/imp918s.imp"
auto void PLANT(int HALFWORD);
#line 188 "test-new/imp918s.imp"
auto void PRR(int OPCODE, int R1, int R2);
#line 188 "test-new/imp918s.imp"
auto void PGLA(int BDRY, int L, int INFADR);
// 189 %ROUTINESPEC CODE OUT
// 190 %ROUTINESPEC CNOP(%INTEGER I,J)
// 191 %ROUTINESPEC PCONST(%INTEGER X)
// 192 %ROUTINESPEC PSI(%INTEGER OPCODE,J,BASE,DISP)
// 193 %ROUTINESPEC PSS(%INTEGER OPCODE,N,BASE,DISP,P,Q)
// 194 %ROUTINESPEC PRX(%INTEGER OPCODE,R1,R2,BASE,DISP)
// 195 %ROUTINESPEC PLANT(%INTEGER VALUE)
// 196 %ROUTINESPEC PRR (%INTEGER OPCODE,R1,R2)
// 197 %ROUTINESPEC PGLA(%INTEGER I,J,K)
// 198 %SYSTEMROUTINESPEC LPUT(%INTEGER A,B,C,D)
#line 198 "test-new/imp918s.imp"
extern void LPUT(int A, int B, int C, int D);
#line 198 "test-new/imp918s.imp"
auto void SETPERMBASE(void);
#line 198 "test-new/imp918s.imp"
auto void PLUG(int AREA, int AT, int VALUE);
#line 198 "test-new/imp918s.imp"
auto void PRHEX(int VALUE, int PLACES);
#line 198 "test-new/imp918s.imp"
auto void RESTORE(short int HEAD);
#line 198 "test-new/imp918s.imp"
auto void GETENV(short int *HEAD);
#line 198 "test-new/imp918s.imp"
auto void INSERTAFTER(short int *CELL, int S1, int S2);
#line 198 "test-new/imp918s.imp"
auto void FROM12(int CELL, int *S1, int *S2);
#line 198 "test-new/imp918s.imp"
auto void FROM123(int CELL, int *S1, int *S2, int *S3);
#line 198 "test-new/imp918s.imp"
auto void POP(short int *CELL, int *S1, int *S2);
#line 198 "test-new/imp918s.imp"
auto void POP123(short int *CELL, int *S1, int *S2, int *S3);
#line 198 "test-new/imp918s.imp"
auto void PUSH(short int *CELL, int S1, int S2);
#line 198 "test-new/imp918s.imp"
auto void PUSH123(short int *CELL, int S1, int S2, int S3);
#line 198 "test-new/imp918s.imp"
auto int FIND(int LAB, int LIST);
#line 198 "test-new/imp918s.imp"
auto int FIND3(int S3, int LIST);
#line 198 "test-new/imp918s.imp"
auto void MLINK(int *CELL);
#line 198 "test-new/imp918s.imp"
auto void REPLACE2(int CELL, int S2);
#line 198 "test-new/imp918s.imp"
auto void REPLACE1(int CELL, int S1);
#line 198 "test-new/imp918s.imp"
auto void REPLACE123(int CELL, int S1, int S2, int S3);
#line 198 "test-new/imp918s.imp"
auto int FROM2(int CELL);
#line 198 "test-new/imp918s.imp"
auto int FROM1(int CELL);
#line 198 "test-new/imp918s.imp"
auto int FROM3(int CELL);
#line 198 "test-new/imp918s.imp"
auto void COMPARE(void);
#line 198 "test-new/imp918s.imp"
auto void PNAME(void);
#line 198 "test-new/imp918s.imp"
auto void CONST(int MODE);
#line 198 "test-new/imp918s.imp"
auto void CONSTLIST(void);
#line 198 "test-new/imp918s.imp"
auto void TEXTTEXT(void);
#line 198 "test-new/imp918s.imp"
auto void READLINE(unsigned char N, unsigned char CHAR);
#line 198 "test-new/imp918s.imp"
auto void FROMAR8(int PTR, double *VALUE);
#line 198 "test-new/imp918s.imp"
auto void FROMAR4(int PTR, int *VALUE);
#line 198 "test-new/imp918s.imp"
auto void TOAR8(int PTR, double VALUE);
#line 198 "test-new/imp918s.imp"
auto void TOAR4(int PTR, int VALUE);
#line 198 "test-new/imp918s.imp"
auto void CSS(int PIN, int CSSMODE);
#line 198 "test-new/imp918s.imp"
auto void FAULT(int N, int FNAME);
#line 198 "test-new/imp918s.imp"
auto void ABORT(void);
#line 198 "test-new/imp918s.imp"
auto void PRINTUSE(void);
#line 198 "test-new/imp918s.imp"
auto void PRINTNAME(int N);
// 199 %ROUTINESPEC SET PERMBASE
// 200 %ROUTINESPEC PLUG(%INTEGER AREA,J,K)
// 201 %ROUTINESPEC PRHEX(%INTEGER VALUE,PLACES)
// 202 %ROUTINESPEC RESTORE(%SHORTINTEGER HEAD)
// 203 %ROUTINESPEC GET ENV(%SHORTINTEGERNAME HEAD)
// 204 ! %INTEGERFNSPEC NEWCELL
// 205 %ROUTINESPEC INSERTAFTER(%SHORTINTEGERNAME STAD,%INTEGER S1,S2)
// 206 ! %ROUTINESPEC INSERTATEND(%SHORTINTEGERNAME S,%INTEGER A,B)
// 207 %ROUTINESPEC FROM12(%INTEGER CELL,%INTEGERNAME S1,S2)
// 208 %ROUTINESPEC FROM123(%INTEGER CELL,%INTEGERNAME S1,S2,S3)
// 209 %ROUTINESPEC POP(%SHORTINTEGERNAME CELL,%INTEGERNAME S1,S2)
// 210 %ROUTINESPEC POP123(%SHORTINTEGERNAME C,%INTEGERNAME P,Q,R)
// 211 %ROUTINESPEC PUSH(%SHORTINTEGERNAME CELL,%INTEGER S1,S2)
// 212 %ROUTINESPEC PUSH123(%SHORTINTEGERNAME C,%INTEGER S1,S2,S3)
// 213 %INTEGERFNSPEC FIND(%INTEGER LAB,LIST)
// 214 %INTEGERFNSPEC FIND3(%INTEGER LAB,LIST)
// 215 %ROUTINESPEC MLINK(%INTEGERNAME CELL)
// 216 %ROUTINESPEC REPLACE2(%INTEGER CELL,S2)
// 217 %ROUTINESPEC REPLACE1(%INTEGER CELL,S1)
// 218 %ROUTINESPEC REPLACE123(%INTEGER CELL,S1,S2,S3)
// 219 %INTEGERFNSPEC FROM2(%INTEGER CELL)
// 220 %INTEGERFNSPEC FROM1(%INTEGER CELL)
// 221 %INTEGERFNSPEC FROM3(%INTEGER CELL)
// 222 ! %ROUTINESPEC CHECK ASL
// 223 !%if INCLUDE DELSTART = 1 %start
// 224 %ROUTINESPEC COMPARE
// 225 %ROUTINESPEC PNAME
// 226 %ROUTINESPEC CONST(%INTEGER MODE)
// 227 %ROUTINESPEC CONSTLIST
// 228 %ROUTINESPEC TEXTTEXT
// 229 %ROUTINESPEC READ LINE(%BYTEINTEGER N,CHAR)
// 230 !%finish
// 231 %ROUTINESPEC FROMAR8(%INTEGER PTR,%LONGREALNAME VALUE)
// 232 %ROUTINESPEC FROMAR4(%INTEGER PTR,%INTEGERNAME VALUE)
// 233 %ROUTINESPEC TOAR8(%INTEGER PTR,%LONGREAL VALUE)
// 234 %ROUTINESPEC TOAR4(%INTEGER PTR,VALUE)
// 235 %ROUTINESPEC CSS(%INTEGER P,MODE)
// 236 %ROUTINESPEC FAULT(%INTEGER N,FNAME)
// 237 %ROUTINESPEC ABORT
// 238 %ROUTINESPEC PRINT USE
// 239 %ROUTINESPEC PRINTNAME (%INTEGER N)
// 240 %SYSTEM %C
// 241+ %ROUTINESPEC RECODE (%INTEGER START,FINISH,CA)
#line 241 "test-new/imp918s.imp"
extern void RECODE(int START, int FINISH, int CA);
#line 241 "test-new/imp918s.imp"
auto void MESSAGE(int N);
// 242 %ROUTINESPEC MESSAGE(%INTEGER N)
// 243 {%FAULT 1,2->OFL,9->INEND,18->SUBSCHAR}
// 244 %on %event 1,2,9{,18} %start
#line 244 "test-new/imp918s.imp"
if (!_imp_on_event(1, 2, 9)) goto L_000B;
// 245 ->OFL %if event_event = 1
#line 245 "test-new/imp918s.imp"
if (_imp_EVENT().EVENT != 1) goto L_000C;
#line 245 "test-new/imp918s.imp"
goto U_1002;
#line 245 "test-new/imp918s.imp"
L_000C:;
// 246 ->OFL %if event_event = 2
#line 246 "test-new/imp918s.imp"
if (_imp_EVENT().EVENT != 2) goto L_000D;
#line 246 "test-new/imp918s.imp"
goto U_1002;
#line 246 "test-new/imp918s.imp"
L_000D:;
// 247 ->INEND %if event_event = 9
#line 247 "test-new/imp918s.imp"
if (_imp_EVENT().EVENT != 9) goto L_000E;
#line 247 "test-new/imp918s.imp"
goto U_1003;
#line 247 "test-new/imp918s.imp"
L_000E:;
// 248 {->SUBSCHAR %if event_event = 18}
// 249 %finish
#line 249 "test-new/imp918s.imp"
L_000B:;
// 250 ! START OF COMPILATION
// 251 %BEGIN
#line 251 "test-new/imp918s.imp"
{ /*%begin*/
// 252 !***********************************************************************
// 253 !* THIS BLOCK INITIALISE THE COMPILER SCALARS AND ARRAYS *
// 254 !* WAS ORIGINALLY ROUTINE 'INITIALISE'. *
// 255 !* THE INITIALISATION OF THE CONSTANT LISTS WITH THE VALUES *
// 256 !* IN PERM MAY BE OMITTED IN BATCH OR CUT-DOWN VERSIONS. *
// 257 !***********************************************************************
// 258 {%SHORTROUTINE}
// 259 !%if INCLUDE DELSTART = 1 %start
// 260 %CONSTBYTEINTEGERARRAY ILETT(0: 410)= 11,
#line 260 "test-new/imp918s.imp"
const unsigned char ILETT[411] = {
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, 12, 83, 72, 79, 82, 84,
73, 78, 84, 69, 71, 69, 82, 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, 6, 78, 69, 88, 84, 67, 72, 255};
// 261+ 'S','E','L','E','C','T','I','N','P','U','T', 12,'S','E','L','E',
// 262+ 'C','T','O','U','T','P','U','T', 7,'N','E','W','L','I','N','E',
// 263+ 5,'S','P','A','C','E', 10,'S','K','I','P','S','Y','M','B','O',
// 264+ 'L', 10,'R','E','A','D','S','T','R','I','N','G', 8,'N','E','W',
// 265+ 'L','I','N','E','S', 6,'S','P','A','C','E','S', 10,'N','E','X',
// 266+ 'T','S','Y','M','B','O','L', 11,'P','R','I','N','T','S','Y','M',
// 267+ 'B','O','L', 10,'R','E','A','D','S','Y','M','B','O','L', 4,'R',
// 268+ 'E','A','D', 5,'W','R','I','T','E', 7,'N','E','W','P','A','G',
// 269+ 'E', 4,'A','D','D','R', 6,'A','R','C','S','I','N', 3,'I','N',
// 270+ 'T', 5,'I','N','T','P','T', 6,'F','R','A','C','P','T', 5,'P',
// 271+ 'R','I','N','T', 7,'P','R','I','N','T','F','L', 4,'R','E','A',
// 272+ 'L', 7,'I','N','T','E','G','E','R', 3,'M','O','D', 6,'A','R',
// 273+ 'C','C','O','S', 4,'S','Q','R','T', 3,'L','O','G', 3,'S','I',
// 274+ 'N', 3,'C','O','S', 3,'T','A','N', 3,'E','X','P', 11,'C','L',
// 275+ 'O','S','E','S','T','R','E','A','M', 11,'B','Y','T','E','I','N',
// 276+ 'T','E','G','E','R', 12,'S','H','O','R','T','I','N','T','E','G',
// 277+ 'E','R', 6,'R','A','D','I','U','S', 6,'A','R','C','T','A','N',
// 278+ 6,'L','E','N','G','T','H', 11,'P','R','I','N','T','S','T','R',
// 279+ 'I','N','G', 2,'N','L', 8,'L','O','N','G','R','E','A','L', 7,
// 280+ 'P','R','I','N','T','C','H', 6,'R','E','A','D','C','H', 6,'S',
// 281+ 'T','R','I','N','G', 8,'R','E','A','D','I','T','E','M', 8,'N',
// 282+ 'E','X','T','I','T','E','M', 6,'C','H','A','R','N','O', 8,'T',
// 283+ 'O','S','T','R','I','N','G', 10,'F','R','O','M','S','T','R','I',
// 284+ 'N','G', 6,'R','E','C','O','R','D', 5,'A','R','R','A','Y', 10,
// 285+ 'S','E','T','M','A','R','G','I','N','S',4,'I','M','O','D',
// 286+ 2,'P','I',6,'N','E','X','T','C','H',255;
// 287 !%finish
// 288 !%if USE MC = 1 %start
// 289 ! *XC_CABUF(108),CABUF ;!CLEAR INTEGER
// 290 ! *XC_FFLAG(24),FFLAG; !CLEAR BYTE FLAG VARIABLES
// 291 ! *XC_MASK(144),MASK; ! CLEAR WORK VARIABLES
// 292 !%finish
// 293 STMTSHELD=0; TOPPTR=500
#line 293 "test-new/imp918s.imp"
STMTSHELD = 0;
#line 293 "test-new/imp918s.imp"
TOPPTR = 500;
// 294 IMAX=(-1)>>1;PLABEL=26999
#line 294 "test-new/imp918s.imp"
IMAX = (unsigned int)-1 >> 1;
#line 294 "test-new/imp918s.imp"
PLABEL = 26999;
// 295 LABSET=3<<30;LETT(0)=0
#line 295 "test-new/imp918s.imp"
LABSET = 3 << 30;
#line 295 "test-new/imp918s.imp"
LETT[0] = 0;
// 296 N0=27; N=12; MARGIN=1024
#line 296 "test-new/imp918s.imp"
N0 = 27;
#line 296 "test-new/imp918s.imp"
N = 12;
#line 296 "test-new/imp918s.imp"
MARGIN = 1024;
// 297 MAX ULAB=NNAMES+16384; ! LARGEST VALID USER LABEL
#line 297 "test-new/imp918s.imp"
MAXULAB = NNAMES + 16384;
// 298 GLACA=N0<<2; GLACABUF=GLACA
#line 298 "test-new/imp918s.imp"
GLACA = N0 << 2;
#line 298 "test-new/imp918s.imp"
GLACABUF = GLACA;
// 299 CHECKSP=1 ; CHECKS=1
#line 299 "test-new/imp918s.imp"
CHECKSP = 1;
#line 299 "test-new/imp918s.imp"
CHECKS = 1;
// 300 LINENOS=1; DIAGS1=1; MONE=1
#line 300 "test-new/imp918s.imp"
LINENOS = 1;
#line 300 "test-new/imp918s.imp"
DIAGS1 = 1;
#line 300 "test-new/imp918s.imp"
MONE = 1;
// 301 LIST=1; SFLABEL=21999; UNASS=1
#line 301 "test-new/imp918s.imp"
LIST = 1;
#line 301 "test-new/imp918s.imp"
SFLABEL = 21999;
#line 301 "test-new/imp918s.imp"
UNASS = 1;
// 302 LET=1; XLABEL=19999; ! FOR EXIT STATEMENTS
#line 302 "test-new/imp918s.imp"
LET = 1;
#line 302 "test-new/imp918s.imp"
XLABEL = 19999;
// 303 ARSIZE=480
#line 303 "test-new/imp918s.imp"
ARSIZE = 480;
// 304 QUICK=11009
#line 304 "test-new/imp918s.imp"
QUICK = 11009;
// 305 MAINEP1=4; MAINEP2=M'S#GO'; ! DEFAULT ENTRY POINT
#line 305 "test-new/imp918s.imp"
MAINEP1 = 4;
#line 305 "test-new/imp918s.imp"
MAINEP2 = 1394820943;
// 306 IOCP1=6; IOCP2=M'S#IO'; IOCP3=M'CPXX'
#line 306 "test-new/imp918s.imp"
IOCP1 = 6;
#line 306 "test-new/imp918s.imp"
IOCP2 = 1394821455;
#line 306 "test-new/imp918s.imp"
IOCP3 = 1129338968;
// 307 IMPMON1=8; IMPMON2=M'S#IM'; IMPMON3=M'PMON'
#line 307 "test-new/imp918s.imp"
IMPMON1 = 8;
#line 307 "test-new/imp918s.imp"
IMPMON2 = 1394821453;
#line 307 "test-new/imp918s.imp"
IMPMON3 = 1347243854;
// 308 !*INSERT
// 309 %IF FILE ADDR#0 %THEN %START
#line 309 "test-new/imp918s.imp"
if (FILEADDR == 0) goto L_000F;
// 310 FILE PTR=FILE ADDR+INTEGER(FILE ADDR+4)
#line 310 "test-new/imp918s.imp"
FILEPTR = FILEADDR + *_imp_INTEGER(FILEADDR + 4);
// 311 FILE END=FILE ADDR+INTEGER(FILE ADDR)
#line 311 "test-new/imp918s.imp"
FILEEND = FILEADDR + *_imp_INTEGER(FILEADDR);
// 312 %FINISH
#line 312 "test-new/imp918s.imp"
L_000F:;
// 313 I=COMREG(27)
#line 313 "test-new/imp918s.imp"
I = *COMREG(27);
// 314 %IF I&2=2 %THEN LIST=0
#line 314 "test-new/imp918s.imp"
if (I & 2 != 2) goto L_0010;
#line 314 "test-new/imp918s.imp"
LIST = 0;
#line 314 "test-new/imp918s.imp"
L_0010:;
// 315 %IF I&4=4 %THEN LINENOS=0
#line 315 "test-new/imp918s.imp"
if (I & 4 != 4) goto L_0011;
#line 315 "test-new/imp918s.imp"
LINENOS = 0;
#line 315 "test-new/imp918s.imp"
L_0011:;
// 316 %IF I&16=16 %THEN UNASS=0
#line 316 "test-new/imp918s.imp"
if (I & 16 != 16) goto L_0012;
#line 316 "test-new/imp918s.imp"
UNASS = 0;
#line 316 "test-new/imp918s.imp"
L_0012:;
// 317 %IF I&32=32 %THEN CHECKS=0
#line 317 "test-new/imp918s.imp"
if (I & 32 != 32) goto L_0013;
#line 317 "test-new/imp918s.imp"
CHECKS = 0;
#line 317 "test-new/imp918s.imp"
L_0013:;
// 318 %IF I&(128<<8)#0 %THEN PRINTMAP=1
#line 318 "test-new/imp918s.imp"
if (I & 128 << 8 == 0) goto L_0014;
#line 318 "test-new/imp918s.imp"
PRINTMAP = 1;
#line 318 "test-new/imp918s.imp"
L_0014:;
// 319 %IF I&(32<<8)#0 %THEN LET=0
#line 319 "test-new/imp918s.imp"
if (I & 32 << 8 == 0) goto L_0015;
#line 319 "test-new/imp918s.imp"
LET = 0;
#line 319 "test-new/imp918s.imp"
L_0015:;
// 320 %IF I&64=64 %THEN DIAGS1=0
#line 320 "test-new/imp918s.imp"
if (I & 64 != 64) goto L_0016;
#line 320 "test-new/imp918s.imp"
DIAGS1 = 0;
#line 320 "test-new/imp918s.imp"
L_0016:;
// 321 DIAGS2=I>>18&1
#line 321 "test-new/imp918s.imp"
DIAGS2 = (unsigned int)I >> 18 & 1;
// 322 TTOPUT=I>>21&1
#line 322 "test-new/imp918s.imp"
TTOPUT = (unsigned int)I >> 21 & 1;
// 323 %IF I&(1<<16)#0 %THEN %START
#line 323 "test-new/imp918s.imp"
if (I & 1 << 16 == 0) goto L_0017;
// 324 CHECKS=0; CHECKSP=0
#line 324 "test-new/imp918s.imp"
CHECKS = 0;
#line 324 "test-new/imp918s.imp"
CHECKSP = 0;
// 325 LINENOS=0; UNASS=0
#line 325 "test-new/imp918s.imp"
LINENOS = 0;
#line 325 "test-new/imp918s.imp"
UNASS = 0;
// 326 %FINISH
#line 326 "test-new/imp918s.imp"
L_0017:;
// 327 GLAFLAG=CHECKSP; ! GLAFLAG SHOULD BE SET TO 0 IF
#line 327 "test-new/imp918s.imp"
GLAFLAG = CHECKSP;
// 328 ! IMPS IS COMPILED NON OPTIMISED.
// 329 WARNINGS(0)=0
#line 329 "test-new/imp918s.imp"
WARNINGS[0] = 0;
// 330 IMPS=I>>23&1; ! BIT SET IF IMPS REQUESTED
#line 330 "test-new/imp918s.imp"
IMPS = (unsigned int)I >> 23 & 1;
// 331 !
// 332 ! OPEN OBJECT FILE HERE BEFORE MORE PAGES OF COMPILER CODE
// 333 ! ARE PAGED IN AND SUB-SYSTEM PAGES MOVE OUT
// 334 !
// 335 LPUT(0,IMPS<<1+1,RELEASE,VERSION)
#line 335 "test-new/imp918s.imp"
LPUT(0, (IMPS << 1) + 1, 9, 18);
// 336 NEWLINES(3); SPACES(20)
#line 336 "test-new/imp918s.imp"
_imp_NEWLINES(3);
#line 336 "test-new/imp918s.imp"
_imp_SPACES(20);
// 337 printstring("E.R.C.C. IMP")
#line 337 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("E.R.C.C. IMP"));
// 338 %IF IMPS#0 %THEN printstring("S")
#line 338 "test-new/imp918s.imp"
if (IMPS == 0) goto L_0018;
#line 338 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("S"));
#line 338 "test-new/imp918s.imp"
L_0018:;
// 339 printstring(" COMPILER RELEASE")
#line 339 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" COMPILER RELEASE"));
// 340 WRITE(RELEASE,1)
#line 340 "test-new/imp918s.imp"
_imp_WRITE(9, 1);
// 341 printstring(" VERSION")
#line 341 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" VERSION"));
// 342 WRITE(VERSION,2)
#line 342 "test-new/imp918s.imp"
_imp_WRITE(18, 2);
// 343 NEWLINES(3)
#line 343 "test-new/imp918s.imp"
_imp_NEWLINES(3);
// 344 WRITE(NNAMES,5); WRITE(ASL,5)
#line 344 "test-new/imp918s.imp"
_imp_WRITE(NNAMES, 5);
#line 344 "test-new/imp918s.imp"
_imp_WRITE(ASL, 5);
// 345 !%if USE MC = 1 %start
// 346 ! *L_1,SET; *XC_0(48,1),0(1)
// 347 ! *L_1,CYCLE; *XC_0(24,1),0(1)
// 348 ! *L_1,NAMES; *XC_0(24,1),0(1)
// 349 ! *L_1,LABEL; *XC_0(24,1),0(1)
// 350 ! *L_1,SBR; *XC_0(24,1),0(1)
// 351 ! *L_1,AVL WSP; *XC_0(192,1),0(1)
// 352 ! *L_1,REGISTER; *XC_0(92,1),0(1)
// 353 ! *L_1,GRUSE; *XC_0(92,1),0(1)
// 354 ! *L_1,GRINF; *XC_0(92,1),0(1)
// 355 ! *L_1,GRAT; *XC_0(92,1),0(1)
// 356 !%finish
// 357 REGISTER(10)=-1; GRUSE(10)=12
#line 357 "test-new/imp918s.imp"
REGISTER[10] = -1;
#line 357 "test-new/imp918s.imp"
GRUSE[10] = 12;
// 358 REGISTER(11)=-1; REGISTER(13)=-1
#line 358 "test-new/imp918s.imp"
REGISTER[11] = -1;
#line 358 "test-new/imp918s.imp"
REGISTER[13] = -1;
// 359 !%if USE MC = 1 %start
// 360 ! *L_1,UVARREG+4; *XC_0(40,1),0(1);!NO USER DEFINED REGS
// 361 !%finish
// 362 %CYCLE I=0,16,ASL-16
#line 362 "test-new/imp918s.imp"
// %for I = 0, 16, ASL - 16 %cycle
#line 362 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 16, _final = ASL - 16;
#line 362 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 16, ASL - 16");
_control = I = _initial - _increment;
#line 362 "test-new/imp918s.imp"
L_0019:
#line 362 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 362 "test-new/imp918s.imp"
if (I == _final) goto L_001A;
#line 362 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 363 SHORT INTEGER(ADDR(ASLIST(I))+30)=I
#line 363 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[I]) + 30) = I;
// 364 %REPEAT
#line 364 "test-new/imp918s.imp"
goto L_0019;
#line 364 "test-new/imp918s.imp"
}
#line 364 "test-new/imp918s.imp"
L_001A:;
// 365 INTEGER(ADDR(ASLIST(0)))=-1
#line 365 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[0])) = -1;
// 366 INTEGER(ADDR(ASLIST(4)))=-1
#line 366 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[4])) = -1;
// 367 INTEGER(ADDR(ASLIST(8)))=-1
#line 367 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[8])) = -1;
// 368 INTEGER(ADDR(ASLIST(12)))=X'FFFF0000'
#line 368 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[12])) = -65536;
// 369 SET PERMBASE
#line 369 "test-new/imp918s.imp"
SETPERMBASE();
// 370 PCONST(X'50FB003C'); ! ST 15,60(11)
#line 370 "test-new/imp918s.imp"
PCONST(1358626876);
// 371 PCONST(X'45FC004C'); ! BAL 15,RTI1
#line 371 "test-new/imp918s.imp"
PCONST(1174143052);
// 372 %CYCLE I=0,1,NNAMES
#line 372 "test-new/imp918s.imp"
// %for I = 0, 1, NNAMES %cycle
#line 372 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = NNAMES;
#line 372 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, NNAMES");
_control = I = _initial - _increment;
#line 372 "test-new/imp918s.imp"
L_001B:
#line 372 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 372 "test-new/imp918s.imp"
if (I == _final) goto L_001C;
#line 372 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 373 WORD(I)=0; TAGS(I)=0
#line 373 "test-new/imp918s.imp"
WORD[I] = 0;
#line 373 "test-new/imp918s.imp"
TAGS[I] = 0;
// 374 %REPEAT
#line 374 "test-new/imp918s.imp"
goto L_001B;
#line 374 "test-new/imp918s.imp"
}
#line 374 "test-new/imp918s.imp"
L_001C:;
// 375 !
// 376 ! NOW DECLARE THE SPECIAL NAMES WHICH ARE IN ARRAY ILETT. A SPECIAL
// 377 ! ALTERNATIVE (19) OF PHRASE <SS> IS PROVIDED FOR THIS PURPOSE
// 378 !
// 379 !%if INCLUDE DELSTART = 1 %start
// 380 A(1)=19; K=0; NEXT=1
#line 380 "test-new/imp918s.imp"
A[8] = 19;
#line 380 "test-new/imp918s.imp"
K = 0;
#line 380 "test-new/imp918s.imp"
NEXT = 1;
// 381 I=ILETT(0)
#line 381 "test-new/imp918s.imp"
I = ILETT[0];
// 382 %WHILE I<255 %CYCLE
#line 382 "test-new/imp918s.imp"
L_001D:;
#line 382 "test-new/imp918s.imp"
if (I >= 255) goto L_001E;
// 383 %CYCLE J=1,1,I
#line 383 "test-new/imp918s.imp"
// %for J = 1, 1, I %cycle
#line 383 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = I;
#line 383 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, I");
_control = J = _initial - _increment;
#line 383 "test-new/imp918s.imp"
L_001F:
#line 383 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 383 "test-new/imp918s.imp"
if (J == _final) goto L_0020;
#line 383 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// ?Non-local
// 384 CC(J)=ILETT(K+J)
#line 384 "test-new/imp918s.imp"
CC[J] = ILETT[K + J];
// 385 %REPEAT; CC(J+1)=';'
#line 385 "test-new/imp918s.imp"
goto L_001F;
#line 385 "test-new/imp918s.imp"
}
#line 385 "test-new/imp918s.imp"
L_0020:;
#line 385 "test-new/imp918s.imp"
CC[J + 1] = 59;
// 386 R=2; Q=ADDR(CC(1)); PNAME
#line 386 "test-new/imp918s.imp"
R = 2;
#line 386 "test-new/imp918s.imp"
Q = _imp_ADDR(/*?*/ &CC[1]);
#line 386 "test-new/imp918s.imp"
PNAME();
// 387 CSS(1,1); K=K+I+1; I=ILETT(K)
#line 387 "test-new/imp918s.imp"
CSS(1, 1);
#line 387 "test-new/imp918s.imp"
K = K + I + 1;
#line 387 "test-new/imp918s.imp"
I = ILETT[K];
// 388 %REPEAT
#line 388 "test-new/imp918s.imp"
goto L_001D;
#line 388 "test-new/imp918s.imp"
L_001E:;
// 389 !%finish
// 390 !
// 391 A(-7)=2; TOAR4(-6,PI1); TOAR4(-4,PI2)
#line 391 "test-new/imp918s.imp"
A[0] = 2;
#line 391 "test-new/imp918s.imp"
TOAR4(-6, PI1);
#line 391 "test-new/imp918s.imp"
TOAR4(-4, PI2);
// 392 A(0)=0; A(1)=12; CSS(1,1); ! COMPILE A BEGIN @ LINE 0
#line 392 "test-new/imp918s.imp"
A[7] = 0;
#line 392 "test-new/imp918s.imp"
A[8] = 12;
#line 392 "test-new/imp918s.imp"
CSS(1, 1);
// 393 COMREG(24)=16; ! RETURN CODE
#line 393 "test-new/imp918s.imp"
*COMREG(24) = 16;
// 394 %CYCLE I=1,1,3
#line 394 "test-new/imp918s.imp"
// %for I = 1, 1, 3 %cycle
#line 394 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = 3;
#line 394 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, 3");
_control = I = _initial - _increment;
#line 394 "test-new/imp918s.imp"
L_0022:
#line 394 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 394 "test-new/imp918s.imp"
if (I == _final) goto L_0023;
#line 394 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 395 PUSH123(CONSTL4,I,0,X'800000E0'+I<<2)
#line 395 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, I, 0, -2147483424 + (I << 2));
// 396 PUSH123(CONSTL4,I<<12,0,X'80000100'+I<<2)
#line 396 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, I << 12, 0, -2147483392 + (I << 2));
// 397 %REPEAT
#line 397 "test-new/imp918s.imp"
goto L_0022;
#line 397 "test-new/imp918s.imp"
}
#line 397 "test-new/imp918s.imp"
L_0023:;
// 398 PUSH123(CONSTL4,-1,0,16)
#line 398 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, -1, 0, 16);
// 399 PUSH123(CONSTL4,255,0,24)
#line 399 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, 255, 0, 24);
// 400 PUSH123(CONSTL4,-4,0,X'800000F8')
#line 400 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, -4, 0, -2147483400);
// 401 PUSH123(CONSTL4,-8,0,X'800000FC')
#line 401 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL4, -8, 0, -2147483396);
// 402 PUSH123(CONSTL8,X'41100000',0,X'800000C8');! FLOATNG =D'1'
#line 402 "test-new/imp918s.imp"
PUSH123(/*?*/ &CONSTL8, 1091567616, 0, -2147483448);
// 403 DUMMY FORMAT=0; ! DUMMY RECORD FORMAT
#line 403 "test-new/imp918s.imp"
DUMMYFORMAT = 0;
// 404 PUSH(CONSTL6,0,0)
#line 404 "test-new/imp918s.imp"
PUSH(/*?*/ &CONSTL6, 0, 0);
// 405 PUSH123(DUMMY FORMAT,0,0,CONSTL6); ! FOR BETTER ERROR RECOVERY
#line 405 "test-new/imp918s.imp"
PUSH123(/*?*/ &DUMMYFORMAT, 0, 0, CONSTL6);
// 406 CONSTL6=0
#line 406 "test-new/imp918s.imp"
CONSTL6 = 0;
// 407 %END
#line 407 "test-new/imp918s.imp"
goto end_1001;
#line 407 "test-new/imp918s.imp"
end_1001:;
#line 407 "test-new/imp918s.imp"
}
// 408 !
// 409 ->Label8
#line 409 "test-new/imp918s.imp"
goto U_1004;
// 410 %ROUTINE LOAD DATA
#line 410 "test-new/imp918s.imp"
void LOADDATA(void) {
// 411 {%SHORTROUTINE}
// 412 !***********************************************************************
// 413 !* PASS INFORMATION TO LPUT TO ENABLE IT TO GENERATE THE *
// 414 !* LOADER DATA AND COMPLETE THE PROGRAM FILE. *
// 415 !***********************************************************************
// 416 %INTEGER JJ,KK,FLAG,XTRA,ID1,ID2,ID3
#line 416 "test-new/imp918s.imp"
int JJ;
#line 416 "test-new/imp918s.imp"
int KK;
#line 416 "test-new/imp918s.imp"
int FLAG;
#line 416 "test-new/imp918s.imp"
int XTRA;
#line 416 "test-new/imp918s.imp"
int ID1;
#line 416 "test-new/imp918s.imp"
int ID2;
#line 416 "test-new/imp918s.imp"
int ID3;
// 417 %SHORTINTEGER HEAD
#line 417 "test-new/imp918s.imp"
short int HEAD;
// 418 GLACA=(GLACA+7)&(-8)
#line 418 "test-new/imp918s.imp"
GLACA = GLACA + 7 & -8;
// 419 CONSTPTR=(CONSTPTR+7)&(-8)
#line 419 "test-new/imp918s.imp"
CONSTPTR = CONSTPTR + 7 & -8;
// 420 !
// 421 ! DEFINE ANY DATA EPS FOR DATA IN THE GLA SYMBOL TABLES. THESE CAN NOT
// 422 ! BE DEFINED BEFORE THE SIZE OF THE GLA IS KNOWN
// 423 !
// 424 %WHILE EPLINK#0 %CYCLE
#line 424 "test-new/imp918s.imp"
L_0024:;
#line 424 "test-new/imp918s.imp"
if (EPLINK == 0) goto L_0025;
// 425 POP123(EPLINK,JJ,XTRA,KK)
#line 425 "test-new/imp918s.imp"
POP123(/*?*/ &EPLINK, /*?*/ &JJ, /*?*/ &XTRA, /*?*/ &KK);
// 426 HEAD=KK; FLAG=JJ>>24; JJ=JJ&X'FFFFFF'
#line 426 "test-new/imp918s.imp"
HEAD = KK;
#line 426 "test-new/imp918s.imp"
FLAG = (unsigned int)JJ >> 24;
#line 426 "test-new/imp918s.imp"
JJ = JJ & 16777215;
// 427 JJ=JJ+GLACA
#line 427 "test-new/imp918s.imp"
JJ = JJ + GLACA;
// 428 POP123(HEAD,ID1,ID2,ID3)
#line 428 "test-new/imp918s.imp"
POP123(/*?*/ &HEAD, /*?*/ &ID1, /*?*/ &ID2, /*?*/ &ID3);
// 429 ID3=ID3<<16
#line 429 "test-new/imp918s.imp"
ID3 = ID3 << 16;
// 430 LPUT(14,XTRA,JJ,ADDR(ID1))
#line 430 "test-new/imp918s.imp"
LPUT(14, XTRA, JJ, _imp_ADDR(/*?*/ &ID1));
// 431 %REPEAT
#line 431 "test-new/imp918s.imp"
goto L_0024;
#line 431 "test-new/imp918s.imp"
L_0025:;
// 432 CNOP(0,8)
#line 432 "test-new/imp918s.imp"
CNOP(0, 8);
// 433 FIXED GLA(2)=GLACA; ! GLA SYMTABS FROM HEAD OF GLA
#line 433 "test-new/imp918s.imp"
FIXEDGLA[2] = GLACA;
// 434 FIXED GLA(3)=CA; ! CODE SYMTABS FROM HEAD OF CODE
#line 434 "test-new/imp918s.imp"
FIXEDGLA[3] = CA;
// 435 FIXED GLA(0)=CA; ! WILL BE RELOCATED
#line 435 "test-new/imp918s.imp"
FIXEDGLA[0] = CA;
// 436 CODE OUT
#line 436 "test-new/imp918s.imp"
CODEOUT();
// 437 I=GLACA-GLACABUF
#line 437 "test-new/imp918s.imp"
I = GLACA - GLACABUF;
// 438 %IF INHCODE=0 %THEN %START
#line 438 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0026;
// 439 LPUT(2,I,GLACABUF,ADDR(GLABUF(0))) %UNLESS I=0;! BACK OF GLAP
#line 439 "test-new/imp918s.imp"
if (I == 0) goto L_0027;
#line 439 "test-new/imp918s.imp"
LPUT(2, I, GLACABUF, _imp_ADDR(/*?*/ &GLABUF[0]));
#line 439 "test-new/imp918s.imp"
L_0027:;
// 440 !
// 441 ! NOW SET THE LANGUAGE FLAG(BYTE 4 OF GLA) 1=IMP,3=IMPS
// 442 !
// 443 BYTE INTEGER(ADDR(FIXED GLA(1)))=16+IMPS<<5;! LANGUAGE FLAG
#line 443 "test-new/imp918s.imp"
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &FIXEDGLA[1])) = 16 + (IMPS << 5);
// 444 LPUT(2,N0<<2,0,ADDR(FIXED GLA(0))); ! FRONT OF GLAP
#line 444 "test-new/imp918s.imp"
LPUT(2, N0 << 2, 0, _imp_ADDR(/*?*/ &FIXEDGLA[0]));
// 445 I=X'E2E2E2E2'
#line 445 "test-new/imp918s.imp"
I = -488447262;
// 446 LPUT(4,4,SSTL,ADDR(I))
#line 446 "test-new/imp918s.imp"
LPUT(4, 4, SSTL, _imp_ADDR(/*?*/ &I));
// 447 !
// 448 ! NOW PLANT ANY RELOCATION INFO THAT HAS BEEN HELD UP AS IT IS RELATIVE
// 449 ! TO THE SYMBOL TABLES. LPUT DEALS ONLY IN CODE & GLA SO THE COMPILER
// 450 ! HAS TO ADJUST ST REFEFERNCES TO ALLOW FOR FRONT OF CODE OR GLA
// 451 !
// 452 ! %WHILE RELHEAD#0 %CYCLE
// 453 ! POP123(RELHEAD,JJ,KK,XTRA)
// 454 ! %IF XTRA=4 %THEN %START; ! CODE ST
// 455 ! KK=KK+CA
// 456 ! %FINISH %ELSE %START; ! GLA ST
// 457 ! KK=KK+GLACA
// 458 ! %FINISH
// 459 ! LPUT(2,4,JJ,ADDR(KK)); ! OUTPUT ADJUSTED POINTER
// 460 ! LPUT(XTRA+16,0,JJ,0); ! AND RELOCATION INFO
// 461 ! %REPEAT
// 462 !
// 463 LPUT(20,0,0,0); ! RELOCATE POINTER TO CST
#line 463 "test-new/imp918s.imp"
LPUT(20, 0, 0, 0);
// 464 LPUT(20,0,28,0); ! RELOCATE GLA HDOFCODE WORD
#line 464 "test-new/imp918s.imp"
LPUT(20, 0, 28, 0);
// 465 LPUT(12,0,23<<2,ADDR(FIXEDGLA(27)));! O-P PERM REFERENCE
#line 465 "test-new/imp918s.imp"
LPUT(12, 0, 23 << 2, _imp_ADDR(/*?*/ &FIXEDGLA[27]));
// 466 LPUT(16,0,64,0); ! DEFINE TOPOFSTORE WORD
#line 466 "test-new/imp918s.imp"
LPUT(16, 0, 64, 0);
// 467 %FINISH
#line 467 "test-new/imp918s.imp"
L_0026:;
// 468 SSTL=(SSTL+11)&(-8)
#line 468 "test-new/imp918s.imp"
SSTL = SSTL + 11 & -8;
// 469 printstring("
#line 469 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\nCODE"));
// 470+ CODE")
// 471 WRITE(CA,6); PRINTSTRING(" BYTES GLAP")
#line 471 "test-new/imp918s.imp"
_imp_WRITE(CA, 6);
#line 471 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BYTES GLAP"));
// 472 WRITE(GLACA,3); printstring("+")
#line 472 "test-new/imp918s.imp"
_imp_WRITE(GLACA, 3);
#line 472 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("+"));
// 473 WRITE(CONSTPTR,1); printstring(" BYTES DIAG TABLES")
#line 473 "test-new/imp918s.imp"
_imp_WRITE(CONSTPTR, 1);
#line 473 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BYTES DIAG TABLES"));
// 474 WRITE(SSTL,3); printstring(" BYTES
#line 474 "test-new/imp918s.imp"
_imp_WRITE(SSTL, 3);
#line 474 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BYTES\nTOTAL"));
// 475+ TOTAL")
// 476 REGISTER(0)=CA; REGISTER(1)=GLACA
#line 476 "test-new/imp918s.imp"
REGISTER[0] = CA;
#line 476 "test-new/imp918s.imp"
REGISTER[1] = GLACA;
// 477 REGISTER(2)=0
#line 477 "test-new/imp918s.imp"
REGISTER[2] = 0;
// 478 REGISTER(3)=SSTL
#line 478 "test-new/imp918s.imp"
REGISTER[3] = SSTL;
// 479 REGISTER(4)=CONSTPTR
#line 479 "test-new/imp918s.imp"
REGISTER[4] = CONSTPTR;
// 480 K=CA+GLACA+SSTL+CONSTPTR;REGISTER(5)=K
#line 480 "test-new/imp918s.imp"
K = CA + GLACA + SSTL + CONSTPTR;
#line 480 "test-new/imp918s.imp"
REGISTER[5] = K;
// 481 WRITE(K,5); printstring(" BYTES")
#line 481 "test-new/imp918s.imp"
_imp_WRITE(K, 5);
#line 481 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BYTES"));
// 482 %IF IMPS=0 %AND WARNINGS(0)>0 %START
#line 482 "test-new/imp918s.imp"
if (IMPS != 0) goto L_0028;
#line 482 "test-new/imp918s.imp"
if (WARNINGS[0] <= 0) goto L_0028;
// 483 J=WARNINGS(0)
#line 483 "test-new/imp918s.imp"
J = WARNINGS[0];
// 484 PRINTSTRING("
#line 484 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\nTHE FOLLOWING LINES ARE NOT ACCEPTABLE TO 2900 IMP:-"));
// 485+ THE FOLLOWING LINES ARE NOT ACCEPTABLE TO 2900 IMP:-")
// 486 NEWLINE
#line 486 "test-new/imp918s.imp"
_imp_NEWLINE();
// 487 %CYCLE I=1,1,J
#line 487 "test-new/imp918s.imp"
// %for I = 1, 1, J %cycle
#line 487 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = J;
#line 487 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, J");
_control = I = _initial - _increment;
#line 487 "test-new/imp918s.imp"
L_0029:
#line 487 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 487 "test-new/imp918s.imp"
if (I == _final) goto L_002A;
#line 487 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 488 WRITE(WARNINGS(I),3)
#line 488 "test-new/imp918s.imp"
_imp_WRITE(WARNINGS[I], 3);
// 489 %EXIT %IF I>=30
#line 489 "test-new/imp918s.imp"
if (I < 30) goto L_002B;
#line 489 "test-new/imp918s.imp"
goto L_002A;
#line 489 "test-new/imp918s.imp"
L_002B:;
// 490 %REPEAT
#line 490 "test-new/imp918s.imp"
goto L_0029;
#line 490 "test-new/imp918s.imp"
}
#line 490 "test-new/imp918s.imp"
L_002A:;
// 491 NEWLINE
#line 491 "test-new/imp918s.imp"
_imp_NEWLINE();
// 492 %IF J>30 %THEN PRINTSTRING("PLUS ") %AND WRITE(J-30,3) %C
#line 492 "test-new/imp918s.imp"
if (J <= 30) goto L_002C;
#line 492 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("PLUS "));
#line 492 "test-new/imp918s.imp"
_imp_WRITE(J - 30, 3);
#line 492 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" MORE\n"));
#line 492 "test-new/imp918s.imp"
L_002C:;
// 493+ %AND PRINTSTRING(" MORE
// 494+ ")
// 495 %FINISH
#line 495 "test-new/imp918s.imp"
L_0028:;
// 496 NEWLINE; print symbol(13); ! MARKER FOR COMP TO PRINT SUMMARY
#line 496 "test-new/imp918s.imp"
_imp_NEWLINE();
#line 496 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(13);
// 497 %IF FAULTY=0 %THEN %START
#line 497 "test-new/imp918s.imp"
if (FAULTY != 0) goto L_002D;
// 498 WRITE(STMTS,7); printstring(" STATEMENTS COMPILED")
#line 498 "test-new/imp918s.imp"
_imp_WRITE(STMTS, 7);
#line 498 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" STATEMENTS COMPILED"));
// 499 %IF GLACA>4096 %THEN printstring("
#line 499 "test-new/imp918s.imp"
if (GLACA <= 4096) goto L_002E;
#line 499 "test-new/imp918s.imp"
_imp_PRINTSTRING(
_imp_str_literal("\nWARNING:- GLAP ROOT IS GREATER THAN 4096 BYTES!\n********\n OBJECT PROGRAM IS "
"LIABLE TO BE VERY INEFFICIENT\n"));
#line 499 "test-new/imp918s.imp"
L_002E:;
// 500+ WARNING:- GLAP ROOT IS GREATER THAN 4096 BYTES!
// 501+ ********
// 502+ OBJECT PROGRAM IS LIABLE TO BE VERY INEFFICIENT
// 503+ ");
// 504 COMREG(47) = STMTS
#line 504 "test-new/imp918s.imp"
*COMREG(47) = STMTS;
// 505 %FINISH %ELSE %START
#line 505 "test-new/imp918s.imp"
goto L_002F;
#line 505 "test-new/imp918s.imp"
L_002D:;
// 506 printstring("PROGRAM CONTAINS"); WRITE(FAULTY,2)
#line 506 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("PROGRAM CONTAINS"));
#line 506 "test-new/imp918s.imp"
_imp_WRITE(FAULTY, 2);
// 507 printstring(" FAULT"); PRINTSYMBOL('S') %IF FAULTY>1
#line 507 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" FAULT"));
#line 507 "test-new/imp918s.imp"
if (FAULTY <= 1) goto L_0030;
#line 507 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(83);
#line 507 "test-new/imp918s.imp"
L_0030:;
// 508 COMREG(47)=FAULTY; ! FOR COMPER
#line 508 "test-new/imp918s.imp"
*COMREG(47) = FAULTY;
// 509 %FINISH
#line 509 "test-new/imp918s.imp"
L_002F:;
// 510 NEWLINES(2)
#line 510 "test-new/imp918s.imp"
_imp_NEWLINES(2);
// 511 I=0; I=8 %IF FAULTY#0
#line 511 "test-new/imp918s.imp"
I = 0;
#line 511 "test-new/imp918s.imp"
if (FAULTY == 0) goto L_0031;
#line 511 "test-new/imp918s.imp"
I = 8;
#line 511 "test-new/imp918s.imp"
L_0031:;
// 512 COMREG(24)=I
#line 512 "test-new/imp918s.imp"
*COMREG(24) = I;
// 513 %IF INHCODE=0 %THEN %C
#line 513 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0032;
#line 513 "test-new/imp918s.imp"
LPUT(7, 24, 0, _imp_ADDR(/*?*/ ®ISTER[0]));
#line 513 "test-new/imp918s.imp"
L_0032:;
// 514+ LPUT(7,24,0,ADDR(REGISTER(0)));! SUMMARY INFO..REGISTER AS BUF
// 515 %STOP
#line 515 "test-new/imp918s.imp"
_imp_stop(0);
// 516 %END
#line 516 "test-new/imp918s.imp"
} /* end of LOADDATA */
// 517 %ROUTINE FAULT(%INTEGER N,FNAME)
#line 517 "test-new/imp918s.imp"
void FAULT(int N, int FNAME) {
// 518 {%SHORTROUTINE}
// 519 %INTEGER I,J,QP,FLINE
#line 519 "test-new/imp918s.imp"
int I;
#line 519 "test-new/imp918s.imp"
int J;
#line 519 "test-new/imp918s.imp"
int QP;
#line 519 "test-new/imp918s.imp"
int FLINE;
// 520 %IF N=100 %THEN FLINE=LINE %ELSE FLINE=A(STPTRS(1)-1)
#line 520 "test-new/imp918s.imp"
if (N != 100) goto L_0033;
#line 520 "test-new/imp918s.imp"
FLINE = LINE;
#line 520 "test-new/imp918s.imp"
goto L_0034;
#line 520 "test-new/imp918s.imp"
L_0033:;
#line 520 "test-new/imp918s.imp"
FLINE = A[STPTRS[0] - 1 + 7];
#line 520 "test-new/imp918s.imp"
L_0034:;
// 521 QP=Q
#line 521 "test-new/imp918s.imp"
QP = Q;
// 522 printstring("
#line 522 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n*"));
// 523+ *"); WRITE(FLINE,4)
#line 523 "test-new/imp918s.imp"
_imp_WRITE(FLINE, 4);
// 524 I=3; I=3*LEVEL %IF LIST=0; SPACES(I)
#line 524 "test-new/imp918s.imp"
I = 3;
#line 524 "test-new/imp918s.imp"
if (LIST != 0) goto L_0035;
#line 524 "test-new/imp918s.imp"
I = 3 * LEVEL;
#line 524 "test-new/imp918s.imp"
L_0035:;
#line 524 "test-new/imp918s.imp"
_imp_SPACES(I);
// 525 CHECKSP=1; FAULTY=FAULTY+1
#line 525 "test-new/imp918s.imp"
CHECKSP = 1;
#line 525 "test-new/imp918s.imp"
FAULTY = FAULTY + 1;
// 526 INHCODE=1 %UNLESS LET=0; ! STOP GENERATING CODE
#line 526 "test-new/imp918s.imp"
if (LET == 0) goto L_0036;
#line 526 "test-new/imp918s.imp"
INHCODE = 1;
#line 526 "test-new/imp918s.imp"
L_0036:;
// 527 %IF N#100 %THEN %START; ! ALL EXCEPT SYNTAX
#line 527 "test-new/imp918s.imp"
if (N == 100) goto L_0037;
// 528 printstring("FAULT"); WRITE(N,2)
#line 528 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("FAULT"));
#line 528 "test-new/imp918s.imp"
_imp_WRITE(N, 2);
// 529 MESSAGE(N)
#line 529 "test-new/imp918s.imp"
MESSAGE(N);
// 530 %IF N>100 %THEN %START
#line 530 "test-new/imp918s.imp"
if (N <= 100) goto L_0038;
// 531 printstring(" DISASTER ")
#line 531 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" DISASTER "));
// 532 ABORT %UNLESS N<=108; %STOP
#line 532 "test-new/imp918s.imp"
if (N <= 108) goto L_0039;
#line 532 "test-new/imp918s.imp"
ABORT();
#line 532 "test-new/imp918s.imp"
L_0039:;
#line 532 "test-new/imp918s.imp"
_imp_stop(0);
// 533 %FINISH
#line 533 "test-new/imp918s.imp"
L_0038:;
// 534 PRINTNAME(FNAME) %UNLESS FNAME=0
#line 534 "test-new/imp918s.imp"
if (FNAME == 0) goto L_003A;
#line 534 "test-new/imp918s.imp"
PRINTNAME(FNAME);
#line 534 "test-new/imp918s.imp"
L_003A:;
// 535 %FINISH %ELSE %START; ! SYMTAX FAULTS
#line 535 "test-new/imp918s.imp"
goto L_003B;
#line 535 "test-new/imp918s.imp"
L_0037:;
// 536 printstring(" SYNTAX ")
#line 536 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" SYNTAX "));
// 537 %IF LINE#OLDLINE %THEN %START
#line 537 "test-new/imp918s.imp"
if (LINE == OLDLINE) goto L_003C;
// 538 printstring("
#line 538 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n TEXT MODE FAILURE "));
// 539+ TEXT MODE FAILURE ")
// 540 WRITE(LINE-OLDLINE,1)
#line 540 "test-new/imp918s.imp"
_imp_WRITE(LINE - OLDLINE, 1);
// 541 printstring(" LINES LOST
#line 541 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" LINES LOST \n"));
// 542+ ")
// 543 Q=QMAX
#line 543 "test-new/imp918s.imp"
Q = QMAX;
// 544 %FINISH %ELSE %START
#line 544 "test-new/imp918s.imp"
goto L_003D;
#line 544 "test-new/imp918s.imp"
L_003C:;
// 545 %CYCLE
#line 545 "test-new/imp918s.imp"
L_003E:;
// 546 J=BYTE INTEGER(Q)
#line 546 "test-new/imp918s.imp"
J = *_imp_BYTEINTEGER(Q);
// 547 PRINT SYMBOL(J)
#line 547 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(J);
// 548 Q=Q+1
#line 548 "test-new/imp918s.imp"
Q = Q + 1;
// 549 %REPEAT %UNTIL J=';' %OR Q=LENGTH
#line 549 "test-new/imp918s.imp"
if (J == 59) goto L_003F;
#line 549 "test-new/imp918s.imp"
if (Q == LENGTH) goto L_003F;
#line 549 "test-new/imp918s.imp"
goto L_003E;
#line 549 "test-new/imp918s.imp"
L_003F:;
// 550 %IF I+20+Q-QP<=120 %THEN %START
#line 550 "test-new/imp918s.imp"
if (I + 20 + Q - QP > 120) goto L_0040;
// 551 NEWLINE; SPACES(I+QMAX-QP+17)
#line 551 "test-new/imp918s.imp"
_imp_NEWLINE();
#line 551 "test-new/imp918s.imp"
_imp_SPACES(I + QMAX - QP + 17);
// 552 printstring("!
#line 552 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("!\n"));
// 553+ ")
// 554 %FINISH
#line 554 "test-new/imp918s.imp"
L_0040:;
// 555 %FINISH
#line 555 "test-new/imp918s.imp"
L_003D:;
// 556 %FINISH
#line 556 "test-new/imp918s.imp"
L_003B:;
// 557 %IF TTOPUT#0 %THEN %START
#line 557 "test-new/imp918s.imp"
if (TTOPUT == 0) goto L_0041;
// 558 Q=QP; TTOPUT=0
#line 558 "test-new/imp918s.imp"
Q = QP;
#line 558 "test-new/imp918s.imp"
TTOPUT = 0;
// 559 SELECT OUTPUT(87)
#line 559 "test-new/imp918s.imp"
_imp_SELECTOUTPUT(87);
// 560 FAULT(N,FNAME)
#line 560 "test-new/imp918s.imp"
FAULT(N, FNAME);
// 561 FAULTY=FAULTY-1
#line 561 "test-new/imp918s.imp"
FAULTY = FAULTY - 1;
// 562 NEWLINE
#line 562 "test-new/imp918s.imp"
_imp_NEWLINE();
// 563 SELECT OUTPUT(82)
#line 563 "test-new/imp918s.imp"
_imp_SELECTOUTPUT(82);
// 564 TTOPUT=1
#line 564 "test-new/imp918s.imp"
TTOPUT = 1;
// 565 %FINISH
#line 565 "test-new/imp918s.imp"
L_0041:;
// 566 %END
#line 566 "test-new/imp918s.imp"
return;
#line 566 "test-new/imp918s.imp"
} /* end of FAULT */
// 567
// 568 %ROUTINE WARN(%INTEGER LINE)
#line 568 "test-new/imp918s.imp"
void WARN(int LINE) {
// 569 !***********************************************************************
// 570 !* STORE A WARNING IF STMNT NOT 2900 IMP COMPATIBLE *
// 571 !***********************************************************************
// 572 %INTEGER I,J
#line 572 "test-new/imp918s.imp"
int I;
#line 572 "test-new/imp918s.imp"
int J;
// 573 I=WARNINGS(0); J=I+1
#line 573 "test-new/imp918s.imp"
I = WARNINGS[0];
#line 573 "test-new/imp918s.imp"
J = I + 1;
// 574 %IF J>30 %THEN WARNINGS(0)=J %AND %RETURN
#line 574 "test-new/imp918s.imp"
if (J <= 30) goto L_0042;
#line 574 "test-new/imp918s.imp"
WARNINGS[0] = J;
#line 574 "test-new/imp918s.imp"
return;
#line 574 "test-new/imp918s.imp"
L_0042:;
// 575 %IF LINE>WARNINGS(I) %THEN WARNINGS(J)=LINE %AND %C
#line 575 "test-new/imp918s.imp"
if (LINE <= WARNINGS[I]) goto L_0043;
#line 575 "test-new/imp918s.imp"
WARNINGS[J] = LINE;
#line 575 "test-new/imp918s.imp"
WARNINGS[0] = J;
#line 575 "test-new/imp918s.imp"
L_0043:;
// 576+ WARNINGS(0)=J
// 577 %END
#line 577 "test-new/imp918s.imp"
return;
#line 577 "test-new/imp918s.imp"
} /* end of WARN */
// 578 %ROUTINE ABORT
#line 578 "test-new/imp918s.imp"
void ABORT(void) {
// 579 printstring("
#line 579 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n**************** ABORT******************** ABORT *******"));
// 580+ **************** ABORT******************** ABORT *******")
// 581 RECODE(ADDR(CODE(0)),ADDR(CODE(PPCURR)),CABUF) %UNLESS CA=CABUF
#line 581 "test-new/imp918s.imp"
if (CA == CABUF) goto L_0044;
#line 581 "test-new/imp918s.imp"
RECODE(_imp_ADDR(/*?*/ &CODE[0]), _imp_ADDR(/*?*/ &CODE[PPCURR]), CABUF);
#line 581 "test-new/imp918s.imp"
L_0044:;
// 582 PRINT USE
#line 582 "test-new/imp918s.imp"
PRINTUSE();
// 583 %MONITOR ; %STOP; %END
#line 583 "test-new/imp918s.imp"
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
#line 583 "test-new/imp918s.imp"
_imp_stop(0);
#line 583 "test-new/imp918s.imp"
} /* end of ABORT */
// 584 %ROUTINE PRINT USE
#line 584 "test-new/imp918s.imp"
void PRINTUSE(void) {
// 585 %INTEGER I, J, K
#line 585 "test-new/imp918s.imp"
int I;
#line 585 "test-new/imp918s.imp"
int J;
#line 585 "test-new/imp918s.imp"
int K;
#line 585 "test-new/imp918s.imp"
auto void USES(int I);
// 586 %ROUTINESPEC USES(%INTEGER I)
// 587 %OWNSTRING (10) %ARRAY STATUS(-1:2)=" LOCKED ",
#line 587 "test-new/imp918s.imp"
static _imp_string10 STATUS[4] = {_imp_str_init(" LOCKED "), _imp_str_init(" FREE "),
_imp_str_init(" CLAIMED "), _imp_str_init(" RESERVED ")};
// 588+ " FREE "," CLAIMED "," RESERVED "
// 589 %INTEGER NNAMES
#line 589 "test-new/imp918s.imp"
int NNAMES;
// 590 !%if USE MC = 1 %start
// 591 ! *L_1,TAGS+8; *MVC_NNAMES(4),8(1)
// 592 !%finish
// 593 NEWLINES(2)
#line 593 "test-new/imp918s.imp"
_imp_NEWLINES(2);
// 594 %CYCLE I=0, 1, 15
#line 594 "test-new/imp918s.imp"
// %for I = 0, 1, 15 %cycle
#line 594 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 15;
#line 594 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, 15");
_control = I = _initial - _increment;
#line 594 "test-new/imp918s.imp"
L_0045:
#line 594 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 594 "test-new/imp918s.imp"
if (I == _final) goto L_0046;
#line 594 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 595 ->Label9 %IF 10<=I<=13
#line 595 "test-new/imp918s.imp"
{
// Double-sided test on I (Part I)
#line 595 "test-new/imp918s.imp"
int tmp;
#line 595 "test-new/imp918s.imp"
if (10 > (tmp = I)) goto L_0047;
// Double-sided test on I (Part II)
#line 595 "test-new/imp918s.imp"
if (tmp > 13) goto L_0047;
#line 595 "test-new/imp918s.imp"
}
#line 595 "test-new/imp918s.imp"
goto U_1005;
#line 595 "test-new/imp918s.imp"
L_0047:;
// 596 ->Label9 %IF REGISTER(I)=0 %AND GRUSE(I)=0 %AND (I>6 %C
#line 596 "test-new/imp918s.imp"
if (REGISTER[I] != 0) goto L_0048;
#line 596 "test-new/imp918s.imp"
if (GRUSE[I] != 0) goto L_0048;
#line 596 "test-new/imp918s.imp"
if (I > 6) goto L_0021;
#line 596 "test-new/imp918s.imp"
if (REGISTER[I + 16] != 0) goto L_0048;
#line 596 "test-new/imp918s.imp"
if (GRUSE[I + 16] != 0) goto L_0048;
#line 596 "test-new/imp918s.imp"
L_0021:;
#line 596 "test-new/imp918s.imp"
goto U_1005;
#line 596 "test-new/imp918s.imp"
L_0048:;
// 597+ %OR (REGISTER(I+16)=0 %AND GRUSE(I+16)=0))
// 598 WRITE(I, 2)
#line 598 "test-new/imp918s.imp"
_imp_WRITE(I, 2);
// 599 PRINTSTRING(STATUS(REGISTER(I)))
#line 599 "test-new/imp918s.imp"
_imp_PRINTSTRING(
#line 599 "test-new/imp918s.imp"
*({
__typeof__(_imp_string10) tmp = STATUS[REGISTER[I] + 1] /*q*/;
(_imp_string255 *)&tmp;
})
#line 599 "test-new/imp918s.imp"
);
// 600 USES(I)
#line 600 "test-new/imp918s.imp"
USES(I);
// 601 ->Label4 %IF I>6 %OR (REGISTER(I+16)=0=GRUSE(I+16))
#line 601 "test-new/imp918s.imp"
if (I > 6) goto L_0049;
#line 601 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 601 "test-new/imp918s.imp"
int tmp;
#line 601 "test-new/imp918s.imp"
if (REGISTER[I + 16] != (tmp = 0)) goto L_004A;
// Double-sided test on 0 (Part II)
#line 601 "test-new/imp918s.imp"
if (tmp != GRUSE[I + 16]) goto L_004A;
#line 601 "test-new/imp918s.imp"
}
#line 601 "test-new/imp918s.imp"
L_0049:;
#line 601 "test-new/imp918s.imp"
goto U_1006;
#line 601 "test-new/imp918s.imp"
L_004A:;
// 602 SPACES(13-K)
#line 602 "test-new/imp918s.imp"
_imp_SPACES(13 - K);
// 603 PRINTSTRING(STATUS(REGISTER(I+16)))
#line 603 "test-new/imp918s.imp"
_imp_PRINTSTRING(
#line 603 "test-new/imp918s.imp"
*({
__typeof__(_imp_string10) tmp = STATUS[REGISTER[I + 16] + 1] /*q*/;
(_imp_string255 *)&tmp;
})
#line 603 "test-new/imp918s.imp"
);
// 604 USES(I+16)
#line 604 "test-new/imp918s.imp"
USES(I + 16);
// 605 Label4: NEWLINE
#line 605 "test-new/imp918s.imp"
U_1006:;
#line 605 "test-new/imp918s.imp"
_imp_NEWLINE();
// 606 Label9: %REPEAT
#line 606 "test-new/imp918s.imp"
U_1005:;
#line 606 "test-new/imp918s.imp"
goto L_0045;
#line 606 "test-new/imp918s.imp"
}
#line 606 "test-new/imp918s.imp"
L_0046:;
// 607 I=CCSTATE>>16
#line 607 "test-new/imp918s.imp"
I = (unsigned int)CCSTATE >> 16;
// 608 %IF 1<=I<=2 %THEN %START
#line 608 "test-new/imp918s.imp"
{
// Double-sided test on I (Part I)
#line 608 "test-new/imp918s.imp"
int tmp;
#line 608 "test-new/imp918s.imp"
if (1 > (tmp = I)) goto L_004B;
// Double-sided test on I (Part II)
#line 608 "test-new/imp918s.imp"
if (tmp > 2) goto L_004B;
#line 608 "test-new/imp918s.imp"
}
// 609 %IF I=1 %THEN PRINTSTRING("ARITHMETIC CC ON REG") %C
#line 609 "test-new/imp918s.imp"
if (I != 1) goto L_004C;
#line 609 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("ARITHMETIC CC ON REG"));
#line 609 "test-new/imp918s.imp"
goto L_004D;
#line 609 "test-new/imp918s.imp"
L_004C:;
#line 609 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("LOGICAL CC ON REG"));
#line 609 "test-new/imp918s.imp"
L_004D:;
// 610+ %ELSE PRINTSTRING("LOGICAL CC ON REG")
// 611 WRITE(CCSTATE&255, 5)
#line 611 "test-new/imp918s.imp"
_imp_WRITE(CCSTATE & 255, 5);
// 612 NEWLINE
#line 612 "test-new/imp918s.imp"
_imp_NEWLINE();
// 613 %FINISH
#line 613 "test-new/imp918s.imp"
L_004B:;
// 614 %RETURN
#line 614 "test-new/imp918s.imp"
return;
// 615 %ROUTINE PN(%INTEGER N)
#line 615 "test-new/imp918s.imp"
void PN(int N) {
// 616 %INTEGER J, P, Q, R
#line 616 "test-new/imp918s.imp"
int J;
#line 616 "test-new/imp918s.imp"
int P;
#line 616 "test-new/imp918s.imp"
int Q;
#line 616 "test-new/imp918s.imp"
int R;
// 617 %CYCLE J=0, 1, NNAMES
#line 617 "test-new/imp918s.imp"
// %for J = 0, 1, NNAMES %cycle
#line 617 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = NNAMES;
#line 617 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 0, 1, NNAMES");
_control = J = _initial - _increment;
#line 617 "test-new/imp918s.imp"
L_004E:
#line 617 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 617 "test-new/imp918s.imp"
if (J == _final) goto L_004F;
#line 617 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 618 ->FOUND %IF N=TAGS(J)
#line 618 "test-new/imp918s.imp"
if (N != TAGS[J]) goto L_0050;
#line 618 "test-new/imp918s.imp"
goto U_1007;
#line 618 "test-new/imp918s.imp"
L_0050:;
// 619 %REPEAT; PRINTSTRING(" ??")
#line 619 "test-new/imp918s.imp"
goto L_004E;
#line 619 "test-new/imp918s.imp"
}
#line 619 "test-new/imp918s.imp"
L_004F:;
#line 619 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" ??"));
// 620 K=K+3; ->Label99
#line 620 "test-new/imp918s.imp"
K = K + 3;
#line 620 "test-new/imp918s.imp"
goto U_1008;
// 621 FOUND: P=WORD(J); R=LETT(P)
#line 621 "test-new/imp918s.imp"
U_1007:;
#line 621 "test-new/imp918s.imp"
P = WORD[J];
#line 621 "test-new/imp918s.imp"
R = LETT[P];
// 622 %IF R#0 %THEN %START
#line 622 "test-new/imp918s.imp"
if (R == 0) goto L_0051;
// 623 %CYCLE Q=1, 1, R
#line 623 "test-new/imp918s.imp"
// %for Q = 1, 1, R %cycle
#line 623 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = R;
#line 623 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle Q = 1, 1, R");
_control = Q = _initial - _increment;
#line 623 "test-new/imp918s.imp"
L_0052:
#line 623 "test-new/imp918s.imp"
if (Q != _control) _imp_signal(4, 2, 0, "Corrupt control variable Q");
#line 623 "test-new/imp918s.imp"
if (Q == _final) goto L_0053;
#line 623 "test-new/imp918s.imp"
_control += _increment;
Q += _increment;
// 624 PRINT SYMBOL(LETT(P+Q))
#line 624 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(LETT[P + Q]);
// 625 %REPEAT
#line 625 "test-new/imp918s.imp"
goto L_0052;
#line 625 "test-new/imp918s.imp"
}
#line 625 "test-new/imp918s.imp"
L_0053:;
// 626 %FINISH %ELSE PRINTSTRING("?")
#line 626 "test-new/imp918s.imp"
goto L_0055;
#line 626 "test-new/imp918s.imp"
L_0051:;
#line 626 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("?"));
#line 626 "test-new/imp918s.imp"
L_0055:;
// 627 K=K+1+R
#line 627 "test-new/imp918s.imp"
K = K + 1 + R;
// 628 Label99: %END
#line 628 "test-new/imp918s.imp"
U_1008:;
#line 628 "test-new/imp918s.imp"
return;
#line 628 "test-new/imp918s.imp"
} /* end of PN */
// 629 %ROUTINE USES(%INTEGER I)
#line 629 "test-new/imp918s.imp"
void USES(int I) {
// 630 %SWITCH SW(0:18)
#line 630 "test-new/imp918s.imp"
int SW_index;
#line 630 "test-new/imp918s.imp"
int SW_line;
#line 630 "test-new/imp918s.imp"
char *SW_file;
#line 630 "test-new/imp918s.imp"
static const void *SW[19] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 631 %INTEGER INF, J
#line 631 "test-new/imp918s.imp"
int INF;
#line 631 "test-new/imp918s.imp"
int J;
// 632 PRINTSTRING(" USE = ")
#line 632 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" USE = "));
// 633 K=0; J=GRUSE(I); INF=GRINF(I)
#line 633 "test-new/imp918s.imp"
K = 0;
#line 633 "test-new/imp918s.imp"
J = GRUSE[I];
#line 633 "test-new/imp918s.imp"
INF = GRINF[I];
// 634 ->SW(J)
#line 634 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = J;
goto case_SW_dispatch;
// 635 SW(0): PRINTSTRING(" NOT KNOWN"); ->Label99
#line 635 "test-new/imp918s.imp"
case_SW_0:;
#line 635 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" NOT KNOWN"));
#line 635 "test-new/imp918s.imp"
goto U_1009;
// 636 SW(1): PRINTSTRING(" I/RESULT ")
#line 636 "test-new/imp918s.imp"
case_SW_1:;
#line 636 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" I/RESULT "));
// 637 Label1: K=7; WRITE(INF, 6); ->Label99
#line 637 "test-new/imp918s.imp"
U_1007:;
#line 637 "test-new/imp918s.imp"
K = 7;
#line 637 "test-new/imp918s.imp"
_imp_WRITE(INF, 6);
#line 637 "test-new/imp918s.imp"
goto U_1009;
// 638 SW(2): PRINTSTRING(" CONST = "); ->Label1
#line 638 "test-new/imp918s.imp"
case_SW_2:;
#line 638 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" CONST = "));
#line 638 "test-new/imp918s.imp"
goto U_1007;
// 639 SW(3): PRINTSTRING(" LOCAL ")
#line 639 "test-new/imp918s.imp"
case_SW_3:;
#line 639 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" LOCAL "));
// 640 Label2: PN(INF); ->Label99
#line 640 "test-new/imp918s.imp"
U_1008:;
#line 640 "test-new/imp918s.imp"
PN(INF);
#line 640 "test-new/imp918s.imp"
goto U_1009;
// 641 SW(4):
#line 641 "test-new/imp918s.imp"
case_SW_4:;
// 642 SW(5):
#line 642 "test-new/imp918s.imp"
case_SW_5:;
// 643 SW(6): PRINTSTRING(" ERROR "); ->Label1
#line 643 "test-new/imp918s.imp"
case_SW_6:;
#line 643 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" ERROR "));
#line 643 "test-new/imp918s.imp"
goto U_1007;
// 644 SW(7): PRINTSTRING(" ADDR OF "); ->Label2
#line 644 "test-new/imp918s.imp"
case_SW_7:;
#line 644 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" ADDR OF "));
#line 644 "test-new/imp918s.imp"
goto U_1008;
// 645 SW(8): PRINTSTRING(" BASE OF "); ->Label2
#line 645 "test-new/imp918s.imp"
case_SW_8:;
#line 645 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BASE OF "));
#line 645 "test-new/imp918s.imp"
goto U_1008;
// 646 SW(9): PN(INF&X'FFFF')
#line 646 "test-new/imp918s.imp"
case_SW_9:;
#line 646 "test-new/imp918s.imp"
PN(INF & 65535);
// 647 PRINTSTRING(" TIMES "); WRITE(INF>>24, 2); ->Label99
#line 647 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" TIMES "));
#line 647 "test-new/imp918s.imp"
_imp_WRITE((unsigned int)INF >> 24, 2);
#line 647 "test-new/imp918s.imp"
goto U_1009;
// 648 SW(10): PRINTSTRING("DOPE V OF "); ->Label2
#line 648 "test-new/imp918s.imp"
case_SW_10:;
#line 648 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("DOPE V OF "));
#line 648 "test-new/imp918s.imp"
goto U_1008;
// 649 SW(11): %IF INF>0 %THEN ->Label111
#line 649 "test-new/imp918s.imp"
case_SW_11:;
#line 649 "test-new/imp918s.imp"
if (INF <= 0) goto L_0057;
#line 649 "test-new/imp918s.imp"
goto U_100A;
#line 649 "test-new/imp918s.imp"
L_0057:;
// 650 PRINTSTRING(" 4K FOR LAB ")
#line 650 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" 4K FOR LAB "));
// 651 K=8; WRITE(\INF, 6); ->Label99
#line 651 "test-new/imp918s.imp"
K = 8;
#line 651 "test-new/imp918s.imp"
_imp_WRITE((~INF), 6);
#line 651 "test-new/imp918s.imp"
goto U_1009;
// 652 Label111: PRINTSTRING(" 4096 * "); K=8; WRITE(INF, 6); ->Label99
#line 652 "test-new/imp918s.imp"
U_100A:;
#line 652 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" 4096 * "));
#line 652 "test-new/imp918s.imp"
K = 8;
#line 652 "test-new/imp918s.imp"
_imp_WRITE(INF, 6);
#line 652 "test-new/imp918s.imp"
goto U_1009;
// 653 SW(12): PRINTSTRING(" BASE AT "); ->Label1
#line 653 "test-new/imp918s.imp"
case_SW_12:;
#line 653 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" BASE AT "));
#line 653 "test-new/imp918s.imp"
goto U_1007;
// 654 SW(13): PRINTSTRING(" STR LEN "); ->Label1
#line 654 "test-new/imp918s.imp"
case_SW_13:;
#line 654 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" STR LEN "));
#line 654 "test-new/imp918s.imp"
goto U_1007;
// 655 SW(14): PRINTSTRING(" CYCLE VAR "); ->Label99
#line 655 "test-new/imp918s.imp"
case_SW_14:;
#line 655 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" CYCLE VAR "));
#line 655 "test-new/imp918s.imp"
goto U_1009;
// 656 SW(15): PRINTSTRING(" RT PARAM "); ->Label99
#line 656 "test-new/imp918s.imp"
case_SW_15:;
#line 656 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" RT PARAM "));
#line 656 "test-new/imp918s.imp"
goto U_1009;
// 657 SW(16): PRINTSTRING(" RSLN PARM "); ->Label1
#line 657 "test-new/imp918s.imp"
case_SW_16:;
#line 657 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" RSLN PARM "));
#line 657 "test-new/imp918s.imp"
goto U_1007;
// 658 SW(17): PRINTSTRING(" ADDR SST "); ->Label1
#line 658 "test-new/imp918s.imp"
case_SW_17:;
#line 658 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" ADDR SST "));
#line 658 "test-new/imp918s.imp"
goto U_1007;
// 659 SW(18): PRINTSTRING(" PERMBASE "); ->Label99
#line 659 "test-new/imp918s.imp"
case_SW_18:;
#line 659 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" PERMBASE "));
#line 659 "test-new/imp918s.imp"
goto U_1009;
// 660 Label99: %END
#line 660 "test-new/imp918s.imp"
U_1009:;
#line 660 "test-new/imp918s.imp"
return;
#line 660 "test-new/imp918s.imp"
case_SW_dispatch:
#line 660 "test-new/imp918s.imp"
if (SW_index < 0 || SW_index > 18)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 660 "test-new/imp918s.imp"
goto *SW[SW_index - 0];
#line 660 "test-new/imp918s.imp"
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
#line 660 "test-new/imp918s.imp"
} /* end of USES */
// 661 %END
#line 661 "test-new/imp918s.imp"
return;
#line 661 "test-new/imp918s.imp"
} /* end of PRINTUSE */
// ?J unused
// 662
// 663
// 664 %ROUTINE MESSAGE(%INTEGER N)
#line 664 "test-new/imp918s.imp"
void MESSAGE(int N) {
// 665 !***********************************************************************
// 666 !* OUTPUTS AN ERROR MESSAGE STORED IN A COMPRESSED FORMAT *
// 667 !***********************************************************************
// 668 %CONSTBYTEINTEGERARRAY WORD(0: 330)=0,%C
#line 668 "test-new/imp918s.imp"
const unsigned char WORD[331] = {
0, 1, 1, 2, 3, 0, 2, 4, 5, 7, 8, 4, 9, 10, 11, 7, 5, 9, 4, 12, 0, 6, 9, 4, 7, 8,
7, 10, 7, 8, 0, 8, 13, 14, 11, 16, 9, 13, 14, 11, 16, 10, 13, 14, 11, 16, 11, 4, 11, 7, 0, 13,
1, 18, 0, 0, 14, 2, 3, 20, 0, 15, 18, 20, 0, 0, 16, 10, 11, 7, 0, 17, 11, 21, 10, 0, 18, 9,
23, 12, 0, 19, 24, 25, 26, 14, 20, 9, 10, 27, 28, 22, 30, 14, 11, 16, 23, 21, 10, 27, 28, 24, 31, 27,
32, 28, 25, 34, 35, 11, 32, 26, 37, 38, 24, 39, 28, 21, 40, 18, 0, 29, 41, 11, 42, 0, 30, 44, 45, 26,
46, 31, 48, 45, 26, 46, 34, 2, 3, 49, 0, 35, 2, 3, 21, 49, 36, 50, 37, 25, 0, 39, 31, 52, 0, 0,
40, 23, 53, 0, 0, 42, 55, 35, 27, 28, 43, 56, 57, 45, 0, 44, 50, 58, 0, 0, 45, 24, 25, 26, 58, 47,
50, 59, 0, 0, 48, 60, 61, 27, 38, 51, 62, 2, 3, 0, 52, 1, 18, 63, 62, 53, 62, 18, 0, 0, 54, 64,
45, 26, 46, 57, 65, 18, 0, 0, 62, 11, 66, 10, 0, 64, 67, 18, 0, 0, 65, 67, 11, 27, 66, 66, 50, 69,
70, 0, 67, 11, 69, 10, 0, 69, 67, 45, 26, 46, 70, 50, 55, 23, 0, 71, 35, 27, 55, 28, 72, 50, 55, 72,
0, 73, 74, 45, 26, 46, 74, 74, 24, 66, 0, 81, 50, 76, 0, 0, 82, 41, 11, 78, 10, 83, 80, 76, 0, 0,
84, 50, 69, 70, 0, 85, 81, 0, 0, 0, 98, 84, 0, 0, 0, 99, 84, 0, 0, 0, 103, 87, 2, 88, 0, 104,
2, 3, 87, 0, 106, 55, 58, 2, 88, 108, 89, 61, 27, 38, 127, 90, 0, 0, 0};
// 669+ 1, 1, 2, 3, 0, 2, 4, 5,
// 670+ 7, 8, 4, 9, 10, 11, 7, 5,
// 671+ 9, 4, 12, 0, 6, 9, 4, 7,
// 672+ 8, 7, 10, 7, 8, 0, 8, 13,
// 673+ 14, 11, 16, 9, 13, 14, 11, 16,
// 674+ 10, 13, 14, 11, 16, 11, 4, 11,
// 675+ 7, 0, 13, 1, 18, 0, 0, 14,
// 676+ 2, 3, 20, 0, 15, 18, 20, 0,
// 677+ 0, 16, 10, 11, 7, 0, 17, 11,
// 678+ 21, 10, 0, 18, 9, 23, 12, 0,
// 679+ 19, 24, 25, 26, 14, 20, 9, 10,
// 680+ 27, 28, 22, 30, 14, 11, 16, 23,
// 681+ 21, 10, 27, 28, 24, 31, 27, 32,
// 682+ 28, 25, 34, 35, 11, 32, 26, 37,
// 683+ 38, 24, 39, 28, 21, 40, 18, 0,
// 684+ 29, 41, 11, 42, 0, 30, 44, 45,
// 685+ 26, 46, 31, 48, 45, 26, 46, 34,
// 686+ 2, 3, 49, 0, 35, 2, 3, 21,
// 687+ 49, 36, 50, 37, 25, 0, 39, 31,
// 688+ 52, 0, 0, 40, 23, 53, 0, 0,
// 689+ 42, 55, 35, 27, 28, 43, 56, 57,
// 690+ 45, 0, 44, 50, 58, 0, 0, 45,
// 691+ 24, 25, 26, 58, 47, 50, 59, 0,
// 692+ 0, 48, 60, 61, 27, 38, 51, 62,
// 693+ 2, 3, 0, 52, 1, 18, 63, 62,
// 694+ 53, 62, 18, 0, 0, 54, 64, 45,
// 695+ 26, 46, 57, 65, 18, 0, 0, 62,
// 696+ 11, 66, 10, 0, 64, 67, 18, 0,
// 697+ 0, 65, 67, 11, 27, 66, 66, 50,
// 698+ 69, 70, 0, 67, 11, 69, 10, 0,
// 699+ 69, 67, 45, 26, 46, 70, 50, 55,
// 700+ 23, 0, 71, 35, 27, 55, 28, 72,
// 701+ 50, 55, 72, 0, 73, 74, 45, 26,
// 702+ 46, 74, 74, 24, 66, 0, 81, 50,
// 703+ 76, 0, 0, 82, 41, 11, 78, 10,
// 704+ 83, 80, 76, 0, 0, 84, 50, 69,
// 705+ 70, 0, 85, 81, 0, 0, 0, 98,
// 706+ 84, 0, 0, 0, 99, 84, 0, 0,
// 707+ 0, 103, 87, 2, 88, 0, 104, 2,
// 708+ 3, 87, 0, 106, 55, 58, 2, 88,
// 709+ 108, 89, 61, 27, 38, 127, 90, 0,
// 710+ 0, 0
// 711 %CONSTINTEGERARRAY LETT(0: 92)=0,%C
#line 711 "test-new/imp918s.imp"
const int LETT[93] = {
0, 1219504232, 1374617600, 875481088, 807545600, 634784531, 334467072, 1286864896, 1391008064,
1323933904, 942483456, 972292096, 374504576, 435316824, 1077021515, 1353881600, 109026315, 201326592,
892574301, 469762048, 365205504, 1240834653, 335544320, 279143296, 1582264768, 970981376, 1019215872,
633339904, 386962663, 939524096, 74754136, 1218535424, 634661323, 1207959552, 253976896, 1479690309,
815792128, 406152448, 1317893376, 817244928, 165988352, 823328768, 280208297, 939524096, 1219800220,
1051983872, 233742705, 1342177280, 1219734312, 817244966, 629942723, 805306368, 386954496, 892568323,
212074496, 1318210446, 106040896, 634603786, 233741568, 361965568, 1319239680, 218206208, 422464720,
109051904, 386506752, 145181568, 435316840, 1319268443, 335544320, 1218673800, 1040552041, 939524096,
1040552041, 1044381696, 1219722027, 1362063360, 372592003, 816716096, 1105818891, 1207959552, 971898880,
288172967, 636357395, 1394606080, 75796839, 1277315859, 1394606080, 942484672, 837695488, 362807296,
1285945947, 1139608491, 92274688};
// 712+ X'48B02868',X'51EF0000',X'342EC800',X'30222B00',
// 713+ X'25D60B13',X'13EF9000',X'4CB40000',X'52E91940',
// 714+ X'4EE9A0D0',X'382D2800',X'39F40000',X'16527C80',
// 715+ X'19F26858',X'40320B4B',X'50B29800',X'067F9C0B',
// 716+ X'0C000000',X'35339A5D',X'1C000000',X'15C49800',
// 717+ X'49F5A25D',X'14000000',X'10A36380',X'5E4F71C0',
// 718+ X'39E00000',X'3CC00000',X'25C00000',X'171094E7',
// 719+ X'38000000',X'0474A858',X'48A16000',X'25D429CB',
// 720+ X'48000000',X'0F236140',X'58324845',X'30A00000',
// 721+ X'18356500',X'4E8D7500',X'30B62B00',X'09E4C800',
// 722+ X'31130000',X'10B3A3A9',X'38000000',X'48B4AC9C',
// 723+ X'3EB40000',X'0DEEA171',X'50000000',X'48B3AB28',
// 724+ X'30B62B26',X'258C29C3',X'30000000',X'17107500',
// 725+ X'35338303',X'0CA40000',X'4E924B8E',X'06520E40',
// 726+ X'25D3490A',X'0DEE9D00',X'15932800',X'4EA20000',
// 727+ X'0D019000',X'192E4CD0',X'06800000',X'1709A000',
// 728+ X'08A74B80',X'19F26868',X'4EA2705B',X'14000000',
// 729+ X'48A37C88',X'3E059069',X'38000000',X'3E059069',
// 730+ X'3E400000',X'48B37B2B',X'512F7000',X'16354D83',
// 731+ X'30AE1940',X'41E9750B',X'48000000',X'39EE0000',
// 732+ X'112D2BA7',X'25EE0B13',X'53200000',X'04849167',
// 733+ X'4C224B13',X'53200000',X'382D2CC0',X'31EE3800',
// 734+ X'15A00000',X'4CA5FA5B',X'43ED0BAB',X'05800000'
// 735
// 736 %INTEGER I,J,K,M,Q,S
#line 736 "test-new/imp918s.imp"
int I;
#line 736 "test-new/imp918s.imp"
int J;
#line 736 "test-new/imp918s.imp"
int K;
#line 736 "test-new/imp918s.imp"
int M;
#line 736 "test-new/imp918s.imp"
int Q;
#line 736 "test-new/imp918s.imp"
int S;
// 737 printstring(" (")
#line 737 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" ("));
// 738 I=-4
#line 738 "test-new/imp918s.imp"
I = -4;
// 739 I=I+5 %UNTIL N=WORD(I) %OR I= 326
#line 739 "test-new/imp918s.imp"
L_0058:;
#line 739 "test-new/imp918s.imp"
I = I + 5;
#line 739 "test-new/imp918s.imp"
if (N == WORD[I]) goto L_0059;
#line 739 "test-new/imp918s.imp"
if (I == 326) goto L_0059;
#line 739 "test-new/imp918s.imp"
goto L_0058;
#line 739 "test-new/imp918s.imp"
L_0059:;
// 740 %CYCLE J=1,1,4
#line 740 "test-new/imp918s.imp"
// %for J = 1, 1, 4 %cycle
#line 740 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = 4;
#line 740 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, 4");
_control = J = _initial - _increment;
#line 740 "test-new/imp918s.imp"
L_005A:
#line 740 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 740 "test-new/imp918s.imp"
if (J == _final) goto L_005B;
#line 740 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 741 K=WORD(I+J)
#line 741 "test-new/imp918s.imp"
K = WORD[I + J];
// 742 %IF K=0 %THEN %EXIT
#line 742 "test-new/imp918s.imp"
if (K != 0) goto L_005C;
#line 742 "test-new/imp918s.imp"
goto L_005B;
#line 742 "test-new/imp918s.imp"
L_005C:;
// 743 SPACE %UNLESS J=1
#line 743 "test-new/imp918s.imp"
if (J == 1) goto L_005D;
#line 743 "test-new/imp918s.imp"
_imp_SPACE();
#line 743 "test-new/imp918s.imp"
L_005D:;
// 744 %CYCLE
#line 744 "test-new/imp918s.imp"
L_005E:;
// 745 M=LETT(K); S=26
#line 745 "test-new/imp918s.imp"
M = LETT[K];
#line 745 "test-new/imp918s.imp"
S = 26;
// 746 %CYCLE
#line 746 "test-new/imp918s.imp"
L_005F:;
// 747 Q=M>>S&31;
#line 747 "test-new/imp918s.imp"
Q = (unsigned int)M >> S & 31;
// 748 %IF Q=31 %THEN Q=-32
#line 748 "test-new/imp918s.imp"
if (Q != 31) goto L_0060;
#line 748 "test-new/imp918s.imp"
Q = -32;
#line 748 "test-new/imp918s.imp"
L_0060:;
// 749 %IF Q\=0 %THEN PRINT SYMBOL(Q+64)
#line 749 "test-new/imp918s.imp"
if (Q == 0) goto L_0061;
#line 749 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(Q + 64);
#line 749 "test-new/imp918s.imp"
L_0061:;
// 750 S=S-5
#line 750 "test-new/imp918s.imp"
S = S - 5;
// 751 %REPEAT %UNTIL S<0
#line 751 "test-new/imp918s.imp"
if (S < 0) goto L_0062;
#line 751 "test-new/imp918s.imp"
goto L_005F;
#line 751 "test-new/imp918s.imp"
L_0062:;
// 752 K=K+1
#line 752 "test-new/imp918s.imp"
K = K + 1;
// 753 %REPEAT %UNTIL M&1=0
#line 753 "test-new/imp918s.imp"
if (M & 1 == 0) goto L_0063;
#line 753 "test-new/imp918s.imp"
goto L_005E;
#line 753 "test-new/imp918s.imp"
L_0063:;
// 754 %REPEAT
#line 754 "test-new/imp918s.imp"
goto L_005A;
#line 754 "test-new/imp918s.imp"
}
#line 754 "test-new/imp918s.imp"
L_005B:;
// 755 printstring(") ")
#line 755 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(") "));
// 756 %END
#line 756 "test-new/imp918s.imp"
return;
#line 756 "test-new/imp918s.imp"
} /* end of MESSAGE */
// 757 INEND: FAULT(108,0)
#line 757 "test-new/imp918s.imp"
U_1003:;
#line 757 "test-new/imp918s.imp"
FAULT(108, 0);
// 758 OFL: FAULT(38,0); ->Label8
#line 758 "test-new/imp918s.imp"
U_1002:;
#line 758 "test-new/imp918s.imp"
FAULT(38, 0);
#line 758 "test-new/imp918s.imp"
goto U_1004;
// 759 SUBSCHAR:LINE=LINE+1;FAULT(48,0)
#line 759 "test-new/imp918s.imp"
U_100B:;
#line 759 "test-new/imp918s.imp"
LINE = LINE + 1;
#line 759 "test-new/imp918s.imp"
FAULT(48, 0);
// 760 SPACES(5)
#line 760 "test-new/imp918s.imp"
_imp_SPACES(5);
// 761 Label15: READSYMBOL(I); ->Label8 %IF I=10
#line 761 "test-new/imp918s.imp"
U_100C:;
#line 761 "test-new/imp918s.imp"
_imp_READSYMBOL(/*?*/ &I);
#line 761 "test-new/imp918s.imp"
if (I != 10) goto L_0064;
#line 761 "test-new/imp918s.imp"
goto U_1004;
#line 761 "test-new/imp918s.imp"
L_0064:;
// 762 PRINTSYMBOL(I); ->Label15
#line 762 "test-new/imp918s.imp"
_imp_PRINTSYMBOL(I);
#line 762 "test-new/imp918s.imp"
goto U_100C;
// 763 %ROUTINE PRINTNAME (%INTEGER N)
#line 763 "test-new/imp918s.imp"
void PRINTNAME(int N) {
// 764 %IF N<0 %THEN %START
#line 764 "test-new/imp918s.imp"
if (N >= 0) goto L_0065;
// 765 N=-N
#line 765 "test-new/imp918s.imp"
N = -N;
// 766 %IF 16384<=N<=MAX ULAB %THEN N=N-16384 %ELSE %START
#line 766 "test-new/imp918s.imp"
{
// Double-sided test on N (Part I)
#line 766 "test-new/imp918s.imp"
int tmp;
#line 766 "test-new/imp918s.imp"
if (16384 > (tmp = N)) goto L_0066;
// Double-sided test on N (Part II)
#line 766 "test-new/imp918s.imp"
if (tmp > MAXULAB) goto L_0066;
#line 766 "test-new/imp918s.imp"
}
#line 766 "test-new/imp918s.imp"
N = N - 16384;
#line 766 "test-new/imp918s.imp"
goto L_0067;
#line 766 "test-new/imp918s.imp"
L_0066:;
// 767 WRITE(N,5); ->Label99
#line 767 "test-new/imp918s.imp"
_imp_WRITE(N, 5);
#line 767 "test-new/imp918s.imp"
goto U_100D;
// 768 %FINISH
#line 768 "test-new/imp918s.imp"
L_0067:;
// 769 %FINISH
#line 769 "test-new/imp918s.imp"
L_0065:;
// 770 printstring(" ")
#line 770 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" "));
// 771 !%if USE MC = 1 %start
// 772 ! **1,WORD(N)
// 773 ! *A_1,LETT; *->P5; ! USE PRINTSTRING IN PERM
// 774 !%finish
// 775 Label99: %END
#line 775 "test-new/imp918s.imp"
U_100D:;
#line 775 "test-new/imp918s.imp"
return;
#line 775 "test-new/imp918s.imp"
} /* end of PRINTNAME */
// 776 !
// 777 !***********************************************************************
// 778 !* IMP CODE PLANTING ROUTINES *
// 779 !* CODE AND GLAP ARE PUT INTO THE BUFFERS 'CODE,GLABUF(0:268)' *
// 780 !* BY A NUMBER OF TRIVIAL ROUTINES.LPUT IS CALLED TO ADD THE *
// 781 !* BUFFER TO THE OUTPUT FILE. THE BUFFERS ARE BASICALLY 0:255 *
// 782 !* WITH A 12-BYTE MARGIN TO MINIMISE THE NUMBER OF TESTS FOR *
// 783 !* THE BUFFER FULL CONDITION *
// 784 !* *
// 785 !* PPCURR(GLACURR) IS THE BUFFER POINTER *
// 786 !* CA(GLACA) IS THE RELATIVE ADDRESS OF THE NEXT BYTE *
// 787 !* CABUF(GLACABUF) IS CA(GLACA) FOR START OF BUFFER *
// 788 !***********************************************************************
// 789 %ROUTINE CODEOUT
#line 789 "test-new/imp918s.imp"
void CODEOUT(void) {
// 790 %IF PPCURR>0 %THEN %START
#line 790 "test-new/imp918s.imp"
if (PPCURR <= 0) goto L_0068;
// 791 %IF DCOMP#0 %THEN %C
#line 791 "test-new/imp918s.imp"
if (DCOMP == 0) goto L_0069;
#line 791 "test-new/imp918s.imp"
RECODE(_imp_ADDR(/*?*/ &CODE[0]), _imp_ADDR(/*?*/ &CODE[PPCURR]), CABUF);
#line 791 "test-new/imp918s.imp"
L_0069:;
// 792+ RECODE(ADDR(CODE(0)),ADDR(CODE(PPCURR)),CABUF)
// 793 LPUT(1,PPCURR,CABUF,ADDR(CODE(0))) %IF INHCODE=0
#line 793 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_006A;
#line 793 "test-new/imp918s.imp"
LPUT(1, PPCURR, CABUF, _imp_ADDR(/*?*/ &CODE[0]));
#line 793 "test-new/imp918s.imp"
L_006A:;
// 794 PPCURR=0; CABUF=CA
#line 794 "test-new/imp918s.imp"
PPCURR = 0;
#line 794 "test-new/imp918s.imp"
CABUF = CA;
// 795 %FINISH
#line 795 "test-new/imp918s.imp"
L_0068:;
// 796 %END
#line 796 "test-new/imp918s.imp"
return;
#line 796 "test-new/imp918s.imp"
} /* end of CODEOUT */
// 797 %ROUTINE PLANT(%INTEGER HALFWORD)
#line 797 "test-new/imp918s.imp"
void PLANT(int HALFWORD) {
// 798 ! ADD A HALF WORD OF BINARY TO THE BUFFER
// 799 SHORT INTEGER(ADDR(CODE(PPCURR)))<-HALFWORD
#line 799 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &CODE[PPCURR])) = (short int)(HALFWORD);
// 800 PPCURR=PPCURR+2
#line 800 "test-new/imp918s.imp"
PPCURR = PPCURR + 2;
// 801 CA=CA+2
#line 801 "test-new/imp918s.imp"
CA = CA + 2;
// 802 CODEOUT %IF PPCURR>=256
#line 802 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_006B;
#line 802 "test-new/imp918s.imp"
CODEOUT();
#line 802 "test-new/imp918s.imp"
L_006B:;
// 803 %END
#line 803 "test-new/imp918s.imp"
return;
#line 803 "test-new/imp918s.imp"
} /* end of PLANT */
// 804 %ROUTINE PCONST(%INTEGER WORD)
#line 804 "test-new/imp918s.imp"
void PCONST(int WORD) {
// 805 ! ADD A WORD OF BINARY TO THE BUFFER
// 806 !%if USE MC = 1 %start
// 807 ! **1,ADDR(CODE(PPCURR))
// 808 ! *MVC_0(4,1),WORD
// 809 !%finish
// 810 PPCURR=PPCURR+4
#line 810 "test-new/imp918s.imp"
PPCURR = PPCURR + 4;
// 811 CA=CA+4
#line 811 "test-new/imp918s.imp"
CA = CA + 4;
// 812 CODEOUT %IF PPCURR>=256
#line 812 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_006C;
#line 812 "test-new/imp918s.imp"
CODEOUT();
#line 812 "test-new/imp918s.imp"
L_006C:;
// 813 %END
#line 813 "test-new/imp918s.imp"
return;
#line 813 "test-new/imp918s.imp"
} /* end of PCONST */
// ?WORD unused
// 814 %ROUTINE PRR(%INTEGER OPCODE,R1,R2)
#line 814 "test-new/imp918s.imp"
void PRR(int OPCODE, int R1, int R2) {
// 815 CODE(PPCURR)=OPCODE
#line 815 "test-new/imp918s.imp"
CODE[PPCURR] = OPCODE;
// 816 CODE(PPCURR+1)=R1<<4!R2
#line 816 "test-new/imp918s.imp"
CODE[PPCURR + 1] = R1 << 4 | R2;
// 817 PPCURR=PPCURR+2
#line 817 "test-new/imp918s.imp"
PPCURR = PPCURR + 2;
// 818 CA=CA+2
#line 818 "test-new/imp918s.imp"
CA = CA + 2;
// 819 CODEOUT %IF PPCURR>=256
#line 819 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_006D;
#line 819 "test-new/imp918s.imp"
CODEOUT();
#line 819 "test-new/imp918s.imp"
L_006D:;
// 820 %END
#line 820 "test-new/imp918s.imp"
return;
#line 820 "test-new/imp918s.imp"
} /* end of PRR */
// 821 %ROUTINE MOVE BACK PC
#line 821 "test-new/imp918s.imp"
void MOVEBACKPC(void) {
// 822 %IF LCA<CABUF %THEN CABUF=LCA %AND PPCURR=0 %ELSE %C
#line 822 "test-new/imp918s.imp"
if (LCA >= CABUF) goto L_006E;
#line 822 "test-new/imp918s.imp"
CABUF = LCA;
#line 822 "test-new/imp918s.imp"
PPCURR = 0;
#line 822 "test-new/imp918s.imp"
goto L_006F;
#line 822 "test-new/imp918s.imp"
L_006E:;
#line 822 "test-new/imp918s.imp"
PPCURR = PPCURR - CA + LCA;
#line 822 "test-new/imp918s.imp"
L_006F:;
// 823+ PPCURR=PPCURR-CA+LCA
// 824 CA=LCA
#line 824 "test-new/imp918s.imp"
CA = LCA;
// 825 %END
#line 825 "test-new/imp918s.imp"
return;
#line 825 "test-new/imp918s.imp"
} /* end of MOVEBACKPC */
// 826 %ROUTINE PRX(%INTEGER OPCODE,R1,R2,B,D)
#line 826 "test-new/imp918s.imp"
void PRX(int OPCODE, int R1, int R2, int B, int D) {
// 827 {%SHORTROUTINE}
// 828 %OWNINTEGER LR1,LR2,LB,LD
#line 828 "test-new/imp918s.imp"
static int LR1;
#line 828 "test-new/imp918s.imp"
static int LR2;
#line 828 "test-new/imp918s.imp"
static int LB;
#line 828 "test-new/imp918s.imp"
static int LD;
// 829 %IF CHECKSP=0 %THEN %START
#line 829 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_0070;
// 830 %IF OPCODE=X'58' %OR OPCODE=X'50' %THEN %START
#line 830 "test-new/imp918s.imp"
if (OPCODE == 88) goto L_0054;
#line 830 "test-new/imp918s.imp"
if (OPCODE != 80) goto L_0071;
#line 830 "test-new/imp918s.imp"
L_0054:;
// 831 %IF LCA+4=CA %AND LB=B %AND R2=0 %AND %C
#line 831 "test-new/imp918s.imp"
if (LCA + 4 != CA) goto L_0072;
#line 831 "test-new/imp918s.imp"
if (LB != B) goto L_0072;
#line 831 "test-new/imp918s.imp"
if (R2 != 0) goto L_0072;
#line 831 "test-new/imp918s.imp"
if (LOPCODE != OPCODE) goto L_0073;
#line 831 "test-new/imp918s.imp"
if (LR1 + 1 & 15 != R1) goto L_0073;
#line 831 "test-new/imp918s.imp"
if (LR2 != 0) goto L_0073;
#line 831 "test-new/imp918s.imp"
if (D == LD + 4) goto L_0074;
#line 831 "test-new/imp918s.imp"
L_0073:;
#line 831 "test-new/imp918s.imp"
if (LOPCODE != OPCODE + 64) goto L_0072;
#line 831 "test-new/imp918s.imp"
if (LR2 + 1 & 15 != R1) goto L_0072;
#line 831 "test-new/imp918s.imp"
if (D != LD + (R1 - LR1 & 15) * 4) goto L_0072;
#line 831 "test-new/imp918s.imp"
L_0074:;
// 832+ ((LOPCODE=OPCODE %AND (LR1+1)&15=R1 %AND LR2=0 %AND %C
// 833+ D=LD+4) %OR (LOPCODE=OPCODE+X'40' %AND %C
// 834+ (LR2+1)&15=R1 %AND D=LD+((R1-LR1)&15)*4)) %START
// 835 %IF DCOMP#0 %THEN printstring("** LOADS COMBINED **")
#line 835 "test-new/imp918s.imp"
if (DCOMP == 0) goto L_0075;
#line 835 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("** LOADS COMBINED **"));
#line 835 "test-new/imp918s.imp"
L_0075:;
// 836 MOVE BACK PC
#line 836 "test-new/imp918s.imp"
MOVEBACKPC();
// 837 CSAVED=CSAVED+4
#line 837 "test-new/imp918s.imp"
CSAVED = CSAVED + 4;
// 838 PRX(X'90'+OPCODE&15,LR1,R1,LB,LD)
#line 838 "test-new/imp918s.imp"
PRX(144 + (OPCODE & 15), LR1, R1, LB, LD);
// 839 %RETURN
#line 839 "test-new/imp918s.imp"
return;
// 840 %FINISH
#line 840 "test-new/imp918s.imp"
L_0072:;
// 841 %FINISH
#line 841 "test-new/imp918s.imp"
L_0071:;
// 842 LCA=CA; LR1=R1; LR2=R2
#line 842 "test-new/imp918s.imp"
LCA = CA;
#line 842 "test-new/imp918s.imp"
LR1 = R1;
#line 842 "test-new/imp918s.imp"
LR2 = R2;
// 843 LB=B; LD=D; LOPCODE=OPCODE
#line 843 "test-new/imp918s.imp"
LB = B;
#line 843 "test-new/imp918s.imp"
LD = D;
#line 843 "test-new/imp918s.imp"
LOPCODE = OPCODE;
// 844 %FINISH
#line 844 "test-new/imp918s.imp"
L_0070:;
// 845 CODE(PPCURR)=OPCODE
#line 845 "test-new/imp918s.imp"
CODE[PPCURR] = OPCODE;
// 846 CODE(PPCURR+1)=R1<<4!R2
#line 846 "test-new/imp918s.imp"
CODE[PPCURR + 1] = R1 << 4 | R2;
// 847 SHORT INTEGER(ADDR(CODE(PPCURR+2)))<- B<<12!D
#line 847 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &CODE[PPCURR + 2])) = (short int)(B << 12 | D);
// 848 PPCURR=PPCURR+4
#line 848 "test-new/imp918s.imp"
PPCURR = PPCURR + 4;
// 849 CA=CA+4
#line 849 "test-new/imp918s.imp"
CA = CA + 4;
// 850 CODEOUT %IF PPCURR>=256
#line 850 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_0076;
#line 850 "test-new/imp918s.imp"
CODEOUT();
#line 850 "test-new/imp918s.imp"
L_0076:;
// 851 %END
#line 851 "test-new/imp918s.imp"
return;
#line 851 "test-new/imp918s.imp"
} /* end of PRX */
// 852 %ROUTINE PSI(%INTEGER OPCODE,J,B,D)
#line 852 "test-new/imp918s.imp"
void PSI(int OPCODE, int J, int B, int D) {
// 853 CODE(PPCURR)=OPCODE
#line 853 "test-new/imp918s.imp"
CODE[PPCURR] = OPCODE;
// 854 CODE(PPCURR+1)=J
#line 854 "test-new/imp918s.imp"
CODE[PPCURR + 1] = J;
// 855 SHORT INTEGER(ADDR(CODE(PPCURR+2)))<- B<<12!D
#line 855 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &CODE[PPCURR + 2])) = (short int)(B << 12 | D);
// 856 PPCURR=PPCURR+4
#line 856 "test-new/imp918s.imp"
PPCURR = PPCURR + 4;
// 857 CA=CA+4
#line 857 "test-new/imp918s.imp"
CA = CA + 4;
// 858 CODEOUT %IF PPCURR>=256
#line 858 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_0077;
#line 858 "test-new/imp918s.imp"
CODEOUT();
#line 858 "test-new/imp918s.imp"
L_0077:;
// 859 %END
#line 859 "test-new/imp918s.imp"
return;
#line 859 "test-new/imp918s.imp"
} /* end of PSI */
// 860 %ROUTINE PSS(%INTEGER OPCODE,N,B1,D1,B2,D2)
#line 860 "test-new/imp918s.imp"
void PSS(int OPCODE, int N, int B1, int D1, int B2, int D2) {
// 861 CODE(PPCURR)=OPCODE
#line 861 "test-new/imp918s.imp"
CODE[PPCURR] = OPCODE;
// 862 N=N-1 %UNLESS N=0
#line 862 "test-new/imp918s.imp"
if (N == 0) goto L_0078;
#line 862 "test-new/imp918s.imp"
N = N - 1;
#line 862 "test-new/imp918s.imp"
L_0078:;
// 863 CODE(PPCURR+1)=N
#line 863 "test-new/imp918s.imp"
CODE[PPCURR + 1] = N;
// 864 SHORT INTEGER(ADDR(CODE(PPCURR+2)))<- B1<<12!D1
#line 864 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &CODE[PPCURR + 2])) = (short int)(B1 << 12 | D1);
// 865 SHORT INTEGER(ADDR(CODE(PPCURR+4)))<- B2<<12!D2
#line 865 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &CODE[PPCURR + 4])) = (short int)(B2 << 12 | D2);
// 866 PPCURR=PPCURR+6
#line 866 "test-new/imp918s.imp"
PPCURR = PPCURR + 6;
// 867 CA=CA+6
#line 867 "test-new/imp918s.imp"
CA = CA + 6;
// 868 CODEOUT %IF PPCURR>=256
#line 868 "test-new/imp918s.imp"
if (PPCURR < 256) goto L_0079;
#line 868 "test-new/imp918s.imp"
CODEOUT();
#line 868 "test-new/imp918s.imp"
L_0079:;
// 869 %END
#line 869 "test-new/imp918s.imp"
return;
#line 869 "test-new/imp918s.imp"
} /* end of PSS */
// 870 %ROUTINE PMVC(%INTEGER L,B1,D1,B2,D2)
#line 870 "test-new/imp918s.imp"
void PMVC(int L, int B1, int D1, int B2, int D2) {
// 871 {%SHORTROUTINE}
// 872 !***********************************************************************
// 873 !* PLANTS AN MVC INSTRN. IN OPTIMISING MODE TRIES TO GLUE IT *
// 874 !* ON TO THE LAST ONE PLANTED *
// 875 !***********************************************************************
// 876 %OWNINTEGER LL,LB1,LD1,LB2,LD2
#line 876 "test-new/imp918s.imp"
static int LL;
#line 876 "test-new/imp918s.imp"
static int LB1;
#line 876 "test-new/imp918s.imp"
static int LD1;
#line 876 "test-new/imp918s.imp"
static int LB2;
#line 876 "test-new/imp918s.imp"
static int LD2;
// 877 %IF CHECKSP#1 %THEN %START
#line 877 "test-new/imp918s.imp"
if (CHECKSP == 1) goto L_007A;
// 878 %IF LCA+6=CA %AND B1=LB1 %AND B2=LB2 %AND LOPCODE=X'D2' %C
#line 878 "test-new/imp918s.imp"
if (LCA + 6 != CA) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (B1 != LB1) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (B2 != LB2) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (LOPCODE != 210) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (D1 != LD1 + LL) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (D2 != LD2 + LL) goto L_007B;
#line 878 "test-new/imp918s.imp"
if (LL + L > 256) goto L_007B;
// 879+ %AND D1=LD1+LL %AND D2=LD2+LL %AND LL+L<=256 %START
// 880 MOVE BACK PC
#line 880 "test-new/imp918s.imp"
MOVEBACKPC();
// 881 CA=LCA; L=L+LL
#line 881 "test-new/imp918s.imp"
CA = LCA;
#line 881 "test-new/imp918s.imp"
L = L + LL;
// 882 D1=LD1; D2=LD2
#line 882 "test-new/imp918s.imp"
D1 = LD1;
#line 882 "test-new/imp918s.imp"
D2 = LD2;
// 883 %FINISH
#line 883 "test-new/imp918s.imp"
L_007B:;
// 884 LCA=CA; LL=L; LB1=B1; LD1=D1
#line 884 "test-new/imp918s.imp"
LCA = CA;
#line 884 "test-new/imp918s.imp"
LL = L;
#line 884 "test-new/imp918s.imp"
LB1 = B1;
#line 884 "test-new/imp918s.imp"
LD1 = D1;
// 885 LB2=B2; LD2=D2; LOPCODE=X'D2'
#line 885 "test-new/imp918s.imp"
LB2 = B2;
#line 885 "test-new/imp918s.imp"
LD2 = D2;
#line 885 "test-new/imp918s.imp"
LOPCODE = 210;
// 886 %FINISH
#line 886 "test-new/imp918s.imp"
L_007A:;
// 887 PSS(X'D2',L,B1,D1,B2,D2)
#line 887 "test-new/imp918s.imp"
PSS(210, L, B1, D1, B2, D2);
// 888 %END
#line 888 "test-new/imp918s.imp"
return;
#line 888 "test-new/imp918s.imp"
} /* end of PMVC */
// 889 %ROUTINE CNOP(%INTEGER I,J)
#line 889 "test-new/imp918s.imp"
void CNOP(int I, int J) {
// 890 PLANT(X'0700') %WHILE CA&(J-1)#I
#line 890 "test-new/imp918s.imp"
L_007C:;
#line 890 "test-new/imp918s.imp"
if (CA & J - 1 == I) goto L_007D;
#line 890 "test-new/imp918s.imp"
PLANT(1792);
#line 890 "test-new/imp918s.imp"
goto L_007C;
#line 890 "test-new/imp918s.imp"
L_007D:;
// 891 %END
#line 891 "test-new/imp918s.imp"
return;
#line 891 "test-new/imp918s.imp"
} /* end of CNOP */
// 892 %ROUTINE PGLA(%INTEGER BDRY,L,INF ADR)
#line 892 "test-new/imp918s.imp"
void PGLA(int BDRY, int L, int INFADR) {
// 893 {%SHORTROUTINE}
// 894 %INTEGER I,J
#line 894 "test-new/imp918s.imp"
int I;
#line 894 "test-new/imp918s.imp"
int J;
// 895 J=GLACA; GLACA=(J+BDRY-1)&(-BDRY)
#line 895 "test-new/imp918s.imp"
J = GLACA;
#line 895 "test-new/imp918s.imp"
GLACA = J + BDRY - 1 & -BDRY;
// 896 GLACURR=GLACURR+GLACA-J; ! COMPLETE THE ROUNDING
#line 896 "test-new/imp918s.imp"
GLACURR = GLACURR + GLACA - J;
// 897 !
// 898 ! RECORD HOLES IN THE GLA FOR FUTURE USE
// 899 !
// 900 %IF J&1#0 %THEN J=J+1
#line 900 "test-new/imp918s.imp"
if (J & 1 == 0) goto L_007E;
#line 900 "test-new/imp918s.imp"
J = J + 1;
#line 900 "test-new/imp918s.imp"
L_007E:;
// 901 %WHILE J+2<=GLACA %CYCLE
#line 901 "test-new/imp918s.imp"
L_007F:;
#line 901 "test-new/imp918s.imp"
if (J + 2 > GLACA) goto L_0080;
// 902 PUSH(GLAHOLES,J,0)
#line 902 "test-new/imp918s.imp"
PUSH(/*?*/ &GLAHOLES, J, 0);
// 903 J=J+2
#line 903 "test-new/imp918s.imp"
J = J + 2;
// 904 %REPEAT
#line 904 "test-new/imp918s.imp"
goto L_007F;
#line 904 "test-new/imp918s.imp"
L_0080:;
// 905 %IF L+GLACURR>256 %THEN %START
#line 905 "test-new/imp918s.imp"
if (L + GLACURR <= 256) goto L_0081;
// 906 %IF INHCODE=0 %THEN LPUT(2,GLACURR,GLACABUF,ADDR(GLABUF(0)))
#line 906 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0082;
#line 906 "test-new/imp918s.imp"
LPUT(2, GLACURR, GLACABUF, _imp_ADDR(/*?*/ &GLABUF[0]));
#line 906 "test-new/imp918s.imp"
L_0082:;
// 907 GLACA=(GLACA+1)&(-2)
#line 907 "test-new/imp918s.imp"
GLACA = GLACA + 1 & -2;
// 908 GLACURR=0; GLACABUF=GLACA
#line 908 "test-new/imp918s.imp"
GLACURR = 0;
#line 908 "test-new/imp918s.imp"
GLACABUF = GLACA;
// 909 %FINISH
#line 909 "test-new/imp918s.imp"
L_0081:;
// 910 !%if USE MC = 1 %start
// 911 ! *LM_1,2,L; *L_3,GLABUF
// 912 ! *A_3,GLACURR; *BCTR_1,0
// 913 ! *EX_1,<MOVE>
// 914 !%finish
// 915 GLACA=GLACA+L; GLACURR=GLACURR+L
#line 915 "test-new/imp918s.imp"
GLACA = GLACA + L;
#line 915 "test-new/imp918s.imp"
GLACURR = GLACURR + L;
// 916 %RETURN
#line 916 "test-new/imp918s.imp"
return;
// 917 !%if USE MC = 1 %start
// 918 !MOVE: *MVC_0(1,3),0(2)
// 919 !%finish
// 920 %END
#line 920 "test-new/imp918s.imp"
} /* end of PGLA */
// ?I unused
// ?INFADR unused
// 921 %ROUTINE PLUG(%INTEGER AREA,AT,VALUE)
#line 921 "test-new/imp918s.imp"
void PLUG(int AREA, int AT, int VALUE) {
// 922 {%SHORTROUTINE}
// 923 !***********************************************************************
// 924 !* WRITE ONE HALFWORD INTO OBJECT FILE OUT OF SEQUENCE *
// 925 !***********************************************************************
// 926 %INTEGERNAME WCABUF
#line 926 "test-new/imp918s.imp"
int *WCABUF;
// 927 %INTEGER RELAD,BUFAD
#line 927 "test-new/imp918s.imp"
int RELAD;
#line 927 "test-new/imp918s.imp"
int BUFAD;
// 928 WCABUF==CABUF; BUFAD=ADDR(CODE(0))
#line 928 "test-new/imp918s.imp"
WCABUF = (int *)/*?*/ &CABUF;
#line 928 "test-new/imp918s.imp"
BUFAD = _imp_ADDR(/*?*/ &CODE[0]);
// 929 %IF AREA=2 %THEN WCABUF==GLACABUF %AND BUFAD=ADDR(GLABUF(0))
#line 929 "test-new/imp918s.imp"
if (AREA != 2) goto L_0083;
#line 929 "test-new/imp918s.imp"
WCABUF = (int *)/*?*/ &GLACABUF;
#line 929 "test-new/imp918s.imp"
BUFAD = _imp_ADDR(/*?*/ &GLABUF[0]);
#line 929 "test-new/imp918s.imp"
L_0083:;
// 930 RELAD=AT-WCABUF
#line 930 "test-new/imp918s.imp"
RELAD = AT - *WCABUF;
// 931 %IF RELAD>=0 %THEN SHORTINTEGER(RELAD+BUFAD)<-VALUE %ELSESTART
#line 931 "test-new/imp918s.imp"
if (RELAD < 0) goto L_0084;
#line 931 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(RELAD + BUFAD) = (short int)(VALUE);
#line 931 "test-new/imp918s.imp"
goto L_0085;
#line 931 "test-new/imp918s.imp"
L_0084:;
// 932 %IF INHCODE=0 %THEN LPUT(AREA,2,AT,ADDR(VALUE)+2)
#line 932 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0086;
#line 932 "test-new/imp918s.imp"
LPUT(AREA, 2, AT, _imp_ADDR(/*?*/ &VALUE) + 2);
#line 932 "test-new/imp918s.imp"
L_0086:;
// 933 %FINISH
#line 933 "test-new/imp918s.imp"
L_0085:;
// 934 %END
#line 934 "test-new/imp918s.imp"
return;
#line 934 "test-new/imp918s.imp"
} /* end of PLUG */
// 935 %ROUTINE SET PERMBASE
#line 935 "test-new/imp918s.imp"
void SETPERMBASE(void) {
// 936 PCONST(X'58CD005C')
#line 936 "test-new/imp918s.imp"
PCONST(1489829980);
// 937 REGISTER(12)=-1
#line 937 "test-new/imp918s.imp"
REGISTER[12] = -1;
// 938 GRUSE(12)=18
#line 938 "test-new/imp918s.imp"
GRUSE[12] = 18;
// 939 GRINF(12)=0
#line 939 "test-new/imp918s.imp"
GRINF[12] = 0;
// 940 %END
#line 940 "test-new/imp918s.imp"
return;
#line 940 "test-new/imp918s.imp"
} /* end of SETPERMBASE */
// 941 %ROUTINE PRHEX(%INTEGER VALUE,PLACES)
#line 941 "test-new/imp918s.imp"
void PRHEX(int VALUE, int PLACES) {
// 942 %OWNINTEGER HT1=M'0123'
#line 942 "test-new/imp918s.imp"
static int HT1 = 808530483;
// 943 %OWNINTEGER HT2=M'4567'
#line 943 "test-new/imp918s.imp"
static int HT2 = 875902519;
// 944 %OWNINTEGER HT3=M'89AB'
#line 944 "test-new/imp918s.imp"
static int HT3 = 943276354;
// 945 %OWNINTEGER HT4=M'CDEF'
#line 945 "test-new/imp918s.imp"
static int HT4 = 1128547654;
// 946 %INTEGER W1,W2,W3
#line 946 "test-new/imp918s.imp"
int W1;
#line 946 "test-new/imp918s.imp"
int W2;
#line 946 "test-new/imp918s.imp"
int W3;
// 947 !%if USE MC = 1 %start
// 948 ! *UNPK_W1+1(9),VALUE(5)
// 949 ! *NC_W1+1(8),MASK1
// 950 ! *TR_W1+1(8),HT1
// 951 ! *LA_1,W1+8; *S_1,PLACES
// 952 ! *MVC_ 0(1,1),PLACES+3
// 953 ! *-> P5; ! PRINTSTRING IN PERM
// 954 !%finish
// 955 %END
#line 955 "test-new/imp918s.imp"
return;
#line 955 "test-new/imp918s.imp"
} /* end of PRHEX */
// ?W3 unused
// ?W2 unused
// ?W1 unused
// ?HT4 unused
// ?HT3 unused
// ?HT2 unused
// ?HT1 unused
// ?PLACES unused
// ?VALUE unused
// 956 %ROUTINE GET ENV(%SHORTINTEGERNAME HEAD)
#line 956 "test-new/imp918s.imp"
void GETENV(short int *HEAD) {
// 957 {%SHORTROUTINE}
// 958 !***********************************************************************
// 959 !* SAVE A COPY OF THE REGISTER STATE FOR FUTURE REFERENCE *
// 960 !***********************************************************************
// 961 %INTEGER I,J
#line 961 "test-new/imp918s.imp"
int I;
#line 961 "test-new/imp918s.imp"
int J;
// 962 %CYCLE J=0,1,14; I=GRMAP(J)
#line 962 "test-new/imp918s.imp"
// %for J = 0, 1, 14 %cycle
#line 962 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 14;
#line 962 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 0, 1, 14");
_control = J = _initial - _increment;
#line 962 "test-new/imp918s.imp"
L_0087:
#line 962 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 962 "test-new/imp918s.imp"
if (J == _final) goto L_0088;
#line 962 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
#line 962 "test-new/imp918s.imp"
I = GRMAP[J];
// 963 PUSH123(HEAD,GRINF(I),GRAT(I),I<<8!GRUSE(I)) %IF GRUSE(I)>1
#line 963 "test-new/imp918s.imp"
if (GRUSE[I] <= 1) goto L_0089;
#line 963 "test-new/imp918s.imp"
PUSH123(HEAD, GRINF[I], GRAT[I], I << 8 | GRUSE[I]);
#line 963 "test-new/imp918s.imp"
L_0089:;
// 964 %REPEAT
#line 964 "test-new/imp918s.imp"
goto L_0087;
#line 964 "test-new/imp918s.imp"
}
#line 964 "test-new/imp918s.imp"
L_0088:;
// 965 %END
#line 965 "test-new/imp918s.imp"
return;
#line 965 "test-new/imp918s.imp"
} /* end of GETENV */
// 966 %ROUTINE RESTORE(%SHORTINTEGER HEAD)
#line 966 "test-new/imp918s.imp"
void RESTORE(short int HEAD) {
// 967 {%SHORTROUTINE}
// 968 !***********************************************************************
// 969 !* RESET THE REGISTERS TO ENVIRONMENT IN LIST HEADED BY 'HEAD' *
// 970 !***********************************************************************
// 971 %INTEGER I,J,R,USE,INF,AT
#line 971 "test-new/imp918s.imp"
int I;
#line 971 "test-new/imp918s.imp"
int J;
#line 971 "test-new/imp918s.imp"
int R;
#line 971 "test-new/imp918s.imp"
int USE;
#line 971 "test-new/imp918s.imp"
int INF;
#line 971 "test-new/imp918s.imp"
int AT;
// 972 CCSTATE=-1
#line 972 "test-new/imp918s.imp"
CCSTATE = -1;
// 973 %CYCLE J=0,1,14; I=GRMAP(J)
#line 973 "test-new/imp918s.imp"
// %for J = 0, 1, 14 %cycle
#line 973 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 14;
#line 973 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 0, 1, 14");
_control = J = _initial - _increment;
#line 973 "test-new/imp918s.imp"
L_008A:
#line 973 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 973 "test-new/imp918s.imp"
if (J == _final) goto L_008B;
#line 973 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
#line 973 "test-new/imp918s.imp"
I = GRMAP[J];
// 974 %IF REGISTER(I)>=0 %THEN GRUSE(I)=0 %AND GRINF(I)=0
#line 974 "test-new/imp918s.imp"
if (REGISTER[I] < 0) goto L_008C;
#line 974 "test-new/imp918s.imp"
GRUSE[I] = 0;
#line 974 "test-new/imp918s.imp"
GRINF[I] = 0;
#line 974 "test-new/imp918s.imp"
L_008C:;
// 975 %REPEAT
#line 975 "test-new/imp918s.imp"
goto L_008A;
#line 975 "test-new/imp918s.imp"
}
#line 975 "test-new/imp918s.imp"
L_008B:;
// 976 %WHILE HEAD#0 %CYCLE
#line 976 "test-new/imp918s.imp"
L_008D:;
#line 976 "test-new/imp918s.imp"
if (HEAD == 0) goto L_008E;
// 977 POP123(HEAD,INF,AT,I)
#line 977 "test-new/imp918s.imp"
POP123(/*?*/ &HEAD, /*?*/ &INF, /*?*/ &AT, /*?*/ &I);
// 978 R=I>>8
#line 978 "test-new/imp918s.imp"
R = (unsigned int)I >> 8;
// 979 %IF REGISTER(R)>=0 %THEN GRUSE(R)=I&255 %AND GRINF(R)=INF
#line 979 "test-new/imp918s.imp"
if (REGISTER[R] < 0) goto L_008F;
#line 979 "test-new/imp918s.imp"
GRUSE[R] = I & 255;
#line 979 "test-new/imp918s.imp"
GRINF[R] = INF;
#line 979 "test-new/imp918s.imp"
L_008F:;
// 980 GRAT(R)=AT
#line 980 "test-new/imp918s.imp"
GRAT[R] = AT;
// 981 %REPEAT
#line 981 "test-new/imp918s.imp"
goto L_008D;
#line 981 "test-new/imp918s.imp"
L_008E:;
// 982 %END
#line 982 "test-new/imp918s.imp"
return;
#line 982 "test-new/imp918s.imp"
} /* end of RESTORE */
// ?USE unused
// 983 ! %ROUTINE PRINT LIST(%INTEGER HEAD)
// 984 ! {%SHORTROUTINE}
// 985 ! %INTEGER I,J,K
// 986 !1: %IF HEAD=0 %THEN %RETURN
// 987 ! FROM123(HEAD,I,J,K)
// 988 ! NEWLINE
// 989 ! PRHEX(I,8)
// 990 ! SPACES(3)
// 991 ! PRHEX(J,8)
// 992 ! SPACES(3)
// 993 ! PRHEX(K,8)
// 994 ! NEWLINE
// 995 ! MLINK(HEAD)
// 996 ! ->Label1
// 997 ! %END
// 998 !
// 999 ! ******* LIST***PROCESSING***ROUTINES
// 1000 ! NEW VERSIONS BASED ON A 96BIT(12 BYTE) UNIT
// 1001 ! S1=S2=32 BIT STREAM, S3=16 BIT STREAM
// 1002 !
// 1003 ! %ROUTINE CHECK ASL
// 1004 !! CHECK ASL FOR CONSISTENCY AND PRINT OUT FREE CELLS
// 1005 !! FOR DEBUGGING OBSCURE LIST PROCESSING FAULTS ONLY
// 1006 ! {%SHORTROUTINE}
// 1007 ! %INTEGER N,Q
// 1008 ! N=0
// 1009 ! Q=ASL
// 1010 !1: ->Label2 %IF Q=0
// 1011 ! ABORT %UNLESS Q&3=0
// 1012 ! MLINK(Q)
// 1013 ! N=N+1
// 1014 ! ->Label1
// 1015 !2: printstring(" FREE CELLS=")
// 1016 ! WRITE(N,3)
// 1017 ! NEWLINE
// 1018 ! %END
// 1019 !
// 1020 ! %INTEGERFN NEW CELL
// 1021 ! %INTEGER I
// 1022 !%if USE MC = 1 %start
// 1023 ! *L_1,ASL
// 1024 ! *LTR_2,1
// 1025 ! *BC_7,<1>
// 1026 !%finish
// 1027 ! FAULT(107,0)
// 1028 !%if USE MC = 1 %start
// 1029 !1: *A_2,ASLIST
// 1030 ! *MVC_ASL+2(2),14(2); !ASL TO NEXT FREE CELL
// 1031 ! *XC_0(16,2),0(2); ! NEWCELL TO ZERO
// 1032 ! *LM_4,15,16(8)
// 1033 ! *BCR_15,15
// 1034 !%finish
// 1035 ! %END
// 1036 %ROUTINE PUSH(%SHORTINTEGERNAME CELL,%INTEGER S1,S2)
#line 1036 "test-new/imp918s.imp"
void PUSH(short int *CELL, int S1, int S2) {
// 1037 !%if USE MC = 1 %start
// 1038 ! *L_4,ASL; *LTR_5,4; *BC_7,<1>
// 1039 !%finish
// 1040 FAULT(107,0)
#line 1040 "test-new/imp918s.imp"
FAULT(107, 0);
// 1041 !%if USE MC = 1 %start
// 1042 !1: *A_5,ASLIST; *MVC_ASL+2(2),14(5)
// 1043 ! *LM_15,1,CELL; *LH_3,0(15); *SR_2,2
// 1044 ! *STH_4,0(15); *STM_0,3,0(5)
// 1045 !%finish
// 1046 %END
#line 1046 "test-new/imp918s.imp"
return;
#line 1046 "test-new/imp918s.imp"
} /* end of PUSH */
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1047 %ROUTINE PUSH123(%SHORTINTEGERNAME CELL,%INTEGER S1,S2,S3)
#line 1047 "test-new/imp918s.imp"
void PUSH123(short int *CELL, int S1, int S2, int S3) {
// 1048 !%if USE MC = 1 %start
// 1049 ! *L_4,ASL; *LTR_5,4; *BC_7,<1>
// 1050 !%finish
// 1051 FAULT(107,0)
#line 1051 "test-new/imp918s.imp"
FAULT(107, 0);
// 1052 !%if USE MC = 1 %start
// 1053 !1: *A_5,ASLIST; *MVC_ASL+2(2),14(5)
// 1054 ! *LM_15,2,CELL; *LH_3,0(15)
// 1055 ! *STH_4,0(15); *STM_0,3,0(5)
// 1056 !%finish
// 1057 %END
#line 1057 "test-new/imp918s.imp"
return;
#line 1057 "test-new/imp918s.imp"
} /* end of PUSH123 */
// ?S3 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1058 %ROUTINE POP(%SHORTINTEGERNAME CELL,%INTEGERNAME S1,S2)
#line 1058 "test-new/imp918s.imp"
void POP(short int *CELL, int *S1, int *S2) {
// 1059 !%if USE MC = 1 %start
// 1060 ! *LM_1,3,CELL; *LH_4,0(1); *L_15,ASLIST
// 1061 ! *L_0,0(4,15); *ST_0,0(2); ! SET S1
// 1062 ! *L_0,4(4,15); *ST_0,0(3); ! SET S2
// 1063 ! *LTR_4,4; *BC_8,<1>; ! HEAD =0 FOR NULL LIST
// 1064 ! *LH_0,14(4,15); *STH_0,0(1); ! HEADCELL TO OLD 2ND CELL
// 1065 ! *L_3,ASL; *STH_3,14(4,15); *ST_4,ASL
// 1066 !%finish
// 1067 Label1: %END
#line 1067 "test-new/imp918s.imp"
U_1006:;
#line 1067 "test-new/imp918s.imp"
return;
#line 1067 "test-new/imp918s.imp"
} /* end of POP */
// ?LABEL1 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1068 %ROUTINE POP123(%SHORTINTEGERNAME CELL,%C
#line 1068 "test-new/imp918s.imp"
void POP123(short int *CELL, int *S1, int *S2, int *S3) {
// 1069+ %INTEGERNAME S1,S2,S3)
// 1070
// 1071 !%if USE MC = 1 %start
// 1072 ! *LM_1,3,CELL; *LH_4,0(1); *L_15,ASLIST
// 1073 ! *L_0,0(4,15); *ST_0,0(2); ! SET S1
// 1074 ! *L_0,4(4,15); *ST_0,0(3); ! SET S2
// 1075 ! *L_0,8(4,15); *L_3,S3; *ST_0,0(3); ! SET S3
// 1076 ! *LTR_4,4; *BC_8,<1>; ! HEAD =0 FOR NULL LIST
// 1077 ! *LH_0,14(4,15); *STH_0,0(1); ! HEADCELL TO OLD 2ND CELL
// 1078 ! *L_3,ASL; *STH_3,14(4,15); *ST_4,ASL
// 1079 !%finish
// 1080 Label1: %END
#line 1080 "test-new/imp918s.imp"
U_100E:;
#line 1080 "test-new/imp918s.imp"
return;
#line 1080 "test-new/imp918s.imp"
} /* end of POP123 */
// ?LABEL1 unused
// ?S3 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1081 %ROUTINE INSERT AFTER(%SHORTINTEGERNAME CELL,%INTEGER S1,S2)
#line 1081 "test-new/imp918s.imp"
void INSERTAFTER(short int *CELL, int S1, int S2) {
// 1082 !%if USE MC = 1 %start
// 1083 ! *L_1,ASL; *LTR_2,1; *BC_7,<2>
// 1084 !%finish
// 1085 FAULT(107,0)
#line 1085 "test-new/imp918s.imp"
FAULT(107, 0);
// 1086 !%if USE MC = 1 %start
// 1087 !2: *A_2,ASLIST; *MVC_ASL+2(2),14(2)
// 1088 ! *SR_0,0; *ST_0,12(2); *ST_0,8(2)
// 1089 ! *L_2,ASLIST;*LM_3,4,S1;*ST_3,0(1,2);*ST_4,4(1,2)
// 1090 ! *L_4,CELL; *LH_3,0(4); *STH_1,0(4)
// 1091 ! *LTR_3,3;*BC_8,<1>;*LH_4,14(3,2)
// 1092 ! *STH_4,14(1,2); *STH_1,14(3,2)
// 1093 !%finish
// 1094 Label1: %END
#line 1094 "test-new/imp918s.imp"
U_1006:;
#line 1094 "test-new/imp918s.imp"
return;
#line 1094 "test-new/imp918s.imp"
} /* end of INSERTAFTER */
// ?LABEL1 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1095
// 1096 %ROUTINE BINSERT(%SHORTINTEGERNAME TOP,BOT,%INTEGER S1,S2,S3)
#line 1096 "test-new/imp918s.imp"
void BINSERT(short int *TOP, short int *BOT, int S1, int S2, int S3) {
// 1097 !***********************************************************************
// 1098 !* ADD A NEWCELL AT THE BOTTOM OF A LIST *
// 1099 !***********************************************************************
// 1100 !%if USE MC = 1 %start
// 1101 ! *LM_14,2,TOP; *L_3,ASL
// 1102 ! *LTR_4,3; *BC_7,<1>
// 1103 !%finish
// 1104 FAULT(107,0)
#line 1104 "test-new/imp918s.imp"
FAULT(107, 0);
// 1105 !%if USE MC = 1 %start
// 1106 !1: *L_5,ASLIST; *LH_6,14(3,5); *ST_6,ASL
// 1107 ! *LH_6,0(15); *LTR_6,6; *BC_7,<2>; ! IS BOT 0 ?
// 1108 ! *STH_3,0(14); *BC_15,<3>; ! YES SET TOP =NEWCELL
// 1109 !2: *STH_3,14(6,5); ! LINK NEWCELL TO PREV BOT
// 1110 !3: *STH_3,0(15); ! BOT =NEWCELL
// 1111 ! *SR_3,3; *AR_4,5
// 1112 ! *STM_0,3,0(4)
// 1113 !%finish
// 1114 %END
#line 1114 "test-new/imp918s.imp"
return;
#line 1114 "test-new/imp918s.imp"
} /* end of BINSERT */
// ?S3 unused
// ?S2 unused
// ?S1 unused
// ?BOT unused
// ?TOP unused
// 1115 %ROUTINE REPLACE123(%INTEGER CELL,S1,S2,S3)
#line 1115 "test-new/imp918s.imp"
void REPLACE123(int CELL, int S1, int S2, int S3) {
// 1116 !%if USE MC = 1 %start
// 1117 ! *LM_15,2,CELL;*A_15,ASLIST
// 1118 ! *STM_0,2,0(15)
// 1119 ! *LM_8,15,32(8); *BCR_15,15
// 1120 !%finish
// 1121 %END
#line 1121 "test-new/imp918s.imp"
return;
#line 1121 "test-new/imp918s.imp"
} /* end of REPLACE123 */
// ?S3 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1122 %ROUTINE REPLACE1(%INTEGER CELL,S1)
#line 1122 "test-new/imp918s.imp"
void REPLACE1(int CELL, int S1) {
// 1123 INTEGER(ADDR(ASLIST(CELL)))=S1
#line 1123 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL])) = S1;
// 1124 %END
#line 1124 "test-new/imp918s.imp"
return;
#line 1124 "test-new/imp918s.imp"
} /* end of REPLACE1 */
// 1125 %ROUTINE REPLACE2(%INTEGER CELL,S2)
#line 1125 "test-new/imp918s.imp"
void REPLACE2(int CELL, int S2) {
// 1126 INTEGER(ADDR(ASLIST(CELL+4)))=S2
#line 1126 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL + 4])) = S2;
// 1127 %END
#line 1127 "test-new/imp918s.imp"
return;
#line 1127 "test-new/imp918s.imp"
} /* end of REPLACE2 */
// 1128 %ROUTINE REPLACE3(%INTEGER CELL,S3)
#line 1128 "test-new/imp918s.imp"
void REPLACE3(int CELL, int S3) {
// 1129 INTEGER(ADDR(ASLIST(CELL+8)))=S3
#line 1129 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL + 8])) = S3;
// 1130 %END
#line 1130 "test-new/imp918s.imp"
return;
#line 1130 "test-new/imp918s.imp"
} /* end of REPLACE3 */
// 1131 %ROUTINE MLINK(%INTEGERNAME CELL)
#line 1131 "test-new/imp918s.imp"
void MLINK(int *CELL) {
// 1132 CELL=SHORTINTEGER(ADDR(ASLIST(CELL+14)))
#line 1132 "test-new/imp918s.imp"
*CELL = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*CELL + 14]));
// 1133 %END
#line 1133 "test-new/imp918s.imp"
return;
#line 1133 "test-new/imp918s.imp"
} /* end of MLINK */
// 1134 %INTEGERFN FIND(%INTEGER LAB,LIST)
#line 1134 "test-new/imp918s.imp"
int FIND(int LAB, int LIST) {
// 1135 ! THIS FUNCTION SEARCHES LIST 'LIST' FOR LAB IN STREAM2 AND
// 1136 ! RETURNS THE CORRESPONDING CELL NO.IT USED FOR MORE THAN
// 1137 ! SCANNING LABEL LISTS.
// 1138 !%if USE MC = 1 %start
// 1139 ! %MCODE
// 1140 ! *LM_0,1,LAB; *L_2,ASLIST
// 1141 ! *LTR_15,1; *BC_8,<FAIL>
// 1142 !AGAIN: *C_0,4(1,2);
// 1143 ! *BC_8,<FOUND>
// 1144 ! *LH_1,14(1,2)
// 1145 ! *LTR_15,1
// 1146 ! *BC_7,<AGAIN>
// 1147 !FAIL: *L_1,0(15,2); ! IF FAIL LOADS-1 ELSE RESULT
// 1148 !FOUND: *LM_8,15,32(8); *BCR_15,15
// 1149 ! %ENDOFMCODE
// 1150 !%finish
// 1151 %result=-1
#line 1151 "test-new/imp918s.imp"
return -1;
// 1152 %END
#line 1152 "test-new/imp918s.imp"
} /* end of FIND */
// ?LIST unused
// ?LAB unused
// 1153 %INTEGERFN FIND3(%INTEGER S3,LIST)
#line 1153 "test-new/imp918s.imp"
int FIND3(int S3, int LIST) {
// 1154 !***********************************************************************
// 1155 !* SEARCHES LIST FOR S3 IN STREAM 3 *
// 1156 !* RETURNS CELL NO AS RESULT *
// 1157 !***********************************************************************
// 1158 !%if USE MC = 1 %start
// 1159 ! *LM_0,1,S3; *L_2,ASLIST; *SR_3,3
// 1160 ! *LTR_1,1; *BC_8,<FAIL>
// 1161 !AGAIN: *C_0,8(1,2)
// 1162 ! *BC_8,<FOUND>
// 1163 ! *LR_3,1; ! SAVE PREVIOUS CELL
// 1164 ! *LH_1,14(1,2)
// 1165 ! *LTR_1,1
// 1166 ! *BC_7,<AGAIN>
// 1167 !FAIL: *BCTR_1,0
// 1168 !FOUND: *ST_3,PREV3CL;
// 1169 ! *LM_8,15,32(8); *BCR_15,15
// 1170 !%finish
// 1171 %result=-1
#line 1171 "test-new/imp918s.imp"
return -1;
// 1172 %END
#line 1172 "test-new/imp918s.imp"
} /* end of FIND3 */
// ?LIST unused
// ?S3 unused
// 1173 %ROUTINE FROM123(%INTEGER CELL,%INTEGERNAME S1,S2,S3)
#line 1173 "test-new/imp918s.imp"
void FROM123(int CELL, int *S1, int *S2, int *S3) {
// 1174 !%if USE MC = 1 %start
// 1175 ! *LM_1,4,CELL; *A_1,ASLIST;
// 1176 ! *LM_15,1,0(1); * ST_15,0(2)
// 1177 ! *ST_ 0,0(3); *ST_1,0(4)
// 1178 ! *LM_8,15,32(8); *BCR_15,15
// 1179 !%finish
// 1180 %END
#line 1180 "test-new/imp918s.imp"
return;
#line 1180 "test-new/imp918s.imp"
} /* end of FROM123 */
// ?S3 unused
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1181 %ROUTINE FROM12(%INTEGER CELL,%INTEGERNAME S1,S2)
#line 1181 "test-new/imp918s.imp"
void FROM12(int CELL, int *S1, int *S2) {
// 1182 !%if USE MC = 1 %start
// 1183 ! *LM_1,3,CELL ;*A_1,ASLIST ;
// 1184 ! *LM_0,1,0(1); *ST_0,0(2); *ST_1,0(3)
// 1185 !%finish
// 1186 %END
#line 1186 "test-new/imp918s.imp"
return;
#line 1186 "test-new/imp918s.imp"
} /* end of FROM12 */
// ?S2 unused
// ?S1 unused
// ?CELL unused
// 1187 %INTEGERFN FROM1(%INTEGER CELL)
#line 1187 "test-new/imp918s.imp"
int FROM1(int CELL) {
// 1188 %RESULT=INTEGER(ADDR(ASLIST(CELL)))
#line 1188 "test-new/imp918s.imp"
return *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL]));
// 1189 %END
#line 1189 "test-new/imp918s.imp"
} /* end of FROM1 */
// 1190 %INTEGERFN FROM2(%INTEGER CELL)
#line 1190 "test-new/imp918s.imp"
int FROM2(int CELL) {
// 1191 %RESULT=INTEGER(ADDR(ASLIST(CELL))+4)
#line 1191 "test-new/imp918s.imp"
return *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL]) + 4);
// 1192 %END
#line 1192 "test-new/imp918s.imp"
} /* end of FROM2 */
// 1193 %INTEGERFN FROM3(%INTEGER CELL)
#line 1193 "test-new/imp918s.imp"
int FROM3(int CELL) {
// 1194 %RESULT=INTEGER(ADDR(ASLIST(CELL))+8)
#line 1194 "test-new/imp918s.imp"
return *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL]) + 8);
// 1195 %END
#line 1195 "test-new/imp918s.imp"
} /* end of FROM3 */
// 1196 %ROUTINE CLEAR LIST (%SHORTINTEGERNAME OPHEAD)
#line 1196 "test-new/imp918s.imp"
void CLEARLIST(short int *OPHEAD) {
// 1197 !%if USE MC = 1 %start
// 1198 ! **1,OPHEAD; *LTR_1,1; *BC_8,<EMPTY>
// 1199 ! *L_2,ASLIST; *L_0,ASL; *ST_1,ASL
// 1200 !AGAIN: *LR_3,1; *LH_1,14(1,2); ! NEXT LINK
// 1201 ! *LTR_1,1; *BC_7,<AGAIN>; ! IS IT ZERO?
// 1202 ! *STH_0,14(3,2); ! LAST LINK TO OLD VALUE OF ASL
// 1203 !%finish
// 1204 EMPTY: OPHEAD=0;
#line 1204 "test-new/imp918s.imp"
U_100E:;
#line 1204 "test-new/imp918s.imp"
*OPHEAD = 0;
// 1205 %END
#line 1205 "test-new/imp918s.imp"
return;
#line 1205 "test-new/imp918s.imp"
} /* end of CLEARLIST */
// ?EMPTY unused
// 1206 ! %ROUTINE CONCAT(%SHORTINTEGERNAME LIST1,LIST2)
// 1207 ! %COMMENT ADDS LIST2 TO BOTTOM OF LIST1
// 1208 !%if USE MC = 1 %start
// 1209 ! *L_4,LIST1
// 1210 ! *L_15,LIST2
// 1211 ! *LH_0,0(15)
// 1212 ! *L_2,ASLIST
// 1213 ! *LH_1,0(4)
// 1214 ! *LTR_3,1
// 1215 ! *BC_7,<ON>
// 1216 ! *STH_0,0(4)
// 1217 ! *BC_15,<COMM>
// 1218 !ON: *LR_3,1
// 1219 ! *LH_1,14(3,2); ! NEXT LINK
// 1220 ! *LTR_1,1
// 1221 ! *BC_7,<ON>
// 1222 ! *STH_0,14(3,2); ! LAST LINK TO NEW LIST
// 1223 !COMM: *STH_1,0(15); ! ZERO HEAD OF LIST2 IN CASE
// 1224 !%finish
// 1225 ! %END; ! AN ERROR PUTS CELL TWICE ONTO
// 1226 ! FREE LIST - CATASTROPHIC!
// 1227 ! %ROUTINE INSERT AT END(%SHORTINTEGERNAME CELL,%INTEGER S1,S2)
// 1228 ! {%SHORTROUTINE}
// 1229 !!***********************************************************************
// 1230 !!* ADD A CELL TO THE BOTTOM OF THE LIST HEADED BY 'CELL' *
// 1231 !!***********************************************************************
// 1232 !%if USE MC = 1 %start
// 1233 ! *L_1,ASL
// 1234 ! *LTR_2,1
// 1235 ! *BC_7,<1>
// 1236 !%finish
// 1237 ! FAULT(107,0)
// 1238 !%if USE MC = 1 %start
// 1239 !1: *A_2,ASLIST
// 1240 ! *MVC_ASL+2(2),14(2)
// 1241 ! *SR_0,0
// 1242 ! *ST_0,12(2)
// 1243 ! *L_2,ASLIST
// 1244 ! *L_4,CELL
// 1245 ! *LH_3,0(4); ! GET HEAD CELL
// 1246 ! *LTR_3,3
// 1247 ! *BC_7,<ON>; ! LIST NOT EMPTY
// 1248 ! *STH_1,0(4)
// 1249 ! *BC_15,<LOAD>; ! EMPTY LIST -- CELL TO TOP
// 1250 !ON: *LR_4,3
// 1251 ! *LH_3,14(2,4); ! IS NEXT CELL THE BOTTOM??
// 1252 ! *LTR_3,3
// 1253 ! *BC_7,<ON>
// 1254 ! *STH_1,14(2,4)
// 1255 !LOAD: *AR_1,2
// 1256 ! *MVC_0(8,1),S1
// 1257 !%finish
// 1258 ! %END
// 1259 ! ************END****OF****LIST****PROCESSING ROUTINES
// 1260 %ROUTINE CSS(%INTEGER PIN,CSSMODE)
#line 1260 "test-new/imp918s.imp"
void CSS(int PIN, int CSSMODE) {
#line 1260 "test-new/imp918s.imp"
auto void CIOCP(int N);
#line 1260 "test-new/imp918s.imp"
auto void DEFINEEP(int MODE, int NAME, int ADR, int XTRA);
#line 1260 "test-new/imp918s.imp"
auto void LABLOOK(int *FLAG, int LAB);
#line 1260 "test-new/imp918s.imp"
auto void SETLOCALBASE(void);
#line 1260 "test-new/imp918s.imp"
auto void STRINGOP(int Z, int L, int BTO, int DTO, int BFRM, int DFRM, int BML, int DML, int XREG);
#line 1260 "test-new/imp918s.imp"
auto void CEND(int KKK);
#line 1260 "test-new/imp918s.imp"
auto void CBPAIR(int *LB, int *UB);
#line 1260 "test-new/imp918s.imp"
auto void CCOND(int IU, int FARLAB);
#line 1260 "test-new/imp918s.imp"
auto void SETLINE(void);
#line 1260 "test-new/imp918s.imp"
auto void CUI(int CODE);
#line 1260 "test-new/imp918s.imp"
auto void CSTART(int CODE);
#line 1260 "test-new/imp918s.imp"
auto void BULKM(int MODE, int L, int B1, int D1, int B2, int D2);
#line 1260 "test-new/imp918s.imp"
auto void TORP(short int *HEAD, short int *BOT, short int *NOPS, int MODE);
#line 1260 "test-new/imp918s.imp"
auto void SETUSE(int R, int U, int I);
#line 1260 "test-new/imp918s.imp"
auto void CSEXP(int REG, int MODE);
#line 1260 "test-new/imp918s.imp"
auto void DSEXP(int REG, int MODE);
#line 1260 "test-new/imp918s.imp"
auto void FREEANDFORGET(int REG);
#line 1260 "test-new/imp918s.imp"
auto void SAVEIRS(int UPPER);
#line 1260 "test-new/imp918s.imp"
auto void BOOTOUT(int REG);
#line 1260 "test-new/imp918s.imp"
auto void EXPOP(int INHEAD, int REG, int NOPS, int MODE);
#line 1260 "test-new/imp918s.imp"
auto void CSTREXP(int MODE, int REG);
#line 1260 "test-new/imp918s.imp"
auto void ASSIGN(int ASSOP, int P1);
#line 1260 "test-new/imp918s.imp"
auto int COPYRECORDTAG(int *SUBS);
#line 1260 "test-new/imp918s.imp"
auto void TESTAPP(int *NUM);
#line 1260 "test-new/imp918s.imp"
auto int DISPLACEMENT(int LINK);
#line 1260 "test-new/imp918s.imp"
auto void SKIPAPP(void);
#line 1260 "test-new/imp918s.imp"
auto void CRFORMAT(short int *OPHEAD);
#line 1260 "test-new/imp918s.imp"
auto int DOPEVECTOR(int ELSIZE, int LB, int UB);
#line 1260 "test-new/imp918s.imp"
auto void DECLAREARRAYS(int FORMAT, int FINF);
#line 1260 "test-new/imp918s.imp"
auto void DECLARESCALARS(int PERMIT, int XTRA);
#line 1260 "test-new/imp918s.imp"
auto void CQN(int P);
#line 1260 "test-new/imp918s.imp"
auto void CLT(void);
#line 1260 "test-new/imp918s.imp"
auto void MOVER(int R, int N);
#line 1260 "test-new/imp918s.imp"
auto void GETWSP(int *PLACE, int SIZE);
#line 1260 "test-new/imp918s.imp"
auto void RETURNWSP(int PLACE, int SIZE);
#line 1260 "test-new/imp918s.imp"
auto void CRCALL(int TCELLP);
#line 1260 "test-new/imp918s.imp"
auto void CNAME(int Z, int REG);
#line 1260 "test-new/imp918s.imp"
auto void CRNAME(int Z, int REG, int MODE, int CLINK, int BS, int IX, int DP);
#line 1260 "test-new/imp918s.imp"
auto void CANAME(int ARRP, int BS, int DP, int BASICDISP);
#line 1260 "test-new/imp918s.imp"
auto void ADJUSTINDEX(int MODE, int *INDEX, int *DISP);
#line 1260 "test-new/imp918s.imp"
auto void CREATEAH(int MODE, int REG, int BS, int DP);
#line 1260 "test-new/imp918s.imp"
auto void CRES(int LAB);
#line 1260 "test-new/imp918s.imp"
auto void CSNAME(int Z, int REG);
#line 1260 "test-new/imp918s.imp"
auto void COPYTAG(int KK);
#line 1260 "test-new/imp918s.imp"
auto void REDUCETAG(int MODE);
#line 1260 "test-new/imp918s.imp"
auto void REPLACETAG(int KK);
#line 1260 "test-new/imp918s.imp"
auto void RTEXIT(void);
#line 1260 "test-new/imp918s.imp"
auto void RTJUMP(int CODE, int R1, int LINK, int WKREG);
#line 1260 "test-new/imp918s.imp"
auto void MERGEINFO(void);
#line 1260 "test-new/imp918s.imp"
auto void REDUCEENV(short int *HEAD);
#line 1260 "test-new/imp918s.imp"
auto void RELOCATE(int GLARAD, int VALUE, int AREA);
#line 1260 "test-new/imp918s.imp"
auto void GXREF(int MODE, int NAME, int XTRA, int AT);
#line 1260 "test-new/imp918s.imp"
auto void CXREF(int MODE, int NAME, int XTRA, int *AT);
#line 1260 "test-new/imp918s.imp"
auto void STORETAG(int KK, int SLINK);
#line 1260 "test-new/imp918s.imp"
auto void TESTNST(void);
#line 1260 "test-new/imp918s.imp"
auto void CUCI(void);
#line 1260 "test-new/imp918s.imp"
auto void SKIPEXP(void);
#line 1260 "test-new/imp918s.imp"
auto void UNPACK(void);
#line 1260 "test-new/imp918s.imp"
auto void PACK(int *PTYPE);
#line 1260 "test-new/imp918s.imp"
auto void CRSPEC(int M);
#line 1260 "test-new/imp918s.imp"
auto void LOADDV(int *REG, int B, int D, int TN);
#line 1260 "test-new/imp918s.imp"
auto void DUMP(int CODE, int REG, int DIS, int X, int LEVEL);
#line 1260 "test-new/imp918s.imp"
auto void DUMPM(int OPCODE, int R1, int R2, int B, int D);
#line 1260 "test-new/imp918s.imp"
auto void DUMPSI(int OPCODE, int L, int B, int D);
#line 1260 "test-new/imp918s.imp"
auto void DUMPSS(int OP, int L, int B1, int D1, int B2, int D2);
#line 1260 "test-new/imp918s.imp"
auto void RHEAD(int KK);
#line 1260 "test-new/imp918s.imp"
auto void ENTERJUMP(int MASK, int LAB, int FLAGS);
#line 1260 "test-new/imp918s.imp"
auto void CFPDEL(void);
#line 1260 "test-new/imp918s.imp"
auto void PPJ(int N);
#line 1260 "test-new/imp918s.imp"
auto void ENTERLAB(int LAB, int FLAGS);
#line 1260 "test-new/imp918s.imp"
auto void CHECKCAPACITY(int REG, int DIS, int X, int LEVEL);
#line 1260 "test-new/imp918s.imp"
auto int TSEXP(int *CODE, int RTMODE);
#line 1260 "test-new/imp918s.imp"
auto void FINDUSE(int *REG, int TYPE, int USE, int INF);
#line 1260 "test-new/imp918s.imp"
auto void CLAIMTHISREG(int REG);
#line 1260 "test-new/imp918s.imp"
auto void CLAIM(int CONTROL, int *REG);
#line 1260 "test-new/imp918s.imp"
auto void FINDREG(int CONTROL, int *REG);
#line 1260 "test-new/imp918s.imp"
auto void FORGET(int REG);
#line 1260 "test-new/imp918s.imp"
auto void FORGETM(int UPPER);
#line 1260 "test-new/imp918s.imp"
auto void FINDSEQ(int *ONE, int *TWO);
#line 1260 "test-new/imp918s.imp"
auto void REMEMBER(void);
#line 1260 "test-new/imp918s.imp"
auto int CONSTFIND(int L, int AD);
#line 1260 "test-new/imp918s.imp"
auto void STORECONST(int *B, int *D, int L, int AD);
#line 1260 "test-new/imp918s.imp"
auto void NOTEASSMENT(int REG, int ASSOP, int VAR);
#line 1260 "test-new/imp918s.imp"
auto void TEXTOUT(int REG);
#line 1260 "test-new/imp918s.imp"
auto void VALLOC(int REG, int TN);
#line 1260 "test-new/imp918s.imp"
auto void VDALLOC(int REG, int REGP);
#line 1260 "test-new/imp918s.imp"
auto void CYCOPT(int *FLAG, int WU);
#line 1260 "test-new/imp918s.imp"
auto void EXTRAPASS(int FST, int LST, int FLAG);
#line 1260 "test-new/imp918s.imp"
auto void CYCRESTORE(void);
// 1261 %ROUTINESPEC CIOCP(%INTEGER N)
// 1262 %ROUTINESPEC DEFINE EP(%INTEGER A,B,C,D)
// 1263 %ROUTINESPEC LAB LOOK(%INTEGERNAME A,%INTEGER B)
// 1264 %ROUTINESPEC SET LOCAL BASE
// 1265 %ROUTINESPEC STRINGOP(%INTEGER Z,L,BTO,DTO,BFRM,DFRM,BML,DML,X)
// 1266 %ROUTINESPEC CEND(%INTEGER KKK)
// 1267 %ROUTINESPEC CBPAIR(%INTEGERNAME LB,UB)
// 1268 %ROUTINESPEC CCOND(%INTEGER IU,FARLAB)
// 1269 %ROUTINESPEC SET LINE
// 1270 %ROUTINESPEC CUI(%INTEGER CODE)
// 1271 %ROUTINESPEC CSTART(%INTEGER CODE)
// 1272 %ROUTINESPEC BULKM(%INTEGER A,B,C,D,E,F)
// 1273 %ROUTINESPEC TORP(%SHORTINTEGERNAME H,B,NOPS,%INTEGER MODE)
// 1274 %ROUTINESPEC SET USE(%INTEGER R,U,I)
// 1275 %ROUTINESPEC CSEXP(%INTEGER REG,MODE)
// 1276 %ROUTINESPEC DSEXP(%INTEGER REG,MODE)
// 1277 %ROUTINESPEC FREE AND FORGET(%INTEGER REG)
// 1278 %ROUTINESPEC SAVE IRS(%INTEGER MODE)
// 1279 %ROUTINESPEC BOOT OUT(%INTEGER MODE)
// 1280 %ROUTINESPEC EXPOP(%INTEGER A,B,C,D)
// 1281 %ROUTINESPEC CSTREXP(%INTEGER MODE,REG)
// 1282 %ROUTINESPEC ASSIGN (%INTEGER P1,P2)
// 1283 %INTEGERFNSPEC COPY RECORD TAG(%INTEGERNAME SUBS)
// 1284 %ROUTINESPEC TEST APP(%INTEGERNAME NUM)
// 1285 %INTEGERFNSPEC DISPLACEMENT(%INTEGER LINK)
// 1286 %ROUTINESPEC SKIP APP
// 1287 %ROUTINESPEC CRFORMAT(%SHORTINTEGERNAME HEAD)
// 1288 %INTEGERFNSPEC DOPE VECTOR(%INTEGER A,B,C)
// 1289 %ROUTINESPEC DECLARE ARRAYS(%INTEGER MODE,XTRA)
// 1290 %ROUTINESPEC DECLARE SCALARS(%INTEGER A,B)
// 1291 %ROUTINESPEC CQN(%INTEGER P)
// 1292 %ROUTINESPEC CLT
// 1293 %ROUTINESPEC MOVE R(%INTEGER R,N)
// 1294 %ROUTINESPEC GET WSP(%INTEGERNAME PLACE,%INTEGER SIZE)
// 1295 %ROUTINESPEC RETURN WSP(%INTEGER PLACE,SIZE)
// 1296 %ROUTINESPEC CRCALL(%INTEGER A)
// 1297 %ROUTINESPEC CNAME(%INTEGER Z,REG)
// 1298 %ROUTINESPEC CRNAME(%INTEGER Z,REG,MODE,CLINK,BS,IX,DP)
// 1299 %ROUTINESPEC CANAME(%INTEGER Z,BS,DP,LINK)
// 1300 %ROUTINESPEC ADJUST INDEX(%INTEGER M,%INTEGERNAME I,D)
// 1301 %ROUTINESPEC CREATE AH(%INTEGER M,R,B,D)
// 1302 %ROUTINESPEC CRES(%INTEGER LAB)
// 1303 %ROUTINESPEC CSNAME(%INTEGER Z,REG)
// 1304 %ROUTINESPEC COPY TAG(%INTEGER KK)
// 1305 %ROUTINESPEC REDUCE TAG(%INTEGER MODE)
// 1306 %ROUTINESPEC REPLACE TAG (%INTEGER KK)
// 1307 %ROUTINESPEC RT EXIT
// 1308 %ROUTINESPEC RT JUMP(%INTEGER CODE,R1,RT,WKREG)
// 1309 %ROUTINESPEC MERGE INFO
// 1310 %ROUTINESPEC REDUCE ENV(%SHORTINTEGERNAME HEAD)
// 1311 %ROUTINESPEC RELOCATE(%INTEGER A,B,C)
// 1312 %ROUTINESPEC GXREF(%INTEGER A,B,C,D)
// 1313 %ROUTINESPEC CXREF(%INTEGER A,B,C,%INTEGERNAME D)
// 1314 %ROUTINESPEC STORE TAG(%INTEGER KK,SLINK)
// 1315 %ROUTINESPEC TESTNST
// 1316 %ROUTINESPEC CUCI
// 1317 %ROUTINESPEC SKIP EXP
// 1318 %ROUTINESPEC UNPACK
// 1319 %ROUTINESPEC PACK(%INTEGERNAME PTYPE)
// 1320 %ROUTINESPEC CRSPEC (%INTEGER M)
// 1321 %ROUTINESPEC LOAD DV(%INTEGERNAME REG,%INTEGER B,D,T)
// 1322 %ROUTINESPEC DUMP(%INTEGER CODE,REG,DIS,X,LEVEL)
// 1323 %ROUTINESPEC DUMPM(%INTEGER OPCODE,R1,R2,B,D)
// 1324 %ROUTINESPEC DUMPSI(%INTEGER OPCODE,L,B,D)
// 1325 %ROUTINESPEC DUMPSS(%INTEGER OP,L,B1,D1,B2,D2)
// 1326 %ROUTINESPEC RHEAD(%INTEGER KK)
// 1327 %ROUTINESPEC ENTER JUMP(%INTEGER MASK,STAD,FLAG)
// 1328 %ROUTINESPEC CFPDEL
// 1329 %ROUTINESPEC PPJ(%INTEGER N)
// 1330 %ROUTINESPEC ENTER LAB(%INTEGER M,FLAG)
// 1331 %ROUTINESPEC CHECK CAPACITY(%INTEGER REG,DIS,X,LEVEL)
// 1332 %INTEGERFNSPEC TSEXP(%INTEGERNAME CODE,%INTEGER I)
// 1333 %ROUTINESPEC FIND USE(%INTEGERNAME REG,%INTEGER TYPE,USE,INF)
// 1334 %ROUTINESPEC CLAIM THIS REG(%INTEGER A)
// 1335 %ROUTINESPEC CLAIM(%INTEGER A,%INTEGERNAME REG)
// 1336 %ROUTINESPEC FIND REG (%INTEGER A,%INTEGERNAME REG)
// 1337 %ROUTINESPEC FORGET(%INTEGER REG)
// 1338 %ROUTINESPEC FORGETM(%INTEGER UPPER)
// 1339 %ROUTINESPEC FIND SEQ(%INTEGERNAME ONE,TWO)
// 1340 %ROUTINESPEC REMEMBER
// 1341 %INTEGERFNSPEC CONST FIND (%INTEGER L,AD)
// 1342 %ROUTINESPEC STORE CONST(%INTEGERNAME B,D,%INTEGER L,AD)
// 1343 %ROUTINESPEC NOTE ASSMENT(%INTEGER REG,ASSOP,VAR)
// 1344 %ROUTINESPEC TEXTOUT(%INTEGER REG)
// 1345 %ROUTINESPEC VALLOC(%INTEGER A,B)
// 1346 %ROUTINESPEC VDALLOC(%INTEGER A,B)
// 1347 %ROUTINESPEC CYCOPT(%INTEGERNAME FLAG,%INTEGER WU)
// 1348 %ROUTINESPEC EXTRA PASS(%INTEGER I,J,K)
// 1349 %ROUTINESPEC CYC RESTORE
// 1350 %SWITCH SW(1:30)
#line 1350 "test-new/imp918s.imp"
int SW_index;
#line 1350 "test-new/imp918s.imp"
int SW_line;
#line 1350 "test-new/imp918s.imp"
char *SW_file;
#line 1350 "test-new/imp918s.imp"
static const void *SW[30] = {&&case_SW_1, &&case_SW_2, &&case_SW_3, &&case_SW_4, &&case_SW_5,
&&case_SW_6, &&case_SW_7, &&case_SW_8, &&case_SW_9, &&case_SW_10,
&&case_SW_11, &&case_SW_12, &&case_SW_13, &&case_SW_14, &&case_SW_15,
&&case_SW_16, &&case_SW_17, &&case_SW_18, &&case_SW_19, &&case_SW_20,
&&case_SW_21, &&case_SW_22, &&case_SW_23, &&case_SW_24, &&case_SW_25,
&&case_SW_26, &&case_SW_27, &&case_SW_28, &&case_SW_29, &&case_SW_missing};
// 1351 %RECORDFORMAT RD(%SHORTINTEGER PTYPE,%BYTEINTEGER XB,FLAG,%C
#line 1351 "test-new/imp918s.imp"
struct RD {
union {
struct {
#line 1351 "test-new/imp918s.imp"
short int PTYPE;
#line 1351 "test-new/imp918s.imp"
unsigned char XB;
#line 1351 "test-new/imp918s.imp"
unsigned char FLAG;
#line 1351 "test-new/imp918s.imp"
int D;
#line 1351 "test-new/imp918s.imp"
short int XTRA;
#line 1351 "test-new/imp918s.imp"
};
};
};
// 1352+ %INTEGER D,%SHORTINTEGER XTRA)
// 1353 %SHORTINTEGER OPHEAD,SFHEAD,TWSPHEAD,DUMHEAD,SNDISP,ACC,K,KFORM
#line 1353 "test-new/imp918s.imp"
short int OPHEAD;
#line 1353 "test-new/imp918s.imp"
short int SFHEAD;
#line 1353 "test-new/imp918s.imp"
short int TWSPHEAD;
#line 1353 "test-new/imp918s.imp"
short int DUMHEAD;
#line 1353 "test-new/imp918s.imp"
short int SNDISP;
#line 1353 "test-new/imp918s.imp"
short int ACC;
#line 1353 "test-new/imp918s.imp"
short int K;
#line 1353 "test-new/imp918s.imp"
short int KFORM;
// 1354 %INTEGER BXLE,TCELL,CURRINST,ADISP,BIMSTR,JJ,JJJ,KK,KKK, %C
#line 1354 "test-new/imp918s.imp"
int BXLE;
#line 1354 "test-new/imp918s.imp"
int TCELL;
#line 1354 "test-new/imp918s.imp"
int CURRINST;
#line 1354 "test-new/imp918s.imp"
int ADISP;
#line 1354 "test-new/imp918s.imp"
int BIMSTR;
#line 1354 "test-new/imp918s.imp"
int JJ;
#line 1354 "test-new/imp918s.imp"
int JJJ;
#line 1354 "test-new/imp918s.imp"
int KK;
#line 1354 "test-new/imp918s.imp"
int KKK;
#line 1354 "test-new/imp918s.imp"
int Q;
#line 1354 "test-new/imp918s.imp"
int QQ;
#line 1354 "test-new/imp918s.imp"
int EXTRN;
#line 1354 "test-new/imp918s.imp"
int STARTCOND;
#line 1354 "test-new/imp918s.imp"
int MARKIU;
#line 1354 "test-new/imp918s.imp"
int MARKUI;
#line 1354 "test-new/imp918s.imp"
int MARKC;
#line 1354 "test-new/imp918s.imp"
int MARKE;
#line 1354 "test-new/imp918s.imp"
int MARKR;
#line 1354 "test-new/imp918s.imp"
int BASE;
#line 1354 "test-new/imp918s.imp"
int INDEX;
#line 1354 "test-new/imp918s.imp"
int DISP;
#line 1354 "test-new/imp918s.imp"
int VALUE;
#line 1354 "test-new/imp918s.imp"
int BML;
#line 1354 "test-new/imp918s.imp"
int DML;
#line 1354 "test-new/imp918s.imp"
int LOCALBASE;
#line 1354 "test-new/imp918s.imp"
int LOCALADDR;
#line 1354 "test-new/imp918s.imp"
int PTYPE;
#line 1354 "test-new/imp918s.imp"
int I;
#line 1354 "test-new/imp918s.imp"
int J;
#line 1354 "test-new/imp918s.imp"
int OLDI;
#line 1354 "test-new/imp918s.imp"
int USEBITS;
#line 1354 "test-new/imp918s.imp"
int SENOPS;
#line 1354 "test-new/imp918s.imp"
int SEFOP;
#line 1354 "test-new/imp918s.imp"
int PTYPEP;
#line 1354 "test-new/imp918s.imp"
int STRINGL;
#line 1354 "test-new/imp918s.imp"
int LINE;
// 1355+ Q,QQ,EXTRN,STARTCOND,MARKIU,MARKUI,MARKC,MARKE,MARKR, %C
// 1356+ BASE,INDEX,DISP,VALUE,BML,DML,LOCAL BASE, LOCAL ADDR, %C
// 1357+ PTYPE,I,J,OLDI,USEBITS,SENOPS,SEFOP,PTYPEP,STRINGL,LINE
// 1358 %BYTEINTEGER ROUT,NAM,ARR,PREC,TYPE,REPORTUI
#line 1358 "test-new/imp918s.imp"
unsigned char ROUT;
#line 1358 "test-new/imp918s.imp"
unsigned char NAM;
#line 1358 "test-new/imp918s.imp"
unsigned char ARR;
#line 1358 "test-new/imp918s.imp"
unsigned char PREC;
#line 1358 "test-new/imp918s.imp"
unsigned char TYPE;
#line 1358 "test-new/imp918s.imp"
unsigned char REPORTUI;
// 1359 {%REGISTER P(14)}%integer P; P=PIN
#line 1359 "test-new/imp918s.imp"
int P;
#line 1359 "test-new/imp918s.imp"
P = PIN;
// 1360 %INTEGERARRAY SGRUSE,SGRINF(0:22)
#line 1360 "test-new/imp918s.imp"
int SGRUSE[23];
#line 1360 "test-new/imp918s.imp"
int SGRINF[23];
// 1361 %CONSTINTEGER WSPTRTAB1=X'00010204',WSPTRTAB2= X'04060607'
// 1362 LINE=A(P-1)
#line 1362 "test-new/imp918s.imp"
LINE = A[P - 1 + 7];
// 1363 LOCAL BASE=0; TWSPHEAD=0
#line 1363 "test-new/imp918s.imp"
LOCALBASE = 0;
#line 1363 "test-new/imp918s.imp"
TWSPHEAD = 0;
// 1364 STARTCOND=0; CURRINST=0
#line 1364 "test-new/imp918s.imp"
STARTCOND = 0;
#line 1364 "test-new/imp918s.imp"
CURRINST = 0;
// 1365 CYC BITS=0; BIMSTR=0
#line 1365 "test-new/imp918s.imp"
CYCBITS = 0;
#line 1365 "test-new/imp918s.imp"
BIMSTR = 0;
// 1366 SENOPS=0; SEFOP=0
#line 1366 "test-new/imp918s.imp"
SENOPS = 0;
#line 1366 "test-new/imp918s.imp"
SEFOP = 0;
// 1367 !
// 1368 ! CHECK THERE ARE SOME CELLS LEFT ON THE AVAILABLE SPACE LIST
// 1369 !
// 1370 %IF ASL<200 %AND CSSMODE#0 %THEN %START;! GARBAGE COLLECT NEEDED
#line 1370 "test-new/imp918s.imp"
if (ASL >= 200) goto L_0090;
#line 1370 "test-new/imp918s.imp"
if (CSSMODE == 0) goto L_0090;
// 1371 %IF PRINTMAP=1 %THEN printstring("
#line 1371 "test-new/imp918s.imp"
if (PRINTMAP != 1) goto L_0091;
#line 1371 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n? LIST SPACE"));
#line 1371 "test-new/imp918s.imp"
L_0091:;
// 1372+ ? LIST SPACE")
// 1373 %IF ASL<200 %THEN %START; ! STILL SHORT OF SPACE
#line 1373 "test-new/imp918s.imp"
if (ASL >= 200) goto L_0092;
// 1374 printstring("?")
#line 1374 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("?"));
// 1375 CLEAR LIST(DVHEAD); ! REMOVE LIST OF SHAREABLE D-VS
#line 1375 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &DVHEAD);
// 1376 CLEAR LIST(CONSTL8); ! AND SHAREABLE LONG CONSTANTS
#line 1376 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &CONSTL8);
// 1377 CLEAR LIST(CONSTL6)
#line 1377 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &CONSTL6);
// 1378 %IF ASL<200 %THEN %START
#line 1378 "test-new/imp918s.imp"
if (ASL >= 200) goto L_0093;
// 1379 printstring("?")
#line 1379 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("?"));
// 1380 CLEAR LIST(CONSTL4);! & INTEGER CONSTANTS
#line 1380 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &CONSTL4);
// 1381 CLEAR LIST(CONSTL2);! & SHORT INT CONSTANTS
#line 1381 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &CONSTL2);
// 1382 %FINISH
#line 1382 "test-new/imp918s.imp"
L_0093:;
// 1383 %FINISH
#line 1383 "test-new/imp918s.imp"
L_0092:;
// 1384 %FINISH
#line 1384 "test-new/imp918s.imp"
L_0090:;
// 1385 OLDI=0; ->SW(A(P))
#line 1385 "test-new/imp918s.imp"
OLDI = 0;
#line 1385 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 7];
goto case_SW_dispatch;
// 1386 SW(23):
#line 1386 "test-new/imp918s.imp"
case_SW_23:;
// 1387 WARN(LINE)
#line 1387 "test-new/imp918s.imp"
WARN(LINE);
// 1388 SBFLAG=1 %IF CHECKSP=0; ! '{%SHORTROUTINE}'
#line 1388 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_0095;
#line 1388 "test-new/imp918s.imp"
SBFLAG = 1;
#line 1388 "test-new/imp918s.imp"
L_0095:;
// 1389 !
// 1390 Label1: LAST INST=CURR INST
#line 1390 "test-new/imp918s.imp"
U_100F:;
#line 1390 "test-new/imp918s.imp"
LASTINST = CURRINST;
// 1391 %WHILE TWSPHEAD#0 %CYCLE
#line 1391 "test-new/imp918s.imp"
L_0096:;
#line 1391 "test-new/imp918s.imp"
if (TWSPHEAD == 0) goto L_0097;
// 1392 POP(TWSPHEAD,JJ,KK)
#line 1392 "test-new/imp918s.imp"
POP(/*?*/ &TWSPHEAD, /*?*/ &JJ, /*?*/ &KK);
// 1393 RETURN WSP(JJ,KK)
#line 1393 "test-new/imp918s.imp"
RETURNWSP(JJ, KK);
// 1394 %REPEAT
#line 1394 "test-new/imp918s.imp"
goto L_0096;
#line 1394 "test-new/imp918s.imp"
L_0097:;
// 1395 SW(29): ! REDUNDANT SEP
#line 1395 "test-new/imp918s.imp"
case_SW_29:;
// 1396 SW(10): ! <CMARK> <COMMENT TEXT>
#line 1396 "test-new/imp918s.imp"
case_SW_10:;
// 1397 ! %CYCLE I=10,1,13
// 1398 ! ABORT %UNLESS REGISTER(I)=-1
// 1399 ! %REPEAT
// 1400 %RETURN
#line 1400 "test-new/imp918s.imp"
return;
// 1401 SW(1): MARKER2=P+1+A(P+1); P=P+2
#line 1401 "test-new/imp918s.imp"
case_SW_1:;
#line 1401 "test-new/imp918s.imp"
MARKER2 = P + 1 + A[P + 1 + 7];
#line 1401 "test-new/imp918s.imp"
P = P + 2;
// 1402 ->LABFND %IF A(MARKER2)=1
#line 1402 "test-new/imp918s.imp"
if (A[MARKER2 + 7] != 1) goto L_0098;
#line 1402 "test-new/imp918s.imp"
goto U_1010;
#line 1402 "test-new/imp918s.imp"
L_0098:;
// 1403 SET LINE %IF LINENOS#0
#line 1403 "test-new/imp918s.imp"
if (LINENOS == 0) goto L_0099;
#line 1403 "test-new/imp918s.imp"
SETLINE();
#line 1403 "test-new/imp918s.imp"
L_0099:;
// 1404 ->Label101 %IF A(MARKER2)<=3
#line 1404 "test-new/imp918s.imp"
if (A[MARKER2 + 7] > 3) goto L_009A;
#line 1404 "test-new/imp918s.imp"
goto U_1011;
#line 1404 "test-new/imp918s.imp"
L_009A:;
// 1405 MASK=15; CUI(0); ->Label1
#line 1405 "test-new/imp918s.imp"
MASK = 15;
#line 1405 "test-new/imp918s.imp"
CUI(0);
#line 1405 "test-new/imp918s.imp"
goto U_100F;
// 1406 LABFND: ->SWITCH %UNLESS A(P)<2 %AND A(P+3)=2;! 1ST ALT UI & NO APP
#line 1406 "test-new/imp918s.imp"
U_1010:;
#line 1406 "test-new/imp918s.imp"
if (A[P + 7] >= 2) goto L_0008;
#line 1406 "test-new/imp918s.imp"
if (A[P + 3 + 7] == 2) goto L_009B;
#line 1406 "test-new/imp918s.imp"
L_0008:;
#line 1406 "test-new/imp918s.imp"
goto U_1012;
#line 1406 "test-new/imp918s.imp"
L_009B:;
// 1407 ->SWITCH %UNLESS A(P+4)=2 %AND A(P+5)=2;! NO ENAME OR ASSOP
#line 1407 "test-new/imp918s.imp"
if (A[P + 4 + 7] != 2) goto L_009C;
#line 1407 "test-new/imp918s.imp"
if (A[P + 5 + 7] == 2) goto L_009D;
#line 1407 "test-new/imp918s.imp"
L_009C:;
#line 1407 "test-new/imp918s.imp"
goto U_1012;
#line 1407 "test-new/imp918s.imp"
L_009D:;
// 1408 K=16384+A(P+2); ->Label401
#line 1408 "test-new/imp918s.imp"
K = 16384 + A[P + 2 + 7];
#line 1408 "test-new/imp918s.imp"
goto U_1013;
// 1409 Label101: MARKE=0; MARKR=0
#line 1409 "test-new/imp918s.imp"
U_1011:;
#line 1409 "test-new/imp918s.imp"
MARKE = 0;
#line 1409 "test-new/imp918s.imp"
MARKR = 0;
// 1410 MARKUI=P; MARKIU=MARKER2+1;MARKC=MARKIU+1
#line 1410 "test-new/imp918s.imp"
MARKUI = P;
#line 1410 "test-new/imp918s.imp"
MARKIU = MARKER2 + 1;
#line 1410 "test-new/imp918s.imp"
MARKC = MARKIU + 1;
// 1411 -> CONEXP %IF A(MARKER2)=2; ->WHILE
#line 1411 "test-new/imp918s.imp"
if (A[MARKER2 + 7] != 2) goto L_009E;
#line 1411 "test-new/imp918s.imp"
goto U_1014;
#line 1411 "test-new/imp918s.imp"
L_009E:;
#line 1411 "test-new/imp918s.imp"
goto U_1015;
// 1412 !
// 1413 SW(2): ! %CYCLE
#line 1413 "test-new/imp918s.imp"
case_SW_2:;
// 1414 !***********************************************************************
// 1415 !* THE LAYOUT OF AN ENTRY ON THE CYCLE LIST IS:- *
// 1416 !* S1= CNAME<<16!LABEL N0 *
// 1417 !* S2= EL<<16!BXLE<<15! CYCLE WORK AREA DISPLACEMENT FROM RBASE *
// 1418 !* S3= BREG (THE REGISTER USED FOR INCREMENT AND FINAL VALUE)*
// 1419 !* WHERE :- *
// 1420 !* CNAME= CYCLE CONTROL NAME(IF SIMPLE SCALAR) OR *
// 1421 !* X'3000'!CYCLE NUM FOR CHECKED OR COMPLEX CYCLES*
// 1422 !* LABEL= NO OF INTERNAL LABEL FOR REPEAT TO JUMP TO *
// 1423 !* BXLE=1 IF 'BXLE' CAN BE USED (IE INCREMENT +VE) ,=0 OTHERWISE*
// 1424 !* EL=LABEL NO FOR EXIT STATEMENT (TOP BIT SET WHEN USED) *
// 1425 !***********************************************************************
// 1426 %BEGIN
#line 1426 "test-new/imp918s.imp"
{ /*%begin*/
// 1427 {%SHORTROUTINE}
// 1428 %INTEGER PP,Q,INC,NAME,TNAME,PASS,WSPL,CFLAG,BREG,OPEN,CREG
#line 1428 "test-new/imp918s.imp"
int PP;
#line 1428 "test-new/imp918s.imp"
int Q;
#line 1428 "test-new/imp918s.imp"
int INC;
#line 1428 "test-new/imp918s.imp"
int NAME;
#line 1428 "test-new/imp918s.imp"
int TNAME;
#line 1428 "test-new/imp918s.imp"
int PASS;
#line 1428 "test-new/imp918s.imp"
int WSPL;
#line 1428 "test-new/imp918s.imp"
int CFLAG;
#line 1428 "test-new/imp918s.imp"
int BREG;
#line 1428 "test-new/imp918s.imp"
int OPEN;
#line 1428 "test-new/imp918s.imp"
int CREG;
// 1429 SET LINE
#line 1429 "test-new/imp918s.imp"
SETLINE();
// 1430 CUR CYC VAR=0; CYC REGS=0
#line 1430 "test-new/imp918s.imp"
CURCYCVAR = 0;
#line 1430 "test-new/imp918s.imp"
CYCREGS = 0;
// 1431 BXLE=0; INC=0; BREG=2; CREG=1; ! DEFAULTS
#line 1431 "test-new/imp918s.imp"
BXLE = 0;
#line 1431 "test-new/imp918s.imp"
INC = 0;
#line 1431 "test-new/imp918s.imp"
BREG = 2;
#line 1431 "test-new/imp918s.imp"
CREG = 1;
// 1432 OPEN=A(P+1)-1; P=P+2; PP=P
#line 1432 "test-new/imp918s.imp"
OPEN = A[P + 1 + 7] - 1;
#line 1432 "test-new/imp918s.imp"
P = P + 2;
#line 1432 "test-new/imp918s.imp"
PP = P;
// 1433 %IF OPEN #0 %THEN %START
#line 1433 "test-new/imp918s.imp"
if (OPEN == 0) goto L_009F;
// 1434 CYCOPT(CFLAG,2) %IF CHECKSP=0
#line 1434 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_00A0;
#line 1434 "test-new/imp918s.imp"
CYCOPT(/*?*/ &CFLAG, 2);
#line 1434 "test-new/imp918s.imp"
L_00A0:;
// 1435 PASS=X'10000000'
#line 1435 "test-new/imp918s.imp"
PASS = 268435456;
// 1436 %FINISH %ELSE %START
#line 1436 "test-new/imp918s.imp"
goto L_00A1;
#line 1436 "test-new/imp918s.imp"
L_009F:;
// 1437 NAME=A(P); TNAME = TAGS(NAME)
#line 1437 "test-new/imp918s.imp"
NAME = A[P + 7];
#line 1437 "test-new/imp918s.imp"
TNAME = TAGS[NAME];
// 1438 COPY TAG (NAME)
#line 1438 "test-new/imp918s.imp"
COPYTAG(NAME);
// 1439 FAULT(25,NAME) %UNLESS TYPE=1 %AND PREC=0
#line 1439 "test-new/imp918s.imp"
if (TYPE != 1) goto L_00A2;
#line 1439 "test-new/imp918s.imp"
if (PREC == 0) goto L_00A3;
#line 1439 "test-new/imp918s.imp"
L_00A2:;
#line 1439 "test-new/imp918s.imp"
FAULT(25, NAME);
#line 1439 "test-new/imp918s.imp"
L_00A3:;
// 1440 %IF A(P+1)=2=A(P+2)%AND UNASS=0%AND CHECKSP=0 %AND %C
#line 1440 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 1440 "test-new/imp918s.imp"
int tmp;
#line 1440 "test-new/imp918s.imp"
if (A[P + 1 + 7] != (tmp = 2)) goto L_00A4;
// Double-sided test on 2 (Part II)
#line 1440 "test-new/imp918s.imp"
if (tmp != A[P + 2 + 7]) goto L_00A4;
#line 1440 "test-new/imp918s.imp"
}
#line 1440 "test-new/imp918s.imp"
if (UNASS != 0) goto L_00A4;
#line 1440 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_00A4;
#line 1440 "test-new/imp918s.imp"
if (NAM != 0) goto L_00A4;
#line 1440 "test-new/imp918s.imp"
if (K >= 4095) goto L_00A4;
// 1441+ NAM=0 %AND K<4095 %THEN %START;! CONTROL A LOCAL SCALAR
// 1442 WSPL=2; P=P+3; PASS= NAME<<16
#line 1442 "test-new/imp918s.imp"
WSPL = 2;
#line 1442 "test-new/imp918s.imp"
P = P + 3;
#line 1442 "test-new/imp918s.imp"
PASS = NAME << 16;
// 1443 CUR CYC VAR=NAME
#line 1443 "test-new/imp918s.imp"
CURCYCVAR = NAME;
// 1444 Q=P; FFLAG=0;
#line 1444 "test-new/imp918s.imp"
Q = P;
#line 1444 "test-new/imp918s.imp"
FFLAG = 0;
// 1445 SKIP EXP; SKIP EXP; SKIP EXP
#line 1445 "test-new/imp918s.imp"
SKIPEXP();
#line 1445 "test-new/imp918s.imp"
SKIPEXP();
#line 1445 "test-new/imp918s.imp"
SKIPEXP();
// 1446 P=Q; ! CHECK FNS IN CNTRL EXPRSNS
#line 1446 "test-new/imp918s.imp"
P = Q;
// 1447 CYCOPT(CFLAG,0)
#line 1447 "test-new/imp918s.imp"
CYCOPT(/*?*/ &CFLAG, 0);
// 1448 P=Q
#line 1448 "test-new/imp918s.imp"
P = Q;
// 1449 %IF CFLAG=0 %THEN CUR CYC VAR=0
#line 1449 "test-new/imp918s.imp"
if (CFLAG != 0) goto L_00A5;
#line 1449 "test-new/imp918s.imp"
CURCYCVAR = 0;
#line 1449 "test-new/imp918s.imp"
L_00A5:;
// 1450 %IF CFLAG>0 %THEN BREG=CFLAG&15
#line 1450 "test-new/imp918s.imp"
if (CFLAG <= 0) goto L_00A6;
#line 1450 "test-new/imp918s.imp"
BREG = CFLAG & 15;
#line 1450 "test-new/imp918s.imp"
L_00A6:;
// 1451 COPYTAG(NAME)
#line 1451 "test-new/imp918s.imp"
COPYTAG(NAME);
// 1452 %IF PTYPE=8 %THEN CREG=K
#line 1452 "test-new/imp918s.imp"
if (PTYPE != 8) goto L_00A7;
#line 1452 "test-new/imp918s.imp"
CREG = K;
#line 1452 "test-new/imp918s.imp"
L_00A7:;
// 1453 %FINISH %ELSE %START; ! CONTROL NAMETYPE OR ARRAY ELEMENT
#line 1453 "test-new/imp918s.imp"
goto L_00A8;
#line 1453 "test-new/imp918s.imp"
L_00A4:;
// 1454 CYCLE NUM=CYCLE NUM+1
#line 1454 "test-new/imp918s.imp"
CYCLENUM = CYCLENUM + 1;
// 1455 PASS=X'30000000'!CYCLE NUM<<16
#line 1455 "test-new/imp918s.imp"
PASS = 805306368 | CYCLENUM << 16;
// 1456 WSPL=3; CNAME(3,4)
#line 1456 "test-new/imp918s.imp"
WSPL = 3;
#line 1456 "test-new/imp918s.imp"
CNAME(3, 4);
// 1457 REGISTER(4)=1
#line 1457 "test-new/imp918s.imp"
REGISTER[4] = 1;
// 1458 %FINISH
#line 1458 "test-new/imp918s.imp"
L_00A8:;
// 1459 %IF BREG=2 %THEN %START; ! REGISTER PAIR NOT AVAILABLE
#line 1459 "test-new/imp918s.imp"
if (BREG != 2) goto L_00A9;
// 1460 GET WSP(INC,WSPL); ! WORKAREA TO INC
#line 1460 "test-new/imp918s.imp"
GETWSP(/*?*/ &INC, WSPL);
// 1461 POP(TWSPHEAD,JJ,KK); ! MUST NOT BE FREED BEFORE REPEAT
#line 1461 "test-new/imp918s.imp"
POP(/*?*/ &TWSPHEAD, /*?*/ &JJ, /*?*/ &KK);
// 1462 %FINISH
#line 1462 "test-new/imp918s.imp"
L_00A9:;
// 1463 Q=P; SKIP EXP; JJ=P; ! Q TO 1ST EXP, JJ TO SECOND
#line 1463 "test-new/imp918s.imp"
Q = P;
#line 1463 "test-new/imp918s.imp"
SKIPEXP();
#line 1463 "test-new/imp918s.imp"
JJ = P;
// 1464 BXLE=1 %IF (3900>CA-CODEBASE %OR CYC BASE#0) %C
#line 1464 "test-new/imp918s.imp"
if (3900 > CA - CODEBASE) goto L_00AA;
#line 1464 "test-new/imp918s.imp"
if (CYCBASE == 0) goto L_00AB;
#line 1464 "test-new/imp918s.imp"
L_00AA:;
#line 1464 "test-new/imp918s.imp"
{
// Double-sided test on TSEXP(/*?*/&JJJ, 0) (Part I)
#line 1464 "test-new/imp918s.imp"
int tmp;
#line 1464 "test-new/imp918s.imp"
if (1 > (tmp = TSEXP(/*?*/ &JJJ, 0))) goto L_00AB;
// Double-sided test on TSEXP(/*?*/&JJJ, 0) (Part II)
#line 1464 "test-new/imp918s.imp"
if (tmp > 2) goto L_00AB;
#line 1464 "test-new/imp918s.imp"
}
#line 1464 "test-new/imp918s.imp"
if (TYPE != 1) goto L_00AB;
#line 1464 "test-new/imp918s.imp"
BXLE = 1;
#line 1464 "test-new/imp918s.imp"
L_00AB:;
// 1465+ %AND 1<=TSEXP (JJJ,0)<=2 %AND TYPE=1
// 1466 P=JJ
#line 1466 "test-new/imp918s.imp"
P = JJ;
// 1467 !
// 1468 ! LOAD INCREMENT AND FINAL TO BREG & BREG+1 UNLESS THIS HAS BEEN
// 1469 ! DONE BY THE LOOP OPTIMISING
// 1470 !
// 1471 DSEXP(BREG,0) %UNLESS BREG>2 %AND GRUSE(BREG)=14
#line 1471 "test-new/imp918s.imp"
if (BREG <= 2) goto L_00AC;
#line 1471 "test-new/imp918s.imp"
if (GRUSE[BREG] == 14) goto L_00AD;
#line 1471 "test-new/imp918s.imp"
L_00AC:;
#line 1471 "test-new/imp918s.imp"
DSEXP(BREG, 0);
#line 1471 "test-new/imp918s.imp"
L_00AD:;
// 1472 %IF BREG=2 %THEN DUMPM(X'90',2,WSPL+1,RBASE,INC);! STORE PARAMS
#line 1472 "test-new/imp918s.imp"
if (BREG != 2) goto L_00AE;
#line 1472 "test-new/imp918s.imp"
DUMPM(144, 2, WSPL + 1, RBASE, INC);
#line 1472 "test-new/imp918s.imp"
L_00AE:;
// 1473 DUMPSI(X'92',CYCLE NUM&255,RBASE,INC+8) %IF UNASS=1
#line 1473 "test-new/imp918s.imp"
if (UNASS != 1) goto L_00AF;
#line 1473 "test-new/imp918s.imp"
DUMPSI(146, CYCLENUM & 255, RBASE, INC + 8);
#line 1473 "test-new/imp918s.imp"
L_00AF:;
// 1474 %CYCLE KK=BREG,1,BREG+WSPL-1
#line 1474 "test-new/imp918s.imp"
// %for KK = BREG, 1, BREG + WSPL - 1 %cycle
#line 1474 "test-new/imp918s.imp"
{
int _control, _initial = BREG, _increment = 1, _final = BREG + WSPL - 1;
#line 1474 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0)
_imp_signal(5, 1, 0, "Illegal cycle KK = BREG, 1, BREG + WSPL - 1");
_control = KK = _initial - _increment;
#line 1474 "test-new/imp918s.imp"
L_00B0:
#line 1474 "test-new/imp918s.imp"
if (KK != _control) _imp_signal(4, 2, 0, "Corrupt control variable KK");
#line 1474 "test-new/imp918s.imp"
if (KK == _final) goto L_00B1;
#line 1474 "test-new/imp918s.imp"
_control += _increment;
KK += _increment;
// ?Non-local
// 1475 %IF KK<4 %AND REGISTER(KK)>0 %THEN REGISTER(KK)=0
#line 1475 "test-new/imp918s.imp"
if (KK >= 4) goto L_00B3;
#line 1475 "test-new/imp918s.imp"
if (REGISTER[KK] <= 0) goto L_00B3;
#line 1475 "test-new/imp918s.imp"
REGISTER[KK] = 0;
#line 1475 "test-new/imp918s.imp"
L_00B3:;
// 1476 %IF CFLAG=0 %THEN FORGET(KK) %ELSE SET USE(KK,14,TNAME)
#line 1476 "test-new/imp918s.imp"
if (CFLAG != 0) goto L_00B4;
#line 1476 "test-new/imp918s.imp"
FORGET(KK);
#line 1476 "test-new/imp918s.imp"
goto L_00B5;
#line 1476 "test-new/imp918s.imp"
L_00B4:;
#line 1476 "test-new/imp918s.imp"
SETUSE(KK, 14, TNAME);
#line 1476 "test-new/imp918s.imp"
L_00B5:;
// 1477 %REPEAT
#line 1477 "test-new/imp918s.imp"
goto L_00B0;
#line 1477 "test-new/imp918s.imp"
}
#line 1477 "test-new/imp918s.imp"
L_00B1:;
// 1478 P=Q; CSEXP(CREG,1)
#line 1478 "test-new/imp918s.imp"
P = Q;
#line 1478 "test-new/imp918s.imp"
CSEXP(CREG, 1);
// 1479 FORGET(CREG); ! BEFORE PPJ TO AVOID A BOOTOUT
#line 1479 "test-new/imp918s.imp"
FORGET(CREG);
// 1480 REGISTER(CREG)=1
#line 1480 "test-new/imp918s.imp"
REGISTER[CREG] = 1;
// 1481 %IF CHECKSP=1 %THEN DUMP(0,2,INC,0,RBASE);! LA 2, CYCLE PARAMS
#line 1481 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_00B6;
#line 1481 "test-new/imp918s.imp"
DUMP(0, 2, INC, 0, RBASE);
#line 1481 "test-new/imp918s.imp"
L_00B6:;
// 1482 REGISTER(CREG)=0; MONE=1
#line 1482 "test-new/imp918s.imp"
REGISTER[CREG] = 0;
#line 1482 "test-new/imp918s.imp"
MONE = 1;
// 1483 %IF CHECKSP=1 %THEN PPJ(17);! CHECK VALIDITY
#line 1483 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_00B7;
#line 1483 "test-new/imp918s.imp"
PPJ(17);
#line 1483 "test-new/imp918s.imp"
L_00B7:;
// 1484 %FINISH
#line 1484 "test-new/imp918s.imp"
L_00A1:;
// 1485 PLABEL=PLABEL-1; PASS=PASS!PLABEL
#line 1485 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
#line 1485 "test-new/imp918s.imp"
PASS = PASS | PLABEL;
// 1486 PUSH123(LABEL(LEVEL),CA,0,PLABEL);! STORE LABEL
#line 1486 "test-new/imp918s.imp"
PUSH123(/*?*/ &LABEL[LEVEL], CA, 0, PLABEL);
// 1487 CCSTATE=-1; LCA=0
#line 1487 "test-new/imp918s.imp"
CCSTATE = -1;
#line 1487 "test-new/imp918s.imp"
LCA = 0;
// 1488 %IF OPEN#0 %THEN %START
#line 1488 "test-new/imp918s.imp"
if (OPEN == 0) goto L_00B8;
// 1489 PLABEL=PLABEL-1
#line 1489 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
// 1490 FORGETM(14)
#line 1490 "test-new/imp918s.imp"
FORGETM(14);
// 1491 %FINISH %ELSE %START
#line 1491 "test-new/imp918s.imp"
goto L_00B9;
#line 1491 "test-new/imp918s.imp"
L_00B8:;
// 1492 %CYCLE JJ=0,1,22
#line 1492 "test-new/imp918s.imp"
// %for JJ = 0, 1, 22 %cycle
#line 1492 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 22;
#line 1492 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle JJ = 0, 1, 22");
_control = JJ = _initial - _increment;
#line 1492 "test-new/imp918s.imp"
L_00BA:
#line 1492 "test-new/imp918s.imp"
if (JJ != _control) _imp_signal(4, 2, 0, "Corrupt control variable JJ");
#line 1492 "test-new/imp918s.imp"
if (JJ == _final) goto L_00BB;
#line 1492 "test-new/imp918s.imp"
_control += _increment;
JJ += _increment;
// ?Non-local
// 1493 FORGET(JJ) %IF REGISTER(JJ)=0 %AND GRUSE(JJ)#14
#line 1493 "test-new/imp918s.imp"
if (REGISTER[JJ] != 0) goto L_00BC;
#line 1493 "test-new/imp918s.imp"
if (GRUSE[JJ] == 14) goto L_00BC;
#line 1493 "test-new/imp918s.imp"
FORGET(JJ);
#line 1493 "test-new/imp918s.imp"
L_00BC:;
// 1494 %REPEAT
#line 1494 "test-new/imp918s.imp"
goto L_00BA;
#line 1494 "test-new/imp918s.imp"
}
#line 1494 "test-new/imp918s.imp"
L_00BB:;
// 1495 %IF WSPL=3 %THEN %START
#line 1495 "test-new/imp918s.imp"
if (WSPL != 3) goto L_00BD;
// 1496 DUMP(1,1,0,0,4)
#line 1496 "test-new/imp918s.imp"
DUMP(1, 1, 0, 0, 4);
// 1497 REGISTER(4)=0
#line 1497 "test-new/imp918s.imp"
REGISTER[4] = 0;
// 1498 %FINISH %ELSE %START
#line 1498 "test-new/imp918s.imp"
goto L_00BE;
#line 1498 "test-new/imp918s.imp"
L_00BD:;
// 1499 %IF CREG=1 %THEN %START
#line 1499 "test-new/imp918s.imp"
if (CREG != 1) goto L_00BF;
// 1500 P=PP; CNAME(1,1)
#line 1500 "test-new/imp918s.imp"
P = PP;
#line 1500 "test-new/imp918s.imp"
CNAME(1, 1);
// 1501 DUMP(1,1,DISP,INDEX,BASE)
#line 1501 "test-new/imp918s.imp"
DUMP(1, 1, DISP, INDEX, BASE);
// 1502 %FINISH
#line 1502 "test-new/imp918s.imp"
L_00BF:;
// 1503 NOTE ASSMENT(CREG,2,NAME)
#line 1503 "test-new/imp918s.imp"
NOTEASSMENT(CREG, 2, NAME);
// 1504 %IF CREG#1 %THEN REGISTER(CREG)=-1
#line 1504 "test-new/imp918s.imp"
if (CREG == 1) goto L_00C0;
#line 1504 "test-new/imp918s.imp"
REGISTER[CREG] = -1;
#line 1504 "test-new/imp918s.imp"
L_00C0:;
// 1505 %FINISH
#line 1505 "test-new/imp918s.imp"
L_00BE:;
// 1506 INC=INC!BXLE<<15
#line 1506 "test-new/imp918s.imp"
INC = INC | BXLE << 15;
// 1507 %FINISH
#line 1507 "test-new/imp918s.imp"
L_00B9:;
// 1508 XLABEL=XLABEL-1
#line 1508 "test-new/imp918s.imp"
XLABEL = XLABEL - 1;
// 1509 PUSH123(CYCLE(LEVEL),PASS,XLABEL<<16!INC,CREG<<16!BREG)
#line 1509 "test-new/imp918s.imp"
PUSH123(/*?*/ &CYCLE[LEVEL], PASS, XLABEL << 16 | INC, CREG << 16 | BREG);
// 1510 %END; ->Label1
#line 1510 "test-new/imp918s.imp"
goto end_1002;
#line 1510 "test-new/imp918s.imp"
end_1002:;
#line 1510 "test-new/imp918s.imp"
}
#line 1510 "test-new/imp918s.imp"
goto U_100F;
// 1511 !
// 1512 SW(3): !REPEAT
#line 1512 "test-new/imp918s.imp"
case_SW_3:;
// 1513 %BEGIN
#line 1513 "test-new/imp918s.imp"
{ /*%begin*/
// 1514 {%SHORTROUTINE}
// 1515 %INTEGER NAME,TOPREG,CNUM,DSP,WSPL,LAB,KK,BREG,ELABEL,EUSED,CREG
#line 1515 "test-new/imp918s.imp"
int NAME;
#line 1515 "test-new/imp918s.imp"
int TOPREG;
#line 1515 "test-new/imp918s.imp"
int CNUM;
#line 1515 "test-new/imp918s.imp"
int DSP;
#line 1515 "test-new/imp918s.imp"
int WSPL;
#line 1515 "test-new/imp918s.imp"
int LAB;
#line 1515 "test-new/imp918s.imp"
int KK;
#line 1515 "test-new/imp918s.imp"
int BREG;
#line 1515 "test-new/imp918s.imp"
int ELABEL;
#line 1515 "test-new/imp918s.imp"
int EUSED;
#line 1515 "test-new/imp918s.imp"
int CREG;
// 1516 %SHORTINTEGER HEAD
#line 1516 "test-new/imp918s.imp"
short int HEAD;
// 1517 %SWITCH CTYPE(0:3)
#line 1517 "test-new/imp918s.imp"
int CTYPE_index;
#line 1517 "test-new/imp918s.imp"
int CTYPE_line;
#line 1517 "test-new/imp918s.imp"
char *CTYPE_file;
#line 1517 "test-new/imp918s.imp"
static const void *CTYPE[4] = {&&case_CTYPE_missing, &&case_CTYPE_missing, &&case_CTYPE_missing,
&&case_CTYPE_missing};
// 1518 SET LINE
#line 1518 "test-new/imp918s.imp"
SETLINE();
// 1519 %IF -1<=FROM1(CYCLE(LEVEL))<=0 %THEN FAULT(1,0) %AND ->Label1
#line 1519 "test-new/imp918s.imp"
{
// Double-sided test on FROM1(CYCLE[LEVEL]) (Part I)
#line 1519 "test-new/imp918s.imp"
int tmp;
#line 1519 "test-new/imp918s.imp"
if (-1 > (tmp = FROM1(CYCLE[LEVEL]))) goto L_00C1;
// Double-sided test on FROM1(CYCLE[LEVEL]) (Part II)
#line 1519 "test-new/imp918s.imp"
if (tmp > 0) goto L_00C1;
#line 1519 "test-new/imp918s.imp"
}
#line 1519 "test-new/imp918s.imp"
FAULT(1, 0);
#line 1519 "test-new/imp918s.imp"
goto U_1016;
#line 1519 "test-new/imp918s.imp"
L_00C1:;
// 1520 CUR CYC VAR=0
#line 1520 "test-new/imp918s.imp"
CURCYCVAR = 0;
// 1521 POP123(CYCLE(LEVEL),J,DSP,BREG)
#line 1521 "test-new/imp918s.imp"
POP123(/*?*/ &CYCLE[LEVEL], /*?*/ &J, /*?*/ &DSP, /*?*/ &BREG);
// 1522 ELABEL=DSP>>16&X'7FFF'
#line 1522 "test-new/imp918s.imp"
ELABEL = (unsigned int)DSP >> 16 & 32767;
// 1523 EUSED=DSP>>31
#line 1523 "test-new/imp918s.imp"
EUSED = (unsigned int)DSP >> 31;
// 1524 BXLE=DSP>>15&1; DSP=DSP&X'7FFF'; LAB=J&X'FFFF'
#line 1524 "test-new/imp918s.imp"
BXLE = (unsigned int)DSP >> 15 & 1;
#line 1524 "test-new/imp918s.imp"
DSP = DSP & 32767;
#line 1524 "test-new/imp918s.imp"
LAB = J & 65535;
// 1525 CREG=BREG>>16; BREG=BREG&X'FFFF'
#line 1525 "test-new/imp918s.imp"
CREG = (unsigned int)BREG >> 16;
#line 1525 "test-new/imp918s.imp"
BREG = BREG & 65535;
// 1526 ->CTYPE(J>>28)
#line 1526 "test-new/imp918s.imp"
CTYPE_line = __LINE__;
CTYPE_file = __FILE__;
CTYPE_index = (unsigned int)J >> 28;
goto case_CTYPE_dispatch;
// 1527 CTYPE(3): ! STEP CYCLE WITH PTR TO CONTROL
#line 1527 "test-new/imp918s.imp"
case_CTYPE_3:;
// 1528 CNUM=J>>16&255; TOPREG=4; WSPL=3; NAME=-1; ->COM
#line 1528 "test-new/imp918s.imp"
CNUM = (unsigned int)J >> 16 & 255;
#line 1528 "test-new/imp918s.imp"
TOPREG = 4;
#line 1528 "test-new/imp918s.imp"
WSPL = 3;
#line 1528 "test-new/imp918s.imp"
NAME = -1;
#line 1528 "test-new/imp918s.imp"
goto U_1017;
// 1529 CTYPE(0): ! STEP CYCLE LOCAL SCALAR CONTROL
#line 1529 "test-new/imp918s.imp"
case_CTYPE_0:;
// 1530 TOPREG=3; WSPL=2; NAME=J>>16
#line 1530 "test-new/imp918s.imp"
TOPREG = 3;
#line 1530 "test-new/imp918s.imp"
WSPL = 2;
#line 1530 "test-new/imp918s.imp"
NAME = (unsigned int)J >> 16;
// 1531 COM: ! ALL STEPWISE CYCLES
#line 1531 "test-new/imp918s.imp"
U_1017:;
// 1532 %IF UNASS=1 %THEN %START; ! CHECK CYCLE ENTERD OK
#line 1532 "test-new/imp918s.imp"
if (UNASS != 1) goto L_00C3;
// 1533 DUMPSI(X'95',CNUM,RBASE,DSP+8);! CLI CYCLE WK AREA,CODE NO
#line 1533 "test-new/imp918s.imp"
DUMPSI(149, CNUM, RBASE, DSP + 8);
// 1534 PCONST(X'477C0028'); ! BNE UNASSIGNED VARIABLE USED
#line 1534 "test-new/imp918s.imp"
PCONST(1199308840);
// 1535 %FINISH
#line 1535 "test-new/imp918s.imp"
L_00C3:;
// 1536 !
// 1537 ! LOAD UP CYCLE PARAMETERS FROM WKAREA UNLESS THEY ARE LOADED ALREADY
// 1538 !
// 1539 %UNLESS BREG>2 %OR (GRUSE(2)=14=GRUSE(3) %AND %C
#line 1539 "test-new/imp918s.imp"
if (BREG > 2) goto L_00C4;
#line 1539 "test-new/imp918s.imp"
{
// Double-sided test on 14 (Part I)
#line 1539 "test-new/imp918s.imp"
int tmp;
#line 1539 "test-new/imp918s.imp"
if (GRUSE[2] != (tmp = 14)) goto L_00C5;
// Double-sided test on 14 (Part II)
#line 1539 "test-new/imp918s.imp"
if (tmp != GRUSE[3]) goto L_00C5;
#line 1539 "test-new/imp918s.imp"
}
#line 1539 "test-new/imp918s.imp"
if (GRUSE[4] == 14) goto L_00C4;
#line 1539 "test-new/imp918s.imp"
if (NAME >= 0) goto L_00C4;
#line 1539 "test-new/imp918s.imp"
L_00C5:;
// 1540+ (GRUSE(4)=14 %OR NAME>=0)) %THEN %START
// 1541 DUMPM(X'98',2,TOPREG,RBASE,DSP);! LM CYCLE PARAMS
#line 1541 "test-new/imp918s.imp"
DUMPM(152, 2, TOPREG, RBASE, DSP);
// 1542 %CYCLE I=1,1,TOPREG
#line 1542 "test-new/imp918s.imp"
// %for I = 1, 1, TOPREG %cycle
#line 1542 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = TOPREG;
#line 1542 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, TOPREG");
_control = I = _initial - _increment;
#line 1542 "test-new/imp918s.imp"
L_00C6:
#line 1542 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 1542 "test-new/imp918s.imp"
if (I == _final) goto L_00C7;
#line 1542 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 1543 FORGET(I); ! FORGET REGISTER USED
#line 1543 "test-new/imp918s.imp"
FORGET(I);
// 1544 %REPEAT
#line 1544 "test-new/imp918s.imp"
goto L_00C6;
#line 1544 "test-new/imp918s.imp"
}
#line 1544 "test-new/imp918s.imp"
L_00C7:;
// 1545 %FINISH
#line 1545 "test-new/imp918s.imp"
L_00C4:;
// 1546 !
// 1547 ! NOW GET CONTROL TO REG 1 VIA POINTER OR DIRECTLY AS RELEVANT
// 1548 !
// 1549 %IF NAME<0 %THEN %START; ! VIA POINTER (REGS NOT ALLOCATED)
#line 1549 "test-new/imp918s.imp"
if (NAME >= 0) goto L_00C8;
// 1550 PRX(X'58',1,0,4,0)
#line 1550 "test-new/imp918s.imp"
PRX(88, 1, 0, 4, 0);
// 1551 REGISTER(4)=1
#line 1551 "test-new/imp918s.imp"
REGISTER[4] = 1;
// 1552 %FINISH %ELSE %START; ! LOCAL SCALAR USE CNAME
#line 1552 "test-new/imp918s.imp"
goto L_00C9;
#line 1552 "test-new/imp918s.imp"
L_00C8:;
// 1553 P=R; A(P)=NAME
#line 1553 "test-new/imp918s.imp"
P = R;
#line 1553 "test-new/imp918s.imp"
A[P + 7] = NAME;
// 1554 A(P+1)=2; A(P+2)=2; ! SET NO APP OR ENAME
#line 1554 "test-new/imp918s.imp"
A[P + 1 + 7] = 2;
#line 1554 "test-new/imp918s.imp"
A[P + 2 + 7] = 2;
// 1555 CNAME(2,CREG); ! CONTROL -> R1 OPTIMUM METHOD
#line 1555 "test-new/imp918s.imp"
CNAME(2, CREG);
// 1556 %FINISH
#line 1556 "test-new/imp918s.imp"
L_00C9:;
// 1557 !
// 1558 ! NOW PLANT CODE TO DO THE TEST AND BRANCH.AGAIN 2 WAYS POSSIBLE
// 1559 !
// 1560 %IF BXLE=0 %THEN %START; ! THE TEDIOUS BUT VALID ROUTE
#line 1560 "test-new/imp918s.imp"
if (BXLE != 0) goto L_00CA;
// 1561 PRR(X'18',0,CREG); ! LR 0,1
#line 1561 "test-new/imp918s.imp"
PRR(24, 0, CREG);
// 1562 PRR(X'1A',CREG,BREG); ! AR 1,INC
#line 1562 "test-new/imp918s.imp"
PRR(26, CREG, BREG);
// 1563 PRR(X'19',0,BREG+1); ! CR 0,FINAL
#line 1563 "test-new/imp918s.imp"
PRR(25, 0, BREG + 1);
// 1564 FORGET(0)
#line 1564 "test-new/imp918s.imp"
FORGET(0);
// 1565 REGISTER(CREG)=1; ! JUMP MAY LOAD 4K MULTIPLE
#line 1565 "test-new/imp918s.imp"
REGISTER[CREG] = 1;
// 1566 REGISTER(BREG)=1; ! SO PROTECT REGISTER IN USE
#line 1566 "test-new/imp918s.imp"
REGISTER[BREG] = 1;
// 1567 REGISTER(BREG+1)=1
#line 1567 "test-new/imp918s.imp"
REGISTER[BREG + 1] = 1;
// 1568 ENTER JUMP(7,LAB,0); ! BNE <BEGIN ANOTHER TRAVERSE>
#line 1568 "test-new/imp918s.imp"
ENTERJUMP(7, LAB, 0);
// 1569 %FINISH %ELSE %START; ! THE BXLE INSTRUCTION CAN BE USED
#line 1569 "test-new/imp918s.imp"
goto L_00CB;
#line 1569 "test-new/imp918s.imp"
L_00CA:;
// 1570 KK=FIND3(LAB,LABEL(LEVEL))
#line 1570 "test-new/imp918s.imp"
KK = FIND3(LAB, LABEL[LEVEL]);
// 1571 KK=FROM1(KK); ! EXTRACT LABEL ADDRESS
#line 1571 "test-new/imp918s.imp"
KK = FROM1(KK);
// 1572 %IF CYC BASE=0 %THEN I=10 %AND KK=KK-CODEBASE %ELSE %C
#line 1572 "test-new/imp918s.imp"
if (CYCBASE != 0) goto L_00CC;
#line 1572 "test-new/imp918s.imp"
I = 10;
#line 1572 "test-new/imp918s.imp"
KK = KK - CODEBASE;
#line 1572 "test-new/imp918s.imp"
goto L_00CD;
#line 1572 "test-new/imp918s.imp"
L_00CC:;
#line 1572 "test-new/imp918s.imp"
I = CYCBASE;
#line 1572 "test-new/imp918s.imp"
KK = KK - CYCADDR;
#line 1572 "test-new/imp918s.imp"
L_00CD:;
// 1573+ I=CYC BASE %AND KK=KK-CYC ADDR
// 1574 PRX(X'87',CREG,BREG,I,KK); ! BXLE 1,2,<NEXT TRAVERSE>
#line 1574 "test-new/imp918s.imp"
PRX(135, CREG, BREG, I, KK);
// 1575 %FINISH
#line 1575 "test-new/imp918s.imp"
L_00CB:;
// 1576 %IF CREG#1 %THEN CYC REGS=CYCREGS!!(1<<CREG)
#line 1576 "test-new/imp918s.imp"
if (CREG == 1) goto L_00CE;
#line 1576 "test-new/imp918s.imp"
CYCREGS = CYCREGS ^ 1 << CREG;
#line 1576 "test-new/imp918s.imp"
L_00CE:;
// 1577 CYC RESTORE; ! DEALLOCATE PRELOADED REGISTERS
#line 1577 "test-new/imp918s.imp"
CYCRESTORE();
// 1578 ! EXCEPT CYCLE CONTROL VARIABLE
// 1579 %CYCLE I=BREG,1,BREG+1
#line 1579 "test-new/imp918s.imp"
// %for I = BREG, 1, BREG + 1 %cycle
#line 1579 "test-new/imp918s.imp"
{
int _control, _initial = BREG, _increment = 1, _final = BREG + 1;
#line 1579 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = BREG, 1, BREG + 1");
_control = I = _initial - _increment;
#line 1579 "test-new/imp918s.imp"
L_00CF:
#line 1579 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 1579 "test-new/imp918s.imp"
if (I == _final) goto L_00D0;
#line 1579 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 1580 FREE AND FORGET(I)
#line 1580 "test-new/imp918s.imp"
FREEANDFORGET(I);
// 1581 %REPEAT
#line 1581 "test-new/imp918s.imp"
goto L_00CF;
#line 1581 "test-new/imp918s.imp"
}
#line 1581 "test-new/imp918s.imp"
L_00D0:;
// 1582 %IF CREG#1 %THEN %START; ! CONTROL ALLOCATED A REG
#line 1582 "test-new/imp918s.imp"
if (CREG == 1) goto L_00D2;
// 1583 VDALLOC(CREG,(BREG+1)*(1-COMPILER))
#line 1583 "test-new/imp918s.imp"
VDALLOC(CREG, (BREG + 1) * (1 - COMPILER));
// 1584 NOTE ASSMENT(BREG+1,2,NAME);! SET CONTROL TO FINAL VALUE
#line 1584 "test-new/imp918s.imp"
NOTEASSMENT(BREG + 1, 2, NAME);
// 1585 %FINISH %ELSE FREE AND FORGET(CREG)
#line 1585 "test-new/imp918s.imp"
goto L_00D3;
#line 1585 "test-new/imp918s.imp"
L_00D2:;
#line 1585 "test-new/imp918s.imp"
FREEANDFORGET(CREG);
#line 1585 "test-new/imp918s.imp"
L_00D3:;
// 1586 %IF NAME<0 %THEN FREE AND FORGET(4)
#line 1586 "test-new/imp918s.imp"
if (NAME >= 0) goto L_00D4;
#line 1586 "test-new/imp918s.imp"
FREEANDFORGET(4);
#line 1586 "test-new/imp918s.imp"
L_00D4:;
// 1587 %IF DSP#0 %THEN RETURN WSP(DSP,WSPL);!WORKAREA TO FREE LIST
#line 1587 "test-new/imp918s.imp"
if (DSP == 0) goto L_00D5;
#line 1587 "test-new/imp918s.imp"
RETURNWSP(DSP, WSPL);
#line 1587 "test-new/imp918s.imp"
L_00D5:;
// 1588 %IF UNASS=1 %THEN DUMPSI(X'92',0,RBASE,DSP+8)
#line 1588 "test-new/imp918s.imp"
if (UNASS != 1) goto L_00D6;
#line 1588 "test-new/imp918s.imp"
DUMPSI(146, 0, RBASE, DSP + 8);
#line 1588 "test-new/imp918s.imp"
L_00D6:;
// 1589 CYC REGS=0; CYC BASE=0
#line 1589 "test-new/imp918s.imp"
CYCREGS = 0;
#line 1589 "test-new/imp918s.imp"
CYCBASE = 0;
// 1590 CCSTATE=-1; ->Label1
#line 1590 "test-new/imp918s.imp"
CCSTATE = -1;
#line 1590 "test-new/imp918s.imp"
goto U_1016;
// 1591 CTYPE(1): ! '%WHILE' '%CYCLE'
#line 1591 "test-new/imp918s.imp"
case_CTYPE_1:;
// 1592 ENTER JUMP(15,LAB,0); ! UNCONDITIONALLY TO WHILE CLAUS
#line 1592 "test-new/imp918s.imp"
ENTERJUMP(15, LAB, 0);
// 1593 ENTER LAB(LAB-1,B'111'); ! CONDITIONAL/REPLACE ENV
#line 1593 "test-new/imp918s.imp"
ENTERLAB(LAB - 1, 7);
// 1594 ->Label2
#line 1594 "test-new/imp918s.imp"
goto U_1018;
// 1595 CTYPE(2): ! '%UNTIL' ... '%CYCLE'
#line 1595 "test-new/imp918s.imp"
case_CTYPE_2:;
// 1596 %IF 500-R>799-TOPPTR %THEN %START
#line 1596 "test-new/imp918s.imp"
if (500 - R <= 799 - TOPPTR) goto L_00D7;
// 1597 P=R+1; WSPL=499-P
#line 1597 "test-new/imp918s.imp"
P = R + 1;
#line 1597 "test-new/imp918s.imp"
WSPL = 499 - P;
// 1598 %FINISH %ELSE %START
#line 1598 "test-new/imp918s.imp"
goto L_00D8;
#line 1598 "test-new/imp918s.imp"
L_00D7:;
// 1599 P=TOPPTR+1; WSPL=799-P
#line 1599 "test-new/imp918s.imp"
P = TOPPTR + 1;
#line 1599 "test-new/imp918s.imp"
WSPL = 799 - P;
// 1600 %FINISH
#line 1600 "test-new/imp918s.imp"
L_00D8:;
// 1601 %IF WSPL<DSP %THEN FAULT(102,0); ! NO ROOM FOR A.R.
#line 1601 "test-new/imp918s.imp"
if (WSPL >= DSP) goto L_00D9;
#line 1601 "test-new/imp918s.imp"
FAULT(102, 0);
#line 1601 "test-new/imp918s.imp"
L_00D9:;
// 1602 WSPL=P; P=P+DSP; HEAD=BREG
#line 1602 "test-new/imp918s.imp"
WSPL = P;
#line 1602 "test-new/imp918s.imp"
P = P + DSP;
#line 1602 "test-new/imp918s.imp"
HEAD = BREG;
// 1603 %CYCLE; ! RETRIEVE AR FROM LIST
#line 1603 "test-new/imp918s.imp"
L_00DA:;
// 1604 POP123(HEAD,JJJ,KKK,KK)
#line 1604 "test-new/imp918s.imp"
POP123(/*?*/ &HEAD, /*?*/ &JJJ, /*?*/ &KKK, /*?*/ &KK);
// 1605 P=P-5
#line 1605 "test-new/imp918s.imp"
P = P - 5;
// 1606 TOAR4(P,JJJ)
#line 1606 "test-new/imp918s.imp"
TOAR4(P, JJJ);
// 1607 TOAR4(P+2,KKK)
#line 1607 "test-new/imp918s.imp"
TOAR4(P + 2, KKK);
// 1608 A(P+4)=KK
#line 1608 "test-new/imp918s.imp"
A[P + 4 + 7] = KK;
// 1609 %REPEAT %UNTIL HEAD=0
#line 1609 "test-new/imp918s.imp"
if (HEAD == 0) goto L_00DB;
#line 1609 "test-new/imp918s.imp"
goto L_00DA;
#line 1609 "test-new/imp918s.imp"
L_00DB:;
// 1610 A(PIN-1)=A(P); ! SET UP LINE NO OF CONDITION
#line 1610 "test-new/imp918s.imp"
A[PIN - 1 + 7] = A[P + 7];
// 1611 P=P+1
#line 1611 "test-new/imp918s.imp"
P = P + 1;
// 1612 R=R+DSP
#line 1612 "test-new/imp918s.imp"
R = R + DSP;
// 1613 CCOND(1,LAB)
#line 1613 "test-new/imp918s.imp"
CCOND(1, LAB);
// 1614 R=R-DSP
#line 1614 "test-new/imp918s.imp"
R = R - DSP;
// 1615 Label2: CYC RESTORE
#line 1615 "test-new/imp918s.imp"
U_1018:;
#line 1615 "test-new/imp918s.imp"
CYCRESTORE();
// 1616 CYC REGS=0; CYC BASE=0
#line 1616 "test-new/imp918s.imp"
CYCREGS = 0;
#line 1616 "test-new/imp918s.imp"
CYCBASE = 0;
// 1617 Label1: %IF EUSED#0 %THEN ENTER LAB(ELABEL,B'11')
#line 1617 "test-new/imp918s.imp"
U_1016:;
#line 1617 "test-new/imp918s.imp"
if (EUSED == 0) goto L_00DC;
#line 1617 "test-new/imp918s.imp"
ENTERLAB(ELABEL, 3);
#line 1617 "test-new/imp918s.imp"
L_00DC:;
// 1618 %END; ->Label1
#line 1618 "test-new/imp918s.imp"
goto end_1003;
#line 1618 "test-new/imp918s.imp"
case_CTYPE_dispatch:
#line 1618 "test-new/imp918s.imp"
if (CTYPE_index < 0 || CTYPE_index > 3)
_imp_signalf(6, 3, CTYPE_index, "->CTYPE(%d) out of bounds at %s line %d", CTYPE_index, CTYPE_file, CTYPE_line);
#line 1618 "test-new/imp918s.imp"
goto *CTYPE[CTYPE_index - 0];
#line 1618 "test-new/imp918s.imp"
case_CTYPE_missing:
_imp_signalf(8, 2, CTYPE_index, "switch jump to undefined label CTYPE(%d): at %s line %d", CTYPE_index,
CTYPE_file, CTYPE_line);
#line 1618 "test-new/imp918s.imp"
end_1003:;
#line 1618 "test-new/imp918s.imp"
}
#line 1618 "test-new/imp918s.imp"
goto U_100F;
// 1619 !
// 1620 SW(4): ! (LABEL)':'
#line 1620 "test-new/imp918s.imp"
case_SW_4:;
// 1621 K=A(P+1)
#line 1621 "test-new/imp918s.imp"
K = A[P + 1 + 7];
// 1622 FAULT(2,0) %IF K=0 %OR K>16383
#line 1622 "test-new/imp918s.imp"
if (K == 0) goto L_00D1;
#line 1622 "test-new/imp918s.imp"
if (K <= 16383) goto L_00DD;
#line 1622 "test-new/imp918s.imp"
L_00D1:;
#line 1622 "test-new/imp918s.imp"
FAULT(2, 0);
#line 1622 "test-new/imp918s.imp"
L_00DD:;
// 1623 Label401: NMDECS=NMDECS!1
#line 1623 "test-new/imp918s.imp"
U_1013:;
#line 1623 "test-new/imp918s.imp"
NMDECS = NMDECS | 1;
// 1624 ENTER LAB(K,0)
#line 1624 "test-new/imp918s.imp"
ENTERLAB(K, 0);
// 1625 CYC BITS=CYC BITS!1; ! SET 'LABEL' BIT
#line 1625 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 1;
// 1626 ->Label1
#line 1626 "test-new/imp918s.imp"
goto U_100F;
// 1627 !
// 1628 SW(5): ! (%IU)(COND)%THEN(UI)(ELSE')
#line 1628 "test-new/imp918s.imp"
case_SW_5:;
// 1629 MARKIU=P+1; MARKC=MARKIU+2
#line 1629 "test-new/imp918s.imp"
MARKIU = P + 1;
#line 1629 "test-new/imp918s.imp"
MARKC = MARKIU + 2;
// 1630 MARKR=P+2+A(P+2); MARKE=0
#line 1630 "test-new/imp918s.imp"
MARKR = P + 2 + A[P + 2 + 7];
#line 1630 "test-new/imp918s.imp"
MARKE = 0;
// 1631 %IF A(MARKR)=3 %THEN %START
#line 1631 "test-new/imp918s.imp"
if (A[MARKR + 7] != 3) goto L_00DE;
// 1632 MARKE=MARKR+1+A(MARKR+1); MARKUI=MARKR+2
#line 1632 "test-new/imp918s.imp"
MARKE = MARKR + 1 + A[MARKR + 1 + 7];
#line 1632 "test-new/imp918s.imp"
MARKUI = MARKR + 2;
// 1633 %FINISH
#line 1633 "test-new/imp918s.imp"
L_00DE:;
// 1634 SET LINE %IF LINENOS#0
#line 1634 "test-new/imp918s.imp"
if (LINENOS == 0) goto L_00DF;
#line 1634 "test-new/imp918s.imp"
SETLINE();
#line 1634 "test-new/imp918s.imp"
L_00DF:;
// 1635 CONEXP: %BEGIN
#line 1635 "test-new/imp918s.imp"
U_1014:;
#line 1635 "test-new/imp918s.imp"
{ /*%begin*/
// 1636 !***********************************************************************
// 1637 !* THIS BLOCK COMPILES CONDITIONAL EXPRESSIONS.IT REQUIRES THE *
// 1638 !* FOLLOWING GLOBAL POINTERS TO BE SET TO THEIR A .R. ENTRY. *
// 1639 !* MARKIU TO THE ENTRY FOR P(%IU) *
// 1640 !* MARKC TO THE ENTRY FOR P(COND) *
// 1641 !* MARKUI TO THE ENTRY FOR (FIRST OCCURRENCE OF) P(UI) *
// 1642 !* MARKE TO THE ENTRY FOR P(ELSE') - =0 FOR BACKWARDS CONDITION*
// 1643 !* MARKR TO ENTRY FOR P(RESTOFIU) *
// 1644 !***********************************************************************
// 1645 {%SHORTROUTINE}
// 1646 MARKIU=A(MARKIU); ! ALT OF IU 1=%IF,2=%UNLESS
#line 1646 "test-new/imp918s.imp"
MARKIU = A[MARKIU + 7];
// 1647 KKK=-1
#line 1647 "test-new/imp918s.imp"
KKK = -1;
// 1648 %IF MARKR>0 %AND A(MARKR)<=2 %START;! '%START' OR '%THENSTART'
#line 1648 "test-new/imp918s.imp"
if (MARKR <= 0) goto L_00E0;
#line 1648 "test-new/imp918s.imp"
if (A[MARKR + 7] > 2) goto L_00E0;
// 1649 KKK=SFLABEL-1
#line 1649 "test-new/imp918s.imp"
KKK = SFLABEL - 1;
// 1650 P=MARKC; CCOND(MARKIU,KKK)
#line 1650 "test-new/imp918s.imp"
P = MARKC;
#line 1650 "test-new/imp918s.imp"
CCOND(MARKIU, KKK);
// 1651 CSTART(1)
#line 1651 "test-new/imp918s.imp"
CSTART(1);
// 1652 ->Label1
#line 1652 "test-new/imp918s.imp"
goto U_1019;
// 1653 %FINISH
#line 1653 "test-new/imp918s.imp"
L_00E0:;
// 1654 %IF A(MARKUI)=2 %AND (A(MARKUI+1)<2 %OR A(MARKUI+3)=2) %THEN %C
#line 1654 "test-new/imp918s.imp"
if (A[MARKUI + 7] != 2) goto L_00E1;
#line 1654 "test-new/imp918s.imp"
if (A[MARKUI + 1 + 7] < 2) goto L_00E2;
#line 1654 "test-new/imp918s.imp"
if (A[MARKUI + 3 + 7] != 2) goto L_00E1;
#line 1654 "test-new/imp918s.imp"
L_00E2:;
#line 1654 "test-new/imp918s.imp"
KKK = A[MARKUI + 2 + 7] + (A[MARKUI + 1 + 7] - 1 << 14);
#line 1654 "test-new/imp918s.imp"
L_00E1:;
// 1655+ KKK=A(MARKUI+2)+(A(MARKUI+1)-1)<<14;! UI = SIMPLE LABEL
// 1656 !
// 1657 %IF A(MARKUI)=8 %AND CYCLE(LEVEL)#0 %START; ! VALID EXIT
#line 1657 "test-new/imp918s.imp"
if (A[MARKUI + 7] != 8) goto L_00E3;
#line 1657 "test-new/imp918s.imp"
if (CYCLE[LEVEL] == 0) goto L_00E3;
// 1658 KKK=FROM2(CYCLE(LEVEL))
#line 1658 "test-new/imp918s.imp"
KKK = FROM2(CYCLE[LEVEL]);
// 1659 REPLACE2(CYCLE(LEVEL),KKK!X'80000000')
#line 1659 "test-new/imp918s.imp"
REPLACE2(CYCLE[LEVEL], KKK | -2147483648);
// 1660 KKK=KKK>>16&X'7FFF'
#line 1660 "test-new/imp918s.imp"
KKK = (unsigned int)KKK >> 16 & 32767;
// 1661 %FINISH
#line 1661 "test-new/imp918s.imp"
L_00E3:;
// 1662 !
// 1663 %IF KKK>=0 %THEN %START; ! FIRST UI IS'->'<LABEL>
#line 1663 "test-new/imp918s.imp"
if (KKK < 0) goto L_00E4;
// 1664 NMDECS=NMDECS!1
#line 1664 "test-new/imp918s.imp"
NMDECS = NMDECS | 1;
// 1665 CYC BITS=CYC BITS!2; ! SET 'JUMP' BIT
#line 1665 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 2;
// 1666 P=MARKC; CCOND(3-MARKIU,KKK)
#line 1666 "test-new/imp918s.imp"
P = MARKC;
#line 1666 "test-new/imp918s.imp"
CCOND(3 - MARKIU, KKK);
// 1667 %IF MARKE>0 %AND A(MARKE)<=2 %START; ! THERE IS AN ELSE CLAUSE
#line 1667 "test-new/imp918s.imp"
if (MARKE <= 0) goto L_00E5;
#line 1667 "test-new/imp918s.imp"
if (A[MARKE + 7] > 2) goto L_00E5;
// 1668 %IF A(MARKE)=1 %THEN CSTART(0) %ELSE %START
#line 1668 "test-new/imp918s.imp"
if (A[MARKE + 7] != 1) goto L_00E6;
#line 1668 "test-new/imp918s.imp"
CSTART(0);
#line 1668 "test-new/imp918s.imp"
goto L_00E7;
#line 1668 "test-new/imp918s.imp"
L_00E6:;
// 1669 P=MARKE+1; MASK=15
#line 1669 "test-new/imp918s.imp"
P = MARKE + 1;
#line 1669 "test-new/imp918s.imp"
MASK = 15;
// 1670 CUI(0)
#line 1670 "test-new/imp918s.imp"
CUI(0);
// 1671 %FINISH
#line 1671 "test-new/imp918s.imp"
L_00E7:;
// 1672 %FINISH
#line 1672 "test-new/imp918s.imp"
L_00E5:;
// 1673 ->Label1
#line 1673 "test-new/imp918s.imp"
goto U_1019;
// 1674 %FINISH
#line 1674 "test-new/imp918s.imp"
L_00E4:;
// 1675 !
// 1676 PLABEL=PLABEL-1; KKK=PLABEL
#line 1676 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
#line 1676 "test-new/imp918s.imp"
KKK = PLABEL;
// 1677 P=MARKC; CCOND(MARKIU,KKK)
#line 1677 "test-new/imp918s.imp"
P = MARKC;
#line 1677 "test-new/imp918s.imp"
CCOND(MARKIU, KKK);
// 1678 P=MARKUI; MASK=15; CUI(1)
#line 1678 "test-new/imp918s.imp"
P = MARKUI;
#line 1678 "test-new/imp918s.imp"
MASK = 15;
#line 1678 "test-new/imp918s.imp"
CUI(1);
// 1679 %UNLESS MARKE>0 %AND A(MARKE)<=2 %START; ! UNLESS %ELSE FOLLOWS
#line 1679 "test-new/imp918s.imp"
if (MARKE <= 0) goto L_00E8;
#line 1679 "test-new/imp918s.imp"
if (A[MARKE + 7] <= 2) goto L_00E9;
#line 1679 "test-new/imp918s.imp"
L_00E8:;
// 1680 ENTER LAB(KKK,B'11'!REPORTUI<<2); ->Label1; ! CONDITIONAL&MERGE
#line 1680 "test-new/imp918s.imp"
ENTERLAB(KKK, 3 | REPORTUI << 2);
#line 1680 "test-new/imp918s.imp"
goto U_1019;
// 1681 %FINISH
#line 1681 "test-new/imp918s.imp"
L_00E9:;
// 1682 !
// 1683 %IF A(MARKE)=1 %THEN %START; ! '%ELSESTART'
#line 1683 "test-new/imp918s.imp"
if (A[MARKE + 7] != 1) goto L_00EA;
// 1684 %IF REPORTUI=0 %THEN %C
#line 1684 "test-new/imp918s.imp"
if (REPORTUI != 0) goto L_00EB;
#line 1684 "test-new/imp918s.imp"
ENTERJUMP(15, SFLABEL - 1, 2);
#line 1684 "test-new/imp918s.imp"
L_00EB:;
// 1685+ ENTER JUMP(15,SFLABEL-1,B'10');! LONG JUMP BUT SAVE ENV
// 1686 CSTART(2)
#line 1686 "test-new/imp918s.imp"
CSTART(2);
// 1687 ENTER LAB(KKK,B'111'); ! CONDITIONAL & REPLACE ENV
#line 1687 "test-new/imp918s.imp"
ENTERLAB(KKK, 7);
// 1688 %FINISH %ELSE %START; ! '%ELSE<UI>'
#line 1688 "test-new/imp918s.imp"
goto L_00EC;
#line 1688 "test-new/imp918s.imp"
L_00EA:;
// 1689 P=MARKE+1
#line 1689 "test-new/imp918s.imp"
P = MARKE + 1;
// 1690 PLABEL=PLABEL-1; JJJ=PLABEL
#line 1690 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
#line 1690 "test-new/imp918s.imp"
JJJ = PLABEL;
// 1691 %IF REPORTUI=0 %THEN %C
#line 1691 "test-new/imp918s.imp"
if (REPORTUI != 0) goto L_00ED;
#line 1691 "test-new/imp918s.imp"
ENTERJUMP(15, JJJ, 3);
#line 1691 "test-new/imp918s.imp"
L_00ED:;
// 1692+ ENTER JUMP(15,JJJ,B'11'); ! SHORT JUMP AND SAVE ENV
// 1693 ENTER LAB(KKK,B'111'); ! CONDITIONAL REPLACE ENV
#line 1693 "test-new/imp918s.imp"
ENTERLAB(KKK, 7);
// 1694 MASK=15; CUI(2)
#line 1694 "test-new/imp918s.imp"
MASK = 15;
#line 1694 "test-new/imp918s.imp"
CUI(2);
// 1695 ENTER LAB(JJJ,B'11'!REPORTUI<<2);! CONDITIONAL MERGE
#line 1695 "test-new/imp918s.imp"
ENTERLAB(JJJ, 3 | REPORTUI << 2);
// 1696 %FINISH
#line 1696 "test-new/imp918s.imp"
L_00EC:;
// 1697 Label1: %END; ->Label1
#line 1697 "test-new/imp918s.imp"
U_1019:;
#line 1697 "test-new/imp918s.imp"
goto end_1004;
#line 1697 "test-new/imp918s.imp"
end_1004:;
#line 1697 "test-new/imp918s.imp"
}
#line 1697 "test-new/imp918s.imp"
goto U_100F;
// 1698 SW(14):
#line 1698 "test-new/imp918s.imp"
case_SW_14:;
// 1699 %BEGIN; ! '%FINISH(ELSE')(S)
#line 1699 "test-new/imp918s.imp"
{ /*%begin*/
// 1700 {%SHORTROUTINE}
// 1701
// 1702 %INTEGER J,K,CODE,CYC,FLAB
#line 1702 "test-new/imp918s.imp"
int J;
#line 1702 "test-new/imp918s.imp"
int K;
#line 1702 "test-new/imp918s.imp"
int CODE;
#line 1702 "test-new/imp918s.imp"
int CYC;
#line 1702 "test-new/imp918s.imp"
int FLAB;
// 1703 POP123(SBR(LEVEL),CODE,FLAB,CYC)
#line 1703 "test-new/imp918s.imp"
POP123(/*?*/ &SBR[LEVEL], /*?*/ &CODE, /*?*/ &FLAB, /*?*/ &CYC);
// 1704 %IF CODE<0 %THEN FAULT(51,0) %AND ->Label1
#line 1704 "test-new/imp918s.imp"
if (CODE >= 0) goto L_00EE;
#line 1704 "test-new/imp918s.imp"
FAULT(51, 0);
#line 1704 "test-new/imp918s.imp"
goto U_101A;
#line 1704 "test-new/imp918s.imp"
L_00EE:;
// 1705 %IF CYC#CYCLE(LEVEL) %THEN FAULT(52,0)
#line 1705 "test-new/imp918s.imp"
if (CYC == CYCLE[LEVEL]) goto L_00EF;
#line 1705 "test-new/imp918s.imp"
FAULT(52, 0);
#line 1705 "test-new/imp918s.imp"
L_00EF:;
// 1706 !
// 1707 %IF A(P+1)<=2 %THEN %START; ! %ELSE CLAUSE PRESENT
#line 1707 "test-new/imp918s.imp"
if (A[P + 1 + 7] > 2) goto L_00F0;
// 1708 FAULT(47,0) %UNLESS CODE=1; ! DANGLING ELSE
#line 1708 "test-new/imp918s.imp"
if (CODE == 1) goto L_00F1;
#line 1708 "test-new/imp918s.imp"
FAULT(47, 0);
#line 1708 "test-new/imp918s.imp"
L_00F1:;
// 1709 %IF A(P+1)=1 %THEN %START; ! %ELSE %START
#line 1709 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_00F2;
// 1710 !
// 1711 ! PLANT A ROUND NEXT START-FINISH %UNLESS PREVIOUS INSTRUCTION WAS ->
// 1712 !
// 1713 ENTER JUMP(15,SFLABEL-1,B'10') %IF LAST INST=0
#line 1713 "test-new/imp918s.imp"
if (LASTINST != 0) goto L_00F3;
#line 1713 "test-new/imp918s.imp"
ENTERJUMP(15, SFLABEL - 1, 2);
#line 1713 "test-new/imp918s.imp"
L_00F3:;
// 1714 CSTART(2)
#line 1714 "test-new/imp918s.imp"
CSTART(2);
// 1715 %FINISH %ELSE %START; ! %ELSE (UI)
#line 1715 "test-new/imp918s.imp"
goto L_00F4;
#line 1715 "test-new/imp918s.imp"
L_00F2:;
// 1716 %IF LAST INST=0 %THEN %START
#line 1716 "test-new/imp918s.imp"
if (LASTINST != 0) goto L_00F5;
// 1717 PLABEL=PLABEL-1; J=PLABEL
#line 1717 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
#line 1717 "test-new/imp918s.imp"
J = PLABEL;
// 1718 ENTER JUMP(15,J,B'11')
#line 1718 "test-new/imp918s.imp"
ENTERJUMP(15, J, 3);
// 1719 %FINISH
#line 1719 "test-new/imp918s.imp"
L_00F5:;
// 1720 P=P+2;! K=A(P); ! K= ALT OF P(UI)
#line 1720 "test-new/imp918s.imp"
P = P + 2;
// 1721 !
// 1722 ! PLANT THE LABEL FOR THE JUMP ROUND THE START FINISH BLOCK JUST ENDED
// 1723 ! THE LABEL IS CONDITIONAL ON THERE HAVING BEEN A JUMP. ENVIRONMENTS ARE
// 1724 ! MERGED UNLESS THE PREVIOUS INSTN IS A -> ETC WHEN ENV IS REPLACED
// 1725 !
// 1726 ENTER LAB(FLAB,B'011'!LAST INST<<2)
#line 1726 "test-new/imp918s.imp"
ENTERLAB(FLAB, 3 | LASTINST << 2);
// 1727 MONE=1; SET LINE; MASK=15
#line 1727 "test-new/imp918s.imp"
MONE = 1;
#line 1727 "test-new/imp918s.imp"
SETLINE();
#line 1727 "test-new/imp918s.imp"
MASK = 15;
// 1728 %IF LAST INST#0 %THEN CUI(0) %AND ->Label1
#line 1728 "test-new/imp918s.imp"
if (LASTINST == 0) goto L_00F6;
#line 1728 "test-new/imp918s.imp"
CUI(0);
#line 1728 "test-new/imp918s.imp"
goto U_101A;
#line 1728 "test-new/imp918s.imp"
L_00F6:;
// 1729 CUI(2); FLAB=J
#line 1729 "test-new/imp918s.imp"
CUI(2);
#line 1729 "test-new/imp918s.imp"
FLAB = J;
// 1730 LAST INST=REPORT UI
#line 1730 "test-new/imp918s.imp"
LASTINST = REPORTUI;
// 1731 %FINISH
#line 1731 "test-new/imp918s.imp"
L_00F4:;
// 1732 !
// 1733 %FINISH %ELSE %START
#line 1733 "test-new/imp918s.imp"
goto L_00F7;
#line 1733 "test-new/imp918s.imp"
L_00F0:;
// 1734 ->Label1 %IF CODE=0
#line 1734 "test-new/imp918s.imp"
if (CODE != 0) goto L_00F8;
#line 1734 "test-new/imp918s.imp"
goto U_101A;
#line 1734 "test-new/imp918s.imp"
L_00F8:;
// 1735 %FINISH
#line 1735 "test-new/imp918s.imp"
L_00F7:;
// 1736 !
// 1737 ENTER LAB(FLAB,B'011'!LAST INST<<2)
#line 1737 "test-new/imp918s.imp"
ENTERLAB(FLAB, 3 | LASTINST << 2);
// 1738 MONE=1
#line 1738 "test-new/imp918s.imp"
MONE = 1;
// 1739 Label1: %END;
#line 1739 "test-new/imp918s.imp"
U_101A:;
#line 1739 "test-new/imp918s.imp"
goto end_1005;
#line 1739 "test-new/imp918s.imp"
end_1005:;
#line 1739 "test-new/imp918s.imp"
}
#line 1739 "test-new/imp918s.imp"
goto U_100F;
// ?K unused
// 1740 ; ->Label1
#line 1740 "test-new/imp918s.imp"
U_1012:;
#line 1740 "test-new/imp918s.imp"
{ /*%begin*/
// 1740 SWITCH: %BEGIN; ! SWITCH LABEL
// 1741 {%SHORTROUTINE}
// 1742 %INTEGER HEAD,BASEPT,BP,FNAME
#line 1742 "test-new/imp918s.imp"
int HEAD;
#line 1742 "test-new/imp918s.imp"
int BASEPT;
#line 1742 "test-new/imp918s.imp"
int BP;
#line 1742 "test-new/imp918s.imp"
int FNAME;
// 1743 MONE=1; LCA=0; FORGETM(14)
#line 1743 "test-new/imp918s.imp"
MONE = 1;
#line 1743 "test-new/imp918s.imp"
LCA = 0;
#line 1743 "test-new/imp918s.imp"
FORGETM(14);
// 1744 CYC BITS=CYC BITS!1; ! SET 'LABEL' BIT
#line 1744 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 1;
// 1745 FNAME=A(P+2)
#line 1745 "test-new/imp918s.imp"
FNAME = A[P + 2 + 7];
// 1746 ->Label1411 %UNLESS A(P)=1 %AND A(P+3)=1; ! 1ST OF UI + APP
#line 1746 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_00F9;
#line 1746 "test-new/imp918s.imp"
if (A[P + 3 + 7] == 1) goto L_00FA;
#line 1746 "test-new/imp918s.imp"
L_00F9:;
#line 1746 "test-new/imp918s.imp"
goto U_101B;
#line 1746 "test-new/imp918s.imp"
L_00FA:;
// 1747 ->Label1411 %UNLESS A(P+6)#3 %AND A(P+7)=2 %AND A(P+8)&7=1
#line 1747 "test-new/imp918s.imp"
if (A[P + 6 + 7] == 3) goto L_00FB;
#line 1747 "test-new/imp918s.imp"
if (A[P + 7 + 7] != 2) goto L_00FB;
#line 1747 "test-new/imp918s.imp"
if (A[P + 8 + 7] & 7 == 1) goto L_00FC;
#line 1747 "test-new/imp918s.imp"
L_00FB:;
#line 1747 "test-new/imp918s.imp"
goto U_101B;
#line 1747 "test-new/imp918s.imp"
L_00FC:;
// 1748 ->Label1411 %UNLESS A(P+11)=2=A(P+12); !NO R.OF.EXP. OR R.OF.APP
#line 1748 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 1748 "test-new/imp918s.imp"
int tmp;
#line 1748 "test-new/imp918s.imp"
if (A[P + 11 + 7] != (tmp = 2)) goto L_00FD;
// Double-sided test on 2 (Part II)
#line 1748 "test-new/imp918s.imp"
if (tmp == A[P + 12 + 7]) goto L_00FE;
#line 1748 "test-new/imp918s.imp"
}
#line 1748 "test-new/imp918s.imp"
L_00FD:;
#line 1748 "test-new/imp918s.imp"
goto U_101B;
#line 1748 "test-new/imp918s.imp"
L_00FE:;
// 1749 ->Label1411 %UNLESS A(P+13)=2=A(P+14); ! NO ENAME OR R.OF.UI
#line 1749 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 1749 "test-new/imp918s.imp"
int tmp;
#line 1749 "test-new/imp918s.imp"
if (A[P + 13 + 7] != (tmp = 2)) goto L_00FF;
// Double-sided test on 2 (Part II)
#line 1749 "test-new/imp918s.imp"
if (tmp == A[P + 14 + 7]) goto L_0100;
#line 1749 "test-new/imp918s.imp"
}
#line 1749 "test-new/imp918s.imp"
L_00FF:;
#line 1749 "test-new/imp918s.imp"
goto U_101B;
#line 1749 "test-new/imp918s.imp"
L_0100:;
// 1750 COPY TAG(FNAME)
#line 1750 "test-new/imp918s.imp"
COPYTAG(FNAME);
// 1751 HEAD=K
#line 1751 "test-new/imp918s.imp"
HEAD = K;
// 1752 %IF OLDI#LEVEL %OR TYPE#6 %THEN FAULT(4,FNAME) %AND ->Label1
#line 1752 "test-new/imp918s.imp"
if (OLDI != LEVEL) goto L_0101;
#line 1752 "test-new/imp918s.imp"
if (TYPE == 6) goto L_0102;
#line 1752 "test-new/imp918s.imp"
L_0101:;
#line 1752 "test-new/imp918s.imp"
FAULT(4, FNAME);
#line 1752 "test-new/imp918s.imp"
goto U_101A;
#line 1752 "test-new/imp918s.imp"
L_0102:;
// 1753 FROM123(HEAD,BASEPT,KKK,KK); ! EXTRACT TABLE ADDR,LB & UB
#line 1753 "test-new/imp918s.imp"
FROM123(HEAD, /*?*/ &BASEPT, /*?*/ &KKK, /*?*/ &KK);
// 1754 MLINK(HEAD); ! K POINTS TO BIT LIST
#line 1754 "test-new/imp918s.imp"
MLINK(/*?*/ &HEAD);
// 1755 FROM AR4(P+9,JJ)
#line 1755 "test-new/imp918s.imp"
FROMAR4(P + 9, /*?*/ &JJ);
// 1756 JJ=-JJ %IF A(P+6)=2
#line 1756 "test-new/imp918s.imp"
if (A[P + 6 + 7] != 2) goto L_0103;
#line 1756 "test-new/imp918s.imp"
JJ = -JJ;
#line 1756 "test-new/imp918s.imp"
L_0103:;
// 1757 ->Label1402 %IF KKK<=JJ<=KK
#line 1757 "test-new/imp918s.imp"
{
// Double-sided test on JJ (Part I)
#line 1757 "test-new/imp918s.imp"
int tmp;
#line 1757 "test-new/imp918s.imp"
if (KKK > (tmp = JJ)) goto L_0104;
// Double-sided test on JJ (Part II)
#line 1757 "test-new/imp918s.imp"
if (tmp > KK) goto L_0104;
#line 1757 "test-new/imp918s.imp"
}
#line 1757 "test-new/imp918s.imp"
goto U_101C;
#line 1757 "test-new/imp918s.imp"
L_0104:;
// 1758 Label1411: FAULT(5,FNAME); ->Label1
#line 1758 "test-new/imp918s.imp"
U_101B:;
#line 1758 "test-new/imp918s.imp"
FAULT(5, FNAME);
#line 1758 "test-new/imp918s.imp"
goto U_101A;
// 1759 Label1402: Q=JJ-KKK
#line 1759 "test-new/imp918s.imp"
U_101C:;
#line 1759 "test-new/imp918s.imp"
Q = JJ - KKK;
// 1760 %WHILE Q>=96 %THEN MLINK(HEAD) %AND Q=Q-96
#line 1760 "test-new/imp918s.imp"
L_0105:;
#line 1760 "test-new/imp918s.imp"
if (Q < 96) goto L_0106;
#line 1760 "test-new/imp918s.imp"
MLINK(/*?*/ &HEAD);
#line 1760 "test-new/imp918s.imp"
Q = Q - 96;
#line 1760 "test-new/imp918s.imp"
goto L_0105;
#line 1760 "test-new/imp918s.imp"
L_0106:;
// 1761 !
// 1762 ! ASLIST(HEAD) IS THE START OF 96 BIT ENTRY IN THE BIT LIST
// 1763 ! CHECK BIT NO Q TO SEE IF LABEL ALREADY SET AND THEN SET BIT Q
// 1764 !
// 1765 QQ=Q>>3+HEAD; ! RIGHT BYTE
#line 1765 "test-new/imp918s.imp"
QQ = ((unsigned int)Q >> 3) + HEAD;
// 1766 Q=Q&7; JJJ=1<<Q; ! BIT IN BYTE
#line 1766 "test-new/imp918s.imp"
Q = Q & 7;
#line 1766 "test-new/imp918s.imp"
JJJ = 1 << Q;
// 1767 FAULT(6,FNAME) %UNLESS ASLIST(QQ)&JJJ=0
#line 1767 "test-new/imp918s.imp"
if (ASLIST[QQ] & JJJ == 0) goto L_0107;
#line 1767 "test-new/imp918s.imp"
FAULT(6, FNAME);
#line 1767 "test-new/imp918s.imp"
L_0107:;
// 1768 ASLIST(QQ)=ASLIST(QQ)!JJJ %UNLESS CSSMODE=0
#line 1768 "test-new/imp918s.imp"
if (CSSMODE == 0) goto L_0108;
#line 1768 "test-new/imp918s.imp"
ASLIST[QQ] = ASLIST[QQ] | JJJ;
#line 1768 "test-new/imp918s.imp"
L_0108:;
// 1769 Q=CA-CODEBASE
#line 1769 "test-new/imp918s.imp"
Q = CA - CODEBASE;
// 1770 BP=BYTES(PREC)
#line 1770 "test-new/imp918s.imp"
BP = BYTES[PREC];
// 1771 QQ=BASEPT+8+(JJ-KKK)*BP; ! REL POSITION OF LABEL IN SST
#line 1771 "test-new/imp918s.imp"
QQ = BASEPT + 8 + (JJ - KKK) * BP;
// 1772 %IF INHCODE=0 %THEN LPUT(4,BP,QQ,ADDR(Q)+4-BP)
#line 1772 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0109;
#line 1772 "test-new/imp918s.imp"
LPUT(4, BP, QQ, _imp_ADDR(/*?*/ &Q) + 4 - BP);
#line 1772 "test-new/imp918s.imp"
L_0109:;
// 1773 FAULT(99,0) %IF Q>X'7FFF' %AND PREC#0
#line 1773 "test-new/imp918s.imp"
if (Q <= 32767) goto L_010A;
#line 1773 "test-new/imp918s.imp"
if (PREC == 0) goto L_010A;
#line 1773 "test-new/imp918s.imp"
FAULT(99, 0);
#line 1773 "test-new/imp918s.imp"
L_010A:;
// 1774 Label1: %END; ->Label1
#line 1774 "test-new/imp918s.imp"
U_101A:;
#line 1774 "test-new/imp918s.imp"
goto end_1006;
#line 1774 "test-new/imp918s.imp"
end_1006:;
#line 1774 "test-new/imp918s.imp"
}
#line 1774 "test-new/imp918s.imp"
goto U_100F;
// 1775 SW(6): ! (%WU)(SC)(COND)(RESTOFWU)
#line 1775 "test-new/imp918s.imp"
case_SW_6:;
// 1776 MARKIU=P+1; ! TO WHILE/UNTIL
#line 1776 "test-new/imp918s.imp"
MARKIU = P + 1;
// 1777 MARKC=MARKIU+2; ! TO (SC)(COND)
#line 1777 "test-new/imp918s.imp"
MARKC = MARKIU + 2;
// 1778 MARKR=P+2+A(P+2); ! TO RESTOF WU
#line 1778 "test-new/imp918s.imp"
MARKR = P + 2 + A[P + 2 + 7];
// 1779 MARKUI=MARKR+1; ! TO P(UI) IF ANY
#line 1779 "test-new/imp918s.imp"
MARKUI = MARKR + 1;
// 1780 SET LINE
#line 1780 "test-new/imp918s.imp"
SETLINE();
// 1781 WHILE: %BEGIN
#line 1781 "test-new/imp918s.imp"
U_1015:;
#line 1781 "test-new/imp918s.imp"
{ /*%begin*/
// 1782 {%SHORTROUTINE}
// 1783 %INTEGER L1,L2,FLAG,XTRA
#line 1783 "test-new/imp918s.imp"
int L1;
#line 1783 "test-new/imp918s.imp"
int L2;
#line 1783 "test-new/imp918s.imp"
int FLAG;
#line 1783 "test-new/imp918s.imp"
int XTRA;
// 1784 %SHORTINTEGER HEAD
#line 1784 "test-new/imp918s.imp"
short int HEAD;
// 1785 HEAD=0; XTRA=0
#line 1785 "test-new/imp918s.imp"
HEAD = 0;
#line 1785 "test-new/imp918s.imp"
XTRA = 0;
// 1786 MARKIU=A(MARKIU); ! =1 FOR'WHILE' =2 FOR'UNTIL'
#line 1786 "test-new/imp918s.imp"
MARKIU = A[MARKIU + 7];
// 1787 SFLABEL=SFLABEL-1
#line 1787 "test-new/imp918s.imp"
SFLABEL = SFLABEL - 1;
// 1788 L1=SFLABEL
#line 1788 "test-new/imp918s.imp"
L1 = SFLABEL;
// 1789 PLABEL=PLABEL-1; ! RESERVE 2 LABELS
#line 1789 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
// 1790 L2=PLABEL
#line 1790 "test-new/imp918s.imp"
L2 = PLABEL;
// 1791 ->WCYCLE %IF MARKR>0 %AND A(MARKR)<=2
#line 1791 "test-new/imp918s.imp"
if (MARKR <= 0) goto L_010B;
#line 1791 "test-new/imp918s.imp"
if (A[MARKR + 7] > 2) goto L_010B;
#line 1791 "test-new/imp918s.imp"
goto U_101A;
#line 1791 "test-new/imp918s.imp"
L_010B:;
// 1792 %IF CSSMODE#0 %AND STMTSHELD>1 %AND CYCREGS=CYCBASE=0 %C
#line 1792 "test-new/imp918s.imp"
if (CSSMODE == 0) goto L_010C;
#line 1792 "test-new/imp918s.imp"
if (STMTSHELD <= 1) goto L_010C;
#line 1792 "test-new/imp918s.imp"
{
// Double-sided test on CYCBASE (Part I)
#line 1792 "test-new/imp918s.imp"
int tmp;
#line 1792 "test-new/imp918s.imp"
if (CYCREGS != (tmp = CYCBASE)) goto L_010C;
// Double-sided test on CYCBASE (Part II)
#line 1792 "test-new/imp918s.imp"
if (tmp != 0) goto L_010C;
#line 1792 "test-new/imp918s.imp"
}
#line 1792 "test-new/imp918s.imp"
EXTRAPASS(1, 1, 100);
#line 1792 "test-new/imp918s.imp"
XTRA = 1;
#line 1792 "test-new/imp918s.imp"
L_010C:;
// 1793+ %THEN EXTRA PASS(1,1,100) %AND XTRA=1
// 1794 ENTER LAB(L1,0); ! UNCONDITIONAL LAB FOR REPEAT
#line 1794 "test-new/imp918s.imp"
ENTERLAB(L1, 0);
// 1795 %IF MARKIU=1 %THEN %START
#line 1795 "test-new/imp918s.imp"
if (MARKIU != 1) goto L_010D;
// 1796 P=MARKC
#line 1796 "test-new/imp918s.imp"
P = MARKC;
// 1797 CCOND(1,L2)
#line 1797 "test-new/imp918s.imp"
CCOND(1, L2);
// 1798 %FINISH
#line 1798 "test-new/imp918s.imp"
L_010D:;
// 1799 !
// 1800 MASK=15; P=MARKUI
#line 1800 "test-new/imp918s.imp"
MASK = 15;
#line 1800 "test-new/imp918s.imp"
P = MARKUI;
// 1801 CUI(1)
#line 1801 "test-new/imp918s.imp"
CUI(1);
// 1802 !
// 1803 %IF MARKIU=1 %THEN %START
#line 1803 "test-new/imp918s.imp"
if (MARKIU != 1) goto L_010E;
// 1804 ENTER JUMP(15,L1,0); ! UNCODITIONALLY TO WHILE COND
#line 1804 "test-new/imp918s.imp"
ENTERJUMP(15, L1, 0);
// 1805 ENTER LAB(L2,B'111')
#line 1805 "test-new/imp918s.imp"
ENTERLAB(L2, 7);
// 1806 %FINISH %ELSE %START
#line 1806 "test-new/imp918s.imp"
goto L_010F;
#line 1806 "test-new/imp918s.imp"
L_010E:;
// 1807 P=MARKC; CCOND(1,L1); ! UNTIL CONDITION AT END
#line 1807 "test-new/imp918s.imp"
P = MARKC;
#line 1807 "test-new/imp918s.imp"
CCOND(1, L1);
// 1808 %FINISH
#line 1808 "test-new/imp918s.imp"
L_010F:;
// 1809 %IF XTRA#0 %THEN CYC RESTORE %AND CYCREGS=0 %AND CYCBASE=0
#line 1809 "test-new/imp918s.imp"
if (XTRA == 0) goto L_0110;
#line 1809 "test-new/imp918s.imp"
CYCRESTORE();
#line 1809 "test-new/imp918s.imp"
CYCREGS = 0;
#line 1809 "test-new/imp918s.imp"
CYCBASE = 0;
#line 1809 "test-new/imp918s.imp"
L_0110:;
// 1810 ->Label1
#line 1810 "test-new/imp918s.imp"
goto U_101C;
// 1811 WCYCLE:
#line 1811 "test-new/imp918s.imp"
U_101A:;
// 1812 !***********************************************************************
// 1813 !* WHILE CYCLES JUST LIKE %WHILE...%THEN<UI> BUT %UNTIL CYCLES *
// 1814 !* STORE AWWAY AN A.R. TO BE RESET AND COMPILED TO PUT THE *
// 1815 !* CONDITION AT THE END. IF IT WAS PUT AT THE BEGINING 2 EXTRA *
// 1816 !* JUMPS ARE NEEDED TO OBTAIN THE CORRECT EFFECT. *
// 1817 !***********************************************************************
// 1818 P=MARKC; FLAG=0
#line 1818 "test-new/imp918s.imp"
P = MARKC;
#line 1818 "test-new/imp918s.imp"
FLAG = 0;
// 1819 %IF CSSMODE=0 %THEN CCOND(1,SFLABEL-1) %ELSE %START
#line 1819 "test-new/imp918s.imp"
if (CSSMODE != 0) goto L_0111;
#line 1819 "test-new/imp918s.imp"
CCOND(1, SFLABEL - 1);
#line 1819 "test-new/imp918s.imp"
goto L_0112;
#line 1819 "test-new/imp918s.imp"
L_0111:;
// 1820 CUR CYC VAR=-1
#line 1820 "test-new/imp918s.imp"
CURCYCVAR = -1;
// 1821 CYCOPT(FLAG,1); ! NOT A PRELIMINARY LOOK
#line 1821 "test-new/imp918s.imp"
CYCOPT(/*?*/ &FLAG, 1);
// 1822 XLABEL=XLABEL-1
#line 1822 "test-new/imp918s.imp"
XLABEL = XLABEL - 1;
// 1823 ENTER LAB(L1,0); ! UNCONDITIONAL FOR REPEAT
#line 1823 "test-new/imp918s.imp"
ENTERLAB(L1, 0);
// 1824 %IF MARKIU=2 %THEN %START; ! '%UNTIL....%CYCLE'
#line 1824 "test-new/imp918s.imp"
if (MARKIU != 2) goto L_0113;
// 1825 L2=MARKR-MARKC+6
#line 1825 "test-new/imp918s.imp"
L2 = MARKR - MARKC + 6;
// 1826 P=P-1; A(P)=A(PIN-1); ! GET LINE NO
#line 1826 "test-new/imp918s.imp"
P = P - 1;
#line 1826 "test-new/imp918s.imp"
A[P + 7] = A[PIN - 1 + 7];
// 1827 %CYCLE; ! DOWN AR FOR <COND>
#line 1827 "test-new/imp918s.imp"
L_0114:;
// 1828 FROMAR4(P,JJJ)
#line 1828 "test-new/imp918s.imp"
FROMAR4(P, /*?*/ &JJJ);
// 1829 FROMAR4(P+2,KKK)
#line 1829 "test-new/imp918s.imp"
FROMAR4(P + 2, /*?*/ &KKK);
// 1830 PUSH123(HEAD,JJJ,KKK,A(P+4))
#line 1830 "test-new/imp918s.imp"
PUSH123(/*?*/ &HEAD, JJJ, KKK, A[P + 4 + 7]);
// 1831 P=P+5
#line 1831 "test-new/imp918s.imp"
P = P + 5;
// 1832 %REPEAT %UNTIL P>=MARKR
#line 1832 "test-new/imp918s.imp"
if (P >= MARKR) goto L_0115;
#line 1832 "test-new/imp918s.imp"
goto L_0114;
#line 1832 "test-new/imp918s.imp"
L_0115:;
// 1833 %FINISH %ELSE %START; ! '%WHILE...%CYCLE
#line 1833 "test-new/imp918s.imp"
goto L_0116;
#line 1833 "test-new/imp918s.imp"
L_0113:;
// 1834 CCOND(1,L1-1)
#line 1834 "test-new/imp918s.imp"
CCOND(1, L1 - 1);
// 1835 SFLABEL=SFLABEL-1
#line 1835 "test-new/imp918s.imp"
SFLABEL = SFLABEL - 1;
// 1836 %FINISH
#line 1836 "test-new/imp918s.imp"
L_0116:;
// 1837 PUSH123(CYCLE(LEVEL),L1!MARKIU<<28,XLABEL<<16!L2,HEAD)
#line 1837 "test-new/imp918s.imp"
PUSH123(/*?*/ &CYCLE[LEVEL], L1 | MARKIU << 28, XLABEL << 16 | L2, HEAD);
// 1838 %FINISH
#line 1838 "test-new/imp918s.imp"
L_0112:;
// 1839 Label1: %END; ->Label1
#line 1839 "test-new/imp918s.imp"
U_101C:;
#line 1839 "test-new/imp918s.imp"
goto end_1007;
#line 1839 "test-new/imp918s.imp"
end_1007:;
#line 1839 "test-new/imp918s.imp"
}
#line 1839 "test-new/imp918s.imp"
goto U_100F;
// 1840 !
// 1841 SW(7): ! SIMPLE DECLN
#line 1841 "test-new/imp918s.imp"
case_SW_7:;
// 1842 FAULT(57,0) %UNLESS LEVEL>=2
#line 1842 "test-new/imp918s.imp"
if (LEVEL >= 2) goto L_0117;
#line 1842 "test-new/imp918s.imp"
FAULT(57, 0);
#line 1842 "test-new/imp918s.imp"
L_0117:;
// 1843 FAULT(40,0) %IF NMDECS&1#0
#line 1843 "test-new/imp918s.imp"
if (NMDECS & 1 == 0) goto L_0118;
#line 1843 "test-new/imp918s.imp"
FAULT(40, 0);
#line 1843 "test-new/imp918s.imp"
L_0118:;
// 1844 SET LINE
#line 1844 "test-new/imp918s.imp"
SETLINE();
// 1845 P=P+1;CLT;ROUT=0
#line 1845 "test-new/imp918s.imp"
P = P + 1;
#line 1845 "test-new/imp918s.imp"
CLT();
#line 1845 "test-new/imp918s.imp"
ROUT = 0;
// 1846 %IF A(P)=1 %THEN %START; ! SCALAR DECLARATIONS
#line 1846 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_0119;
// 1847 CQN(P+1);P=P+2
#line 1847 "test-new/imp918s.imp"
CQN(P + 1);
#line 1847 "test-new/imp918s.imp"
P = P + 2;
// 1848 DECLARE SCALARS(1,0)
#line 1848 "test-new/imp918s.imp"
DECLARESCALARS(1, 0);
// 1849 %FINISH %ELSE %START; ! ARRAY DECLARATIONS
#line 1849 "test-new/imp918s.imp"
goto L_011A;
#line 1849 "test-new/imp918s.imp"
L_0119:;
// 1850 FAULT(70,0) %IF TYPE=5 %AND ACC=0
#line 1850 "test-new/imp918s.imp"
if (TYPE != 5) goto L_011B;
#line 1850 "test-new/imp918s.imp"
if (ACC != 0) goto L_011B;
#line 1850 "test-new/imp918s.imp"
FAULT(70, 0);
#line 1850 "test-new/imp918s.imp"
L_011B:;
// 1851 NAM=0
#line 1851 "test-new/imp918s.imp"
NAM = 0;
// 1852 QQ=2-A(P+1); P=P+2; ! QQ=1 FOR ARRAYFORMATS
#line 1852 "test-new/imp918s.imp"
QQ = 2 - A[P + 1 + 7];
#line 1852 "test-new/imp918s.imp"
P = P + 2;
// 1853 DECLARE ARRAYS(QQ,0)
#line 1853 "test-new/imp918s.imp"
DECLAREARRAYS(QQ, 0);
// 1854 %FINISH
#line 1854 "test-new/imp918s.imp"
L_011A:;
// 1855 ->Label1
#line 1855 "test-new/imp918s.imp"
goto U_100F;
// 1856 !
// 1857 %ROUTINE DECLARE SCALARS(%INTEGER PERMIT,XTRA)
#line 1857 "test-new/imp918s.imp"
void DECLARESCALARS(int PERMIT, int XTRA) {
// 1858 {%SHORTROUTINE}
// 1859 !***********************************************************************
// 1860 !* THIS ROUTINE DECLARES A LIST OF SCALARS FROM INFORMATION *
// 1861 !* IN THE GLOBAL VARIABLES ROUT,NAM,ARR,PREC,TYPE & ACC.IT WORKS *
// 1862 !* OUT ROUNDING FACTORS FOR ITSELF. IF PERMIT#0 STRINGS AND *
// 1863 !* RECORDS ARE ALLOCATED AT RUN TIME(ALLOC=1) WHEN SPACE IS *
// 1864 !* TIGHT. P POINTS TO THE NAMELIST ON ENTRY AND IS UPDATED. *
// 1865 !***********************************************************************
// 1866 %INTEGER REP,ALLOC,INC,ROUND,Q,SCHAIN,NIN
#line 1866 "test-new/imp918s.imp"
int REP;
#line 1866 "test-new/imp918s.imp"
int ALLOC;
#line 1866 "test-new/imp918s.imp"
int INC;
#line 1866 "test-new/imp918s.imp"
int ROUND;
#line 1866 "test-new/imp918s.imp"
int Q;
#line 1866 "test-new/imp918s.imp"
int SCHAIN;
#line 1866 "test-new/imp918s.imp"
int NIN;
// 1867 %CONSTBYTEINTEGERARRAY RACC (1:32)= %C
#line 1867 "test-new/imp918s.imp"
const unsigned char RACC[32] = {[0 ... 1] = 68, 128, 0, 16, [5 ... 9] = 0, 17, [11 ... 19] = 0, 34,
[21 ... 29] = 0, 0, 136};
// 1868+ X'44' (2),X'80',0,X'10',0(5),
// 1869+ X'11',0(9),
// 1870+ X'22',0(9),
// 1871+ 0,X'88'
// 1872 PACK(PTYPE); J=0; NIN=N
#line 1872 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
#line 1872 "test-new/imp918s.imp"
J = 0;
#line 1872 "test-new/imp918s.imp"
NIN = N;
// 1873 %IF PTYPE<=32 %THEN ROUND=RACC(PTYPE) %ELSE %START
#line 1873 "test-new/imp918s.imp"
if (PTYPE > 32) goto L_011C;
#line 1873 "test-new/imp918s.imp"
ROUND = RACC[PTYPE - 1];
#line 1873 "test-new/imp918s.imp"
goto L_011D;
#line 1873 "test-new/imp918s.imp"
L_011C:;
// 1874 %IF NAM=1 %AND TYPE=0 %AND ROUT=0 %THEN ROUND=X'48' %C
#line 1874 "test-new/imp918s.imp"
if (NAM != 1) goto L_011E;
#line 1874 "test-new/imp918s.imp"
if (TYPE != 0) goto L_011E;
#line 1874 "test-new/imp918s.imp"
if (ROUT != 0) goto L_011E;
#line 1874 "test-new/imp918s.imp"
ROUND = 72;
#line 1874 "test-new/imp918s.imp"
goto L_011F;
#line 1874 "test-new/imp918s.imp"
L_011E:;
#line 1874 "test-new/imp918s.imp"
ROUND = 68;
#line 1874 "test-new/imp918s.imp"
L_011F:;
// 1875+ %ELSE ROUND=X'44'
// 1876 %FINISH
#line 1876 "test-new/imp918s.imp"
L_011D:;
// 1877 %IF ARR=1 %AND ROUT=0 %THEN INC=16 %ELSE INC=ROUND&15
#line 1877 "test-new/imp918s.imp"
if (ARR != 1) goto L_0120;
#line 1877 "test-new/imp918s.imp"
if (ROUT != 0) goto L_0120;
#line 1877 "test-new/imp918s.imp"
INC = 16;
#line 1877 "test-new/imp918s.imp"
goto L_0121;
#line 1877 "test-new/imp918s.imp"
L_0120:;
#line 1877 "test-new/imp918s.imp"
INC = ROUND & 15;
#line 1877 "test-new/imp918s.imp"
L_0121:;
// 1878 ! BEWARE MAPS
// 1879 %IF INC=0 %THEN INC=ACC
#line 1879 "test-new/imp918s.imp"
if (INC != 0) goto L_0122;
#line 1879 "test-new/imp918s.imp"
INC = ACC;
#line 1879 "test-new/imp918s.imp"
L_0122:;
// 1880 ROUND=ROUND>>4; ! ITEM LENGTH AND BOUNDARY O.K.
#line 1880 "test-new/imp918s.imp"
ROUND = (unsigned int)ROUND >> 4;
// 1881 %IF PTYPE=5 %AND ACC=0 %THEN FAULT(70,0)
#line 1881 "test-new/imp918s.imp"
if (PTYPE != 5) goto L_0123;
#line 1881 "test-new/imp918s.imp"
if (ACC != 0) goto L_0123;
#line 1881 "test-new/imp918s.imp"
FAULT(70, 0);
#line 1881 "test-new/imp918s.imp"
L_0123:;
// 1882 ALLOC=0; REP=A(P)
#line 1882 "test-new/imp918s.imp"
ALLOC = 0;
#line 1882 "test-new/imp918s.imp"
REP = A[P + 7];
// 1883 %IF PERMIT#0 %AND(PTYPE=3 %OR PTYPE=5) %AND %C
#line 1883 "test-new/imp918s.imp"
if (PERMIT == 0) goto L_0124;
#line 1883 "test-new/imp918s.imp"
if (PTYPE == 3) goto L_0125;
#line 1883 "test-new/imp918s.imp"
if (PTYPE != 5) goto L_0124;
#line 1883 "test-new/imp918s.imp"
L_0125:;
#line 1883 "test-new/imp918s.imp"
if (ACC * REP + N <= 4096 - MARGIN) goto L_0124;
// 1884+ ACC*REP+N>4096-MARGIN %THEN %START
// 1885 NAM=1; PACK(PTYPE)
#line 1885 "test-new/imp918s.imp"
NAM = 1;
#line 1885 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 1886 ROUND=4; INC=4
#line 1886 "test-new/imp918s.imp"
ROUND = 4;
#line 1886 "test-new/imp918s.imp"
INC = 4;
// 1887 ALLOC=1
#line 1887 "test-new/imp918s.imp"
ALLOC = 1;
// 1888 %FINISH
#line 1888 "test-new/imp918s.imp"
L_0124:;
// 1889 N=(N+ROUND-1)&(-ROUND)
#line 1889 "test-new/imp918s.imp"
N = N + ROUND - 1 & -ROUND;
// 1890 %CYCLE Q=1,1,REP; ! DOWN THE NAMELIST
#line 1890 "test-new/imp918s.imp"
// %for Q = 1, 1, REP %cycle
#line 1890 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = REP;
#line 1890 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle Q = 1, 1, REP");
_control = Q = _initial - _increment;
#line 1890 "test-new/imp918s.imp"
L_0126:
#line 1890 "test-new/imp918s.imp"
if (Q != _control) _imp_signal(4, 2, 0, "Corrupt control variable Q");
#line 1890 "test-new/imp918s.imp"
if (Q == _final) goto L_0127;
#line 1890 "test-new/imp918s.imp"
_control += _increment;
Q += _increment;
// 1891 K=A(P+Q); TEST NST
#line 1891 "test-new/imp918s.imp"
K = A[P + Q + 7];
#line 1891 "test-new/imp918s.imp"
TESTNST();
// 1892 SCHAIN=N
#line 1892 "test-new/imp918s.imp"
SCHAIN = N;
// 1893 %IF ROUT=1 %THEN %START
#line 1893 "test-new/imp918s.imp"
if (ROUT != 1) goto L_0129;
// 1894 SCHAIN=0; J=13; SNDISP=N>>2
#line 1894 "test-new/imp918s.imp"
SCHAIN = 0;
#line 1894 "test-new/imp918s.imp"
J = 13;
#line 1894 "test-new/imp918s.imp"
SNDISP = (unsigned int)N >> 2;
// 1895 KFORM=1000
#line 1895 "test-new/imp918s.imp"
KFORM = 1000;
// 1896 %FINISH
#line 1896 "test-new/imp918s.imp"
L_0129:;
// 1897 %IF TYPE=3 %THEN KFORM=XTRA
#line 1897 "test-new/imp918s.imp"
if (TYPE != 3) goto L_012A;
#line 1897 "test-new/imp918s.imp"
KFORM = XTRA;
#line 1897 "test-new/imp918s.imp"
L_012A:;
// 1898 STORE TAG(K,SCHAIN)
#line 1898 "test-new/imp918s.imp"
STORETAG(K, SCHAIN);
// 1899 %IF ALLOC=1 %THEN %START
#line 1899 "test-new/imp918s.imp"
if (ALLOC != 1) goto L_012B;
// 1900 %IF UNASS=1 %THEN PSS(X'D2',8,WSPR,0,CODER,216)
#line 1900 "test-new/imp918s.imp"
if (UNASS != 1) goto L_012C;
#line 1900 "test-new/imp918s.imp"
PSS(210, 8, 11, 0, 12, 216);
#line 1900 "test-new/imp918s.imp"
L_012C:;
// 1901 DUMP(X'50',WSPR,N,0,RBASE)
#line 1901 "test-new/imp918s.imp"
DUMP(80, 11, N, 0, RBASE);
// 1902 %IF TYPE=5 %THEN DUMPSI(X'92',ACC-1,RBASE,N)
#line 1902 "test-new/imp918s.imp"
if (TYPE != 5) goto L_012D;
#line 1902 "test-new/imp918s.imp"
DUMPSI(146, ACC - 1, RBASE, N);
#line 1902 "test-new/imp918s.imp"
L_012D:;
// 1903 MOVER(WSPR,(ACC+7)&(-8))
#line 1903 "test-new/imp918s.imp"
MOVER(11, ACC + 7 & -8);
// 1904 %FINISH
#line 1904 "test-new/imp918s.imp"
L_012B:;
// 1905 N=N+INC
#line 1905 "test-new/imp918s.imp"
N = N + INC;
// 1906 %REPEAT
#line 1906 "test-new/imp918s.imp"
goto L_0126;
#line 1906 "test-new/imp918s.imp"
}
#line 1906 "test-new/imp918s.imp"
L_0127:;
// 1907 P=P+REP+1
#line 1907 "test-new/imp918s.imp"
P = P + REP + 1;
// 1908 N=(N+3)&(-4) %IF PERMIT#0;! NO ROUNDING AMONG PARAMS
#line 1908 "test-new/imp918s.imp"
if (PERMIT == 0) goto L_012E;
#line 1908 "test-new/imp918s.imp"
N = N + 3 & -4;
#line 1908 "test-new/imp918s.imp"
L_012E:;
// 1909 BULKM(0,N-NIN,RBASE,NIN,0,X'80') %IF UNASS=1 %AND %C
#line 1909 "test-new/imp918s.imp"
if (UNASS != 1) goto L_012F;
#line 1909 "test-new/imp918s.imp"
if (ALLOC != 0) goto L_012F;
#line 1909 "test-new/imp918s.imp"
if (PERMIT == 0) goto L_012F;
#line 1909 "test-new/imp918s.imp"
BULKM(0, N - NIN, RBASE, NIN, 0, 128);
#line 1909 "test-new/imp918s.imp"
L_012F:;
// 1910+ ALLOC=0 %AND PERMIT\=0
// 1911 %END
#line 1911 "test-new/imp918s.imp"
return;
#line 1911 "test-new/imp918s.imp"
} /* end of DECLARESCALARS */
// 1912 %ROUTINE DECLARE ARRAYS(%INTEGER FORMAT,FINF)
#line 1912 "test-new/imp918s.imp"
void DECLAREARRAYS(int FORMAT, int FINF) {
// 1913 {%SHORTROUTINE}
// 1914 !***********************************************************************
// 1915 !* FORMAT=1 FOR 'ARRAYFORMAT' =0 OTHERWISE *
// 1916 !* FINF>0 FOR RECORD FORMAT INFORMATION =0 OTHERWISE *
// 1917 !* P IS AT P<ADECLN> IN *
// 1918 !* *
// 1919 !* P<ADECLN>=<NAMELIST> <BPAIR> <RESTOFDECLN> *
// 1920 !* P<BPAIR> = <CBPAIR>,'('<EXPR>':'<EXRR><RESTOFBP>*')' *
// 1921 !* *
// 1922 !* ARRAYS OF ONE DIMENSION WITH CONSTANT BOUNDS HAVE THEIR *
// 1923 !* DOPE-VECTOR IN THE CONSTANT AREA AND MAY HAVE THEIR SPACE *
// 1924 !* ALLOCATED AT COMPILE TIME AMONG THE SCALARS *
// 1925 !* ALL OTHER ARRAYS HAVE A DOPE VECTOR AMONG THE LOCALS AND GET *
// 1926 !* THEIR SPACE OFF THE STACK AT RUN TIME *
// 1927 !* BOTH SORTS OF ARRAYS HAVE A FOUR WORD HEAD AND D-V TO EMAS *
// 1928 !* SYSTEM STANDARDS *
// 1929 !***********************************************************************
// 1930 %INTEGER DVDISP,PP,DVF,ELSIZE,TOTSIZE,L,U,D1,D0
#line 1930 "test-new/imp918s.imp"
int DVDISP;
#line 1930 "test-new/imp918s.imp"
int PP;
#line 1930 "test-new/imp918s.imp"
int DVF;
#line 1930 "test-new/imp918s.imp"
int ELSIZE;
#line 1930 "test-new/imp918s.imp"
int TOTSIZE;
#line 1930 "test-new/imp918s.imp"
int L;
#line 1930 "test-new/imp918s.imp"
int U;
#line 1930 "test-new/imp918s.imp"
int D1;
#line 1930 "test-new/imp918s.imp"
int D0;
// 1931 %INTEGER PTYPEP,ARRP,NN,ND,II,JJ,QQ,R,CDV
#line 1931 "test-new/imp918s.imp"
int PTYPEP;
#line 1931 "test-new/imp918s.imp"
int ARRP;
#line 1931 "test-new/imp918s.imp"
int NN;
#line 1931 "test-new/imp918s.imp"
int ND;
#line 1931 "test-new/imp918s.imp"
int II;
#line 1931 "test-new/imp918s.imp"
int JJ;
#line 1931 "test-new/imp918s.imp"
int QQ;
#line 1931 "test-new/imp918s.imp"
int R;
#line 1931 "test-new/imp918s.imp"
int CDV;
// 1932 ARRP=2*FORMAT+1; ARR=ARRP; PACK(PTYPEP)
#line 1932 "test-new/imp918s.imp"
ARRP = 2 * FORMAT + 1;
#line 1932 "test-new/imp918s.imp"
ARR = ARRP;
#line 1932 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPEP);
// 1933 ELSIZE=ACC
#line 1933 "test-new/imp918s.imp"
ELSIZE = ACC;
// 1934 START: NN=A(P+1); ! NO OF NAMES IN NAMELIST
#line 1934 "test-new/imp918s.imp"
U_101D:;
#line 1934 "test-new/imp918s.imp"
NN = A[P + 1 + 7];
// 1935 PP=P; CDV=0
#line 1935 "test-new/imp918s.imp"
PP = P;
#line 1935 "test-new/imp918s.imp"
CDV = 0;
// 1936 P=P+2+NN;
#line 1936 "test-new/imp918s.imp"
P = P + 2 + NN;
// 1937 %IF A(P)=1 %THEN -> CONSTDV; ! P<BPAIR> =<CBPAIR>
#line 1937 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_0130;
#line 1937 "test-new/imp918s.imp"
goto U_101E;
#line 1937 "test-new/imp918s.imp"
L_0130:;
// 1938 !
// 1939 ! NORMAL CASE - PLANT CODE TO SET UP DOPE-VECTOR AT RUN TIME
// 1940 !
// 1941 ND=0; JJ=P; DVF=0;TOTSIZE=X'FFFF'
#line 1941 "test-new/imp918s.imp"
ND = 0;
#line 1941 "test-new/imp918s.imp"
JJ = P;
#line 1941 "test-new/imp918s.imp"
DVF = 0;
#line 1941 "test-new/imp918s.imp"
TOTSIZE = 65535;
// 1942 %CYCLE; ! TILL NO MORE BPAIRS
#line 1942 "test-new/imp918s.imp"
L_0131:;
// 1943 P=P+1; ND=ND+1; ! COUNT NO OF DIMENSIONS
#line 1943 "test-new/imp918s.imp"
P = P + 1;
#line 1943 "test-new/imp918s.imp"
ND = ND + 1;
// 1944 SKIP EXP; SKIP EXP
#line 1944 "test-new/imp918s.imp"
SKIPEXP();
#line 1944 "test-new/imp918s.imp"
SKIPEXP();
// 1945 %REPEAT %UNTIL A(P)=2
#line 1945 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0132;
#line 1945 "test-new/imp918s.imp"
goto L_0131;
#line 1945 "test-new/imp918s.imp"
L_0132:;
// 1946 P=JJ; DVDISP=N; ! DVDISP IS D-V POSITION
#line 1946 "test-new/imp918s.imp"
P = JJ;
#line 1946 "test-new/imp918s.imp"
DVDISP = N;
// 1947 N=N+12*ND+4; ! CLAIM SPACE FOR THE D-V
#line 1947 "test-new/imp918s.imp"
N = N + 12 * ND + 4;
// 1948 FAULT(37,0) %IF ND>7; ! TOO MANY DIMENSIONS
#line 1948 "test-new/imp918s.imp"
if (ND <= 7) goto L_0133;
#line 1948 "test-new/imp918s.imp"
FAULT(37, 0);
#line 1948 "test-new/imp918s.imp"
L_0133:;
// 1949 !
// 1950 DUMP(0,-2,ELSIZE,0,0)
#line 1950 "test-new/imp918s.imp"
DUMP(0, -2, ELSIZE, 0, 0);
// 1951 REGISTER(NEST)=1
#line 1951 "test-new/imp918s.imp"
REGISTER[NEST] = 1;
// 1952 DUMP(X'50',NEST,DVDISP,0,RBASE)
#line 1952 "test-new/imp918s.imp"
DUMP(80, NEST, DVDISP, 0, RBASE);
// 1953 FREE AND FORGET(NEST)
#line 1953 "test-new/imp918s.imp"
FREEANDFORGET(NEST);
// 1954 DUMPSI(X'92',ND,RBASE,DVDISP+1); ! FIRST ND=ND<<16!ELSIZE
#line 1954 "test-new/imp918s.imp"
DUMPSI(146, ND, RBASE, DVDISP + 1);
// 1955 !
// 1956 %CYCLE II=0,1,ND-1
#line 1956 "test-new/imp918s.imp"
// %for II = 0, 1, ND - 1 %cycle
#line 1956 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = ND - 1;
#line 1956 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle II = 0, 1, ND - 1");
_control = II = _initial - _increment;
#line 1956 "test-new/imp918s.imp"
L_0134:
#line 1956 "test-new/imp918s.imp"
if (II != _control) _imp_signal(4, 2, 0, "Corrupt control variable II");
#line 1956 "test-new/imp918s.imp"
if (II == _final) goto L_0135;
#line 1956 "test-new/imp918s.imp"
_control += _increment;
II += _increment;
// 1957 P=P+1
#line 1957 "test-new/imp918s.imp"
P = P + 1;
// 1958 %CYCLE JJ=0,1,1
#line 1958 "test-new/imp918s.imp"
// %for JJ = 0, 1, 1 %cycle
#line 1958 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 1;
#line 1958 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle JJ = 0, 1, 1");
_control = JJ = _initial - _increment;
#line 1958 "test-new/imp918s.imp"
L_0136:
#line 1958 "test-new/imp918s.imp"
if (JJ != _control) _imp_signal(4, 2, 0, "Corrupt control variable JJ");
#line 1958 "test-new/imp918s.imp"
if (JJ == _final) goto L_0137;
#line 1958 "test-new/imp918s.imp"
_control += _increment;
JJ += _increment;
// 1959 QQ=12*II+4*JJ+4+DVDISP
#line 1959 "test-new/imp918s.imp"
QQ = 12 * II + 4 * JJ + 4 + DVDISP;
// 1960 TYPE=1; PREC=0; PTYPE=1
#line 1960 "test-new/imp918s.imp"
TYPE = 1;
#line 1960 "test-new/imp918s.imp"
PREC = 0;
#line 1960 "test-new/imp918s.imp"
PTYPE = 1;
// 1961 ASSIGN(2,RBASE<<16!QQ); ! ASSIGN EXPR TO DVITEM
#line 1961 "test-new/imp918s.imp"
ASSIGN(2, RBASE << 16 | QQ);
// 1962 %REPEAT
#line 1962 "test-new/imp918s.imp"
goto L_0136;
#line 1962 "test-new/imp918s.imp"
}
#line 1962 "test-new/imp918s.imp"
L_0137:;
// 1963 %REPEAT
#line 1963 "test-new/imp918s.imp"
goto L_0134;
#line 1963 "test-new/imp918s.imp"
}
#line 1963 "test-new/imp918s.imp"
L_0135:;
// 1964 P=P+1
#line 1964 "test-new/imp918s.imp"
P = P + 1;
// 1965 DUMP(0,2,DVDISP,0,RBASE)
#line 1965 "test-new/imp918s.imp"
DUMP(0, 2, DVDISP, 0, RBASE);
// 1966 RUN TIME: ! ALLOCATE SPACE AT RUN TIME
#line 1966 "test-new/imp918s.imp"
U_101F:;
// 1967 ! R2 POINTS TO D-V
// 1968 DVF=0; ! NOT VECTORS
#line 1968 "test-new/imp918s.imp"
DVF = 0;
// 1969 PRX(X'50',2,0,GLA,36); ! PUT POINTER INTO GLA
#line 1969 "test-new/imp918s.imp"
PRX(80, 2, 0, 13, 36);
// 1970 JJ=FORMAT<<7!UNASS
#line 1970 "test-new/imp918s.imp"
JJ = FORMAT << 7 | UNASS;
// 1971 PSI(X'92',JJ,GLA,36) %IF JJ#0;! AND ADD FLAGS
#line 1971 "test-new/imp918s.imp"
if (JJ == 0) goto L_0138;
#line 1971 "test-new/imp918s.imp"
PSI(146, JJ, 13, 36);
#line 1971 "test-new/imp918s.imp"
L_0138:;
// 1972 -> DECL
#line 1972 "test-new/imp918s.imp"
goto U_1020;
// 1973 CONSTDV: ! ONE DIMENSION - CONSTANT BOUNDS
#line 1973 "test-new/imp918s.imp"
U_101E:;
// 1974 DVF=1; ND=1; P=P+1; CDV=1
#line 1974 "test-new/imp918s.imp"
DVF = 1;
#line 1974 "test-new/imp918s.imp"
ND = 1;
#line 1974 "test-new/imp918s.imp"
P = P + 1;
#line 1974 "test-new/imp918s.imp"
CDV = 1;
// 1975 CBPAIR(L,U); ! GET BOUNDS
#line 1975 "test-new/imp918s.imp"
CBPAIR(/*?*/ &L, /*?*/ &U);
// 1976 DVDISP=DOPE VECTOR(ELSIZE,L,U); ! AND GENERATE A D-V
#line 1976 "test-new/imp918s.imp"
DVDISP = DOPEVECTOR(ELSIZE, L, U);
// 1977 R=U-L+1; ! RANGE=SPACES AS ELEMENTS
#line 1977 "test-new/imp918s.imp"
R = U - L + 1;
// 1978 TOTSIZE=R*ELSIZE
#line 1978 "test-new/imp918s.imp"
TOTSIZE = R * ELSIZE;
// 1979 !
// 1980 II=DVDISP-GRINF(2)
#line 1980 "test-new/imp918s.imp"
II = DVDISP - GRINF[2];
// 1981 %UNLESS GRUSE(2)=17 %AND II>=0 %THEN %START
#line 1981 "test-new/imp918s.imp"
if (GRUSE[2] != 17) goto L_0128;
#line 1981 "test-new/imp918s.imp"
if (II >= 0) goto L_0139;
#line 1981 "test-new/imp918s.imp"
L_0128:;
// 1982 PCONST(X'5820D000'); ! LOAD R2,POINTER TO SST
#line 1982 "test-new/imp918s.imp"
PCONST(1478545408);
// 1983 FORGET(2)
#line 1983 "test-new/imp918s.imp"
FORGET(2);
// 1984 II=DVDISP
#line 1984 "test-new/imp918s.imp"
II = DVDISP;
// 1985 %FINISH
#line 1985 "test-new/imp918s.imp"
L_0139:;
// 1986 !
// 1987 REGISTER(2)=1
#line 1987 "test-new/imp918s.imp"
REGISTER[2] = 1;
// 1988 DUMP(0,2,II,0,2) %UNLESS II=0
#line 1988 "test-new/imp918s.imp"
if (II == 0) goto L_013A;
#line 1988 "test-new/imp918s.imp"
DUMP(0, 2, II, 0, 2);
#line 1988 "test-new/imp918s.imp"
L_013A:;
// 1989 REGISTER(2)=0
#line 1989 "test-new/imp918s.imp"
REGISTER[2] = 0;
// 1990 JJ=4096-N-MARGIN; ! SPACE AVAILABLE
#line 1990 "test-new/imp918s.imp"
JJ = 4096 - N - MARGIN;
// 1991 JJ=JJ-MARGIN//2 %IF RBASE=9; ! LEAVE LARGER MARGIN AT TOP
#line 1991 "test-new/imp918s.imp"
if (RBASE != 9) goto L_013B;
#line 1991 "test-new/imp918s.imp"
JJ = JJ - ((long)MARGIN / (long)2);
#line 1991 "test-new/imp918s.imp"
L_013B:;
// 1992 ! LEVEL SINCE DECLNS THERE ARE
// 1993 ! ONLY EXECUTED ONCE
// 1994 -> RUNTIME %UNLESS FORMAT=0 %AND UNASS=0
#line 1994 "test-new/imp918s.imp"
if (FORMAT != 0) goto L_013C;
#line 1994 "test-new/imp918s.imp"
if (UNASS == 0) goto L_013D;
#line 1994 "test-new/imp918s.imp"
L_013C:;
#line 1994 "test-new/imp918s.imp"
goto U_101F;
#line 1994 "test-new/imp918s.imp"
L_013D:;
// 1995 -> RUNTIME %IF NN*TOTSIZE>JJ %OR L>U
#line 1995 "test-new/imp918s.imp"
if (NN * TOTSIZE > JJ) goto L_013E;
#line 1995 "test-new/imp918s.imp"
if (L <= U) goto L_013F;
#line 1995 "test-new/imp918s.imp"
L_013E:;
#line 1995 "test-new/imp918s.imp"
goto U_101F;
#line 1995 "test-new/imp918s.imp"
L_013F:;
// 1996 II=N-L*ELSIZE
#line 1996 "test-new/imp918s.imp"
II = N - L * ELSIZE;
// 1997 -> RUNTIME %UNLESS II>0 %AND II+(NN-1)*(TOTSIZE+16)<4000
#line 1997 "test-new/imp918s.imp"
if (II <= 0) goto L_0140;
#line 1997 "test-new/imp918s.imp"
if (II + (NN - 1) * (TOTSIZE + 16) < 4000) goto L_0141;
#line 1997 "test-new/imp918s.imp"
L_0140:;
#line 1997 "test-new/imp918s.imp"
goto U_101F;
#line 1997 "test-new/imp918s.imp"
L_0141:;
// 1998 !
// 1999 ! CAN ALLOCATE ARRAYS AS STRINGS OF LOCALS. THIS SAVES TIME AT DECLARATION
// 2000 ! BUT ALSO ALLOWS THE LEVEL POINTER TO BE USED TO ADDRESS
// 2001 ! THE ARRAY SAVING A REGISTER ON EACH ACCESS.
// 2002 !
// 2003 DUMP(0,3,ELSIZE,0,0) %UNLESS COMPILER=1
#line 2003 "test-new/imp918s.imp"
if (COMPILER == 1) goto L_0142;
#line 2003 "test-new/imp918s.imp"
DUMP(0, 3, ELSIZE, 0, 0);
#line 2003 "test-new/imp918s.imp"
L_0142:;
// 2004 DECL: ! MAKE DECLN - BOTH WAYS
#line 2004 "test-new/imp918s.imp"
U_1020:;
// 2005 PTYPE=PTYPEP+100*DVF; ! ARR=2 FOR VECTORS =3 FOR FORMAT
#line 2005 "test-new/imp918s.imp"
PTYPE = PTYPEP + 100 * DVF;
// 2006 J=ND
#line 2006 "test-new/imp918s.imp"
J = ND;
// 2007 %CYCLE JJJ=1,1,A(PP+1);
#line 2007 "test-new/imp918s.imp"
// %for JJJ = 1, 1, A[PP + 1 + 7] %cycle
#line 2007 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[PP + 1 + 7];
#line 2007 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle JJJ = 1, 1, A[PP + 1 + 7]");
_control = JJJ = _initial - _increment;
#line 2007 "test-new/imp918s.imp"
L_0143:
#line 2007 "test-new/imp918s.imp"
if (JJJ != _control) _imp_signal(4, 2, 0, "Corrupt control variable JJJ");
#line 2007 "test-new/imp918s.imp"
if (JJJ == _final) goto L_0144;
#line 2007 "test-new/imp918s.imp"
_control += _increment;
JJJ += _increment;
// ?Non-local
// 2008 ; ! DOWN NAMELIST
#line 2008 "test-new/imp918s.imp"
if (DVF == 0) goto L_0146;
// 2008 %IF DVF#0 %THEN %START; ! ARRAY IS STRING OF LOCALS
// 2009 N=(N+7)&(-8); ! ARRAYS START ON D-W BNDARY
#line 2009 "test-new/imp918s.imp"
N = N + 7 & -8;
// 2010 D1=N+16
#line 2010 "test-new/imp918s.imp"
D1 = N + 16;
// 2011 D0=D1-L*ELSIZE; SNDISP=D0
#line 2011 "test-new/imp918s.imp"
D0 = D1 - L * ELSIZE;
#line 2011 "test-new/imp918s.imp"
SNDISP = D0;
// 2012 PRX(X'41',0,0,RBASE,D0);! LA 0,ADDR(A(0))
#line 2012 "test-new/imp918s.imp"
PRX(65, 0, 0, RBASE, D0);
// 2013 PRX(X'41',1,0,RBASE,D1);! LA 1,ADDR(A(L.B))
#line 2013 "test-new/imp918s.imp"
PRX(65, 1, 0, RBASE, D1);
// 2014 JJ=16+TOTSIZE
#line 2014 "test-new/imp918s.imp"
JJ = 16 + TOTSIZE;
// 2015 FORGETM(3)
#line 2015 "test-new/imp918s.imp"
FORGETM(3);
// 2016 %FINISH %ELSE %START; ! LONGWAY PERM MUST DECLARE
#line 2016 "test-new/imp918s.imp"
goto L_0147;
#line 2016 "test-new/imp918s.imp"
L_0146:;
// 2017 PPJ(13); FORGET(4)
#line 2017 "test-new/imp918s.imp"
PPJ(13);
#line 2017 "test-new/imp918s.imp"
FORGET(4);
// 2018 JJ=16
#line 2018 "test-new/imp918s.imp"
JJ = 16;
// 2019 SNDISP=0
#line 2019 "test-new/imp918s.imp"
SNDISP = 0;
// 2020 %FINISH
#line 2020 "test-new/imp918s.imp"
L_0147:;
// 2021 !
// 2022 ACC=ELSIZE; ! RESET ACC AFTER DV CMPLD
#line 2022 "test-new/imp918s.imp"
ACC = ELSIZE;
// 2023 KFORM=FINF; ! FORMAT INFORMATION
#line 2023 "test-new/imp918s.imp"
KFORM = FINF;
// 2024 K=A(JJJ+PP+1); TEST NST
#line 2024 "test-new/imp918s.imp"
K = A[JJJ + PP + 1 + 7];
#line 2024 "test-new/imp918s.imp"
TESTNST();
// 2025 STORE TAG(K,N)
#line 2025 "test-new/imp918s.imp"
STORETAG(K, N);
// 2026 REGISTER(1)=1; ! MUST LOCK REGISTERS CONTAINING
#line 2026 "test-new/imp918s.imp"
REGISTER[1] = 1;
// 2027 REGISTER(2)=1; ! ARRAYHEAD IN CASE 4K MULTIPLE
#line 2027 "test-new/imp918s.imp"
REGISTER[2] = 1;
// 2028 REGISTER(3)=1; ! NEEDED TO STORE ARRAYHEAD
#line 2028 "test-new/imp918s.imp"
REGISTER[3] = 1;
// 2029 DUMPM(X'90',0,3,RBASE,N)
#line 2029 "test-new/imp918s.imp"
DUMPM(144, 0, 3, RBASE, N);
// 2030 %CYCLE II=0,1,3
#line 2030 "test-new/imp918s.imp"
// %for II = 0, 1, 3 %cycle
#line 2030 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 3;
#line 2030 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle II = 0, 1, 3");
_control = II = _initial - _increment;
#line 2030 "test-new/imp918s.imp"
L_0148:
#line 2030 "test-new/imp918s.imp"
if (II != _control) _imp_signal(4, 2, 0, "Corrupt control variable II");
#line 2030 "test-new/imp918s.imp"
if (II == _final) goto L_0149;
#line 2030 "test-new/imp918s.imp"
_control += _increment;
II += _increment;
// 2031 FREE AND FORGET(II); ! NOW FORGET REGISTERS
#line 2031 "test-new/imp918s.imp"
FREEANDFORGET(II);
// 2032 %REPEAT
#line 2032 "test-new/imp918s.imp"
goto L_0148;
#line 2032 "test-new/imp918s.imp"
}
#line 2032 "test-new/imp918s.imp"
L_0149:;
// 2033 N=N+JJ
#line 2033 "test-new/imp918s.imp"
N = N + JJ;
// 2034 %REPEAT
#line 2034 "test-new/imp918s.imp"
goto L_0143;
#line 2034 "test-new/imp918s.imp"
}
#line 2034 "test-new/imp918s.imp"
L_0144:;
// 2035 %IF CDV#0 %THEN SET USE(2,17,DVDISP)
#line 2035 "test-new/imp918s.imp"
if (CDV == 0) goto L_014A;
#line 2035 "test-new/imp918s.imp"
SETUSE(2, 17, DVDISP);
#line 2035 "test-new/imp918s.imp"
L_014A:;
// 2036 P=P+1; ! PAST REST OF ARRAYLIST
#line 2036 "test-new/imp918s.imp"
P = P + 1;
// 2037 N=(N+3)&(-4)
#line 2037 "test-new/imp918s.imp"
N = N + 3 & -4;
// 2038 %IF A(P-1)=1 %THEN -> START
#line 2038 "test-new/imp918s.imp"
if (A[P - 1 + 7] != 1) goto L_014B;
#line 2038 "test-new/imp918s.imp"
goto U_101D;
#line 2038 "test-new/imp918s.imp"
L_014B:;
// 2039 %END
#line 2039 "test-new/imp918s.imp"
return;
#line 2039 "test-new/imp918s.imp"
} /* end of DECLAREARRAYS */
// 2040 SW(8): ! %END
#line 2040 "test-new/imp918s.imp"
case_SW_8:;
// 2041 %BEGIN
#line 2041 "test-new/imp918s.imp"
{ /*%begin*/
// 2042 {%SHORTROUTINE}
// 2043 %SWITCH S(1:5)
#line 2043 "test-new/imp918s.imp"
int S_index;
#line 2043 "test-new/imp918s.imp"
int S_line;
#line 2043 "test-new/imp918s.imp"
char *S_file;
#line 2043 "test-new/imp918s.imp"
static const void *S[5] = {&&case_S_1, &&case_S_2, &&case_S_3, &&case_S_4, &&case_S_5};
// 2044 -> S(A(P+1))
#line 2044 "test-new/imp918s.imp"
S_line = __LINE__;
S_file = __FILE__;
S_index = A[P + 1 + 7];
goto case_S_dispatch;
// 2045 S(1): ! ENDOFPROGRAM
#line 2045 "test-new/imp918s.imp"
case_S_1:;
// 2046 S(2): ! ENDOFFILE
#line 2046 "test-new/imp918s.imp"
case_S_2:;
// 2047 %IF CPRMODE=0 %THEN CPRMODE=2
#line 2047 "test-new/imp918s.imp"
if (CPRMODE != 0) goto L_014D;
#line 2047 "test-new/imp918s.imp"
CPRMODE = 2;
#line 2047 "test-new/imp918s.imp"
L_014D:;
// 2048 FAULT(15,0) %UNLESS LEVEL+CPRMODE=3
#line 2048 "test-new/imp918s.imp"
if (LEVEL + CPRMODE == 3) goto L_014E;
#line 2048 "test-new/imp918s.imp"
FAULT(15, 0);
#line 2048 "test-new/imp918s.imp"
L_014E:;
// 2049 FAULT(56,0) %UNLESS A(P+1)=CPRMODE
#line 2049 "test-new/imp918s.imp"
if (A[P + 1 + 7] == CPRMODE) goto L_014F;
#line 2049 "test-new/imp918s.imp"
FAULT(56, 0);
#line 2049 "test-new/imp918s.imp"
L_014F:;
// 2050 CEND(CPRMODE)
#line 2050 "test-new/imp918s.imp"
CEND(CPRMODE);
// 2051 LOAD DATA; {%STOP - load data does a %stop!}
#line 2051 "test-new/imp918s.imp"
LOADDATA();
// 2052 S(3): ! ENDOFLIST
#line 2052 "test-new/imp918s.imp"
case_S_3:;
// 2053 LIST=0;
#line 2053 "test-new/imp918s.imp"
LIST = 0;
// 2054 S(4): ! ENDOFMCODE
#line 2054 "test-new/imp918s.imp"
case_S_4:;
// 2055 ->Label1
#line 2055 "test-new/imp918s.imp"
goto U_1021;
// 2056 S(5): ! END
#line 2056 "test-new/imp918s.imp"
case_S_5:;
// 2057 CEND(FLAG)
#line 2057 "test-new/imp918s.imp"
CEND(FLAG);
// 2058 Label1: %END; ->Label1
#line 2058 "test-new/imp918s.imp"
U_1021:;
#line 2058 "test-new/imp918s.imp"
goto end_1008;
#line 2058 "test-new/imp918s.imp"
case_S_dispatch:
#line 2058 "test-new/imp918s.imp"
if (S_index < 1 || S_index > 5)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
#line 2058 "test-new/imp918s.imp"
goto *S[S_index - 1];
#line 2058 "test-new/imp918s.imp"
end_1008:;
#line 2058 "test-new/imp918s.imp"
}
#line 2058 "test-new/imp918s.imp"
goto U_100F;
// 2059 !
// 2060 SW(9): P=P+1; MARKER1=A(P)+P; ! (SEX)(RT)(SPEC')(NAME)(FPP)
#line 2060 "test-new/imp918s.imp"
case_SW_9:;
#line 2060 "test-new/imp918s.imp"
P = P + 1;
#line 2060 "test-new/imp918s.imp"
MARKER1 = A[P + 7] + P;
// 2061 Label900: Q=P; KKK=A(MARKER1+1); ! KKK ON NAME
#line 2061 "test-new/imp918s.imp"
U_1019:;
#line 2061 "test-new/imp918s.imp"
Q = P;
#line 2061 "test-new/imp918s.imp"
KKK = A[MARKER1 + 1 + 7];
// 2062 EXTRN=A(P+1)
#line 2062 "test-new/imp918s.imp"
EXTRN = A[P + 1 + 7];
// 2063 %IF A(MARKER1)=1 %THEN %START;! P<%SPEC'>='%SPEC'
#line 2063 "test-new/imp918s.imp"
if (A[MARKER1 + 7] != 1) goto L_0150;
// 2064 P=P+1; CRSPEC(1-EXTRN>>2);! 0 FOR ROUTINESPEC
#line 2064 "test-new/imp918s.imp"
P = P + 1;
#line 2064 "test-new/imp918s.imp"
CRSPEC(1 - ((unsigned int)EXTRN >> 2));
// 2065 ! 1 FOR EXTERNAL (ETC) SPEC
// 2066 ->Label1
#line 2066 "test-new/imp918s.imp"
goto U_100F;
// 2067 %FINISH
#line 2067 "test-new/imp918s.imp"
L_0150:;
// 2068 KK=KKK; ! ROUTINE HEADING NOT SPEC
#line 2068 "test-new/imp918s.imp"
KK = KKK;
// 2069 CNOP(0,4)
#line 2069 "test-new/imp918s.imp"
CNOP(0, 4);
// 2070 COPY TAG(KKK)
#line 2070 "test-new/imp918s.imp"
COPYTAG(KKK);
// 2071 ->Label939 %IF OLDI#LEVEL; ! NAME DECLARED AT OUTER LEVEL
#line 2071 "test-new/imp918s.imp"
if (OLDI == LEVEL) goto L_0151;
#line 2071 "test-new/imp918s.imp"
goto U_1021;
#line 2071 "test-new/imp918s.imp"
L_0151:;
// 2072 %IF CPRMODE=0 %THEN %START; ! NO BEGIN OR ROUTINE STMNT YET?
#line 2072 "test-new/imp918s.imp"
if (CPRMODE != 0) goto L_0152;
// 2073 CA=0; CABUF=0
#line 2073 "test-new/imp918s.imp"
CA = 0;
#line 2073 "test-new/imp918s.imp"
CABUF = 0;
// 2074 PPCURR=0; CPRMODE=2; ! FLAG AS FILE OF ROUTINES
#line 2074 "test-new/imp918s.imp"
PPCURR = 0;
#line 2074 "test-new/imp918s.imp"
CPRMODE = 2;
// 2075 %FINISH
#line 2075 "test-new/imp918s.imp"
L_0152:;
// 2076 !
// 2077 %IF EXTRN#4 %THEN %START; ! SYSTEM EXTERNAL DYNAMIC
#line 2077 "test-new/imp918s.imp"
if (EXTRN == 4) goto L_0153;
// 2078 %IF (CPRMODE=2 %AND LEVEL=1) %OR COMPILER=1=RLEVEL %START
#line 2078 "test-new/imp918s.imp"
if (CPRMODE != 2) goto L_0154;
#line 2078 "test-new/imp918s.imp"
if (LEVEL == 1) goto L_00B2;
#line 2078 "test-new/imp918s.imp"
L_0154:;
#line 2078 "test-new/imp918s.imp"
{
// Double-sided test on 1 (Part I)
#line 2078 "test-new/imp918s.imp"
int tmp;
#line 2078 "test-new/imp918s.imp"
if (COMPILER != (tmp = 1)) goto L_0155;
// Double-sided test on 1 (Part II)
#line 2078 "test-new/imp918s.imp"
if (tmp != RLEVEL) goto L_0155;
#line 2078 "test-new/imp918s.imp"
}
#line 2078 "test-new/imp918s.imp"
L_00B2:;
// 2079 %IF EXTRN=3 %THEN EXTRN=2
#line 2079 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_0156;
#line 2079 "test-new/imp918s.imp"
EXTRN = 2;
#line 2079 "test-new/imp918s.imp"
L_0156:;
// 2080 DEFINE EP(EXTRN,KKK,CA,0)
#line 2080 "test-new/imp918s.imp"
DEFINEEP(EXTRN, KKK, CA, 0);
// 2081 SET PERMBASE
#line 2081 "test-new/imp918s.imp"
SETPERMBASE();
// 2082 %FINISH %ELSE %START; ! EXTERNALS IN PRGM OR WRNG LEVEL
#line 2082 "test-new/imp918s.imp"
goto L_0157;
#line 2082 "test-new/imp918s.imp"
L_0155:;
// 2083 FAULT(55,0); EXTRN=4
#line 2083 "test-new/imp918s.imp"
FAULT(55, 0);
#line 2083 "test-new/imp918s.imp"
EXTRN = 4;
// 2084 %FINISH
#line 2084 "test-new/imp918s.imp"
L_0157:;
// 2085 %FINISH
#line 2085 "test-new/imp918s.imp"
L_0153:;
// 2086 %IF A(P+2)=1 %THEN KKK=10000 %ELSE %START
#line 2086 "test-new/imp918s.imp"
if (A[P + 2 + 7] != 1) goto L_0158;
#line 2086 "test-new/imp918s.imp"
KKK = 10000;
#line 2086 "test-new/imp918s.imp"
goto L_0159;
#line 2086 "test-new/imp918s.imp"
L_0158:;
// 2087 ROUT=1; P=P+3; ! FIGURE OUT PTYPE FOR FNS&MAPS
#line 2087 "test-new/imp918s.imp"
ROUT = 1;
#line 2087 "test-new/imp918s.imp"
P = P + 3;
// 2088 CLT; ARR=0
#line 2088 "test-new/imp918s.imp"
CLT();
#line 2088 "test-new/imp918s.imp"
ARR = 0;
// 2089 NAM=(A(P)-1)<<1; ! SET NAME ARRAY BIT FOR MAPS
#line 2089 "test-new/imp918s.imp"
NAM = A[P + 7] - 1 << 1;
// 2090 PACK(KKK); ! AND STORE PTYPE IN KKK
#line 2090 "test-new/imp918s.imp"
PACK(/*?*/ &KKK);
// 2091 %FINISH
#line 2091 "test-new/imp918s.imp"
L_0159:;
// 2092 ->Label940 %IF J=15 %AND PTYPE=KKK
#line 2092 "test-new/imp918s.imp"
if (J != 15) goto L_015A;
#line 2092 "test-new/imp918s.imp"
if (PTYPE != KKK) goto L_015A;
#line 2092 "test-new/imp918s.imp"
goto U_1022;
#line 2092 "test-new/imp918s.imp"
L_015A:;
// 2093 Label939: P=Q+1; CRSPEC(0); P=Q; ->Label900
#line 2093 "test-new/imp918s.imp"
U_1021:;
#line 2093 "test-new/imp918s.imp"
P = Q + 1;
#line 2093 "test-new/imp918s.imp"
CRSPEC(0);
#line 2093 "test-new/imp918s.imp"
P = Q;
#line 2093 "test-new/imp918s.imp"
goto U_1019;
// 2094 Label940: %BEGIN
#line 2094 "test-new/imp918s.imp"
U_1022:;
#line 2094 "test-new/imp918s.imp"
{ /*%begin*/
// 2095 {%SHORTROUTINE}
// 2096 %INTEGER PTR,PTYPEP
#line 2096 "test-new/imp918s.imp"
int PTR;
#line 2096 "test-new/imp918s.imp"
int PTYPEP;
// 2097 J=0; REPLACE TAG(KK);! BODY GIVEN SO UPDATE TAGS INFO
#line 2097 "test-new/imp918s.imp"
J = 0;
#line 2097 "test-new/imp918s.imp"
REPLACETAG(KK);
// 2098 JJ=K; PLABEL=PLABEL-1
#line 2098 "test-new/imp918s.imp"
JJ = K;
#line 2098 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
// 2099 ENTER JUMP(15,PLABEL,0) %UNLESS COMPILER=1 %OR %C
#line 2099 "test-new/imp918s.imp"
if (COMPILER == 1) goto L_015B;
#line 2099 "test-new/imp918s.imp"
if (CPRMODE != 2) goto L_0145;
#line 2099 "test-new/imp918s.imp"
if (LEVEL == 1) goto L_015B;
#line 2099 "test-new/imp918s.imp"
L_0145:;
#line 2099 "test-new/imp918s.imp"
ENTERJUMP(15, PLABEL, 0);
#line 2099 "test-new/imp918s.imp"
L_015B:;
// 2100+ (CPRMODE=2 %AND LEVEL=1)
// 2101 PTYPEP=PTYPE
#line 2101 "test-new/imp918s.imp"
PTYPEP = PTYPE;
// 2102 RHEAD(KK)
#line 2102 "test-new/imp918s.imp"
RHEAD(KK);
// 2103 FLAG=PTYPEP
#line 2103 "test-new/imp918s.imp"
FLAG = PTYPEP;
// 2104 P=MARKER1+1
#line 2104 "test-new/imp918s.imp"
P = MARKER1 + 1;
// 2105 %IF A(P+1)=1 %THEN %START; ! FORMAL PARAMETERS TO DEAL WITH
#line 2105 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_015C;
// 2106 %CYCLE; ! UNTIL NO MORE FP-PART
#line 2106 "test-new/imp918s.imp"
L_015D:;
// 2107 P=P+2
#line 2107 "test-new/imp918s.imp"
P = P + 2;
// 2108 CFPDEL
#line 2108 "test-new/imp918s.imp"
CFPDEL();
// 2109 %CYCLE PTR=1,1,A(P); ! CYCLE DOWN NAMELIST
#line 2109 "test-new/imp918s.imp"
// %for PTR = 1, 1, A[P + 7] %cycle
#line 2109 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[P + 7];
#line 2109 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle PTR = 1, 1, A[P + 7]");
_control = PTR = _initial - _increment;
#line 2109 "test-new/imp918s.imp"
L_015E:
#line 2109 "test-new/imp918s.imp"
if (PTR != _control) _imp_signal(4, 2, 0, "Corrupt control variable PTR");
#line 2109 "test-new/imp918s.imp"
if (PTR == _final) goto L_015F;
#line 2109 "test-new/imp918s.imp"
_control += _increment;
PTR += _increment;
// 2110 %IF JJ#0 %THEN %START
#line 2110 "test-new/imp918s.imp"
if (JJ == 0) goto L_0161;
// 2111 FROM12(JJ,J,JJJ);! EXTRACT PTYPE XTRA INFO
#line 2111 "test-new/imp918s.imp"
FROM12(JJ, /*?*/ &J, /*?*/ &JJJ);
// 2112 %UNLESS J=PTYPE %AND (PTYPE#5 %OR JJJ>>16=ACC) %C
#line 2112 "test-new/imp918s.imp"
if (J != PTYPE) goto L_0162;
#line 2112 "test-new/imp918s.imp"
if (PTYPE != 5) goto L_0163;
#line 2112 "test-new/imp918s.imp"
if ((unsigned int)JJJ >> 16 == ACC) goto L_0163;
#line 2112 "test-new/imp918s.imp"
L_0162:;
#line 2112 "test-new/imp918s.imp"
FAULT(9, A[P + PTR + 7]);
#line 2112 "test-new/imp918s.imp"
L_0163:;
// 2113+ %THEN FAULT(9,A(P+PTR))
// 2114 %FINISH %ELSE FAULT(8,0);! MORE FPS THAN IN SPEC
#line 2114 "test-new/imp918s.imp"
goto L_0164;
#line 2114 "test-new/imp918s.imp"
L_0161:;
#line 2114 "test-new/imp918s.imp"
FAULT(8, 0);
#line 2114 "test-new/imp918s.imp"
L_0164:;
// 2115 MLINK(JJ)
#line 2115 "test-new/imp918s.imp"
MLINK(/*?*/ &JJ);
// 2116 %REPEAT
#line 2116 "test-new/imp918s.imp"
goto L_015E;
#line 2116 "test-new/imp918s.imp"
}
#line 2116 "test-new/imp918s.imp"
L_015F:;
// 2117 DECLARE SCALARS(0,0)
#line 2117 "test-new/imp918s.imp"
DECLARESCALARS(0, 0);
// 2118 %REPEAT %UNTIL A(P)=2;! UNTIL NO MORE FP-PART
#line 2118 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0165;
#line 2118 "test-new/imp918s.imp"
goto L_015D;
#line 2118 "test-new/imp918s.imp"
L_0165:;
// 2119 N=(N+3)&(-4); ! TO WORD BOUNDARY AFTER ALL SYSTEM
#line 2119 "test-new/imp918s.imp"
N = N + 3 & -4;
// 2120 ! STANDARD PARAMETERS HAVE BEEN DECLARED
// 2121 %FINISH
#line 2121 "test-new/imp918s.imp"
L_015C:;
// 2122 FAULT(10,0) %UNLESS JJ=0
#line 2122 "test-new/imp918s.imp"
if (JJ == 0) goto L_0166;
#line 2122 "test-new/imp918s.imp"
FAULT(10, 0);
#line 2122 "test-new/imp918s.imp"
L_0166:;
// 2123 %END; ->Label1202
#line 2123 "test-new/imp918s.imp"
goto end_1009;
#line 2123 "test-new/imp918s.imp"
end_1009:;
#line 2123 "test-new/imp918s.imp"
}
#line 2123 "test-new/imp918s.imp"
goto U_1023;
// 2124 !
// 2125 SW(11): !REALS(LN)
#line 2125 "test-new/imp918s.imp"
case_SW_11:;
// 2126 ALL LONG=A(P+1)&1;->Label1
#line 2126 "test-new/imp918s.imp"
ALLLONG = A[P + 1 + 7] & 1;
#line 2126 "test-new/imp918s.imp"
goto U_100F;
// 2127 !
// 2128 SW(12): !%BEGIN
#line 2128 "test-new/imp918s.imp"
case_SW_12:;
// 2129 PTYPE=0; RHEAD(-1)
#line 2129 "test-new/imp918s.imp"
PTYPE = 0;
#line 2129 "test-new/imp918s.imp"
RHEAD(-1);
// 2130 ->Label1 %IF LEVEL=1=RLEVEL
#line 2130 "test-new/imp918s.imp"
{
// Double-sided test on 1 (Part I)
#line 2130 "test-new/imp918s.imp"
int tmp;
#line 2130 "test-new/imp918s.imp"
if (LEVEL != (tmp = 1)) goto L_0167;
// Double-sided test on 1 (Part II)
#line 2130 "test-new/imp918s.imp"
if (tmp != RLEVEL) goto L_0167;
#line 2130 "test-new/imp918s.imp"
}
#line 2130 "test-new/imp918s.imp"
goto U_100F;
#line 2130 "test-new/imp918s.imp"
L_0167:;
// 2131 ->Label1202 %UNLESS LEVEL=2
#line 2131 "test-new/imp918s.imp"
if (LEVEL == 2) goto L_0168;
#line 2131 "test-new/imp918s.imp"
goto U_1023;
#line 2131 "test-new/imp918s.imp"
L_0168:;
// 2132 CPRMODE=1 %IF CPRMODE=0
#line 2132 "test-new/imp918s.imp"
if (CPRMODE != 0) goto L_0169;
#line 2132 "test-new/imp918s.imp"
CPRMODE = 1;
#line 2132 "test-new/imp918s.imp"
L_0169:;
// 2133 DEFINE EP(0,0,0,0)
#line 2133 "test-new/imp918s.imp"
DEFINEEP(0, 0, 0, 0);
// 2134 FAULT(55,0) %UNLESS CPRMODE=1
#line 2134 "test-new/imp918s.imp"
if (CPRMODE == 1) goto L_016A;
#line 2134 "test-new/imp918s.imp"
FAULT(55, 0);
#line 2134 "test-new/imp918s.imp"
L_016A:;
// 2135 Label1202: %IF SBFLAG=0 %THEN %START
#line 2135 "test-new/imp918s.imp"
U_1023:;
#line 2135 "test-new/imp918s.imp"
if (SBFLAG != 0) goto L_016B;
// 2136 PLANT(X'05A0'); CODEBASE=CA;
#line 2136 "test-new/imp918s.imp"
PLANT(1440);
#line 2136 "test-new/imp918s.imp"
CODEBASE = CA;
// 2137 GRINF(10)=CA; CUR CYC VAR=0
#line 2137 "test-new/imp918s.imp"
GRINF[10] = CA;
#line 2137 "test-new/imp918s.imp"
CURCYCVAR = 0;
// 2138 %FINISH
#line 2138 "test-new/imp918s.imp"
L_016B:;
// 2139 %IF CHECKSP#0 %THEN %START
#line 2139 "test-new/imp918s.imp"
if (CHECKSP == 0) goto L_016C;
// 2140 PCONST(X'41000004'); ! LA 0,4 --- FAULT 4=EXCESS BLKS
#line 2140 "test-new/imp918s.imp"
PCONST(1090519044);
// 2141 PCONST(X'9812D040'); ! LM 1,2 TOPSTREF
#line 2141 "test-new/imp918s.imp"
PCONST(-1743597504);
// 2142 PLANT(X'1211'); ! LTR 1,1
#line 2142 "test-new/imp918s.imp"
PLANT(4625);
// 2143 PRX(X'47',10,0,10,CA-CODEBASE+8);! BHE *+8
#line 2143 "test-new/imp918s.imp"
PRX(71, 10, 0, 10, CA - CODEBASE + 8);
// 2144 PCONST(X'58202000'); ! L 2,0(2)
#line 2144 "test-new/imp918s.imp"
PCONST(1478500352);
// 2145 PLANT(X'19B2'); ! CR 11,2
#line 2145 "test-new/imp918s.imp"
PLANT(6578);
// 2146 PCONST(X'4720C054'); ! BH RUN TIME FAULT ROUTINE
#line 2146 "test-new/imp918s.imp"
PCONST(1193328724);
// 2147 CCSTATE=-1
#line 2147 "test-new/imp918s.imp"
CCSTATE = -1;
// 2148 FORGET(1); FORGET(2)
#line 2148 "test-new/imp918s.imp"
FORGET(1);
#line 2148 "test-new/imp918s.imp"
FORGET(2);
// 2149 %FINISH
#line 2149 "test-new/imp918s.imp"
L_016C:;
// 2150 ->Label1
#line 2150 "test-new/imp918s.imp"
goto U_100F;
// 2151 !
// 2152 SW(13):
#line 2152 "test-new/imp918s.imp"
case_SW_13:;
// 2153 ! '%FAULT'(FLIST)(S)
// 2154 WARN(LINE)
#line 2154 "test-new/imp918s.imp"
WARN(LINE);
// 2155 FAULT(26,0) %UNLESS LEVEL=2 %AND CPRMODE#2
#line 2155 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_016D;
#line 2155 "test-new/imp918s.imp"
if (CPRMODE != 2) goto L_016E;
#line 2155 "test-new/imp918s.imp"
L_016D:;
#line 2155 "test-new/imp918s.imp"
FAULT(26, 0);
#line 2155 "test-new/imp918s.imp"
L_016E:;
// 2156 NMDECS=NMDECS!1
#line 2156 "test-new/imp918s.imp"
NMDECS = NMDECS | 1;
// 2157 %CYCLE; ! UNTIL RESTOFFAULTLIST IS NULL
#line 2157 "test-new/imp918s.imp"
L_016F:;
// 2158 P=P+2; Q=P+1
#line 2158 "test-new/imp918s.imp"
P = P + 2;
#line 2158 "test-new/imp918s.imp"
Q = P + 1;
// 2159 Q=Q+2 %WHILE A(Q)#2
#line 2159 "test-new/imp918s.imp"
L_0170:;
#line 2159 "test-new/imp918s.imp"
if (A[Q + 7] == 2) goto L_0171;
#line 2159 "test-new/imp918s.imp"
Q = Q + 2;
#line 2159 "test-new/imp918s.imp"
goto L_0170;
#line 2159 "test-new/imp918s.imp"
L_0171:;
// 2160 %CYCLE; ! UNTIL RESTOFNLIST IS NULL
#line 2160 "test-new/imp918s.imp"
L_0172:;
// 2161 K=A(Q+2)+(A(Q+1)-1)<<14
#line 2161 "test-new/imp918s.imp"
K = A[Q + 2 + 7] + (A[Q + 1 + 7] - 1 << 14);
// 2162 KKK=A(P);PCONST(X'41100000'!KKK)
#line 2162 "test-new/imp918s.imp"
KKK = A[P + 7];
#line 2162 "test-new/imp918s.imp"
PCONST(1091567616 | KKK);
// 2163 FAULT(36,0) %IF KKK>32 %OR KKK=0 %OR KKK=29 %OR 11<KKK<14
#line 2163 "test-new/imp918s.imp"
if (KKK > 32) goto L_0160;
#line 2163 "test-new/imp918s.imp"
if (KKK == 0) goto L_0160;
#line 2163 "test-new/imp918s.imp"
if (KKK == 29) goto L_0160;
#line 2163 "test-new/imp918s.imp"
{
// Double-sided test on KKK (Part I)
#line 2163 "test-new/imp918s.imp"
int tmp;
#line 2163 "test-new/imp918s.imp"
if (11 >= (tmp = KKK)) goto L_0173;
// Double-sided test on KKK (Part II)
#line 2163 "test-new/imp918s.imp"
if (tmp >= 14) goto L_0173;
#line 2163 "test-new/imp918s.imp"
}
#line 2163 "test-new/imp918s.imp"
L_0160:;
#line 2163 "test-new/imp918s.imp"
FAULT(36, 0);
#line 2163 "test-new/imp918s.imp"
L_0173:;
// 2164 PPJ(20); QQ=CA
#line 2164 "test-new/imp918s.imp"
PPJ(20);
#line 2164 "test-new/imp918s.imp"
QQ = CA;
// 2165 ENTER JUMP(15,K,0); ! JUMP TO LABEL
#line 2165 "test-new/imp918s.imp"
ENTERJUMP(15, K, 0);
// 2166 PCONST(X'07000700') %UNLESS CA=QQ+8;! JUMP MUST BE 8 BYTES
#line 2166 "test-new/imp918s.imp"
if (CA == QQ + 8) goto L_0174;
#line 2166 "test-new/imp918s.imp"
PCONST(117442304);
#line 2166 "test-new/imp918s.imp"
L_0174:;
// 2167 P=P+2
#line 2167 "test-new/imp918s.imp"
P = P + 2;
// 2168 %REPEAT %UNTIL A(P-1)=2
#line 2168 "test-new/imp918s.imp"
if (A[P - 1 + 7] == 2) goto L_0175;
#line 2168 "test-new/imp918s.imp"
goto L_0172;
#line 2168 "test-new/imp918s.imp"
L_0175:;
// 2169 P=P+2
#line 2169 "test-new/imp918s.imp"
P = P + 2;
// 2170 %REPEAT %UNTIL A(P)=2; ->Label1
#line 2170 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0176;
#line 2170 "test-new/imp918s.imp"
goto L_016F;
#line 2170 "test-new/imp918s.imp"
L_0176:;
#line 2170 "test-new/imp918s.imp"
goto U_100F;
// 2171 !
// 2172 SW(15): %BEGIN; !SWITCH (SWITCH LIST)
#line 2172 "test-new/imp918s.imp"
case_SW_15:;
#line 2172 "test-new/imp918s.imp"
{ /*%begin*/
// 2173 {%SHORTROUTINE}
// 2174 %INTEGER Q,RANGE,KKK,KK,LB
#line 2174 "test-new/imp918s.imp"
int Q;
#line 2174 "test-new/imp918s.imp"
int RANGE;
#line 2174 "test-new/imp918s.imp"
int KKK;
#line 2174 "test-new/imp918s.imp"
int KK;
#line 2174 "test-new/imp918s.imp"
int LB;
// 2175 Q=P
#line 2175 "test-new/imp918s.imp"
Q = P;
// 2176 FAULT(56,0) %UNLESS LEVEL>=2
#line 2176 "test-new/imp918s.imp"
if (LEVEL >= 2) goto L_0177;
#line 2176 "test-new/imp918s.imp"
FAULT(56, 0);
#line 2176 "test-new/imp918s.imp"
L_0177:;
// 2177 %IF SBFLAG=1 %OR COMPILER=1 %THEN PREC=2 %ELSE PREC=0
#line 2177 "test-new/imp918s.imp"
if (SBFLAG == 1) goto L_0178;
#line 2177 "test-new/imp918s.imp"
if (COMPILER != 1) goto L_0179;
#line 2177 "test-new/imp918s.imp"
L_0178:;
#line 2177 "test-new/imp918s.imp"
PREC = 2;
#line 2177 "test-new/imp918s.imp"
goto L_017A;
#line 2177 "test-new/imp918s.imp"
L_0179:;
#line 2177 "test-new/imp918s.imp"
PREC = 0;
#line 2177 "test-new/imp918s.imp"
L_017A:;
// 2178 PTYPE=106+10*PREC; !(SHORT?) LABEL ARRAY
#line 2178 "test-new/imp918s.imp"
PTYPE = 106 + 10 * PREC;
// 2179 %CYCLE; ! UNTIL NO'REST OF SW LIST'
#line 2179 "test-new/imp918s.imp"
L_017B:;
// 2180 P=A(Q+1)+Q+2; ! PAST 'NAMELIST' TO 'BPAIR'
#line 2180 "test-new/imp918s.imp"
P = A[Q + 1 + 7] + Q + 2;
// 2181 CBPAIR(KKK,KK); ! LOWER BOUND TO KKK UPPER TO KK
#line 2181 "test-new/imp918s.imp"
CBPAIR(/*?*/ &KKK, /*?*/ &KK);
// 2182 %UNLESS |KKK| <X'7FFF'>|KK| %THEN %START
#line 2182 "test-new/imp918s.imp"
{
// Double-sided test on 32767 (Part I)
#line 2182 "test-new/imp918s.imp"
int tmp;
#line 2182 "test-new/imp918s.imp"
if (_imp_IMOD(KKK) >= (tmp = 32767)) goto L_017C;
// Double-sided test on 32767 (Part II)
#line 2182 "test-new/imp918s.imp"
if (tmp > _imp_IMOD(KK)) goto L_017D;
#line 2182 "test-new/imp918s.imp"
}
#line 2182 "test-new/imp918s.imp"
L_017C:;
// 2183 FAULT(18,0); KK=0; KKK=0
#line 2183 "test-new/imp918s.imp"
FAULT(18, 0);
#line 2183 "test-new/imp918s.imp"
KK = 0;
#line 2183 "test-new/imp918s.imp"
KKK = 0;
// 2184 %FINISH
#line 2184 "test-new/imp918s.imp"
L_017D:;
// 2185 RANGE=(KK-KKK+1)*BYTES(PREC)
#line 2185 "test-new/imp918s.imp"
RANGE = (KK - KKK + 1) * BYTES[PREC];
// 2186 LB=KKK; KKK=KKK&X'FFFFFF'!PREC<<24
#line 2186 "test-new/imp918s.imp"
LB = KKK;
#line 2186 "test-new/imp918s.imp"
KKK = KKK & 16777215 | PREC << 24;
// 2187 %CYCLE QQ=1,1,A(Q+1);
#line 2187 "test-new/imp918s.imp"
// %for QQ = 1, 1, A[Q + 1 + 7] %cycle
#line 2187 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[Q + 1 + 7];
#line 2187 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle QQ = 1, 1, A[Q + 1 + 7]");
_control = QQ = _initial - _increment;
#line 2187 "test-new/imp918s.imp"
L_017E:
#line 2187 "test-new/imp918s.imp"
if (QQ != _control) _imp_signal(4, 2, 0, "Corrupt control variable QQ");
#line 2187 "test-new/imp918s.imp"
if (QQ == _final) goto L_017F;
#line 2187 "test-new/imp918s.imp"
_control += _increment;
QQ += _increment;
// ?Non-local
// 2188 ; ! DOWN NAMELIST
#line 2188 "test-new/imp918s.imp"
K = A[Q + QQ + 1 + 7];
// 2188 K=A(Q+QQ+1)
// 2189 TEST NST
#line 2189 "test-new/imp918s.imp"
TESTNST();
// 2190 SSTL=(SSTL+3)&(-4); ! CONST TABLES TO WORD BNDRY
#line 2190 "test-new/imp918s.imp"
SSTL = SSTL + 3 & -4;
// 2191 OPHEAD=0; R=LB
#line 2191 "test-new/imp918s.imp"
OPHEAD = 0;
#line 2191 "test-new/imp918s.imp"
R = LB;
// 2192 !
// 2193 ! SET UP A BIT LIST (96 BITS PER CELL) TO CHECK FOR SWITCH LABELS
// 2194 ! SET TWICE
// 2195 !
// 2196 %CYCLE
#line 2196 "test-new/imp918s.imp"
L_0181:;
// 2197 PUSH123(OPHEAD,0,0,0)
#line 2197 "test-new/imp918s.imp"
PUSH123(/*?*/ &OPHEAD, 0, 0, 0);
// 2198 R=R+96
#line 2198 "test-new/imp918s.imp"
R = R + 96;
// 2199 %REPEAT %UNTIL R>KK
#line 2199 "test-new/imp918s.imp"
if (R > KK) goto L_0182;
#line 2199 "test-new/imp918s.imp"
goto L_0181;
#line 2199 "test-new/imp918s.imp"
L_0182:;
// 2200 !
// 2201 ! OUTPUT ARRAYBOUNDS (CHECKING MODE) AND CLEAR THE TABLE SPACE
// 2202 !
// 2203 %IF (COMPILER=0 %OR CHECKSP=1) %AND (INHCODE=0)%C
#line 2203 "test-new/imp918s.imp"
if (COMPILER == 0) goto L_0183;
#line 2203 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_0184;
#line 2203 "test-new/imp918s.imp"
L_0183:;
#line 2203 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0184;
// 2204+ %THEN %START
// 2205 LPUT(4,8,SSTL,ADDR(KKK))
#line 2205 "test-new/imp918s.imp"
LPUT(4, 8, SSTL, _imp_ADDR(/*?*/ &KKK));
// 2206 SSTL=SSTL+8
#line 2206 "test-new/imp918s.imp"
SSTL = SSTL + 8;
// 2207 %FINISH
#line 2207 "test-new/imp918s.imp"
L_0184:;
// 2208 PUSH123(OPHEAD,SSTL-8,LB,KK)
#line 2208 "test-new/imp918s.imp"
PUSH123(/*?*/ &OPHEAD, SSTL - 8, LB, KK);
// 2209 J=1; STORE TAG(K,OPHEAD)
#line 2209 "test-new/imp918s.imp"
J = 1;
#line 2209 "test-new/imp918s.imp"
STORETAG(K, OPHEAD);
// 2210 %IF INHCODE=0 %THEN %C
#line 2210 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_0185;
#line 2210 "test-new/imp918s.imp"
LPUT(4, RANGE, SSTL, COMPILER);
#line 2210 "test-new/imp918s.imp"
L_0185:;
// 2211+ LPUT(4,RANGE,SSTL,COMPILER)
// 2212 SSTL=(SSTL+RANGE+3)&(-4)
#line 2212 "test-new/imp918s.imp"
SSTL = SSTL + RANGE + 3 & -4;
// 2213 %REPEAT; ! FOR ANY MORE NAMES IN NAMELIST
#line 2213 "test-new/imp918s.imp"
goto L_017E;
#line 2213 "test-new/imp918s.imp"
}
#line 2213 "test-new/imp918s.imp"
L_017F:;
// 2214 Q=P
#line 2214 "test-new/imp918s.imp"
Q = P;
// 2215 %REPEAT %UNTIL A(Q)=2; ! UNTIL A(Q)=2
#line 2215 "test-new/imp918s.imp"
if (A[Q + 7] == 2) goto L_0186;
#line 2215 "test-new/imp918s.imp"
goto L_017B;
#line 2215 "test-new/imp918s.imp"
L_0186:;
// 2216 %END;->Label1
#line 2216 "test-new/imp918s.imp"
goto end_1010;
#line 2216 "test-new/imp918s.imp"
end_1010:;
#line 2216 "test-new/imp918s.imp"
}
#line 2216 "test-new/imp918s.imp"
goto U_100F;
// 2217 !
// 2218 SW(16): LIST=1; ->Label1; ! %LIST
#line 2218 "test-new/imp918s.imp"
case_SW_16:;
#line 2218 "test-new/imp918s.imp"
LIST = 1;
#line 2218 "test-new/imp918s.imp"
goto U_100F;
// 2219 !
// 2220 !
// 2221 SW(17): ! '%OWN' (TYPE)(OWNDEC)
#line 2221 "test-new/imp918s.imp"
case_SW_17:;
// 2222 %BEGIN
#line 2222 "test-new/imp918s.imp"
{ /*%begin*/
#line 2222 "test-new/imp918s.imp"
auto void CLEAR(int LENGTH);
#line 2222 "test-new/imp918s.imp"
auto void STAG(int J, int DATALEN);
// 2223 {%SHORTROUTINE}
// 2224 !***********************************************************************
// 2225 !* INITIALISED DECLARATION GO INTO THE GLA OR GLA SYMBOL TABLES *
// 2226 !* EXCEPT FOR CONST ARRAYS WHICH GO INTO THE CODE SYMBOL TABLES *
// 2227 !* STRINGS AND ARRAYS HAVE A HEADER IN THE GLA. LPUT ARRANGES *
// 2228 !* FOR THE LOADER TO RELOCATE THE HEADERS. *
// 2229 !* EXTERNALS ARE IDENTICAL WITH OWN BUT ALSO HAVE A DATA EP DEFN *
// 2230 !* IN THE LOAD DATA SO THEY CAN BE FOUND AT LOAD TIME *
// 2231 !* EXTRINSICS HAVE A DATA REFERENCE AND A DUMMY HEADER IN THE GLA *
// 2232 !* THE LOADER USES THE FORMER TO RELOCATE THE LATTER. *
// 2233 !***********************************************************************
// 2234 %ROUTINESPEC CLEAR(%INTEGER L)
// 2235 %ROUTINESPEC STAG(%INTEGER J,DATALEN)
// 2236 %INTEGER LENGTH,BP,PP,SIGN,CBASE,MODE
#line 2236 "test-new/imp918s.imp"
int LENGTH;
#line 2236 "test-new/imp918s.imp"
int BP;
#line 2236 "test-new/imp918s.imp"
int PP;
#line 2236 "test-new/imp918s.imp"
int SIGN;
#line 2236 "test-new/imp918s.imp"
int CBASE;
#line 2236 "test-new/imp918s.imp"
int MODE;
// 2237 %INTEGER ICONST,CTYPE,TAGDISP,EPTYPE,EPDISP
#line 2237 "test-new/imp918s.imp"
int ICONST;
#line 2237 "test-new/imp918s.imp"
int CTYPE;
#line 2237 "test-new/imp918s.imp"
int TAGDISP;
#line 2237 "test-new/imp918s.imp"
int EPTYPE;
#line 2237 "test-new/imp918s.imp"
int EPDISP;
// 2238 %LONGREAL RCONST
#line 2238 "test-new/imp918s.imp"
double RCONST;
// 2239 %STRING(255) SCONST
#line 2239 "test-new/imp918s.imp"
_imp_string255 SCONST;
// 2240 %INTEGER AH1,AH2,AH3,AH4,AD,FNAM,FINF
#line 2240 "test-new/imp918s.imp"
int AH1;
#line 2240 "test-new/imp918s.imp"
int AH2;
#line 2240 "test-new/imp918s.imp"
int AH3;
#line 2240 "test-new/imp918s.imp"
int AH4;
#line 2240 "test-new/imp918s.imp"
int AD;
#line 2240 "test-new/imp918s.imp"
int FNAM;
#line 2240 "test-new/imp918s.imp"
int FINF;
// 2241 %INTEGER SPOINT,CONSTSFOUND,EXTRN,NNAMES,MARK,LPUTP
#line 2241 "test-new/imp918s.imp"
int SPOINT;
#line 2241 "test-new/imp918s.imp"
int CONSTSFOUND;
#line 2241 "test-new/imp918s.imp"
int EXTRN;
#line 2241 "test-new/imp918s.imp"
int NNAMES;
#line 2241 "test-new/imp918s.imp"
int MARK;
#line 2241 "test-new/imp918s.imp"
int LPUTP;
// 2242 %INTEGERNAME STPTR
#line 2242 "test-new/imp918s.imp"
int *STPTR;
// 2243 LPUTP=5; STPTR==CONSTPTR; ! NORMAL CASE GLA SYMBOLTABLES
#line 2243 "test-new/imp918s.imp"
LPUTP = 5;
#line 2243 "test-new/imp918s.imp"
STPTR = (int *)/*?*/ &CONSTPTR;
// 2244 ! FAULT(40,0) %IF NMDECS&1#0
// 2245 EXTRN=A(P+1)&3
#line 2245 "test-new/imp918s.imp"
EXTRN = A[P + 1 + 7] & 3;
// 2246 %IF EXTRN=0 %THEN LPUTP=4 %AND STPTR==SSTL
#line 2246 "test-new/imp918s.imp"
if (EXTRN != 0) goto L_0187;
#line 2246 "test-new/imp918s.imp"
LPUTP = 4;
#line 2246 "test-new/imp918s.imp"
STPTR = (int *)/*?*/ &SSTL;
#line 2246 "test-new/imp918s.imp"
L_0187:;
// 2247 P=P+3; CBASE=GLA
#line 2247 "test-new/imp918s.imp"
P = P + 3;
#line 2247 "test-new/imp918s.imp"
CBASE = 13;
// 2248 MODE=A(P-1); ! MODE =1 FOR NORMAL OWNS
#line 2248 "test-new/imp918s.imp"
MODE = A[P - 1 + 7];
// 2249 ->RECORD %IF MODE>1; ! MODE =2 FOR OWN RECORDS
#line 2249 "test-new/imp918s.imp"
if (MODE <= 1) goto L_0188;
#line 2249 "test-new/imp918s.imp"
goto U_1024;
#line 2249 "test-new/imp918s.imp"
L_0188:;
// 2250 CLT; ! MODE =3 FOR OWN RECORD ARRAYS
#line 2250 "test-new/imp918s.imp"
CLT();
// 2251 %IF TYPE=5 %AND ACC=0 %THEN FAULT(70,0) %AND ACC=2
#line 2251 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0189;
#line 2251 "test-new/imp918s.imp"
if (ACC != 0) goto L_0189;
#line 2251 "test-new/imp918s.imp"
FAULT(70, 0);
#line 2251 "test-new/imp918s.imp"
ACC = 2;
#line 2251 "test-new/imp918s.imp"
L_0189:;
// 2252 %IF EXTRN=0 %THEN PREC=PREC!4
#line 2252 "test-new/imp918s.imp"
if (EXTRN != 0) goto L_018A;
#line 2252 "test-new/imp918s.imp"
PREC = PREC | 4;
#line 2252 "test-new/imp918s.imp"
L_018A:;
// 2253 NAM=TYPE>>2; ROUT=0; ARR=A(P)-1; PACK(PTYPE)
#line 2253 "test-new/imp918s.imp"
NAM = (unsigned int)TYPE >> 2;
#line 2253 "test-new/imp918s.imp"
ROUT = 0;
#line 2253 "test-new/imp918s.imp"
ARR = A[P + 7] - 1;
#line 2253 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 2254 -> NON SCALAR %UNLESS ARR=0
#line 2254 "test-new/imp918s.imp"
if (ARR == 0) goto L_018B;
#line 2254 "test-new/imp918s.imp"
goto U_1025;
#line 2254 "test-new/imp918s.imp"
L_018B:;
// 2255 %CYCLE; ! UNTIL <RESTOFOWNDEC> NULL
#line 2255 "test-new/imp918s.imp"
L_018C:;
// 2256 MARK= P+1+A(P+1); NNAMES=A(P+2)
#line 2256 "test-new/imp918s.imp"
MARK = P + 1 + A[P + 1 + 7];
#line 2256 "test-new/imp918s.imp"
NNAMES = A[P + 2 + 7];
// 2257 PP=P+3; P=PP+NNAMES; ! P ON CONST'
#line 2257 "test-new/imp918s.imp"
PP = P + 3;
#line 2257 "test-new/imp918s.imp"
P = PP + NNAMES;
// 2258 !
// 2259 ! OBTAIN THE INITIAL CONSTANT,ITS TYPE(CTYPE) AND SIGN(SIGN)
// 2260 ! CONVERT TO ALL LEGAL FORMS AND STORE THE INTEGER IN ICONST
// 2261 ! THE REAL IN RCONST AND THE STRING IN SCONST.
// 2262 ! NB 65 IS A VALID INTEGER OR REAL AND ALSO A STRING ('A')
// 2263 !
// 2264 ICONST=0; RCONST=0; SCONST=""
#line 2264 "test-new/imp918s.imp"
ICONST = 0;
#line 2264 "test-new/imp918s.imp"
RCONST = 0;
#line 2264 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &SCONST, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 2265 SIGN=4; CTYPE=TYPE; CONSTSFOUND=0
#line 2265 "test-new/imp918s.imp"
SIGN = 4;
#line 2265 "test-new/imp918s.imp"
CTYPE = TYPE;
#line 2265 "test-new/imp918s.imp"
CONSTSFOUND = 0;
// 2266 !
// 2267 %IF A(P)=1 %THEN %START; ! CONSTANT GIVEN
#line 2267 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_018D;
// 2268 SIGN=A(P+1); CTYPE=A(P+2)&7
#line 2268 "test-new/imp918s.imp"
SIGN = A[P + 1 + 7];
#line 2268 "test-new/imp918s.imp"
CTYPE = A[P + 2 + 7] & 7;
// 2269 CONSTSFOUND=1
#line 2269 "test-new/imp918s.imp"
CONSTSFOUND = 1;
// 2270 %IF CTYPE=2 %THEN %START; ! REAL CONSTANT
#line 2270 "test-new/imp918s.imp"
if (CTYPE != 2) goto L_018E;
// 2271 FROMAR8(P+3,RCONST)
#line 2271 "test-new/imp918s.imp"
FROMAR8(P + 3, /*?*/ &RCONST);
// 2272 %IF SIGN=2 %THEN RCONST=-RCONST
#line 2272 "test-new/imp918s.imp"
if (SIGN != 2) goto L_018F;
#line 2272 "test-new/imp918s.imp"
RCONST = -RCONST;
#line 2272 "test-new/imp918s.imp"
L_018F:;
// 2273 %FINISH
#line 2273 "test-new/imp918s.imp"
L_018E:;
// 2274 !
// 2275 %IF CTYPE=5 %THEN SCONST=STRING(ADDR(A(P+3))+1)
#line 2275 "test-new/imp918s.imp"
if (CTYPE != 5) goto L_0190;
#line 2275 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &SCONST, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *_imp_STRING(_imp_ADDR(/*?*/ &A[P + 3 + 7]) + 1);
(void *)&tmp;
}),
/*max:*/ 255);
#line 2275 "test-new/imp918s.imp"
L_0190:;
// 2276 !
// 2277 %IF CTYPE=1 %THEN %START; ! INTEGER CONSTANT
#line 2277 "test-new/imp918s.imp"
if (CTYPE != 1) goto L_0191;
// 2278 FROMAR4(P+3,ICONST)
#line 2278 "test-new/imp918s.imp"
FROMAR4(P + 3, /*?*/ &ICONST);
// 2279 %IF SIGN=2 %THEN ICONST=-ICONST
#line 2279 "test-new/imp918s.imp"
if (SIGN != 2) goto L_0192;
#line 2279 "test-new/imp918s.imp"
ICONST = -ICONST;
#line 2279 "test-new/imp918s.imp"
L_0192:;
// 2280 %IF SIGN=3 %THEN ICONST=\ICONST
#line 2280 "test-new/imp918s.imp"
if (SIGN != 3) goto L_0193;
#line 2280 "test-new/imp918s.imp"
ICONST = (~ICONST);
#line 2280 "test-new/imp918s.imp"
L_0193:;
// 2281 %IF TYPE=2 %THEN %C
#line 2281 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0194;
#line 2281 "test-new/imp918s.imp"
RCONST = ICONST;
#line 2281 "test-new/imp918s.imp"
L_0194:;
// 2282+ RCONST=ICONST; ! INTEGER A SPECIAL CASE OF REAL
// 2283 %IF 1<=ICONST<=127 %THEN SCONST=TOSTRING(ICONST)
#line 2283 "test-new/imp918s.imp"
{
// Double-sided test on ICONST (Part I)
#line 2283 "test-new/imp918s.imp"
int tmp;
#line 2283 "test-new/imp918s.imp"
if (1 > (tmp = ICONST)) goto L_0195;
// Double-sided test on ICONST (Part II)
#line 2283 "test-new/imp918s.imp"
if (tmp > 127) goto L_0195;
#line 2283 "test-new/imp918s.imp"
}
#line 2283 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &SCONST, ({
__typeof__(_imp_string1) tmp; /*B*/
tmp = _imp_TOSTRING(ICONST);
(void *)&tmp;
}),
/*max:*/ 255);
#line 2283 "test-new/imp918s.imp"
L_0195:;
// 2284 %FINISH
#line 2284 "test-new/imp918s.imp"
L_0191:;
// 2285 %FINISH
#line 2285 "test-new/imp918s.imp"
L_018D:;
// 2286 LENGTH=BYTEINTEGER(ADDR(SCONST))
#line 2286 "test-new/imp918s.imp"
LENGTH = *_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &SCONST));
// 2287 !
// 2288 !
// 2289 ! FAULT ANY OBVIOUS ERRORS IE:-
// 2290 ! CONSTANT FOR EXTRINSIC OR INCOMPATIBLE TYPE OR STRING TOO LONG
// 2291 !
// 2292 %IF (EXTRN=3 %AND CONSTSFOUND#0 ) %OR %C
#line 2292 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_0196;
#line 2292 "test-new/imp918s.imp"
if (CONSTSFOUND != 0) goto L_0180;
#line 2292 "test-new/imp918s.imp"
L_0196:;
#line 2292 "test-new/imp918s.imp"
if (CTYPE != 2) goto L_0197;
#line 2292 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0180;
#line 2292 "test-new/imp918s.imp"
L_0197:;
#line 2292 "test-new/imp918s.imp"
if (CTYPE != 5) goto L_0198;
#line 2292 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0180;
#line 2292 "test-new/imp918s.imp"
if (SIGN != 4) goto L_0180;
#line 2292 "test-new/imp918s.imp"
if (LENGTH >= ACC) goto L_0180;
#line 2292 "test-new/imp918s.imp"
L_0198:;
#line 2292 "test-new/imp918s.imp"
if (SIGN != 3) goto L_0199;
#line 2292 "test-new/imp918s.imp"
if (CTYPE == 1) goto L_0199;
#line 2292 "test-new/imp918s.imp"
L_0180:;
#line 2292 "test-new/imp918s.imp"
FAULT(44, 0);
#line 2292 "test-new/imp918s.imp"
L_0199:;
// 2293+ (CTYPE=2 %AND TYPE#2) %OR %C
// 2294+ (CTYPE=5 %AND (TYPE#5 %OR SIGN#4 %OR LENGTH>=ACC)) %C
// 2295+ %OR (SIGN=3 %AND CTYPE#1) %THEN FAULT(44,0)
// 2296 !
// 2297 %CYCLE; ! DOWN <NAMELIST>
#line 2297 "test-new/imp918s.imp"
L_019A:;
// 2298 J=0; K=A(PP)
#line 2298 "test-new/imp918s.imp"
J = 0;
#line 2298 "test-new/imp918s.imp"
K = A[PP + 7];
// 2299 %IF TYPE=5 %THEN %START; ! STRING
#line 2299 "test-new/imp918s.imp"
if (TYPE != 5) goto L_019B;
// 2300 QQ=STPTR; AD=ADDR(SCONST)
#line 2300 "test-new/imp918s.imp"
QQ = *STPTR;
#line 2300 "test-new/imp918s.imp"
AD = _imp_ADDR(/*?*/ &SCONST);
// 2301 %IF EXTRN<=1 %AND ACC<=8 %THEN %START
#line 2301 "test-new/imp918s.imp"
if (EXTRN > 1) goto L_019C;
#line 2301 "test-new/imp918s.imp"
if (ACC > 8) goto L_019C;
// 2302 NAM=0; PACK(PTYPE)
#line 2302 "test-new/imp918s.imp"
NAM = 0;
#line 2302 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 2303 TAGDISP=GLACA; ! SHORT STRING INTO GLA NO POINTER
#line 2303 "test-new/imp918s.imp"
TAGDISP = GLACA;
// 2304 PGLA(1,ACC,AD)
#line 2304 "test-new/imp918s.imp"
PGLA(1, ACC, AD);
// 2305 %FINISH %ELSE %START
#line 2305 "test-new/imp918s.imp"
goto L_019D;
#line 2305 "test-new/imp918s.imp"
L_019C:;
// 2306 %IF EXTRN=3 %THEN %START; ! EXTRINSIC STRINGS
#line 2306 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_019E;
// 2307 AH3=0; ! DUMMY STRING HEADER
#line 2307 "test-new/imp918s.imp"
AH3 = 0;
// 2308 %FINISH %ELSE %START
#line 2308 "test-new/imp918s.imp"
goto L_019F;
#line 2308 "test-new/imp918s.imp"
L_019E:;
// 2309 LPUT(LPUTP,ACC,QQ,AD) %IF INHCODE=0;! O/P STRING
#line 2309 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_01A0;
#line 2309 "test-new/imp918s.imp"
LPUT(LPUTP, ACC, QQ, AD);
#line 2309 "test-new/imp918s.imp"
L_01A0:;
// 2310 STPTR=(STPTR+ACC+3)&(-4)
#line 2310 "test-new/imp918s.imp"
*STPTR = *STPTR + ACC + 3 & -4;
// 2311 AH3=QQ
#line 2311 "test-new/imp918s.imp"
AH3 = QQ;
// 2312 %FINISH
#line 2312 "test-new/imp918s.imp"
L_019F:;
// 2313 AH3=AH3!(ACC-1)<<24
#line 2313 "test-new/imp918s.imp"
AH3 = AH3 | ACC - 1 << 24;
// 2314 PGLA(4,4,ADDR(AH3))
#line 2314 "test-new/imp918s.imp"
PGLA(4, 4, _imp_ADDR(/*?*/ &AH3));
// 2315 TAGDISP=GLACA-4
#line 2315 "test-new/imp918s.imp"
TAGDISP = GLACA - 4;
// 2316 %IF EXTRN=3 %THEN GXREF(2,K,ACC,TAGDISP) %C
#line 2316 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01A1;
#line 2316 "test-new/imp918s.imp"
GXREF(2, K, ACC, TAGDISP);
#line 2316 "test-new/imp918s.imp"
goto L_01A2;
#line 2316 "test-new/imp918s.imp"
L_01A1:;
#line 2316 "test-new/imp918s.imp"
RELOCATE(TAGDISP, AH3, LPUTP);
#line 2316 "test-new/imp918s.imp"
L_01A2:;
// 2317+ %ELSE RELOCATE(TAGDISP,AH3,LPUTP)
// 2318 EPTYPE=4; EPDISP=QQ; ! DATA IN GLA SYMBOL TABLES
#line 2318 "test-new/imp918s.imp"
EPTYPE = 4;
#line 2318 "test-new/imp918s.imp"
EPDISP = QQ;
// 2319 %FINISH
#line 2319 "test-new/imp918s.imp"
L_019D:;
// 2320 %FINISH %ELSE %START; ! INTEGER & REAL
#line 2320 "test-new/imp918s.imp"
goto L_01A3;
#line 2320 "test-new/imp918s.imp"
L_019B:;
// 2321 %IF EXTRN=3 %THEN %START; ! EXTRINSICS
#line 2321 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01A4;
// 2322 NAM=1; PACK(PTYPE); ! EXTRINSICS VIA PTR
#line 2322 "test-new/imp918s.imp"
NAM = 1;
#line 2322 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 2323 CXREF(2,K,ACC,TAGDISP)
#line 2323 "test-new/imp918s.imp"
CXREF(2, K, ACC, /*?*/ &TAGDISP);
// 2324 %FINISH %ELSE %START; ! OWN,EXTERNAL&CONST
#line 2324 "test-new/imp918s.imp"
goto L_01A5;
#line 2324 "test-new/imp918s.imp"
L_01A4:;
// 2325 %IF TYPE=2 %THEN %START
#line 2325 "test-new/imp918s.imp"
if (TYPE != 2) goto L_01A6;
// 2326 AD=ADDR(RCONST)
#line 2326 "test-new/imp918s.imp"
AD = _imp_ADDR(/*?*/ &RCONST);
// 2327 %FINISH %ELSE %START; ! INTEGER VARIABLES
#line 2327 "test-new/imp918s.imp"
goto L_01A7;
#line 2327 "test-new/imp918s.imp"
L_01A6:;
// 2328 FAULT(44,0) %IF (PREC&3=1 %AND ICONST>255) %C
#line 2328 "test-new/imp918s.imp"
if (PREC & 3 != 1) goto L_01A8;
#line 2328 "test-new/imp918s.imp"
if (ICONST > 255) goto L_01A9;
#line 2328 "test-new/imp918s.imp"
L_01A8:;
#line 2328 "test-new/imp918s.imp"
if (PREC & 3 != 2) goto L_01AA;
#line 2328 "test-new/imp918s.imp"
if ((unsigned int)_imp_IMOD(ICONST) >> 16 == 0) goto L_01AA;
#line 2328 "test-new/imp918s.imp"
L_01A9:;
#line 2328 "test-new/imp918s.imp"
FAULT(44, 0);
#line 2328 "test-new/imp918s.imp"
L_01AA:;
// 2329+ %OR (PREC&3=2 %AND |ICONST|>>16#0)
// 2330 AD=ADDR(ICONST)+4-ACC
#line 2330 "test-new/imp918s.imp"
AD = _imp_ADDR(/*?*/ &ICONST) + 4 - ACC;
// 2331 %FINISH
#line 2331 "test-new/imp918s.imp"
L_01A7:;
// 2332 %IF TYPE=1 %AND EXTRN=0 %AND 0<=ICONST<4096 %C
#line 2332 "test-new/imp918s.imp"
if (TYPE != 1) goto L_01AB;
#line 2332 "test-new/imp918s.imp"
if (EXTRN != 0) goto L_01AB;
#line 2332 "test-new/imp918s.imp"
{
// Double-sided test on ICONST (Part I)
#line 2332 "test-new/imp918s.imp"
int tmp;
#line 2332 "test-new/imp918s.imp"
if (0 > (tmp = ICONST)) goto L_01AB;
// Double-sided test on ICONST (Part II)
#line 2332 "test-new/imp918s.imp"
if (tmp >= 4096) goto L_01AB;
#line 2332 "test-new/imp918s.imp"
}
#line 2332 "test-new/imp918s.imp"
KFORM = ICONST;
#line 2332 "test-new/imp918s.imp"
goto L_01AC;
#line 2332 "test-new/imp918s.imp"
L_01AB:;
#line 2332 "test-new/imp918s.imp"
KFORM = -1;
#line 2332 "test-new/imp918s.imp"
L_01AC:;
// 2333+ %THEN KFORM=ICONST %ELSE KFORM=-1
// 2334 %IF EXTRN=0 %AND ACC>1 %START; !CONST VAR==CONST SO SHARE IT
#line 2334 "test-new/imp918s.imp"
if (EXTRN != 0) goto L_01AD;
#line 2334 "test-new/imp918s.imp"
if (ACC <= 1) goto L_01AD;
// 2335 STORE CONST(CBASE,TAGDISP,ACC,AD)
#line 2335 "test-new/imp918s.imp"
STORECONST(/*?*/ &CBASE, /*?*/ &TAGDISP, ACC, AD);
// 2336 %FINISH %ELSE %START
#line 2336 "test-new/imp918s.imp"
goto L_01AE;
#line 2336 "test-new/imp918s.imp"
L_01AD:;
// 2337 PGLA(ACC,ACC,AD); ! PUT CONSTANT INTO GLA
#line 2337 "test-new/imp918s.imp"
PGLA(ACC, ACC, AD);
// 2338 CBASE=GLA
#line 2338 "test-new/imp918s.imp"
CBASE = 13;
// 2339 TAGDISP=GLACA-ACC; ! OFFSET OF VAR FOR TAGS
#line 2339 "test-new/imp918s.imp"
TAGDISP = GLACA - ACC;
// 2340 EPDISP=TAGDISP; ! AND FOR ENTRY DEFN
#line 2340 "test-new/imp918s.imp"
EPDISP = TAGDISP;
// 2341 EPTYPE=3; ! DATA IN ADRESSABLE GLA
#line 2341 "test-new/imp918s.imp"
EPTYPE = 3;
// 2342 %FINISH
#line 2342 "test-new/imp918s.imp"
L_01AE:;
// 2343 %FINISH
#line 2343 "test-new/imp918s.imp"
L_01A5:;
// 2344 %FINISH
#line 2344 "test-new/imp918s.imp"
L_01A3:;
// 2345 STAG(TAGDISP,ACC)
#line 2345 "test-new/imp918s.imp"
STAG(TAGDISP, ACC);
// 2346 PP=PP+1
#line 2346 "test-new/imp918s.imp"
PP = PP + 1;
// 2347 %REPEAT %UNTIL NNAMES=0
#line 2347 "test-new/imp918s.imp"
if (NNAMES == 0) goto L_01AF;
#line 2347 "test-new/imp918s.imp"
goto L_019A;
#line 2347 "test-new/imp918s.imp"
L_01AF:;
// 2348 P=MARK
#line 2348 "test-new/imp918s.imp"
P = MARK;
// 2349 %REPEAT %UNTIL A(MARK)=2
#line 2349 "test-new/imp918s.imp"
if (A[MARK + 7] == 2) goto L_01B0;
#line 2349 "test-new/imp918s.imp"
goto L_018C;
#line 2349 "test-new/imp918s.imp"
L_01B0:;
// 2350 ->Label99
#line 2350 "test-new/imp918s.imp"
goto U_1026;
// 2351 RECORD: ! <XOWN>'%RECORD'<NAMELIST>
#line 2351 "test-new/imp918s.imp"
U_1024:;
// 2352 !***********************************************************************
// 2353 !* NO INITIALISATION OF OWN RECORDS ALLOWED SO THEY ARE ALL *
// 2354 !* CLEARED TO ZERO. *
// 2355 !***********************************************************************
// 2356 MARKER1=P+A(P)+3-MODE; ! TO FORMAT NAME
#line 2356 "test-new/imp918s.imp"
MARKER1 = P + A[P + 7] + 3 - MODE;
// 2357 FNAM=A(MARKER1)
#line 2357 "test-new/imp918s.imp"
FNAM = A[MARKER1 + 7];
// 2358 COPYTAG(FNAM)
#line 2358 "test-new/imp918s.imp"
COPYTAG(FNAM);
// 2359 FINF=TCELL
#line 2359 "test-new/imp918s.imp"
FINF = TCELL;
// 2360 %IF PTYPE#4 %THEN FAULT(62,FNAM) %AND ->Label99
#line 2360 "test-new/imp918s.imp"
if (PTYPE == 4) goto L_01B1;
#line 2360 "test-new/imp918s.imp"
FAULT(62, FNAM);
#line 2360 "test-new/imp918s.imp"
goto U_1026;
#line 2360 "test-new/imp918s.imp"
L_01B1:;
// 2361 %IF EXTRN=0 %THEN PTYPE=143 %ELSE PTYPE=103
#line 2361 "test-new/imp918s.imp"
if (EXTRN != 0) goto L_01B2;
#line 2361 "test-new/imp918s.imp"
PTYPE = 143;
#line 2361 "test-new/imp918s.imp"
goto L_01B3;
#line 2361 "test-new/imp918s.imp"
L_01B2:;
#line 2361 "test-new/imp918s.imp"
PTYPE = 103;
#line 2361 "test-new/imp918s.imp"
L_01B3:;
// 2362 KFORM=FINF;! UNPACK
#line 2362 "test-new/imp918s.imp"
KFORM = FINF;
// 2363 !%if USE MC = 1 %start
// 2364 ! *L_1,PTYPE; *CVD_1,0(11)
// 2365 ! *UNPK_ROUT(5),5(3,11)
// 2366 ! *NC_ROUT(5),MASK1
// 2367 !%finish
// 2368 ->NONSCALAR %IF MODE=3
#line 2368 "test-new/imp918s.imp"
if (MODE != 3) goto L_01B4;
#line 2368 "test-new/imp918s.imp"
goto U_1025;
#line 2368 "test-new/imp918s.imp"
L_01B4:;
// 2369 NNAMES=A(P); PTYPE=1003; J=0
#line 2369 "test-new/imp918s.imp"
NNAMES = A[P + 7];
#line 2369 "test-new/imp918s.imp"
PTYPE = 1003;
#line 2369 "test-new/imp918s.imp"
J = 0;
// 2370 %CYCLE
#line 2370 "test-new/imp918s.imp"
L_01B5:;
// 2371 P=P+1; K=A(P)
#line 2371 "test-new/imp918s.imp"
P = P + 1;
#line 2371 "test-new/imp918s.imp"
K = A[P + 7];
// 2372 %IF EXTRN=3 %THEN %START; ! EXTRINISIC
#line 2372 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01B6;
// 2373 CXREF(2,K,ACC,TAGDISP); ! RELOCATE BY EXTERNAL
#line 2373 "test-new/imp918s.imp"
CXREF(2, K, ACC, /*?*/ &TAGDISP);
// 2374 %FINISH %ELSE %START
#line 2374 "test-new/imp918s.imp"
goto L_01B7;
#line 2374 "test-new/imp918s.imp"
L_01B6:;
// 2375 CLEAR(ACC)
#line 2375 "test-new/imp918s.imp"
CLEAR(ACC);
// 2376 EPDISP=STPTR-ACC
#line 2376 "test-new/imp918s.imp"
EPDISP = *STPTR - ACC;
// 2377 AH3=EPDISP
#line 2377 "test-new/imp918s.imp"
AH3 = EPDISP;
// 2378 RELOCATE(-1,AH3,LPUTP);! PUT DISP INTO GLA
#line 2378 "test-new/imp918s.imp"
RELOCATE(-1, AH3, LPUTP);
// 2379 TAGDISP=GLACA-4; ! AND RELOCATE REL APPROPIATE AREA
#line 2379 "test-new/imp918s.imp"
TAGDISP = GLACA - 4;
// 2380 EPTYPE=4; ! DATA IN GLA SYMBOL TABLES
#line 2380 "test-new/imp918s.imp"
EPTYPE = 4;
// 2381 %FINISH
#line 2381 "test-new/imp918s.imp"
L_01B7:;
// 2382 STAG(TAGDISP,ACC)
#line 2382 "test-new/imp918s.imp"
STAG(TAGDISP, ACC);
// 2383 %REPEAT %UNTIL NNAMES=0
#line 2383 "test-new/imp918s.imp"
if (NNAMES == 0) goto L_01B8;
#line 2383 "test-new/imp918s.imp"
goto L_01B5;
#line 2383 "test-new/imp918s.imp"
L_01B8:;
// 2384 ->Label99
#line 2384 "test-new/imp918s.imp"
goto U_1026;
// 2385 NONSCALAR: ! OWN AND OWNRECORD ARRAYS
#line 2385 "test-new/imp918s.imp"
U_1025:;
// 2386 !***********************************************************************
// 2387 !* OWN ARRAYS CAN BE INITIALISED BUT ONLY ONE ARRAY CAN BE *
// 2388 !* DECLARED IN A STATEMENT.(THANK HEAVENS!) *
// 2389 !* OWN RECORD ARRAYS ARE CLEARED TO ZERO *
// 2390 !***********************************************************************
// 2391 PP=P+1; P=P+2; J=1; NNAMES=1
#line 2391 "test-new/imp918s.imp"
PP = P + 1;
#line 2391 "test-new/imp918s.imp"
P = P + 2;
#line 2391 "test-new/imp918s.imp"
J = 1;
#line 2391 "test-new/imp918s.imp"
NNAMES = 1;
// 2392 K=A(PP)
#line 2392 "test-new/imp918s.imp"
K = A[PP + 7];
// 2393 CBPAIR(KK,KKK)
#line 2393 "test-new/imp918s.imp"
CBPAIR(/*?*/ &KK, /*?*/ &KKK);
// 2394 %IF TYPE>=3 %THEN BP=ACC %ELSE BP=BYTES(PREC)
#line 2394 "test-new/imp918s.imp"
if (TYPE < 3) goto L_01B9;
#line 2394 "test-new/imp918s.imp"
BP = ACC;
#line 2394 "test-new/imp918s.imp"
goto L_01BA;
#line 2394 "test-new/imp918s.imp"
L_01B9:;
#line 2394 "test-new/imp918s.imp"
BP = BYTES[PREC];
#line 2394 "test-new/imp918s.imp"
L_01BA:;
// 2395 LENGTH=KKK-KK+1; QQ=LENGTH*BP
#line 2395 "test-new/imp918s.imp"
LENGTH = KKK - KK + 1;
#line 2395 "test-new/imp918s.imp"
QQ = LENGTH * BP;
// 2396 CONSTS FOUND=0
#line 2396 "test-new/imp918s.imp"
CONSTSFOUND = 0;
// 2397 %IF MODE#3 %THEN %START; ! NOT A RECORD ARRAY
#line 2397 "test-new/imp918s.imp"
if (MODE == 3) goto L_01BB;
// 2398 FROM AR4(P+1,CONSTS FOUND)
#line 2398 "test-new/imp918s.imp"
FROMAR4(P + 1, /*?*/ &CONSTSFOUND);
// 2399 FROM AR4(P+3,SPOINT); ! DISPLACEMENT OF CONSTANTS
#line 2399 "test-new/imp918s.imp"
FROMAR4(P + 3, /*?*/ &SPOINT);
// 2400 %FINISH
#line 2400 "test-new/imp918s.imp"
L_01BB:;
// 2401 !*INSERT
// 2402 %IF CONSTS FOUND=0 %THEN %START;! NO CONSTANTS GIVEN
#line 2402 "test-new/imp918s.imp"
if (CONSTSFOUND != 0) goto L_01BC;
// 2403 ! SO CLEAR AN AREA TO ZERO
// 2404 CONSTS FOUND=LENGTH
#line 2404 "test-new/imp918s.imp"
CONSTSFOUND = LENGTH;
// 2405 CLEAR(QQ) %UNLESS LENGTH<1 %OR EXTRN=3
#line 2405 "test-new/imp918s.imp"
if (LENGTH < 1) goto L_01BD;
#line 2405 "test-new/imp918s.imp"
if (EXTRN == 3) goto L_01BD;
#line 2405 "test-new/imp918s.imp"
CLEAR(QQ);
#line 2405 "test-new/imp918s.imp"
L_01BD:;
// 2406 SPOINT=STPTR-QQ
#line 2406 "test-new/imp918s.imp"
SPOINT = *STPTR - QQ;
// 2407 %FINISH %ELSE %START
#line 2407 "test-new/imp918s.imp"
goto L_01BE;
#line 2407 "test-new/imp918s.imp"
L_01BC:;
// 2408 !*INSERT
// 2409 FAULT(46,K) %IF EXTRN=3
#line 2409 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01BF;
#line 2409 "test-new/imp918s.imp"
FAULT(46, K);
#line 2409 "test-new/imp918s.imp"
L_01BF:;
// 2410 %FINISH
#line 2410 "test-new/imp918s.imp"
L_01BE:;
// 2411 FAULT(45,K) %UNLESS KKK>=KK %AND LENGTH=CONSTS FOUND
#line 2411 "test-new/imp918s.imp"
if (KKK < KK) goto L_01C0;
#line 2411 "test-new/imp918s.imp"
if (LENGTH == CONSTSFOUND) goto L_01C1;
#line 2411 "test-new/imp918s.imp"
L_01C0:;
#line 2411 "test-new/imp918s.imp"
FAULT(45, K);
#line 2411 "test-new/imp918s.imp"
L_01C1:;
// 2412 !
// 2413 ! NOW OUTPUT A DOPE VECTOR FOR STRING ARRAYS OR IF CHECKS ARE ON
// 2414 !
// 2415 %UNLESS COMPILER=1 %AND CHECKS=0 %AND TYPE#5 %THEN %START
#line 2415 "test-new/imp918s.imp"
if (COMPILER != 1) goto L_01C2;
#line 2415 "test-new/imp918s.imp"
if (CHECKS != 0) goto L_01C2;
#line 2415 "test-new/imp918s.imp"
if (TYPE != 5) goto L_01C3;
#line 2415 "test-new/imp918s.imp"
L_01C2:;
// 2416 AH3=DOPE VECTOR(BP,KK,KKK)
#line 2416 "test-new/imp918s.imp"
AH3 = DOPEVECTOR(BP, KK, KKK);
// 2417 %FINISH %ELSE AH3=SSTL
#line 2417 "test-new/imp918s.imp"
goto L_01C4;
#line 2417 "test-new/imp918s.imp"
L_01C3:;
#line 2417 "test-new/imp918s.imp"
AH3 = SSTL;
#line 2417 "test-new/imp918s.imp"
L_01C4:;
// 2418 %IF EXTRN=3 %THEN EPDISP=0 %ELSE EPDISP=SPOINT
#line 2418 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01C5;
#line 2418 "test-new/imp918s.imp"
EPDISP = 0;
#line 2418 "test-new/imp918s.imp"
goto L_01C6;
#line 2418 "test-new/imp918s.imp"
L_01C5:;
#line 2418 "test-new/imp918s.imp"
EPDISP = SPOINT;
#line 2418 "test-new/imp918s.imp"
L_01C6:;
// 2419 !
// 2420 ! OUTPUT AN ARRAYHEAD INTO THE GLA RELATIVE TO THE START OF THE SYMBOL-
// 2421 ! TABLES IN WHICH THE ARRAY RESIDES. PERM INITIALISATION WILL RELOCATE
// 2422 ! BY ADDING INTO AH1-3 THE VIRTUAL ADDRESS OF THE START OF THE
// 2423 ! APPROPIATE AREA.
// 2424 !
// 2425 AH1=EPDISP-KK*BP
#line 2425 "test-new/imp918s.imp"
AH1 = EPDISP - KK * BP;
// 2426 AH2=EPDISP
#line 2426 "test-new/imp918s.imp"
AH2 = EPDISP;
// 2427 AH4=BP; JJ=16-COMPILER<<2
#line 2427 "test-new/imp918s.imp"
AH4 = BP;
#line 2427 "test-new/imp918s.imp"
JJ = 16 - (COMPILER << 2);
// 2428 PGLA(4,JJ,ADDR(AH1))
#line 2428 "test-new/imp918s.imp"
PGLA(4, JJ, _imp_ADDR(/*?*/ &AH1));
// 2429 TAGDISP=GLACA-JJ
#line 2429 "test-new/imp918s.imp"
TAGDISP = GLACA - JJ;
// 2430 %IF EXTRN=3 %THEN %START; ! EXTRINSIC ARRAYS
#line 2430 "test-new/imp918s.imp"
if (EXTRN != 3) goto L_01C7;
// 2431 GXREF(2,K,QQ,TAGDISP); ! RELOCATE ADDR(A(0))
#line 2431 "test-new/imp918s.imp"
GXREF(2, K, QQ, TAGDISP);
// 2432 GXREF(2,K,QQ,TAGDISP+4); ! RELOCATE ADDR(A(FIRST))
#line 2432 "test-new/imp918s.imp"
GXREF(2, K, QQ, TAGDISP + 4);
// 2433 %FINISH %ELSE %START
#line 2433 "test-new/imp918s.imp"
goto L_01C8;
#line 2433 "test-new/imp918s.imp"
L_01C7:;
// 2434 RELOCATE(TAGDISP,AH1,LPUTP);! RELOCATE ADDR(A(0))
#line 2434 "test-new/imp918s.imp"
RELOCATE(TAGDISP, AH1, LPUTP);
// 2435 RELOCATE(TAGDISP+4,AH2,LPUTP);! RELOCATE ADDR(A(FIRST))
#line 2435 "test-new/imp918s.imp"
RELOCATE(TAGDISP + 4, AH2, LPUTP);
// 2436 %FINISH
#line 2436 "test-new/imp918s.imp"
L_01C8:;
// 2437 RELOCATE(TAGDISP+8,AH3,4); ! RELOCATE DV POINTER
#line 2437 "test-new/imp918s.imp"
RELOCATE(TAGDISP + 8, AH3, 4);
// 2438 EPTYPE=4; ! DATA IN GLA SYMBOL TABLES
#line 2438 "test-new/imp918s.imp"
EPTYPE = 4;
// 2439 STAG(TAGDISP,QQ)
#line 2439 "test-new/imp918s.imp"
STAG(TAGDISP, QQ);
// 2440 ->Label99
#line 2440 "test-new/imp918s.imp"
goto U_1026;
// 2441 %ROUTINE CLEAR(%INTEGER LENGTH)
#line 2441 "test-new/imp918s.imp"
void CLEAR(int LENGTH) {
// 2442 STPTR=(STPTR+7)&(-8)
#line 2442 "test-new/imp918s.imp"
*STPTR = *STPTR + 7 & -8;
// 2443 LENGTH=(LENGTH+3)&(-4)
#line 2443 "test-new/imp918s.imp"
LENGTH = LENGTH + 3 & -4;
// 2444 LPUT(LPUTP,LENGTH,STPTR,0)%IF INHCODE=0
#line 2444 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_01C9;
#line 2444 "test-new/imp918s.imp"
LPUT(LPUTP, LENGTH, *STPTR, 0);
#line 2444 "test-new/imp918s.imp"
L_01C9:;
// 2445 STPTR=STPTR+LENGTH
#line 2445 "test-new/imp918s.imp"
*STPTR = *STPTR + LENGTH;
// 2446 %END
#line 2446 "test-new/imp918s.imp"
return;
#line 2446 "test-new/imp918s.imp"
} /* end of CLEAR */
// 2447 %ROUTINE STAG(%INTEGER J,DATALEN)
#line 2447 "test-new/imp918s.imp"
void STAG(int J, int DATALEN) {
// 2448 TEST NST
#line 2448 "test-new/imp918s.imp"
TESTNST();
// 2449 %IF EXTRN=2 %THEN DEFINE EP(EPTYPE,K,EPDISP,DATALEN)
#line 2449 "test-new/imp918s.imp"
if (EXTRN != 2) goto L_01CA;
#line 2449 "test-new/imp918s.imp"
DEFINEEP(EPTYPE, K, EPDISP, DATALEN);
#line 2449 "test-new/imp918s.imp"
L_01CA:;
// 2450 RBASE=CBASE
#line 2450 "test-new/imp918s.imp"
RBASE = CBASE;
// 2451 STORE TAG(K,J)
#line 2451 "test-new/imp918s.imp"
STORETAG(K, J);
// 2452 RBASE=10-RLEVEL
#line 2452 "test-new/imp918s.imp"
RBASE = 10 - RLEVEL;
// 2453 NNAMES=NNAMES-1
#line 2453 "test-new/imp918s.imp"
NNAMES = NNAMES - 1;
// 2454 %END
#line 2454 "test-new/imp918s.imp"
return;
#line 2454 "test-new/imp918s.imp"
} /* end of STAG */
// 2455 Label99: %END; ->Label1
#line 2455 "test-new/imp918s.imp"
U_1026:;
#line 2455 "test-new/imp918s.imp"
goto end_1011;
#line 2455 "test-new/imp918s.imp"
end_1011:;
#line 2455 "test-new/imp918s.imp"
}
#line 2455 "test-new/imp918s.imp"
goto U_100F;
// 2456 SW(18):
#line 2456 "test-new/imp918s.imp"
case_SW_18:;
// 2457 P=P+1
#line 2457 "test-new/imp918s.imp"
P = P + 1;
// 2458 CRSPEC(2); ->Label1
#line 2458 "test-new/imp918s.imp"
CRSPEC(2);
#line 2458 "test-new/imp918s.imp"
goto U_100F;
// 2459 SW(19):
#line 2459 "test-new/imp918s.imp"
case_SW_19:;
// 2460 ! '%NAME' SPECIAL NAME
// 2461 PUSH123(TAGS(A(P+1)),SNPT<<16!X'8090',0,SNUM<<16)
#line 2461 "test-new/imp918s.imp"
PUSH123(/*?*/ &TAGS[A[P + 1 + 7]], 10006 << 16 | 32912, 0, SNUM << 16);
// 2462 SNUM=SNUM+1;->Label1
#line 2462 "test-new/imp918s.imp"
SNUM = SNUM + 1;
#line 2462 "test-new/imp918s.imp"
goto U_100F;
// 2463 SW(20): ! TRUSTED PROGRAM
#line 2463 "test-new/imp918s.imp"
case_SW_20:;
// 2464 !
// 2465 ! TRUSTED PROGRAMS HAVE:-
// 2466 ! 1) NO JUMPS ROUND ROUTINE BODIES
// 2467 ! 2) NO ERROR EXITS FROM FNS & MAPS
// 2468 ! 3) NO CYCLES OF THE FORM I:=1,1,I
// 2469 ! 4) NO RELIANCE ON THE VALUE OF CYCLE VARIABLES AT TERMINATION
// 2470 !
// 2471 MARGIN=512
#line 2471 "test-new/imp918s.imp"
MARGIN = 512;
// 2472 COMPILER=1 %IF CHECKSP=0; ! ONLY WORKS ON PARM OPT
#line 2472 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_01CB;
#line 2472 "test-new/imp918s.imp"
COMPILER = 1;
#line 2472 "test-new/imp918s.imp"
L_01CB:;
// 2473 ->Label1
#line 2473 "test-new/imp918s.imp"
goto U_100F;
// 2474 SW(21):
#line 2474 "test-new/imp918s.imp"
case_SW_21:;
// 2475 ! '%REGISTER'(NAME)(S)
// 2476 WARN(LINE)
#line 2476 "test-new/imp918s.imp"
WARN(LINE);
// 2477 %IF A(P+2)=1 %THEN KK=A(P+3) %ELSE FINDREG(CLMABL,KK)
#line 2477 "test-new/imp918s.imp"
if (A[P + 2 + 7] != 1) goto L_01CC;
#line 2477 "test-new/imp918s.imp"
KK = A[P + 3 + 7];
#line 2477 "test-new/imp918s.imp"
goto L_01CD;
#line 2477 "test-new/imp918s.imp"
L_01CC:;
#line 2477 "test-new/imp918s.imp"
FINDREG(66830, /*?*/ &KK);
#line 2477 "test-new/imp918s.imp"
L_01CD:;
// 2478 %IF 4<KK<15 %AND REGISTER(KK)=0 %THEN %START
#line 2478 "test-new/imp918s.imp"
{
// Double-sided test on KK (Part I)
#line 2478 "test-new/imp918s.imp"
int tmp;
#line 2478 "test-new/imp918s.imp"
if (4 >= (tmp = KK)) goto L_01CE;
// Double-sided test on KK (Part II)
#line 2478 "test-new/imp918s.imp"
if (tmp >= 15) goto L_01CE;
#line 2478 "test-new/imp918s.imp"
}
#line 2478 "test-new/imp918s.imp"
if (REGISTER[KK] != 0) goto L_01CE;
// 2479 UVARREG(KK)=LEVEL
#line 2479 "test-new/imp918s.imp"
UVARREG[KK - 5] = LEVEL;
// 2480 PTYPE=8; J=0
#line 2480 "test-new/imp918s.imp"
PTYPE = 8;
#line 2480 "test-new/imp918s.imp"
J = 0;
// 2481 K=A(P+1); TESTNST
#line 2481 "test-new/imp918s.imp"
K = A[P + 1 + 7];
#line 2481 "test-new/imp918s.imp"
TESTNST();
// 2482 KFORM=M'RG'
#line 2482 "test-new/imp918s.imp"
KFORM = 21063;
// 2483 STORE TAG(K,KK)
#line 2483 "test-new/imp918s.imp"
STORETAG(K, KK);
// 2484 SET USE(KK,3,TAGS(K))
#line 2484 "test-new/imp918s.imp"
SETUSE(KK, 3, TAGS[K]);
// 2485 REGISTER(KK)=-1
#line 2485 "test-new/imp918s.imp"
REGISTER[KK] = -1;
// 2486 %FINISH %ELSE FAULT(58,0)
#line 2486 "test-new/imp918s.imp"
goto L_01CF;
#line 2486 "test-new/imp918s.imp"
L_01CE:;
#line 2486 "test-new/imp918s.imp"
FAULT(58, 0);
#line 2486 "test-new/imp918s.imp"
L_01CF:;
// 2487 SW(22):
#line 2487 "test-new/imp918s.imp"
case_SW_22:;
// 2488 ->Label1; ! '%MCODE'
#line 2488 "test-new/imp918s.imp"
goto U_100F;
// 2489 SW(24):
#line 2489 "test-new/imp918s.imp"
case_SW_24:;
// 2490 P=P+1; LCA=0; CUCI; ->Label1; ! '*'(UCI)(S)
#line 2490 "test-new/imp918s.imp"
P = P + 1;
#line 2490 "test-new/imp918s.imp"
LCA = 0;
#line 2490 "test-new/imp918s.imp"
CUCI();
#line 2490 "test-new/imp918s.imp"
goto U_100F;
// 2491 SW(26):
#line 2491 "test-new/imp918s.imp"
case_SW_26:;
// 2492 %BEGIN; ! %COMMENT %DEFINE (SOMETHING)
#line 2492 "test-new/imp918s.imp"
{ /*%begin*/
// 2493 {%SHORTROUTINE}
// 2494 %SWITCH S(1:3)
#line 2494 "test-new/imp918s.imp"
int S_index;
#line 2494 "test-new/imp918s.imp"
int S_line;
#line 2494 "test-new/imp918s.imp"
char *S_file;
#line 2494 "test-new/imp918s.imp"
static const void *S[3] = {&&case_S_missing, &&case_S_missing, &&case_S_missing};
// 2495 %INTEGER I,J,K
#line 2495 "test-new/imp918s.imp"
int I;
#line 2495 "test-new/imp918s.imp"
int J;
#line 2495 "test-new/imp918s.imp"
int K;
// 2496 -> S(A(P+1))
#line 2496 "test-new/imp918s.imp"
S_line = __LINE__;
S_file = __FILE__;
S_index = A[P + 1 + 7];
goto case_S_dispatch;
// 2497 S(1): I=ADDR(FIXED GLA(27)); ->Label1
#line 2497 "test-new/imp918s.imp"
case_S_1:;
#line 2497 "test-new/imp918s.imp"
I = _imp_ADDR(/*?*/ &FIXEDGLA[27]);
#line 2497 "test-new/imp918s.imp"
goto U_1027;
// 2498 S(2): I=ADDR(IOCP1)+3; ->Label1
#line 2498 "test-new/imp918s.imp"
case_S_2:;
#line 2498 "test-new/imp918s.imp"
I = _imp_ADDR(/*?*/ &IOCP1) + 3;
#line 2498 "test-new/imp918s.imp"
goto U_1027;
// 2499 S(3): I=ADDR(MAIN EP1)+3
#line 2499 "test-new/imp918s.imp"
case_S_3:;
#line 2499 "test-new/imp918s.imp"
I = _imp_ADDR(/*?*/ &MAINEP1) + 3;
// 2500 Label1: K=A(P+2)
#line 2500 "test-new/imp918s.imp"
U_1027:;
#line 2500 "test-new/imp918s.imp"
K = A[P + 2 + 7];
// 2501 FAULT(50,0) %UNLESS CPRMODE=0 %AND K<=7
#line 2501 "test-new/imp918s.imp"
if (CPRMODE != 0) goto L_01D1;
#line 2501 "test-new/imp918s.imp"
if (K <= 7) goto L_01D2;
#line 2501 "test-new/imp918s.imp"
L_01D1:;
#line 2501 "test-new/imp918s.imp"
FAULT(50, 0);
#line 2501 "test-new/imp918s.imp"
L_01D2:;
// 2502 J=ADDR(A(P+2))+1
#line 2502 "test-new/imp918s.imp"
J = _imp_ADDR(/*?*/ &A[P + 2 + 7]) + 1;
// 2503 !%if USE MC = 1 %start
// 2504 ! *L_1,I;*L_2,J
// 2505 ! *MVC_0(8,1),0(2)
// 2506 !%finish
// 2507 %END; ->Label1
#line 2507 "test-new/imp918s.imp"
goto end_1012;
#line 2507 "test-new/imp918s.imp"
case_S_dispatch:
#line 2507 "test-new/imp918s.imp"
if (S_index < 1 || S_index > 3)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
#line 2507 "test-new/imp918s.imp"
goto *S[S_index - 1];
#line 2507 "test-new/imp918s.imp"
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
#line 2507 "test-new/imp918s.imp"
end_1012:;
#line 2507 "test-new/imp918s.imp"
}
#line 2507 "test-new/imp918s.imp"
goto U_100F;
// 2508 SW(25):
#line 2508 "test-new/imp918s.imp"
case_SW_25:;
// 2509 ! %CONTROL (CONST)
// 2510 ! FAULT(33,0) %UNLESS IMPS=1
// 2511 FROM AR4(P+2,J)
#line 2511 "test-new/imp918s.imp"
FROMAR4(P + 2, /*?*/ &J);
// 2512 K=J&15; LINENOS=K %UNLESS K=15
#line 2512 "test-new/imp918s.imp"
K = J & 15;
#line 2512 "test-new/imp918s.imp"
if (K == 15) goto L_01D3;
#line 2512 "test-new/imp918s.imp"
LINENOS = K;
#line 2512 "test-new/imp918s.imp"
L_01D3:;
// 2513 K=J>>4&15; DIAGS1=K&1 %AND DIAGS2=K&2 %UNLESS K=15
#line 2513 "test-new/imp918s.imp"
K = (unsigned int)J >> 4 & 15;
#line 2513 "test-new/imp918s.imp"
if (K == 15) goto L_01D4;
#line 2513 "test-new/imp918s.imp"
DIAGS1 = K & 1;
#line 2513 "test-new/imp918s.imp"
DIAGS2 = K & 2;
#line 2513 "test-new/imp918s.imp"
L_01D4:;
// 2514 K=J>>8&15
#line 2514 "test-new/imp918s.imp"
K = (unsigned int)J >> 8 & 15;
// 2515 CHECKS=K %UNLESS K=15
#line 2515 "test-new/imp918s.imp"
if (K == 15) goto L_01D5;
#line 2515 "test-new/imp918s.imp"
CHECKS = K;
#line 2515 "test-new/imp918s.imp"
L_01D5:;
// 2516 CHECKSP=K&14 %UNLESS K=15
#line 2516 "test-new/imp918s.imp"
if (K == 15) goto L_01D6;
#line 2516 "test-new/imp918s.imp"
CHECKSP = K & 14;
#line 2516 "test-new/imp918s.imp"
L_01D6:;
// 2517 GLAFLAG=CHECKSP
#line 2517 "test-new/imp918s.imp"
GLAFLAG = CHECKSP;
// 2518 K=J>>12&15
#line 2518 "test-new/imp918s.imp"
K = (unsigned int)J >> 12 & 15;
// 2519 UNASS=K %UNLESS K=15
#line 2519 "test-new/imp918s.imp"
if (K == 15) goto L_01D7;
#line 2519 "test-new/imp918s.imp"
UNASS = K;
#line 2519 "test-new/imp918s.imp"
L_01D7:;
// 2520 K=J>>24&15
#line 2520 "test-new/imp918s.imp"
K = (unsigned int)J >> 24 & 15;
// 2521 %IF K=1 %THEN %START; ! PERMIT LOWER CASE NAMES
#line 2521 "test-new/imp918s.imp"
if (K != 1) goto L_01D8;
// 2522 %CYCLE I=1,1,26
#line 2522 "test-new/imp918s.imp"
// %for I = 1, 1, 26 %cycle
#line 2522 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = 26;
#line 2522 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, 26");
_control = I = _initial - _increment;
#line 2522 "test-new/imp918s.imp"
L_01D9:
#line 2522 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 2522 "test-new/imp918s.imp"
if (I == _final) goto L_01DA;
#line 2522 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 2523 TRTABS(I+96)=0
#line 2523 "test-new/imp918s.imp"
TRTABS[I + 96] = 0;
// 2524 %REPEAT
#line 2524 "test-new/imp918s.imp"
goto L_01D9;
#line 2524 "test-new/imp918s.imp"
}
#line 2524 "test-new/imp918s.imp"
L_01DA:;
// 2525 %FINISH
#line 2525 "test-new/imp918s.imp"
L_01D8:;
// 2526 K=J>>28
#line 2526 "test-new/imp918s.imp"
K = (unsigned int)J >> 28;
// 2527 %IF K=1 %THEN CODEOUT
#line 2527 "test-new/imp918s.imp"
if (K != 1) goto L_01DC;
#line 2527 "test-new/imp918s.imp"
CODEOUT();
#line 2527 "test-new/imp918s.imp"
L_01DC:;
// 2528 DCOMP=K %UNLESS K=15
#line 2528 "test-new/imp918s.imp"
if (K == 15) goto L_01DD;
#line 2528 "test-new/imp918s.imp"
DCOMP = K;
#line 2528 "test-new/imp918s.imp"
L_01DD:;
// 2529 ->Label1
#line 2529 "test-new/imp918s.imp"
goto U_100F;
// 2530 SW(27):
#line 2530 "test-new/imp918s.imp"
case_SW_27:;
// 2531 %BEGIN; ! %RECORD (RDECLN)
#line 2531 "test-new/imp918s.imp"
{ /*%begin*/
// 2532 !***********************************************************************
// 2533 !* RECORDS ARE ALLOCATED AT COMPILE TIME WHEN POSSIBLE *
// 2534 !* SEE CRFORMAT FOR ACTION ON RECORD FORMAT DECLARATIONS *
// 2535 !***********************************************************************
// 2536 {%SHORTROUTINE}
// 2537 %INTEGER MODE,RECL,ALLOC,FNAM,FINF,NAME
#line 2537 "test-new/imp918s.imp"
int MODE;
#line 2537 "test-new/imp918s.imp"
int RECL;
#line 2537 "test-new/imp918s.imp"
int ALLOC;
#line 2537 "test-new/imp918s.imp"
int FNAM;
#line 2537 "test-new/imp918s.imp"
int FINF;
#line 2537 "test-new/imp918s.imp"
int NAME;
// 2538 P=P+1; MODE=A(P)
#line 2538 "test-new/imp918s.imp"
P = P + 1;
#line 2538 "test-new/imp918s.imp"
MODE = A[P + 7];
// 2539 %IF MODE=1 %THEN %START; ! DEAL WITH FORMAT
#line 2539 "test-new/imp918s.imp"
if (MODE != 1) goto L_01DE;
// 2540 NAME=A(P+1); P=P+2
#line 2540 "test-new/imp918s.imp"
NAME = A[P + 1 + 7];
#line 2540 "test-new/imp918s.imp"
P = P + 2;
// 2541 CRFORMAT(OPHEAD); K=NAME
#line 2541 "test-new/imp918s.imp"
CRFORMAT(/*?*/ &OPHEAD);
#line 2541 "test-new/imp918s.imp"
K = NAME;
// 2542 PTYPE=4; J=0
#line 2542 "test-new/imp918s.imp"
PTYPE = 4;
#line 2542 "test-new/imp918s.imp"
J = 0;
// 2543 KFORM=OPHEAD
#line 2543 "test-new/imp918s.imp"
KFORM = OPHEAD;
// 2544 TEST NST; STORE TAG(K,OPHEAD)
#line 2544 "test-new/imp918s.imp"
TESTNST();
#line 2544 "test-new/imp918s.imp"
STORETAG(K, OPHEAD);
// 2545 ->Label99
#line 2545 "test-new/imp918s.imp"
goto U_1028;
// 2546 %FINISH
#line 2546 "test-new/imp918s.imp"
L_01DE:;
// 2547 P=P+1; MARKER1=P+A(P)
#line 2547 "test-new/imp918s.imp"
P = P + 1;
#line 2547 "test-new/imp918s.imp"
MARKER1 = P + A[P + 7];
// 2548 FNAM=A(MARKER1); ! FORMAT NAME
#line 2548 "test-new/imp918s.imp"
FNAM = A[MARKER1 + 7];
// 2549 COPY TAG(FNAM)
#line 2549 "test-new/imp918s.imp"
COPYTAG(FNAM);
// 2550 FINF=TCELL
#line 2550 "test-new/imp918s.imp"
FINF = TCELL;
// 2551 %IF TYPE#4 %THEN %START
#line 2551 "test-new/imp918s.imp"
if (TYPE == 4) goto L_01DF;
// 2552 FINF=DUMMY FORMAT
#line 2552 "test-new/imp918s.imp"
FINF = DUMMYFORMAT;
// 2553 ACC=4; FAULT(62,FNAM)
#line 2553 "test-new/imp918s.imp"
ACC = 4;
#line 2553 "test-new/imp918s.imp"
FAULT(62, FNAM);
// 2554 %FINISH
#line 2554 "test-new/imp918s.imp"
L_01DF:;
// 2555 RECL=ACC
#line 2555 "test-new/imp918s.imp"
RECL = ACC;
// 2556 %IF MODE=2%THEN %START; ! '%RECORDSPEC'
#line 2556 "test-new/imp918s.imp"
if (MODE != 2) goto L_01E0;
// 2557 COPY TAG(A(P+1))
#line 2557 "test-new/imp918s.imp"
COPYTAG(A[P + 1 + 7]);
// 2558 %IF A(P+2)=1 %AND TYPE=4 %START;! SPEC FOR FORMAT ELEMENT
#line 2558 "test-new/imp918s.imp"
if (A[P + 2 + 7] != 1) goto L_01E1;
#line 2558 "test-new/imp918s.imp"
if (TYPE != 4) goto L_01E1;
// 2559 P=P+3
#line 2559 "test-new/imp918s.imp"
P = P + 3;
// 2560 Q=DISPLACEMENT(TCELL)
#line 2560 "test-new/imp918s.imp"
Q = DISPLACEMENT(TCELL);
// 2561 ! UNPACK
// 2562 !%if USE MC = 1 %start
// 2563 ! *L_1,PTYPE; *CVD_1,0(11)
// 2564 ! *UNPK_ROUT(5),5(3,11)
// 2565 ! *NC_ROUT(5),MASK1
// 2566 !%finish
// 2567 %FINISH
#line 2567 "test-new/imp918s.imp"
L_01E1:;
// 2568 %IF TYPE=3 %AND NAM=1 %AND FROM3(TCELL)&X'FFFF'=0 %START
#line 2568 "test-new/imp918s.imp"
if (TYPE != 3) goto L_01E2;
#line 2568 "test-new/imp918s.imp"
if (NAM != 1) goto L_01E2;
#line 2568 "test-new/imp918s.imp"
if (FROM3(TCELL) & 65535 != 0) goto L_01E2;
// 2569 REPLACE3(TCELL,FINF!K<<16)
#line 2569 "test-new/imp918s.imp"
REPLACE3(TCELL, FINF | K << 16);
// 2570 REPLACE2(TCELL,SNDISP<<16!RECL)
#line 2570 "test-new/imp918s.imp"
REPLACE2(TCELL, SNDISP << 16 | RECL);
// 2571 %FINISH %ELSE FAULT(63,0)
#line 2571 "test-new/imp918s.imp"
goto L_01E3;
#line 2571 "test-new/imp918s.imp"
L_01E2:;
#line 2571 "test-new/imp918s.imp"
FAULT(63, 0);
#line 2571 "test-new/imp918s.imp"
L_01E3:;
// 2572 %FINISH %ELSE %START; ! RECORD DECLARATION
#line 2572 "test-new/imp918s.imp"
goto L_01E4;
#line 2572 "test-new/imp918s.imp"
L_01E0:;
// 2573 FAULT(57,0) %UNLESS LEVEL>=2
#line 2573 "test-new/imp918s.imp"
if (LEVEL >= 2) goto L_01E5;
#line 2573 "test-new/imp918s.imp"
FAULT(57, 0);
#line 2573 "test-new/imp918s.imp"
L_01E5:;
// 2574 FAULT(40,0) %IF NMDECS&1#0
#line 2574 "test-new/imp918s.imp"
if (NMDECS & 1 == 0) goto L_01E6;
#line 2574 "test-new/imp918s.imp"
FAULT(40, 0);
#line 2574 "test-new/imp918s.imp"
L_01E6:;
// 2575 TYPE=3; PREC=0; ROUT=0
#line 2575 "test-new/imp918s.imp"
TYPE = 3;
#line 2575 "test-new/imp918s.imp"
PREC = 0;
#line 2575 "test-new/imp918s.imp"
ROUT = 0;
// 2576 %IF A(P+1)=1 %THEN %START; ! SIMPLE RECORD AND RECORDNAMES
#line 2576 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_01E7;
// 2577 ALLOC=ACC; CQN(P+2)
#line 2577 "test-new/imp918s.imp"
ALLOC = ACC;
#line 2577 "test-new/imp918s.imp"
CQN(P + 2);
// 2578 ACC=ALLOC; P=P+3
#line 2578 "test-new/imp918s.imp"
ACC = ALLOC;
#line 2578 "test-new/imp918s.imp"
P = P + 3;
// 2579 DECLARE SCALARS(1,FINF)
#line 2579 "test-new/imp918s.imp"
DECLARESCALARS(1, FINF);
// 2580 %FINISH %ELSE %START; ! ARRAYS OF RECORDS
#line 2580 "test-new/imp918s.imp"
goto L_01E8;
#line 2580 "test-new/imp918s.imp"
L_01E7:;
// 2581 NAM=0
#line 2581 "test-new/imp918s.imp"
NAM = 0;
// 2582 Q=2-A(P+2); P=P+3; ! Q=1 FOR ARRAY FORMAT
#line 2582 "test-new/imp918s.imp"
Q = 2 - A[P + 2 + 7];
#line 2582 "test-new/imp918s.imp"
P = P + 3;
// 2583 DECLARE ARRAYS(Q,FINF)
#line 2583 "test-new/imp918s.imp"
DECLAREARRAYS(Q, FINF);
// 2584 %FINISH
#line 2584 "test-new/imp918s.imp"
L_01E8:;
// 2585 %FINISH
#line 2585 "test-new/imp918s.imp"
L_01E4:;
// 2586 Label99: %END;->Label1
#line 2586 "test-new/imp918s.imp"
U_1028:;
#line 2586 "test-new/imp918s.imp"
goto end_1013;
#line 2586 "test-new/imp918s.imp"
end_1013:;
#line 2586 "test-new/imp918s.imp"
}
#line 2586 "test-new/imp918s.imp"
goto U_100F;
// 2587 !
// 2588
// 2589 SW(28): ! '%ON'(EVENT')(N)(RESTOFNLIST)
#line 2589 "test-new/imp918s.imp"
case_SW_28:;
// 2590 %BEGIN
#line 2590 "test-new/imp918s.imp"
{ /*%begin*/
// 2591 {%SHORTROUTINE}
// 2592 %INTEGER EL,KK,EF
#line 2592 "test-new/imp918s.imp"
int EL;
#line 2592 "test-new/imp918s.imp"
int KK;
#line 2592 "test-new/imp918s.imp"
int EF;
// 2593 %CONSTINTEGERARRAY EFMAP(1:14)=X'04E10003',8,X'20000',X'2000',
#line 2593 "test-new/imp918s.imp"
const int EFMAP[14] = {81854467, 8, 131072, 8192, 135266420, -1610612736,
33554432, 1073741824, 256, 16777216, 262144, [11 ... 13] = 0};
// 2594+ X'08100074',X'A0000000',X'2000000',X'40000000',
// 2595+ X'100',X'01000000',X'40000',0(3);
// 2596 FAULT(40,0) %IF NMDECS&1#0
#line 2596 "test-new/imp918s.imp"
if (NMDECS & 1 == 0) goto L_01E9;
#line 2596 "test-new/imp918s.imp"
FAULT(40, 0);
#line 2596 "test-new/imp918s.imp"
L_01E9:;
// 2597 NMDECS=NMDECS!1
#line 2597 "test-new/imp918s.imp"
NMDECS = NMDECS | 1;
// 2598 FAULT(26,0) %UNLESS LEVEL=2 %AND CPRMODE#2
#line 2598 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_01EA;
#line 2598 "test-new/imp918s.imp"
if (CPRMODE != 2) goto L_01EB;
#line 2598 "test-new/imp918s.imp"
L_01EA:;
#line 2598 "test-new/imp918s.imp"
FAULT(26, 0);
#line 2598 "test-new/imp918s.imp"
L_01EB:;
// 2599 P=P+2; SFLABEL=SFLABEL-1; EL=SFLABEL
#line 2599 "test-new/imp918s.imp"
P = P + 2;
#line 2599 "test-new/imp918s.imp"
SFLABEL = SFLABEL - 1;
#line 2599 "test-new/imp918s.imp"
EL = SFLABEL;
// 2600 %CYCLE; ! UNTIL NO MORE RESTOFNLIST
#line 2600 "test-new/imp918s.imp"
L_01EC:;
// 2601 KK=A(P)
#line 2601 "test-new/imp918s.imp"
KK = A[P + 7];
// 2602 %IF 1<=KK<=14 %START
#line 2602 "test-new/imp918s.imp"
{
// Double-sided test on KK (Part I)
#line 2602 "test-new/imp918s.imp"
int tmp;
#line 2602 "test-new/imp918s.imp"
if (1 > (tmp = KK)) goto L_01ED;
// Double-sided test on KK (Part II)
#line 2602 "test-new/imp918s.imp"
if (tmp > 14) goto L_01ED;
#line 2602 "test-new/imp918s.imp"
}
// 2603 EF=EFMAP(KK)
#line 2603 "test-new/imp918s.imp"
EF = EFMAP[KK - 1];
// 2604 %CYCLE I=0,1,31
#line 2604 "test-new/imp918s.imp"
// %for I = 0, 1, 31 %cycle
#line 2604 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 31;
#line 2604 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, 31");
_control = I = _initial - _increment;
#line 2604 "test-new/imp918s.imp"
L_01EE:
#line 2604 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 2604 "test-new/imp918s.imp"
if (I == _final) goto L_01EF;
#line 2604 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// ?Non-local
// 2605 %IF 1<<I&EF#0 %START
#line 2605 "test-new/imp918s.imp"
if (1 << I & EF == 0) goto L_01F1;
// 2606 PCONST(X'41100001'+I)
#line 2606 "test-new/imp918s.imp"
PCONST(1091567617 + I);
// 2607 PPJ(20); QQ=CA
#line 2607 "test-new/imp918s.imp"
PPJ(20);
#line 2607 "test-new/imp918s.imp"
QQ = CA;
// 2608 ENTER JUMP(15,EL,0)
#line 2608 "test-new/imp918s.imp"
ENTERJUMP(15, EL, 0);
// 2609 PCONST(X'07000700') %UNLESS CA=QQ+8
#line 2609 "test-new/imp918s.imp"
if (CA == QQ + 8) goto L_01F2;
#line 2609 "test-new/imp918s.imp"
PCONST(117442304);
#line 2609 "test-new/imp918s.imp"
L_01F2:;
// 2610 %FINISH
#line 2610 "test-new/imp918s.imp"
L_01F1:;
// 2611 %REPEAT
#line 2611 "test-new/imp918s.imp"
goto L_01EE;
#line 2611 "test-new/imp918s.imp"
}
#line 2611 "test-new/imp918s.imp"
L_01EF:;
// 2612 %FINISH %ELSE FAULT(36,0)
#line 2612 "test-new/imp918s.imp"
goto L_01F3;
#line 2612 "test-new/imp918s.imp"
L_01ED:;
#line 2612 "test-new/imp918s.imp"
FAULT(36, 0);
#line 2612 "test-new/imp918s.imp"
L_01F3:;
// 2613 P=P+2
#line 2613 "test-new/imp918s.imp"
P = P + 2;
// 2614 %REPEAT %UNTIL A(P-1)=2
#line 2614 "test-new/imp918s.imp"
if (A[P - 1 + 7] == 2) goto L_01F4;
#line 2614 "test-new/imp918s.imp"
goto L_01EC;
#line 2614 "test-new/imp918s.imp"
L_01F4:;
// 2615 ENTER JUMP(15,SFLABEL-1,0); ! ROUND ON START-FINISH
#line 2615 "test-new/imp918s.imp"
ENTERJUMP(15, SFLABEL - 1, 0);
// 2616 CSTART(2)
#line 2616 "test-new/imp918s.imp"
CSTART(2);
// 2617 ENTER LAB(EL,0); MONE=1
#line 2617 "test-new/imp918s.imp"
ENTERLAB(EL, 0);
#line 2617 "test-new/imp918s.imp"
MONE = 1;
// 2618 %END; ->Label1
#line 2618 "test-new/imp918s.imp"
goto end_1014;
#line 2618 "test-new/imp918s.imp"
end_1014:;
#line 2618 "test-new/imp918s.imp"
}
#line 2618 "test-new/imp918s.imp"
goto U_100F;
// 2619 %ROUTINE CRFORMAT(%SHORTINTEGERNAME OPHEAD)
#line 2619 "test-new/imp918s.imp"
void CRFORMAT(short int *OPHEAD) {
// 2620 {%SHORTROUTINE}
// 2621 !***********************************************************************
// 2622 !* CONVERTS A RECORDFORMAT STATEMENT TO A LIST HEADED BY OPHEAD *
// 2623 !* FORMAT OF AN ENTRY. *
// 2624 !* S1=SUBNAME<<20!PTYPE<<4!J *
// 2625 !* S2,S3=4 16 BIT DISPLACEMENTS D2,ACC,D1,KFORM *
// 2626 !* NORMALLY D1=RECORD RELATIVE DISPLACEMENT AND ACC=LMAX(STRINGS)*
// 2627 !* FOR ARRAYS D2=ZERO ELEMENT DISPLACEMENT AND D1=DISPLACEMENT *
// 2628 !* OF RECORD RELATIVE ARRAYHEAD IN THE GLA *
// 2629 !* KFORM IS ONLY USED FOR RECORDS AND POINTS TO THE FORMAT *
// 2630 !* ON EXIT ACC HAS THE RECORD SIZE ROUNDED UP TO THE BOUNDARY *
// 2631 !* REQUIRED BY ITS LARGEST COMPONENT *
// 2632 !***********************************************************************
// 2633 %SHORTINTEGER D1,D2,NLIST,SLIST,FORM
#line 2633 "test-new/imp918s.imp"
short int D1;
#line 2633 "test-new/imp918s.imp"
short int D2;
#line 2633 "test-new/imp918s.imp"
short int NLIST;
#line 2633 "test-new/imp918s.imp"
short int SLIST;
#line 2633 "test-new/imp918s.imp"
short int FORM;
// 2634 %INTEGER RL,MRL; ! ROUNDING LENGTH & MAX
#line 2634 "test-new/imp918s.imp"
int RL;
#line 2634 "test-new/imp918s.imp"
int MRL;
// 2635 %INTEGER REP,INC,Q,LB,UB,R,A0,A1,DV,L,RFD
#line 2635 "test-new/imp918s.imp"
int REP;
#line 2635 "test-new/imp918s.imp"
int INC;
#line 2635 "test-new/imp918s.imp"
int Q;
#line 2635 "test-new/imp918s.imp"
int LB;
#line 2635 "test-new/imp918s.imp"
int UB;
#line 2635 "test-new/imp918s.imp"
int R;
#line 2635 "test-new/imp918s.imp"
int A0;
#line 2635 "test-new/imp918s.imp"
int A1;
#line 2635 "test-new/imp918s.imp"
int DV;
#line 2635 "test-new/imp918s.imp"
int L;
#line 2635 "test-new/imp918s.imp"
int RFD;
// 2636 %SWITCH RFEL(1:5)
#line 2636 "test-new/imp918s.imp"
int RFEL_index;
#line 2636 "test-new/imp918s.imp"
int RFEL_line;
#line 2636 "test-new/imp918s.imp"
char *RFEL_file;
#line 2636 "test-new/imp918s.imp"
static const void *RFEL[5] = {&&case_RFEL_missing, &&case_RFEL_missing, &&case_RFEL_missing, &&case_RFEL_missing,
&&case_RFEL_missing};
#line 2636 "test-new/imp918s.imp"
auto void SN(int Q);
#line 2636 "test-new/imp918s.imp"
auto void ROUND(void);
// 2637 %ROUTINESPEC SN(%INTEGER Q)
// 2638 %ROUTINESPEC ROUND
// 2639 NLIST=0; OPHEAD=0; FORM=0; ACC=0
#line 2639 "test-new/imp918s.imp"
NLIST = 0;
#line 2639 "test-new/imp918s.imp"
*OPHEAD = 0;
#line 2639 "test-new/imp918s.imp"
FORM = 0;
#line 2639 "test-new/imp918s.imp"
ACC = 0;
// 2640 MRL=0; INC=0; ! INC COUNTS DOWN RECORD
#line 2640 "test-new/imp918s.imp"
MRL = 0;
#line 2640 "test-new/imp918s.imp"
INC = 0;
// 2641 NEXT: ROUT=0; NAM=0; RFD=A(P)
#line 2641 "test-new/imp918s.imp"
U_1029:;
#line 2641 "test-new/imp918s.imp"
ROUT = 0;
#line 2641 "test-new/imp918s.imp"
NAM = 0;
#line 2641 "test-new/imp918s.imp"
RFD = A[P + 7];
// 2642 %IF RFD<=2 %THEN P=P+1 %AND CLT
#line 2642 "test-new/imp918s.imp"
if (RFD > 2) goto L_01F5;
#line 2642 "test-new/imp918s.imp"
P = P + 1;
#line 2642 "test-new/imp918s.imp"
CLT();
#line 2642 "test-new/imp918s.imp"
L_01F5:;
// 2643 ->RFEL(RFD)
#line 2643 "test-new/imp918s.imp"
RFEL_line = __LINE__;
RFEL_file = __FILE__;
RFEL_index = RFD;
goto case_RFEL_dispatch;
// 2644 RFEL(1): ! (TYPE) (QNAME')(NAMELIST)
#line 2644 "test-new/imp918s.imp"
case_RFEL_1:;
// 2645 CQN(P); P=P+1
#line 2645 "test-new/imp918s.imp"
CQN(P);
#line 2645 "test-new/imp918s.imp"
P = P + 1;
// 2646 PACK(PTYPE); D2=0
#line 2646 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
#line 2646 "test-new/imp918s.imp"
D2 = 0;
// 2647 %IF ACC>8 %THEN RL=3 %ELSE RL=ACC-1
#line 2647 "test-new/imp918s.imp"
if (ACC <= 8) goto L_01F7;
#line 2647 "test-new/imp918s.imp"
RL = 3;
#line 2647 "test-new/imp918s.imp"
goto L_01F8;
#line 2647 "test-new/imp918s.imp"
L_01F7:;
#line 2647 "test-new/imp918s.imp"
RL = ACC - 1;
#line 2647 "test-new/imp918s.imp"
L_01F8:;
// 2648 %IF PTYPE=5 %THEN RL=0; ! STRINGS NOT ALIGNED
#line 2648 "test-new/imp918s.imp"
if (PTYPE != 5) goto L_01F9;
#line 2648 "test-new/imp918s.imp"
RL = 0;
#line 2648 "test-new/imp918s.imp"
L_01F9:;
// 2649 Label1: ROUND ; J=0
#line 2649 "test-new/imp918s.imp"
U_102A:;
#line 2649 "test-new/imp918s.imp"
ROUND();
#line 2649 "test-new/imp918s.imp"
J = 0;
// 2650 %CYCLE REP=1,1,A(P)
#line 2650 "test-new/imp918s.imp"
// %for REP = 1, 1, A[P + 7] %cycle
#line 2650 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[P + 7];
#line 2650 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle REP = 1, 1, A[P + 7]");
_control = REP = _initial - _increment;
#line 2650 "test-new/imp918s.imp"
L_01FA:
#line 2650 "test-new/imp918s.imp"
if (REP != _control) _imp_signal(4, 2, 0, "Corrupt control variable REP");
#line 2650 "test-new/imp918s.imp"
if (REP == _final) goto L_01FB;
#line 2650 "test-new/imp918s.imp"
_control += _increment;
REP += _increment;
// 2651 P=P+1; D1=INC
#line 2651 "test-new/imp918s.imp"
P = P + 1;
#line 2651 "test-new/imp918s.imp"
D1 = INC;
// 2652 SN(P); INC=INC+ACC
#line 2652 "test-new/imp918s.imp"
SN(P);
#line 2652 "test-new/imp918s.imp"
INC = INC + ACC;
// 2653 %REPEAT
#line 2653 "test-new/imp918s.imp"
goto L_01FA;
#line 2653 "test-new/imp918s.imp"
}
#line 2653 "test-new/imp918s.imp"
L_01FB:;
// 2654 P=P+1+RFD>>2; ! EXTRA ONE FOR RECORDS TO SKIP FORMAT
#line 2654 "test-new/imp918s.imp"
P = P + 1 + ((unsigned int)RFD >> 2);
// 2655 TRY END: -> END %IF A(P)=2
#line 2655 "test-new/imp918s.imp"
U_102B:;
#line 2655 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_01FD;
#line 2655 "test-new/imp918s.imp"
goto U_102C;
#line 2655 "test-new/imp918s.imp"
L_01FD:;
// 2656 P=P+1; -> NEXT
#line 2656 "test-new/imp918s.imp"
P = P + 1;
#line 2656 "test-new/imp918s.imp"
goto U_1029;
// 2657 RFEL(2):Label2: ! (TYPE)%ARRAY(NAMELIST)(CBPAIR)
#line 2657 "test-new/imp918s.imp"
case_RFEL_2:;
#line 2657 "test-new/imp918s.imp"
U_102D:;
// 2658 Q=P; ARR=1; PACK(PTYPE)
#line 2658 "test-new/imp918s.imp"
Q = P;
#line 2658 "test-new/imp918s.imp"
ARR = 1;
#line 2658 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 2659 %CYCLE; ! UNTIL <RESTOFARRAYLIST> NULL
#line 2659 "test-new/imp918s.imp"
L_01FE:;
// 2660 P=A(P)+P+1; CBPAIR(LB,UB)
#line 2660 "test-new/imp918s.imp"
P = A[P + 7] + P + 1;
#line 2660 "test-new/imp918s.imp"
CBPAIR(/*?*/ &LB, /*?*/ &UB);
// 2661 R=UB-LB+1
#line 2661 "test-new/imp918s.imp"
R = UB - LB + 1;
// 2662 DV=DOPE VECTOR(ACC,LB,UB); ! DOPE VECTOR INTO SHAREABLE S.T.
#line 2662 "test-new/imp918s.imp"
DV = DOPEVECTOR(ACC, LB, UB);
// 2663 %IF TYPE=5 %THEN RL=0 %ELSE RL=ACC-1
#line 2663 "test-new/imp918s.imp"
if (TYPE != 5) goto L_01FF;
#line 2663 "test-new/imp918s.imp"
RL = 0;
#line 2663 "test-new/imp918s.imp"
goto L_0200;
#line 2663 "test-new/imp918s.imp"
L_01FF:;
#line 2663 "test-new/imp918s.imp"
RL = ACC - 1;
#line 2663 "test-new/imp918s.imp"
L_0200:;
// 2664 %IF TYPE=3 %THEN RL=7
#line 2664 "test-new/imp918s.imp"
if (TYPE != 3) goto L_0201;
#line 2664 "test-new/imp918s.imp"
RL = 7;
#line 2664 "test-new/imp918s.imp"
L_0201:;
// 2665 ROUND; J=1
#line 2665 "test-new/imp918s.imp"
ROUND();
#line 2665 "test-new/imp918s.imp"
J = 1;
// 2666 %CYCLE REP=1,1,A(Q); ! ARRAYHEAD INTO GLA FOR EACH AR
#line 2666 "test-new/imp918s.imp"
// %for REP = 1, 1, A[Q + 7] %cycle
#line 2666 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[Q + 7];
#line 2666 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle REP = 1, 1, A[Q + 7]");
_control = REP = _initial - _increment;
#line 2666 "test-new/imp918s.imp"
L_0202:
#line 2666 "test-new/imp918s.imp"
if (REP != _control) _imp_signal(4, 2, 0, "Corrupt control variable REP");
#line 2666 "test-new/imp918s.imp"
if (REP == _final) goto L_0203;
#line 2666 "test-new/imp918s.imp"
_control += _increment;
REP += _increment;
// 2667 A1=INC; A0=A1-ACC*LB
#line 2667 "test-new/imp918s.imp"
A1 = INC;
#line 2667 "test-new/imp918s.imp"
A0 = A1 - ACC * LB;
// 2668 L=ACC
#line 2668 "test-new/imp918s.imp"
L = ACC;
// 2669 PGLA(4,16,ADDR(A0))
#line 2669 "test-new/imp918s.imp"
PGLA(4, 16, _imp_ADDR(/*?*/ &A0));
// 2670 D1=GLACA-16
#line 2670 "test-new/imp918s.imp"
D1 = GLACA - 16;
// 2671 RELOCATE(D1+8,DV,4); ! RELOCATE DV POINTER
#line 2671 "test-new/imp918s.imp"
RELOCATE(D1 + 8, DV, 4);
// 2672 D2=A0
#line 2672 "test-new/imp918s.imp"
D2 = A0;
// 2673 SN(Q+REP); INC=INC+R*ACC
#line 2673 "test-new/imp918s.imp"
SN(Q + REP);
#line 2673 "test-new/imp918s.imp"
INC = INC + R * ACC;
// 2674 %REPEAT
#line 2674 "test-new/imp918s.imp"
goto L_0202;
#line 2674 "test-new/imp918s.imp"
}
#line 2674 "test-new/imp918s.imp"
L_0203:;
// 2675 P=P+1; Q=P
#line 2675 "test-new/imp918s.imp"
P = P + 1;
#line 2675 "test-new/imp918s.imp"
Q = P;
// 2676 %REPEAT %UNTIL A(P-1)=2
#line 2676 "test-new/imp918s.imp"
if (A[P - 1 + 7] == 2) goto L_0204;
#line 2676 "test-new/imp918s.imp"
goto L_01FE;
#line 2676 "test-new/imp918s.imp"
L_0204:;
// 2677 P=P+1 %IF RFD=5
#line 2677 "test-new/imp918s.imp"
if (RFD != 5) goto L_0205;
#line 2677 "test-new/imp918s.imp"
P = P + 1;
#line 2677 "test-new/imp918s.imp"
L_0205:;
// 2678 -> TRY END
#line 2678 "test-new/imp918s.imp"
goto U_102B;
// 2679 RFEL(3): ! %RECORD (%ARRAY) %NAME
#line 2679 "test-new/imp918s.imp"
case_RFEL_3:;
// 2680 TYPE=3; PREC=0; NAM=1
#line 2680 "test-new/imp918s.imp"
TYPE = 3;
#line 2680 "test-new/imp918s.imp"
PREC = 0;
#line 2680 "test-new/imp918s.imp"
NAM = 1;
// 2681 ARR=2-A(P+1); P=P+2
#line 2681 "test-new/imp918s.imp"
ARR = 2 - A[P + 1 + 7];
#line 2681 "test-new/imp918s.imp"
P = P + 2;
// 2682 PACK(PTYPE); D2=0
#line 2682 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
#line 2682 "test-new/imp918s.imp"
D2 = 0;
// 2683 RL=3; ACC=4+12*ARR
#line 2683 "test-new/imp918s.imp"
RL = 3;
#line 2683 "test-new/imp918s.imp"
ACC = 4 + 12 * ARR;
// 2684 FORM=0
#line 2684 "test-new/imp918s.imp"
FORM = 0;
// 2685 ->Label1
#line 2685 "test-new/imp918s.imp"
goto U_102A;
// 2686 RFEL(4): ! RECORDS IN RECORDS
#line 2686 "test-new/imp918s.imp"
case_RFEL_4:;
// 2687 RFEL(5): ! RECORDARRAYS IN RECORDS
#line 2687 "test-new/imp918s.imp"
case_RFEL_5:;
// 2688 Q=P+A(P+1)+6-RFD
#line 2688 "test-new/imp918s.imp"
Q = P + A[P + 1 + 7] + 6 - RFD;
// 2689 COPY TAG(A(Q)); ! COPY FORMAT TAG & SET ACC
#line 2689 "test-new/imp918s.imp"
COPYTAG(A[Q + 7]);
// 2690 FAULT(62,A(Q)) %UNLESS PTYPE=4
#line 2690 "test-new/imp918s.imp"
if (PTYPE == 4) goto L_0206;
#line 2690 "test-new/imp918s.imp"
FAULT(62, A[Q + 7]);
#line 2690 "test-new/imp918s.imp"
L_0206:;
// 2691 TYPE=3; FORM=TCELL
#line 2691 "test-new/imp918s.imp"
TYPE = 3;
#line 2691 "test-new/imp918s.imp"
FORM = TCELL;
// 2692 %IF RFD=4 %THEN %START
#line 2692 "test-new/imp918s.imp"
if (RFD != 4) goto L_0207;
// 2693 PTYPE=3; P=P+1; D2=0
#line 2693 "test-new/imp918s.imp"
PTYPE = 3;
#line 2693 "test-new/imp918s.imp"
P = P + 1;
#line 2693 "test-new/imp918s.imp"
D2 = 0;
// 2694 RL=7; ->Label1
#line 2694 "test-new/imp918s.imp"
RL = 7;
#line 2694 "test-new/imp918s.imp"
goto U_102A;
// 2695 %FINISH
#line 2695 "test-new/imp918s.imp"
L_0207:;
// 2696 P=P+2; ->Label2
#line 2696 "test-new/imp918s.imp"
P = P + 2;
#line 2696 "test-new/imp918s.imp"
goto U_102D;
// 2697 END: ! FINISH OFF
#line 2697 "test-new/imp918s.imp"
U_102C:;
// 2698 RL=MRL; ROUND
#line 2698 "test-new/imp918s.imp"
RL = MRL;
#line 2698 "test-new/imp918s.imp"
ROUND();
// 2699 ACC=INC; ! SIZE ROUNDED APPROPRIATELY
#line 2699 "test-new/imp918s.imp"
ACC = INC;
// 2700 FAULT(98,0) %UNLESS INC<=X'7FFF'
#line 2700 "test-new/imp918s.imp"
if (INC <= 32767) goto L_0208;
#line 2700 "test-new/imp918s.imp"
FAULT(98, 0);
#line 2700 "test-new/imp918s.imp"
L_0208:;
// 2701 OPHEAD=SLIST
#line 2701 "test-new/imp918s.imp"
*OPHEAD = SLIST;
// 2702 CLEAR LIST(NLIST)
#line 2702 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &NLIST);
// 2703 %RETURN
#line 2703 "test-new/imp918s.imp"
return;
// 2704 %ROUTINE SN(%INTEGER Q)
#line 2704 "test-new/imp918s.imp"
void SN(int Q) {
// 2705 !***********************************************************************
// 2706 !* CHECK THE SUBNAME HAS NOT BEEN USED BEFORE IN THIS FORMAT *
// 2707 !* AND ENTER IT WITH ITS DESCRIPTORS INTO THE LIST. *
// 2708 !***********************************************************************
// 2709 FNAME=A(Q)
#line 2709 "test-new/imp918s.imp"
FNAME = A[Q + 7];
// 2710 FAULT(7,FNAME) %UNLESS FIND(FNAME,NLIST)=-1
#line 2710 "test-new/imp918s.imp"
if (FIND(FNAME, NLIST) == -1) goto L_0209;
#line 2710 "test-new/imp918s.imp"
FAULT(7, FNAME);
#line 2710 "test-new/imp918s.imp"
L_0209:;
// 2711 INSERT AFTER(OPHEAD,FNAME<<20!PTYPE<<4!J,D2<<16!ACC)
#line 2711 "test-new/imp918s.imp"
INSERTAFTER(OPHEAD, FNAME << 20 | PTYPE << 4 | J, D2 << 16 | ACC);
// 2712 REPLACE3(OPHEAD,D1<<16!FORM)
#line 2712 "test-new/imp918s.imp"
REPLACE3(*OPHEAD, D1 << 16 | FORM);
// 2713 %IF NLIST=0 %THEN SLIST=OPHEAD
#line 2713 "test-new/imp918s.imp"
if (NLIST != 0) goto L_020A;
#line 2713 "test-new/imp918s.imp"
SLIST = *OPHEAD;
#line 2713 "test-new/imp918s.imp"
L_020A:;
// 2714 PUSH(NLIST,0,FNAME)
#line 2714 "test-new/imp918s.imp"
PUSH(/*?*/ &NLIST, 0, FNAME);
// 2715 %END
#line 2715 "test-new/imp918s.imp"
return;
#line 2715 "test-new/imp918s.imp"
} /* end of SN */
// 2716 %ROUTINE ROUND
#line 2716 "test-new/imp918s.imp"
void ROUND(void) {
// 2717 MRL=RL %IF RL>MRL
#line 2717 "test-new/imp918s.imp"
if (RL <= MRL) goto L_020B;
#line 2717 "test-new/imp918s.imp"
MRL = RL;
#line 2717 "test-new/imp918s.imp"
L_020B:;
// 2718 INC=INC+1 %WHILE INC&RL#0
#line 2718 "test-new/imp918s.imp"
L_020C:;
#line 2718 "test-new/imp918s.imp"
if (INC & RL == 0) goto L_020D;
#line 2718 "test-new/imp918s.imp"
INC = INC + 1;
#line 2718 "test-new/imp918s.imp"
goto L_020C;
#line 2718 "test-new/imp918s.imp"
L_020D:;
// 2719 %END
#line 2719 "test-new/imp918s.imp"
return;
#line 2719 "test-new/imp918s.imp"
} /* end of ROUND */
// 2720 %END; ! OF ROUTINE CRFORMAT
#line 2720 "test-new/imp918s.imp"
return;
#line 2720 "test-new/imp918s.imp"
case_RFEL_dispatch:
#line 2720 "test-new/imp918s.imp"
if (RFEL_index < 1 || RFEL_index > 5)
_imp_signalf(6, 3, RFEL_index, "->RFEL(%d) out of bounds at %s line %d", RFEL_index, RFEL_file, RFEL_line);
#line 2720 "test-new/imp918s.imp"
goto *RFEL[RFEL_index - 1];
#line 2720 "test-new/imp918s.imp"
case_RFEL_missing:
_imp_signalf(8, 2, RFEL_index, "switch jump to undefined label RFEL(%d): at %s line %d", RFEL_index, RFEL_file,
RFEL_line);
#line 2720 "test-new/imp918s.imp"
} /* end of CRFORMAT */
// 2721 %ROUTINE CRNAME(%INTEGER Z,REG,MODE,CLINK,BS,IX,DP)
#line 2721 "test-new/imp918s.imp"
void CRNAME(int Z, int REG, int MODE, int CLINK, int BS, int IX, int DP) {
// 2722 {%SHORTROUTINE}
// 2723 !***********************************************************************
// 2724 !* DEAL WITH RECORD ELEMENT NAMES.Z AS FOR CNAME.CLINK=TAGS(RN) *
// 2725 !* MODE=0 IF RECORD AT BS,IX&DP *
// 2726 !* MODE=1 IF POINTER IN CORE AT BS,IX&DP *
// 2727 !* ON EXIT BASE,INDEX & DISP POINT TO REQUIRED ELEMENT *
// 2728 !* RECURSIVE CALL IS NEEDED TO DEAL WITH RECORDS IN RECORDS *
// 2729 !* DEPTH SHEWS RECURSIVE LEVELS- NEEDED TO AVOID MIS SETTING *
// 2730 !* REGISTER IN USE IF RECORDNAME IN RECORD HAS THE SAME NAME AS *
// 2731 !* A GENUINE RECORD NAME. *
// 2732 !***********************************************************************
// 2733 %INTEGER DEPTH,FNAME,ACCP
#line 2733 "test-new/imp918s.imp"
int DEPTH;
#line 2733 "test-new/imp918s.imp"
int FNAME;
#line 2733 "test-new/imp918s.imp"
int ACCP;
#line 2733 "test-new/imp918s.imp"
auto void CENAME(int MODE, int FNAME, int BS, int IX, int DP);
#line 2733 "test-new/imp918s.imp"
auto void NOAPP(void);
// 2734 %ROUTINESPEC CENAME(%INTEGER MODE,FNAME,BS,IX,DP)
// 2735 %ROUTINESPEC NOAPP
// 2736 DEPTH=0
#line 2736 "test-new/imp918s.imp"
DEPTH = 0;
// 2737 FNAME=KFORM; ! POINTER TO FORMAT
#line 2737 "test-new/imp918s.imp"
FNAME = KFORM;
// 2738 %IF ARR\=0 %THEN %START; ! RECORDARRAY(ARRAYNAME)
#line 2738 "test-new/imp918s.imp"
if (ARR == 0) goto L_020E;
// 2739 FAULT(217,0) %IF IX\=0
#line 2739 "test-new/imp918s.imp"
if (IX == 0) goto L_020F;
#line 2739 "test-new/imp918s.imp"
FAULT(217, 0);
#line 2739 "test-new/imp918s.imp"
L_020F:;
// 2740 CANAME(ARR,BS,DP,SNDISP)
#line 2740 "test-new/imp918s.imp"
CANAME(ARR, BS, DP, SNDISP);
// 2741 NAM=0; ARR=0; ! ARR & NAM AS FOR SCALAR RECORD
#line 2741 "test-new/imp918s.imp"
NAM = 0;
#line 2741 "test-new/imp918s.imp"
ARR = 0;
// 2742 CENAME(0,FNAME,BASE,INDEX,DISP)
#line 2742 "test-new/imp918s.imp"
CENAME(0, FNAME, BASE, INDEX, DISP);
// 2743 %FINISH %ELSE %START
#line 2743 "test-new/imp918s.imp"
goto L_0210;
#line 2743 "test-new/imp918s.imp"
L_020E:;
// 2744 %IF A(P+1)=2 %THEN P=P+2 %ELSE NO APP
#line 2744 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0211;
#line 2744 "test-new/imp918s.imp"
P = P + 2;
#line 2744 "test-new/imp918s.imp"
goto L_0212;
#line 2744 "test-new/imp918s.imp"
L_0211:;
#line 2744 "test-new/imp918s.imp"
NOAPP();
#line 2744 "test-new/imp918s.imp"
L_0212:;
// 2745 CENAME(MODE,FNAME,BS,IX,DP)
#line 2745 "test-new/imp918s.imp"
CENAME(MODE, FNAME, BS, IX, DP);
// 2746 %FINISH; ->Label99
#line 2746 "test-new/imp918s.imp"
L_0210:;
#line 2746 "test-new/imp918s.imp"
goto U_102E;
// 2747 !
// 2748 %ROUTINE NOAPP
#line 2748 "test-new/imp918s.imp"
void NOAPP(void) {
// 2749 P=P+1
#line 2749 "test-new/imp918s.imp"
P = P + 1;
// 2750 %IF A(P)=1 %THEN %START; ! <APP> PRESENT
#line 2750 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_0213;
// 2751 FAULT(19,A(P-1))
#line 2751 "test-new/imp918s.imp"
FAULT(19, A[P - 1 + 7]);
// 2752 SKIP APP
#line 2752 "test-new/imp918s.imp"
SKIPAPP();
// 2753 %FINISH %ELSE P=P+1; ! P NOW POINTS TO ENAME
#line 2753 "test-new/imp918s.imp"
goto L_0214;
#line 2753 "test-new/imp918s.imp"
L_0213:;
#line 2753 "test-new/imp918s.imp"
P = P + 1;
#line 2753 "test-new/imp918s.imp"
L_0214:;
// 2754 %END
#line 2754 "test-new/imp918s.imp"
return;
#line 2754 "test-new/imp918s.imp"
} /* end of NOAPP */
// 2755 %ROUTINE CENAME(%INTEGER MODE,FNAME,BS,IX,DP)
#line 2755 "test-new/imp918s.imp"
void CENAME(int MODE, int FNAME, int BS, int IX, int DP) {
#line 2755 "test-new/imp918s.imp"
auto void CHANGEMODE(void);
#line 2755 "test-new/imp918s.imp"
auto void COMBINE(int HOW);
// 2756 !***********************************************************************
// 2757 !* FINDS OUT ABOUT SUBNAME AND ACTS ACCORDINGLY.MOSTLY ACTION *
// 2758 !* CONSISTS OF UPPING DP BY OFFSET OF THE SUBNAME BUT IS VERY *
// 2759 !* HAIRY FOR RECORDS IN RECORDS ETC *
// 2760 !***********************************************************************
// 2761 %ROUTINESPEC CHANGE MODE
// 2762 %ROUTINESPEC COMBINE(%INTEGER HOW)
// 2763 %INTEGER Q,QQ,D,C
#line 2763 "test-new/imp918s.imp"
int Q;
#line 2763 "test-new/imp918s.imp"
int QQ;
#line 2763 "test-new/imp918s.imp"
int D;
#line 2763 "test-new/imp918s.imp"
int C;
// 2764 DEPTH=DEPTH+1
#line 2764 "test-new/imp918s.imp"
DEPTH = DEPTH + 1;
// 2765 %IF A(P)=2 %THEN %START; ! ENAME MISSING
#line 2765 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_0215;
// 2766 BASE=BS; DISP=DP;INDEX=IX; ! FOR POINTER
#line 2766 "test-new/imp918s.imp"
BASE = BS;
#line 2766 "test-new/imp918s.imp"
DISP = DP;
#line 2766 "test-new/imp918s.imp"
INDEX = IX;
// 2767 %IF Z<14 %THEN %START; ! NOT A RECORD OPERATION
#line 2767 "test-new/imp918s.imp"
if (Z >= 14) goto L_0216;
// 2768 P=P-2
#line 2768 "test-new/imp918s.imp"
P = P - 2;
// 2769 %UNLESS 3<=Z<=4 %OR (Z=1 %AND REG=99) %START;! ADDR(RECORD)
#line 2769 "test-new/imp918s.imp"
{
// Double-sided test on Z (Part I)
#line 2769 "test-new/imp918s.imp"
int tmp;
#line 2769 "test-new/imp918s.imp"
if (3 > (tmp = Z)) goto L_01F0;
// Double-sided test on Z (Part II)
#line 2769 "test-new/imp918s.imp"
if (tmp <= 4) goto L_0217;
#line 2769 "test-new/imp918s.imp"
}
#line 2769 "test-new/imp918s.imp"
L_01F0:;
#line 2769 "test-new/imp918s.imp"
if (Z != 1) goto L_0218;
#line 2769 "test-new/imp918s.imp"
if (REG == 99) goto L_0217;
#line 2769 "test-new/imp918s.imp"
L_0218:;
// 2770 FAULT(64,0); BASE=RBASE
#line 2770 "test-new/imp918s.imp"
FAULT(64, 0);
#line 2770 "test-new/imp918s.imp"
BASE = RBASE;
// 2771 DISP=0; INDEX=0; PTYPE=1;! UNPACK
#line 2771 "test-new/imp918s.imp"
DISP = 0;
#line 2771 "test-new/imp918s.imp"
INDEX = 0;
#line 2771 "test-new/imp918s.imp"
PTYPE = 1;
// 2772 !%if USE MC = 1 %start
// 2773 ! *L_1,PTYPE; *CVD_1,0(11)
// 2774 ! *UNPK_ROUT(5),5(3,11)
// 2775 ! *NC_ROUT(5),MASK1
// 2776 !%finish
// 2777 %FINISH
#line 2777 "test-new/imp918s.imp"
L_0217:;
// 2778 %FINISH
#line 2778 "test-new/imp918s.imp"
L_0216:;
// 2779 %RETURN
#line 2779 "test-new/imp918s.imp"
return;
// 2780 %FINISH
#line 2780 "test-new/imp918s.imp"
L_0215:;
// 2781 P=P+1; ! FIND OUT ABOUT SUBNAME
#line 2781 "test-new/imp918s.imp"
P = P + 1;
// 2782 Q=DISPLACEMENT(FNAME); ! TCELL POINTS TO CELL HOLDING
#line 2782 "test-new/imp918s.imp"
Q = DISPLACEMENT(FNAME);
// 2783 ! UNPACK; ! INFO ABOUT THE SUBNAME
// 2784 !%if USE MC = 1 %start
// 2785 ! *L_1,PTYPE; *CVD_1,0(11)
// 2786 ! *UNPK_ROUT(5),5(3,11)
// 2787 ! *NC_ROUT(5),MASK1
// 2788 !%finish
// 2789 %IF Q=-1=ACC %OR PTYPE=7 %START;! WRONG SUBNAME(HAS BEEN FAULTED)
#line 2789 "test-new/imp918s.imp"
{
// Double-sided test on -1 (Part I)
#line 2789 "test-new/imp918s.imp"
int tmp;
#line 2789 "test-new/imp918s.imp"
if (Q != (tmp = -1)) goto L_0219;
// Double-sided test on -1 (Part II)
#line 2789 "test-new/imp918s.imp"
if (tmp == ACC) goto L_01FC;
#line 2789 "test-new/imp918s.imp"
}
#line 2789 "test-new/imp918s.imp"
L_0219:;
#line 2789 "test-new/imp918s.imp"
if (PTYPE != 7) goto L_021A;
#line 2789 "test-new/imp918s.imp"
L_01FC:;
// 2790 P=P+1; SKIP APP; P=P-2
#line 2790 "test-new/imp918s.imp"
P = P + 1;
#line 2790 "test-new/imp918s.imp"
SKIPAPP();
#line 2790 "test-new/imp918s.imp"
P = P - 2;
// 2791 INDEX=0; BASE=0; DISP=0
#line 2791 "test-new/imp918s.imp"
INDEX = 0;
#line 2791 "test-new/imp918s.imp"
BASE = 0;
#line 2791 "test-new/imp918s.imp"
DISP = 0;
// 2792 %RETURN
#line 2792 "test-new/imp918s.imp"
return;
// 2793 %FINISH
#line 2793 "test-new/imp918s.imp"
L_021A:;
// 2794 ->Label20 %IF ARR=1
#line 2794 "test-new/imp918s.imp"
if (ARR != 1) goto L_021B;
#line 2794 "test-new/imp918s.imp"
goto U_102B;
#line 2794 "test-new/imp918s.imp"
L_021B:;
// 2795 %IF MODE=1 %THEN CHANGE MODE
#line 2795 "test-new/imp918s.imp"
if (MODE != 1) goto L_021C;
#line 2795 "test-new/imp918s.imp"
CHANGEMODE();
#line 2795 "test-new/imp918s.imp"
L_021C:;
// 2796 %IF TYPE<=2 %OR TYPE=5 %THEN %START
#line 2796 "test-new/imp918s.imp"
if (TYPE <= 2) goto L_021D;
#line 2796 "test-new/imp918s.imp"
if (TYPE != 5) goto L_021E;
#line 2796 "test-new/imp918s.imp"
L_021D:;
// 2797 BASE=BS; INDEX=IX; DISP=DP+Q
#line 2797 "test-new/imp918s.imp"
BASE = BS;
#line 2797 "test-new/imp918s.imp"
INDEX = IX;
#line 2797 "test-new/imp918s.imp"
DISP = DP + Q;
// 2798 ->Label99; %FINISH
#line 2798 "test-new/imp918s.imp"
goto U_102C;
#line 2798 "test-new/imp918s.imp"
L_021E:;
// 2799 !
// 2800 ! NOW CODING BECOMES HAIRY:- STILL LEFT ARE
// 2801 ! A) RECORDS IN RECORDS Q POINTS TO SECONDARY RECORD
// 2802 ! B) RECORDNAMES IN RECORDS Q HAS OFF-SET OF A POINTER
// 2803 ! C) RECORDARRAYNAMES IN RECORDS Q HAS OFF-SET A HEADER IN RECORD
// 2804 ! D) RECORDARRAYS IN RECORDS NOT YET ALLOWED
// 2805 ! Q WOULD HAVE OFF-SET OF A RECORD RELATIVE HEADER IN THE GLA
// 2806 !
// 2807 %IF A(P+1)=2 %THEN P=P+2 %ELSE NOAPP
#line 2807 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_021F;
#line 2807 "test-new/imp918s.imp"
P = P + 2;
#line 2807 "test-new/imp918s.imp"
goto L_0220;
#line 2807 "test-new/imp918s.imp"
L_021F:;
#line 2807 "test-new/imp918s.imp"
NOAPP();
#line 2807 "test-new/imp918s.imp"
L_0220:;
// 2808 CENAME(NAM,KFORM,BS,IX,DP+Q)
#line 2808 "test-new/imp918s.imp"
CENAME(NAM, KFORM, BS, IX, DP + Q);
// 2809 ->Label99
#line 2809 "test-new/imp918s.imp"
goto U_102C;
// 2810 Label20: ! ARRAYS AND ARRAYNAMES AS ELEMEN
#line 2810 "test-new/imp918s.imp"
U_102B:;
// 2811 FROM123(TCELL,Q,INTEGER(ADDR(SNDISP)),INTEGER(ADDR(K)))
#line 2811 "test-new/imp918s.imp"
FROM123(TCELL, /*?*/ &Q, _imp_INTEGER(_imp_ADDR(/*?*/ &SNDISP)), _imp_INTEGER(_imp_ADDR(/*?*/ &K)));
// 2812 C=ACC; D=SNDISP; Q=K; QQ=KFORM
#line 2812 "test-new/imp918s.imp"
C = ACC;
#line 2812 "test-new/imp918s.imp"
D = SNDISP;
#line 2812 "test-new/imp918s.imp"
Q = K;
#line 2812 "test-new/imp918s.imp"
QQ = KFORM;
// 2813 %IF Z=12 %AND A(P+1)=2 %START;! 'GET ARRAYHEAD' CALL
#line 2813 "test-new/imp918s.imp"
if (Z != 12) goto L_0221;
#line 2813 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0221;
// 2814 %IF MODE=1 %THEN CHANGE MODE
#line 2814 "test-new/imp918s.imp"
if (MODE != 1) goto L_0222;
#line 2814 "test-new/imp918s.imp"
CHANGEMODE();
#line 2814 "test-new/imp918s.imp"
L_0222:;
// 2815 %IF NAM=1 %THEN %START
#line 2815 "test-new/imp918s.imp"
if (NAM != 1) goto L_0223;
// 2816 COMBINE(0)
#line 2816 "test-new/imp918s.imp"
COMBINE(0);
// 2817 INDEX=0; BASE=BS; DISP=DP+Q
#line 2817 "test-new/imp918s.imp"
INDEX = 0;
#line 2817 "test-new/imp918s.imp"
BASE = BS;
#line 2817 "test-new/imp918s.imp"
DISP = DP + Q;
// 2818 %RETURN
#line 2818 "test-new/imp918s.imp"
return;
// 2819 %FINISH
#line 2819 "test-new/imp918s.imp"
L_0223:;
// 2820 !
// 2821 ! PASSING AN ARRAY IN A RECORD BY NAME MUST CONSTRUCT PROPER ARRAYHEAD
// 2822 ! FROM THE RECORD RELATIVE ONE AT Q(GLA)
// 2823 !
// 2824 COMBINE(1); ! REDUCE TO A SINGLE POINTER
#line 2824 "test-new/imp918s.imp"
COMBINE(1);
// 2825 CREATE AH(1,BS,GLA,Q)
#line 2825 "test-new/imp918s.imp"
CREATEAH(1, BS, 13, Q);
// 2826 REGISTER(BS)=0 %IF REGISTER(BS)=2
#line 2826 "test-new/imp918s.imp"
if (REGISTER[BS] != 2) goto L_0224;
#line 2826 "test-new/imp918s.imp"
REGISTER[BS] = 0;
#line 2826 "test-new/imp918s.imp"
L_0224:;
// 2827 %FINISH %ELSE %START; ! ARRAY ELEMENTS IN RECORDS
#line 2827 "test-new/imp918s.imp"
goto L_0225;
#line 2827 "test-new/imp918s.imp"
L_0221:;
// 2828 %IF NAM=1 %THEN %START; ! ARRAYNAMES-FULLHEAD IN RECORD
#line 2828 "test-new/imp918s.imp"
if (NAM != 1) goto L_0226;
// 2829 %IF MODE=1 %THEN CHANGE MODE
#line 2829 "test-new/imp918s.imp"
if (MODE != 1) goto L_0227;
#line 2829 "test-new/imp918s.imp"
CHANGEMODE();
#line 2829 "test-new/imp918s.imp"
L_0227:;
// 2830 COMBINE(0); ! IN CASE ARRAYNAME IN RECDARRAY
#line 2830 "test-new/imp918s.imp"
COMBINE(0);
// 2831 CANAME(17,BS,DP+Q,0); ! ARRAY MODE SETS DISP,INDEX&BASE
#line 2831 "test-new/imp918s.imp"
CANAME(17, BS, DP + Q, 0);
// 2832 REGISTER(BS)=0 %IF REGISTER(BS)=2
#line 2832 "test-new/imp918s.imp"
if (REGISTER[BS] != 2) goto L_0228;
#line 2832 "test-new/imp918s.imp"
REGISTER[BS] = 0;
#line 2832 "test-new/imp918s.imp"
L_0228:;
// 2833 BML=BS; DML=DP; NAM=0; ! HEAD POSN STRINGS NEED
#line 2833 "test-new/imp918s.imp"
BML = BS;
#line 2833 "test-new/imp918s.imp"
DML = DP;
#line 2833 "test-new/imp918s.imp"
NAM = 0;
// 2834 ! LMAX FROM DOPEVECTOR
// 2835 %FINISH %ELSE %START; ! ARRAY RELATIVE HEAD IN GLA
#line 2835 "test-new/imp918s.imp"
goto L_0229;
#line 2835 "test-new/imp918s.imp"
L_0226:;
// 2836 COMBINE(0); J=1; ! REDUCE TWO POINTERS TO ONE
#line 2836 "test-new/imp918s.imp"
COMBINE(0);
#line 2836 "test-new/imp918s.imp"
J = 1;
// 2837 CANAME(3,GLA,Q,D); ! VECTOR MODE D= BASIC DISP
#line 2837 "test-new/imp918s.imp"
CANAME(3, 13, Q, D);
// 2838 ! SETS INDEX AND DISP ONLY
// 2839 %IF INDEX>0 %THEN REGISTER(INDEX)=REGISTER(INDEX)!1
#line 2839 "test-new/imp918s.imp"
if (INDEX <= 0) goto L_022A;
#line 2839 "test-new/imp918s.imp"
REGISTER[INDEX] = REGISTER[INDEX] | 1;
#line 2839 "test-new/imp918s.imp"
L_022A:;
// 2840 %IF MODE=1 %THEN CHANGE MODE
#line 2840 "test-new/imp918s.imp"
if (MODE != 1) goto L_022B;
#line 2840 "test-new/imp918s.imp"
CHANGEMODE();
#line 2840 "test-new/imp918s.imp"
L_022B:;
// 2841 %IF INDEX>0<=REGISTER(INDEX) %THEN REGISTER(INDEX)=0
#line 2841 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 2841 "test-new/imp918s.imp"
int tmp;
#line 2841 "test-new/imp918s.imp"
if (INDEX <= (tmp = 0)) goto L_022C;
// Double-sided test on 0 (Part II)
#line 2841 "test-new/imp918s.imp"
if (tmp > REGISTER[INDEX]) goto L_022C;
#line 2841 "test-new/imp918s.imp"
}
#line 2841 "test-new/imp918s.imp"
REGISTER[INDEX] = 0;
#line 2841 "test-new/imp918s.imp"
L_022C:;
// 2842 BASE=BS; DISP=DISP+DP
#line 2842 "test-new/imp918s.imp"
BASE = BS;
#line 2842 "test-new/imp918s.imp"
DISP = DISP + DP;
// 2843 BML=-1; DML=C&X'FFFF'-1;! FOR STRING ARRAYS
#line 2843 "test-new/imp918s.imp"
BML = -1;
#line 2843 "test-new/imp918s.imp"
DML = (C & 65535) - 1;
// 2844 ADJUST INDEX(REGISTER(INDEX)+1,INDEX,DISP) %IF DISP<0
#line 2844 "test-new/imp918s.imp"
if (DISP >= 0) goto L_022D;
#line 2844 "test-new/imp918s.imp"
ADJUSTINDEX(REGISTER[INDEX] + 1, /*?*/ &INDEX, /*?*/ &DISP);
#line 2844 "test-new/imp918s.imp"
L_022D:;
// 2845 %FINISH
#line 2845 "test-new/imp918s.imp"
L_0229:;
// 2846 %IF TYPE=3 %THEN CENAME(0,QQ,BASE,INDEX,DISP)
#line 2846 "test-new/imp918s.imp"
if (TYPE != 3) goto L_022E;
#line 2846 "test-new/imp918s.imp"
CENAME(0, QQ, BASE, INDEX, DISP);
#line 2846 "test-new/imp918s.imp"
L_022E:;
// 2847 %FINISH
#line 2847 "test-new/imp918s.imp"
L_0225:;
// 2848 ->Label99
#line 2848 "test-new/imp918s.imp"
goto U_102C;
// 2849 %ROUTINE CHANGE MODE
#line 2849 "test-new/imp918s.imp"
void CHANGEMODE(void) {
// 2850 !***********************************************************************
// 2851 !* CHANGES MODE=1 RECORDS TO MODE=0 RECORDS BY PICKING UP THE *
// 2852 !* POINTER TO SAFE REGISTER AND RESETTING BS,DP AND IX *
// 2853 !***********************************************************************
// 2854 %INTEGER REG
#line 2854 "test-new/imp918s.imp"
int REG;
// 2855 REG=-1
#line 2855 "test-new/imp918s.imp"
REG = -1;
// 2856 %IF DEPTH=1 %THEN FIND USE(REG,1,7,CLINK)
#line 2856 "test-new/imp918s.imp"
if (DEPTH != 1) goto L_022F;
#line 2856 "test-new/imp918s.imp"
FINDUSE(/*?*/ ®, 1, 7, CLINK);
#line 2856 "test-new/imp918s.imp"
L_022F:;
// 2857 %UNLESS REG>0 %AND REGISTER(REG)#1 %START
#line 2857 "test-new/imp918s.imp"
if (REG <= 0) goto L_0230;
#line 2857 "test-new/imp918s.imp"
if (REGISTER[REG] != 1) goto L_0231;
#line 2857 "test-new/imp918s.imp"
L_0230:;
// 2858 FIND REG(ADDREG,REG)
#line 2858 "test-new/imp918s.imp"
FINDREG(-61951, /*?*/ ®);
// 2859 DUMP(X'58',REG,DP,IX,BS); ! L REG POINTER
#line 2859 "test-new/imp918s.imp"
DUMP(88, REG, DP, IX, BS);
// 2860 %IF DEPTH=1 %AND CLINK>0 %THEN SET USE(REG,7,CLINK) %C
#line 2860 "test-new/imp918s.imp"
if (DEPTH != 1) goto L_0232;
#line 2860 "test-new/imp918s.imp"
if (CLINK <= 0) goto L_0232;
#line 2860 "test-new/imp918s.imp"
SETUSE(REG, 7, CLINK);
#line 2860 "test-new/imp918s.imp"
goto L_0233;
#line 2860 "test-new/imp918s.imp"
L_0232:;
#line 2860 "test-new/imp918s.imp"
FORGET(REG);
#line 2860 "test-new/imp918s.imp"
L_0233:;
// 2861+ %ELSE FORGET(REG)
// 2862 %IF REGISTER(BS)=2 %THEN REGISTER(BS)=0
#line 2862 "test-new/imp918s.imp"
if (REGISTER[BS] != 2) goto L_0234;
#line 2862 "test-new/imp918s.imp"
REGISTER[BS] = 0;
#line 2862 "test-new/imp918s.imp"
L_0234:;
// 2863 %FINISH
#line 2863 "test-new/imp918s.imp"
L_0231:;
// 2864 REGISTER(REG)=2 %IF REGISTER(REG)=0
#line 2864 "test-new/imp918s.imp"
if (REGISTER[REG] != 0) goto L_0235;
#line 2864 "test-new/imp918s.imp"
REGISTER[REG] = 2;
#line 2864 "test-new/imp918s.imp"
L_0235:;
// 2865 GRAT(REG)=CA
#line 2865 "test-new/imp918s.imp"
GRAT[REG] = CA;
// 2866 BS=REG;IX=0; MODE=0; DP=0
#line 2866 "test-new/imp918s.imp"
BS = REG;
#line 2866 "test-new/imp918s.imp"
IX = 0;
#line 2866 "test-new/imp918s.imp"
MODE = 0;
#line 2866 "test-new/imp918s.imp"
DP = 0;
// 2867 %END; ! OF CHANGE MODE
#line 2867 "test-new/imp918s.imp"
return;
#line 2867 "test-new/imp918s.imp"
} /* end of CHANGEMODE */
// 2868 %ROUTINE COMBINE(%INTEGER HOW)
#line 2868 "test-new/imp918s.imp"
void COMBINE(int HOW) {
// 2869 !***********************************************************************
// 2870 !* COMBINES IX&BS INTO ONE SAFE REGISTER - IF HOW=1 THEN DP IS *
// 2871 !* INCLUDED ALSO. IF HOW=0 THEN DP IS LEFT ALONE *
// 2872 !***********************************************************************
// 2873 %INTEGER REG
#line 2873 "test-new/imp918s.imp"
int REG;
// 2874 %IF IX=0 %AND (HOW=0 %OR DP=0) %THEN %RETURN
#line 2874 "test-new/imp918s.imp"
if (IX != 0) goto L_0236;
#line 2874 "test-new/imp918s.imp"
if (HOW == 0) goto L_0237;
#line 2874 "test-new/imp918s.imp"
if (DP != 0) goto L_0236;
#line 2874 "test-new/imp918s.imp"
L_0237:;
#line 2874 "test-new/imp918s.imp"
return;
#line 2874 "test-new/imp918s.imp"
L_0236:;
// 2875 %IF 4<=BS<=14 %AND REGISTER(BS)>=0 %THEN REG=BS %ELSE %C
#line 2875 "test-new/imp918s.imp"
{
// Double-sided test on BS (Part I)
#line 2875 "test-new/imp918s.imp"
int tmp;
#line 2875 "test-new/imp918s.imp"
if (4 > (tmp = BS)) goto L_0238;
// Double-sided test on BS (Part II)
#line 2875 "test-new/imp918s.imp"
if (tmp > 14) goto L_0238;
#line 2875 "test-new/imp918s.imp"
}
#line 2875 "test-new/imp918s.imp"
if (REGISTER[BS] < 0) goto L_0238;
#line 2875 "test-new/imp918s.imp"
REG = BS;
#line 2875 "test-new/imp918s.imp"
goto L_0239;
#line 2875 "test-new/imp918s.imp"
L_0238:;
#line 2875 "test-new/imp918s.imp"
FINDREG(-61951, /*?*/ ®);
#line 2875 "test-new/imp918s.imp"
L_0239:;
// 2876+ FIND REG(ADDREG,REG)
// 2877 DUMP(X'41',REG,DP*HOW,IX,BS)
#line 2877 "test-new/imp918s.imp"
DUMP(65, REG, DP * HOW, IX, BS);
// 2878 %IF REGISTER(BS)=2 %THEN REGISTER(BS)=0
#line 2878 "test-new/imp918s.imp"
if (REGISTER[BS] != 2) goto L_023A;
#line 2878 "test-new/imp918s.imp"
REGISTER[BS] = 0;
#line 2878 "test-new/imp918s.imp"
L_023A:;
// 2879 FORGET(REG); IX=0
#line 2879 "test-new/imp918s.imp"
FORGET(REG);
#line 2879 "test-new/imp918s.imp"
IX = 0;
// 2880 BS=REG; REGISTER(BS)=2
#line 2880 "test-new/imp918s.imp"
BS = REG;
#line 2880 "test-new/imp918s.imp"
REGISTER[BS] = 2;
// 2881 %IF HOW=1 %THEN DP=0
#line 2881 "test-new/imp918s.imp"
if (HOW != 1) goto L_023B;
#line 2881 "test-new/imp918s.imp"
DP = 0;
#line 2881 "test-new/imp918s.imp"
L_023B:;
// 2882 %END; ! OF ROUTINE COMBINE
#line 2882 "test-new/imp918s.imp"
return;
#line 2882 "test-new/imp918s.imp"
} /* end of COMBINE */
// 2883 Label99: %END; ! OF ROUTINE CENAME
#line 2883 "test-new/imp918s.imp"
U_102C:;
#line 2883 "test-new/imp918s.imp"
return;
#line 2883 "test-new/imp918s.imp"
} /* end of CENAME */
// 2884 Label99: REGISTER(BASE)=0 %IF REGISTER(BASE)=2
#line 2884 "test-new/imp918s.imp"
U_102E:;
#line 2884 "test-new/imp918s.imp"
if (REGISTER[BASE] != 2) goto L_023C;
#line 2884 "test-new/imp918s.imp"
REGISTER[BASE] = 0;
#line 2884 "test-new/imp918s.imp"
L_023C:;
// 2885 %END;
#line 2885 "test-new/imp918s.imp"
return;
#line 2885 "test-new/imp918s.imp"
} /* end of CRNAME */
// ?ACCP unused
// 2886 ; ! OF ROUTINE CRNAME
#line 2886 "test-new/imp918s.imp"
int DISPLACEMENT(int LINK) {
// 2886 %INTEGERFN DISPLACEMENT(%INTEGER LINK)
// 2887 {%SHORTROUTINE}
// 2888 !***********************************************************************
// 2889 !* SEARCH A FORMAT LIST FOR A SUBNAME *
// 2890 !* A(P) HAS ENAME--LINK IS HEAD OF RFORMAT LIST. RESULT IS DISP *
// 2891 !* FROM START OF RECORD *
// 2892 !***********************************************************************
// 2893 %INTEGER RR,II,ENAME,CELL
#line 2893 "test-new/imp918s.imp"
int RR;
#line 2893 "test-new/imp918s.imp"
int II;
#line 2893 "test-new/imp918s.imp"
int ENAME;
#line 2893 "test-new/imp918s.imp"
int CELL;
// 2894 ENAME=A(P); CELL=0
#line 2894 "test-new/imp918s.imp"
ENAME = A[P + 7];
#line 2894 "test-new/imp918s.imp"
CELL = 0;
// 2895 %IF LINK#0 %THEN %START; ! CHK RECORDSPEC NOT OMITTED
#line 2895 "test-new/imp918s.imp"
if (LINK == 0) goto L_023D;
// 2896 LINK=FROM3(LINK)&X'7FFF'; ! LINK TO SIDE CHAIN
#line 2896 "test-new/imp918s.imp"
LINK = FROM3(LINK) & 32767;
// 2897 CELL=LINK; II=-1; ACC=-1
#line 2897 "test-new/imp918s.imp"
CELL = LINK;
#line 2897 "test-new/imp918s.imp"
II = -1;
#line 2897 "test-new/imp918s.imp"
ACC = -1;
// 2898 ! %WHILE LINK>0 %CYCLE
// 2899 ! FROM123(LINK,RR,INTEGER(ADDR(SNDISP)),INTEGER(ADDR(K)))
// 2900 ! TCELL=LINK
// 2901 ! MLINK(LINK)
// 2902 ! %IF RR>>20=ENAME %THEN %START; ! RIGHT SUBNAME LOCATED
// 2903 ! J=RR&15; PTYPE=RR>>4&X'FFFF'
// 2904 ! %RESULT=K
// 2905 ! %FINISH
// 2906 ! %REPEAT
// 2907 !%if USE MC = 1 %start
// 2908 ! *L_0,ENAME; *L_1,LINK; *L_2,ASLIST
// 2909 !AGN: *LTR_1,1; *BC_12,<END>
// 2910 ! *L_3,0(1,2); *SRL_3,20; *CR_3,0
// 2911 ! *BC_8,<HIT>; *LH_1,14(1,2); *BC_15,<AGN>
// 2912 !HIT: *ST_1,TCELL
// 2913 ! *A_1,ASLIST; *LM_2,4,0(1)
// 2914 ! *ST_2,RR; *ST_3,SNDISP; *ST_4,K
// 2915 !%finish
// 2916 J=RR&15; PTYPE=RR>>4&X'FFFF'
#line 2916 "test-new/imp918s.imp"
J = RR & 15;
#line 2916 "test-new/imp918s.imp"
PTYPE = (unsigned int)RR >> 4 & 65535;
// 2917 %RESULT=K
#line 2917 "test-new/imp918s.imp"
return K;
// 2918 END:
#line 2918 "test-new/imp918s.imp"
U_102F:;
// 2919 %FINISH
#line 2919 "test-new/imp918s.imp"
L_023D:;
// 2920 FAULT(65,ENAME)
#line 2920 "test-new/imp918s.imp"
FAULT(65, ENAME);
// 2921 %IF CELL>0 %THEN %C
#line 2921 "test-new/imp918s.imp"
if (CELL <= 0) goto L_023E;
#line 2921 "test-new/imp918s.imp"
PUSH(_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL + 14])), ENAME << 20 | 7 << 4, 0);
#line 2921 "test-new/imp918s.imp"
L_023E:;
// 2922+ PUSH(SHORT INTEGER(ADDR(ASLIST(CELL+14))),ENAME<<20!7<<4,0)
// 2923 PTYPE=7; TCELL=0
#line 2923 "test-new/imp918s.imp"
PTYPE = 7;
#line 2923 "test-new/imp918s.imp"
TCELL = 0;
// 2924 %RESULT=-1
#line 2924 "test-new/imp918s.imp"
return -1;
// 2925 %END
#line 2925 "test-new/imp918s.imp"
} /* end of DISPLACEMENT */
// ?END unused
// 2926 %INTEGERFN COPY RECORD TAG(%INTEGERNAME SUBS)
#line 2926 "test-new/imp918s.imp"
int COPYRECORDTAG(int *SUBS) {
// 2927 {%SHORTROUTINE}
// 2928 !***********************************************************************
// 2929 !* PRODUCE PTYPE ETC FOR A COMPOUND NAME BY CHAINING DOWN ONE *
// 2930 !* ONE OR MORE RECORD FORMAT LISTS. ON EXIT RESULT =0 IF NO *
// 2931 !* SUBNAME FOUND OR SUBNAME IS OF TYPE RECORD WITH NO FURTHER *
// 2932 !* SUBNAME ATTACHED. RESULT#0 IF BONE-FIDE SUBNAME LOCATED *
// 2933 !* ON ENTRY KFORM HAS POINTER TO THE (FIRST ) FORMAT LIST AND *
// 2934 !* P POINTS TO THE A.R. ENTRY FOR (FIRST) ENAME *
// 2935 !***********************************************************************
// 2936 %INTEGER Q,FNAME
#line 2936 "test-new/imp918s.imp"
int Q;
#line 2936 "test-new/imp918s.imp"
int FNAME;
// 2937 SUBS=0
#line 2937 "test-new/imp918s.imp"
*SUBS = 0;
// 2938 %CYCLE
#line 2938 "test-new/imp918s.imp"
L_023F:;
// 2939 FNAME=KFORM
#line 2939 "test-new/imp918s.imp"
FNAME = KFORM;
// 2940 P=P+1; %IF A(P)=2 %THEN P=P+1 %ELSE SKIP APP
#line 2940 "test-new/imp918s.imp"
P = P + 1;
#line 2940 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_0240;
#line 2940 "test-new/imp918s.imp"
P = P + 1;
#line 2940 "test-new/imp918s.imp"
goto L_0241;
#line 2940 "test-new/imp918s.imp"
L_0240:;
#line 2940 "test-new/imp918s.imp"
SKIPAPP();
#line 2940 "test-new/imp918s.imp"
L_0241:;
// 2941 %RESULT=0 %IF A(P)=2 %OR FNAME<=0;! NO (FURTHER) ENAME
#line 2941 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_01DB;
#line 2941 "test-new/imp918s.imp"
if (FNAME > 0) goto L_0242;
#line 2941 "test-new/imp918s.imp"
L_01DB:;
#line 2941 "test-new/imp918s.imp"
return 0;
#line 2941 "test-new/imp918s.imp"
L_0242:;
// 2942 SUBS=SUBS+1
#line 2942 "test-new/imp918s.imp"
*SUBS = *SUBS + 1;
// 2943 P=P+1; Q=DISPLACEMENT (FNAME)
#line 2943 "test-new/imp918s.imp"
P = P + 1;
#line 2943 "test-new/imp918s.imp"
Q = DISPLACEMENT(FNAME);
// 2944 ! UNPACK
// 2945 !%if USE MC = 1 %start
// 2946 ! *L_1,PTYPE; *CVD_1,0(11)
// 2947 ! *UNPK_ROUT(5),5(3,11)
// 2948 ! *NC_ROUT(5),MASK1
// 2949 !%finish
// 2950 %REPEAT %UNTIL TYPE#3
#line 2950 "test-new/imp918s.imp"
if (TYPE != 3) goto L_0243;
#line 2950 "test-new/imp918s.imp"
goto L_023F;
#line 2950 "test-new/imp918s.imp"
L_0243:;
// 2951 %RESULT=Q+1; ! GIVES 0 IF SUBNAME NOT KNOWN
#line 2951 "test-new/imp918s.imp"
return Q + 1;
// 2952 %END
#line 2952 "test-new/imp918s.imp"
} /* end of COPYRECORDTAG */
// 2953 %ROUTINE STRINGOP(%INTEGER Z,L,BTO,DTO,BFRM,DFRM,BML,DML,XREG)
#line 2953 "test-new/imp918s.imp"
void STRINGOP(int Z, int L, int BTO, int DTO, int BFRM, int DFRM, int BML, int DML, int XREG) {
// 2954 !***********************************************************************
// 2955 !* PERFORM ANY STRING OPERATION WHICH INVOLVES EXECUTING SS *
// 2956 !* INSTRUCTIONS *
// 2957 !* Z=0 FOR CLC *
// 2958 !* Z=1 FOR STORE(=) *
// 2959 !* Z=2 FOR CONCATENATE *
// 2960 !* Z=4 FOR STORE(<-) *
// 2961 !* Z=5 FOR LEXIOGRAPHIC STRING ORDERING *
// 2962 !* STRINGL>0 %IF LENGTH OF STRING KNOWN =0 NOT KNOWN *
// 2963 !* BML & DML DEFINE POSITION OF MAX LENGTH BYTE *
// 2964 !* BML=0 DML=MAX LENGTH IF THIS KNOWN AT COMPILE TIME *
// 2965 !***********************************************************************
// 2966 {%SHORTROUTINE}
// 2967 %INTEGER RSTATE1,RSTATE2,RSTATE3,W,FIXL,CCREG,SCA
#line 2967 "test-new/imp918s.imp"
int RSTATE1;
#line 2967 "test-new/imp918s.imp"
int RSTATE2;
#line 2967 "test-new/imp918s.imp"
int RSTATE3;
#line 2967 "test-new/imp918s.imp"
int W;
#line 2967 "test-new/imp918s.imp"
int FIXL;
#line 2967 "test-new/imp918s.imp"
int CCREG;
#line 2967 "test-new/imp918s.imp"
int SCA;
// 2968 %IF Z=4 %AND BML<=0 %AND DML=255 %THEN Z=1
#line 2968 "test-new/imp918s.imp"
if (Z != 4) goto L_0244;
#line 2968 "test-new/imp918s.imp"
if (BML > 0) goto L_0244;
#line 2968 "test-new/imp918s.imp"
if (DML != 255) goto L_0244;
#line 2968 "test-new/imp918s.imp"
Z = 1;
#line 2968 "test-new/imp918s.imp"
L_0244:;
// 2969 RSTATE1=REGISTER(BTO); REGISTER(BTO)=1
#line 2969 "test-new/imp918s.imp"
RSTATE1 = REGISTER[BTO];
#line 2969 "test-new/imp918s.imp"
REGISTER[BTO] = 1;
// 2970 RSTATE2=REGISTER(BFRM); REGISTER(BFRM)=1
#line 2970 "test-new/imp918s.imp"
RSTATE2 = REGISTER[BFRM];
#line 2970 "test-new/imp918s.imp"
REGISTER[BFRM] = 1;
// 2971 %IF BML>0 %THEN RSTATE3=REGISTER(BML) %AND REGISTER(BML)=1
#line 2971 "test-new/imp918s.imp"
if (BML <= 0) goto L_0245;
#line 2971 "test-new/imp918s.imp"
RSTATE3 = REGISTER[BML];
#line 2971 "test-new/imp918s.imp"
REGISTER[BML] = 1;
#line 2971 "test-new/imp918s.imp"
L_0245:;
// 2972 BML=0 %IF BML<0
#line 2972 "test-new/imp918s.imp"
if (BML >= 0) goto L_0246;
#line 2972 "test-new/imp918s.imp"
BML = 0;
#line 2972 "test-new/imp918s.imp"
L_0246:;
// 2973 PLABEL=PLABEL-1
#line 2973 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
// 2974 %IF Z=5 %THEN %START; ! LEXIOGRAPHIC ORDERING
#line 2974 "test-new/imp918s.imp"
if (Z != 5) goto L_0247;
// 2975 !
// 2976 ! THE CAREFULLY OPTIMISED BUT OBSCURE CODE PLANTED IS:-
// 2977 ! SR XREG,XREG. IC XREG, D2(B2)
// 2978 ! (OR LA XREG,STRLENGTH2 WHEN 2ND OPERAND LENGTH KNOWN)
// 2979 ! CLC D1(1,B1),D2(B2) COMPARE THE LENGTHS
// 2980 ! BALR CCREG,0 SAVE CC FOR LATER & SET BASEREG
// 2981 ! BNH L3 SHORTEST LENGTH IN XREG
// 2982 !LEX CLC D1+1(1,B1),D2+1(B1) FOR EXECUTING BUT QUICKER TO
// 2983 ! OBEY THIS LINE THAN JUMP ROUND IT
// 2984 ! IC XREG,D1(B1) SHORTEST LENGTH TO XREG
// 2985 !L3 LTR XREG,XREG
// 2986 ! BZ L4
// 2987 ! BCTR XREG,0 XREG = LEASTCHARS-1
// 2988 ! EX XREG,LEX
// 2989 ! BC 7,LEND
// 2990 !L4 SPM CCREG RESTORE SAVED CONDITION COD
// 2991 !LEND EQU *
// 2992 !
// 2993 %IF XREG<=0 %THEN CLAIM(GR1,XREG)
#line 2993 "test-new/imp918s.imp"
if (XREG > 0) goto L_0248;
#line 2993 "test-new/imp918s.imp"
CLAIM(65807, /*?*/ &XREG);
#line 2993 "test-new/imp918s.imp"
L_0248:;
// 2994 CLAIM(GR1,CCREG)
#line 2994 "test-new/imp918s.imp"
CLAIM(65807, /*?*/ &CCREG);
// 2995 %IF L<=0 %THEN DUMP(4,XREG,DTO,0,BTO) %ELSE %C
#line 2995 "test-new/imp918s.imp"
if (L > 0) goto L_0249;
#line 2995 "test-new/imp918s.imp"
DUMP(4, XREG, DTO, 0, BTO);
#line 2995 "test-new/imp918s.imp"
goto L_024A;
#line 2995 "test-new/imp918s.imp"
L_0249:;
#line 2995 "test-new/imp918s.imp"
DUMP(0, XREG, L, 0, 0);
#line 2995 "test-new/imp918s.imp"
L_024A:;
// 2996+ DUMP(0,XREG,L,0,0)
// 2997 SET USE(XREG,2,-2); ! REMEMBER TO 24 BITS ZERO
#line 2997 "test-new/imp918s.imp"
SETUSE(XREG, 2, -2);
// 2998 DUMPSS(X'D5',1,BFRM,DFRM,BTO,DTO); ! CLC LENGTHS
#line 2998 "test-new/imp918s.imp"
DUMPSS(213, 1, BFRM, DFRM, BTO, DTO);
// 2999 PRR(5,CCREG,0)
#line 2999 "test-new/imp918s.imp"
PRR(5, CCREG, 0);
// 3000 %IF CA-CODEBASE>4095-MARGIN %THEN SETUSE(CCREG,12,CA) %C
#line 3000 "test-new/imp918s.imp"
if (CA - CODEBASE <= 4095 - MARGIN) goto L_024B;
#line 3000 "test-new/imp918s.imp"
SETUSE(CCREG, 12, CA);
#line 3000 "test-new/imp918s.imp"
goto L_024C;
#line 3000 "test-new/imp918s.imp"
L_024B:;
#line 3000 "test-new/imp918s.imp"
FORGET(CCREG);
#line 3000 "test-new/imp918s.imp"
L_024C:;
// 3001+ %ELSE FORGET(CCREG)
// 3002 SCA=CA
#line 3002 "test-new/imp918s.imp"
SCA = CA;
// 3003 PRX(X'47',11,CCREG,0,0)
#line 3003 "test-new/imp918s.imp"
PRX(71, 11, CCREG, 0, 0);
// 3004 DUMPSS(X'D5',1,BFRM,DFRM+1,BTO,DTO+1)
#line 3004 "test-new/imp918s.imp"
DUMPSS(213, 1, BFRM, DFRM + 1, BTO, DTO + 1);
// 3005 PRX(X'43',XREG,BFRM,0,DFRM)
#line 3005 "test-new/imp918s.imp"
PRX(67, XREG, BFRM, 0, DFRM);
// 3006 PLUG(1,SCA+2,CA-SCA); ! FILL JUMP
#line 3006 "test-new/imp918s.imp"
PLUG(1, SCA + 2, CA - SCA);
// 3007 PRR(X'12',XREG,XREG)
#line 3007 "test-new/imp918s.imp"
PRR(18, XREG, XREG);
// 3008 PRX(X'47',8,CCREG,0,CA+14-SCA)
#line 3008 "test-new/imp918s.imp"
PRX(71, 8, CCREG, 0, CA + 14 - SCA);
// 3009 PRR(6,XREG,0)
#line 3009 "test-new/imp918s.imp"
PRR(6, XREG, 0);
// 3010 PRX(X'44',XREG,CCREG,0,CA-18-SCA)
#line 3010 "test-new/imp918s.imp"
PRX(68, XREG, CCREG, 0, CA - 18 - SCA);
// 3011 PRX(X'47',7,CCREG,0,CA-SCA+6)
#line 3011 "test-new/imp918s.imp"
PRX(71, 7, CCREG, 0, CA - SCA + 6);
// 3012 PRR(4,CCREG,0); ! SPM CCREG
#line 3012 "test-new/imp918s.imp"
PRR(4, CCREG, 0);
// 3013 REGISTER(CCREG)=0
#line 3013 "test-new/imp918s.imp"
REGISTER[CCREG] = 0;
// 3014 %FINISH %ELSE %START
#line 3014 "test-new/imp918s.imp"
goto L_024D;
#line 3014 "test-new/imp918s.imp"
L_0247:;
// 3015 %IF Z=4 %THEN %START; ! JAM TRANSFER NEEDS LMAX
#line 3015 "test-new/imp918s.imp"
if (Z != 4) goto L_024E;
// 3016 %IF BML=0 %THEN W=X'41' %ELSE W=X'43'
#line 3016 "test-new/imp918s.imp"
if (BML != 0) goto L_024F;
#line 3016 "test-new/imp918s.imp"
W = 65;
#line 3016 "test-new/imp918s.imp"
goto L_0250;
#line 3016 "test-new/imp918s.imp"
L_024F:;
#line 3016 "test-new/imp918s.imp"
W = 67;
#line 3016 "test-new/imp918s.imp"
L_0250:;
// 3017 DUMP(W,XREG,DML,0,BML); ! IC %OR LA TO GET LMAX TO XREG
#line 3017 "test-new/imp918s.imp"
DUMP(W, XREG, DML, 0, BML);
// 3018 XREG=NEST; REGISTER(XREG)=1;! CLAIM REGISTER FOR LMAX
#line 3018 "test-new/imp918s.imp"
XREG = NEST;
#line 3018 "test-new/imp918s.imp"
REGISTER[XREG] = 1;
// 3019 SET USE(XREG,2,-2)
#line 3019 "test-new/imp918s.imp"
SETUSE(XREG, 2, -2);
// 3020 %FINISH
#line 3020 "test-new/imp918s.imp"
L_024E:;
// 3021 !
// 3022 ! FOR JAM TRANSFER OR ASSIGN WITH CHECKS A LENGTH COMPARISION IS NEEDED
// 3023 ! THIS CAN BE AVOIDED IF RESULT IS KNOWN AT COMPILE TIME
// 3024 !
// 3025 %IF (Z=4 %OR Z=1=CHECKS)%AND(BML#0 %OR L<=0 %OR L>DML)%START
#line 3025 "test-new/imp918s.imp"
if (Z == 4) goto L_0251;
#line 3025 "test-new/imp918s.imp"
{
// Double-sided test on 1 (Part I)
#line 3025 "test-new/imp918s.imp"
int tmp;
#line 3025 "test-new/imp918s.imp"
if (Z != (tmp = 1)) goto L_0252;
// Double-sided test on 1 (Part II)
#line 3025 "test-new/imp918s.imp"
if (tmp != CHECKS) goto L_0252;
#line 3025 "test-new/imp918s.imp"
}
#line 3025 "test-new/imp918s.imp"
L_0251:;
#line 3025 "test-new/imp918s.imp"
if (BML != 0) goto L_0253;
#line 3025 "test-new/imp918s.imp"
if (L <= 0) goto L_0253;
#line 3025 "test-new/imp918s.imp"
if (L <= DML) goto L_0252;
#line 3025 "test-new/imp918s.imp"
L_0253:;
// 3026 %IF BML#0 %THEN %START; ! MAX LENGTH NOT KNOWN
#line 3026 "test-new/imp918s.imp"
if (BML == 0) goto L_0254;
// 3027 DUMPSS(X'D5',1,BFRM,DFRM,BML,DML);! CLC (LENGTHS)
#line 3027 "test-new/imp918s.imp"
DUMPSS(213, 1, BFRM, DFRM, BML, DML);
// 3028 %FINISH %ELSE PSI(X'95',DML,BFRM,DFRM)
#line 3028 "test-new/imp918s.imp"
goto L_0255;
#line 3028 "test-new/imp918s.imp"
L_0254:;
#line 3028 "test-new/imp918s.imp"
PSI(149, DML, BFRM, DFRM);
#line 3028 "test-new/imp918s.imp"
L_0255:;
// 3029 %IF Z=4 %THEN ENTER JUMP(10,PLABEL,B'11') %ELSE %C
#line 3029 "test-new/imp918s.imp"
if (Z != 4) goto L_0256;
#line 3029 "test-new/imp918s.imp"
ENTERJUMP(10, PLABEL, 3);
#line 3029 "test-new/imp918s.imp"
goto L_0257;
#line 3029 "test-new/imp918s.imp"
L_0256:;
#line 3029 "test-new/imp918s.imp"
PRX(71, 2, 0, 12, 88);
#line 3029 "test-new/imp918s.imp"
L_0257:;
// 3030+ PRX(X'47',2,0,CODER,88); ! BH CAP. EXCEEDED
// 3031 %FINISH
#line 3031 "test-new/imp918s.imp"
L_0252:;
// 3032 !
// 3033 %IF Z=0 %THEN W=X'D5' %ELSE W=X'D2'
#line 3033 "test-new/imp918s.imp"
if (Z != 0) goto L_0258;
#line 3033 "test-new/imp918s.imp"
W = 213;
#line 3033 "test-new/imp918s.imp"
goto L_0259;
#line 3033 "test-new/imp918s.imp"
L_0258:;
#line 3033 "test-new/imp918s.imp"
W = 210;
#line 3033 "test-new/imp918s.imp"
L_0259:;
// 3034 !
// 3035 ! LENGTHS UP TO 15 IT IS QUICKER TO MOVE XTRA CHARS.
// 3036 !
// 3037 %IF Z=1 %AND BML=0 %AND DML<=15 %AND L<=0 %THEN L=DML
#line 3037 "test-new/imp918s.imp"
if (Z != 1) goto L_025A;
#line 3037 "test-new/imp918s.imp"
if (BML != 0) goto L_025A;
#line 3037 "test-new/imp918s.imp"
if (DML > 15) goto L_025A;
#line 3037 "test-new/imp918s.imp"
if (L > 0) goto L_025A;
#line 3037 "test-new/imp918s.imp"
L = DML;
#line 3037 "test-new/imp918s.imp"
L_025A:;
// 3038 !
// 3039 ! IF THE LENGTH IS KNOWN AT COMPILE TIME THEN CODE CAN BE PLANTED TO
// 3040 ! PERFORM THE OPERATION. IF LENGTH NOT KNOWN UNTIL RUN TIME THEN AN
// 3041 ! INSTRUCTION WITH ZERO LENGTH HAS TO BE SET AND CODE PLANTED
// 3042 ! TO EXECUTE THE INSTRUCTION AT RUN TIME. EXECUTE ORS THE LENGTH INTO
// 3043 ! THE INSTRUCTION BEFORE OBEYING IT.
// 3044 !
// 3045 %IF L>0 %AND Z#4 %THEN FIXL=L+1 %ELSE %START;! EXECUTE NEEDED
#line 3045 "test-new/imp918s.imp"
if (L <= 0) goto L_025B;
#line 3045 "test-new/imp918s.imp"
if (Z == 4) goto L_025B;
#line 3045 "test-new/imp918s.imp"
FIXL = L + 1;
#line 3045 "test-new/imp918s.imp"
goto L_025C;
#line 3045 "test-new/imp918s.imp"
L_025B:;
// 3046 FIXL=0
#line 3046 "test-new/imp918s.imp"
FIXL = 0;
// 3047 %UNLESS DFRM<0 %OR DFRM>4095 %OR Z=2 %THEN %START
#line 3047 "test-new/imp918s.imp"
if (DFRM < 0) goto L_025D;
#line 3047 "test-new/imp918s.imp"
if (DFRM > 4095) goto L_025D;
#line 3047 "test-new/imp918s.imp"
if (Z == 2) goto L_025D;
// 3048 %IF XREG<0 %THEN FINDREG(GR1,XREG) %AND FORGET(XREG)
#line 3048 "test-new/imp918s.imp"
if (XREG >= 0) goto L_025E;
#line 3048 "test-new/imp918s.imp"
FINDREG(65807, /*?*/ &XREG);
#line 3048 "test-new/imp918s.imp"
FORGET(XREG);
#line 3048 "test-new/imp918s.imp"
L_025E:;
// 3049 PRX(X'43',XREG,0,BFRM,DFRM) %UNLESS GRUSE(XREG)=13
#line 3049 "test-new/imp918s.imp"
if (GRUSE[XREG] == 13) goto L_025F;
#line 3049 "test-new/imp918s.imp"
PRX(67, XREG, 0, BFRM, DFRM);
#line 3049 "test-new/imp918s.imp"
L_025F:;
// 3050 %FINISH %ELSE %START
#line 3050 "test-new/imp918s.imp"
goto L_0260;
#line 3050 "test-new/imp918s.imp"
L_025D:;
// 3051 DUMP(X'43',XREG,DFRM,0,BFRM)
#line 3051 "test-new/imp918s.imp"
DUMP(67, XREG, DFRM, 0, BFRM);
// 3052 XREG=NEST %IF XREG<0
#line 3052 "test-new/imp918s.imp"
if (XREG >= 0) goto L_0261;
#line 3052 "test-new/imp918s.imp"
XREG = NEST;
#line 3052 "test-new/imp918s.imp"
L_0261:;
// 3053 SET USE(XREG,2,-2)
#line 3053 "test-new/imp918s.imp"
SETUSE(XREG, 2, -2);
// 3054 %FINISH
#line 3054 "test-new/imp918s.imp"
L_0260:;
// 3055 REGISTER(XREG)=1
#line 3055 "test-new/imp918s.imp"
REGISTER[XREG] = 1;
// 3056 ENTER LAB(PLABEL,B'11') %IF Z=4
#line 3056 "test-new/imp918s.imp"
if (Z != 4) goto L_0262;
#line 3056 "test-new/imp918s.imp"
ENTERLAB(PLABEL, 3);
#line 3056 "test-new/imp918s.imp"
L_0262:;
// 3057 SET LOCAL BASE
#line 3057 "test-new/imp918s.imp"
SETLOCALBASE();
// 3058 %FINISH
#line 3058 "test-new/imp918s.imp"
L_025C:;
// 3059 %IF Z=2 %THEN DFRM=DFRM+1
#line 3059 "test-new/imp918s.imp"
if (Z != 2) goto L_0263;
#line 3059 "test-new/imp918s.imp"
DFRM = DFRM + 1;
#line 3059 "test-new/imp918s.imp"
L_0263:;
// 3060 DUMPSS(W,FIXL,BTO,DTO,BFRM,DFRM)
#line 3060 "test-new/imp918s.imp"
DUMPSS(W, FIXL, BTO, DTO, BFRM, DFRM);
// 3061 %IF FIXL=0 %THEN %START
#line 3061 "test-new/imp918s.imp"
if (FIXL != 0) goto L_0264;
// 3062 DUMP(X'44',XREG,CA-LOCALADDR-6,0,LOCALBASE);! EXECUTE IT
#line 3062 "test-new/imp918s.imp"
DUMP(68, XREG, CA - LOCALADDR - 6, 0, LOCALBASE);
// 3063 DUMP(X'42',XREG,DTO,0,BTO) %IF Z=4;! STC LENGTH BYTE IF <-
#line 3063 "test-new/imp918s.imp"
if (Z != 4) goto L_0265;
#line 3063 "test-new/imp918s.imp"
DUMP(66, XREG, DTO, 0, BTO);
#line 3063 "test-new/imp918s.imp"
L_0265:;
// 3064 %FINISH
#line 3064 "test-new/imp918s.imp"
L_0264:;
// 3065 %FINISH
#line 3065 "test-new/imp918s.imp"
L_024D:;
// 3066 %IF XREG>0 %THEN REGISTER(XREG)=0
#line 3066 "test-new/imp918s.imp"
if (XREG <= 0) goto L_0266;
#line 3066 "test-new/imp918s.imp"
REGISTER[XREG] = 0;
#line 3066 "test-new/imp918s.imp"
L_0266:;
// 3067 NEST=XREG
#line 3067 "test-new/imp918s.imp"
NEST = XREG;
// 3068 %IF BML>0 %THEN REGISTER(BML)=RSTATE3
#line 3068 "test-new/imp918s.imp"
if (BML <= 0) goto L_0267;
#line 3068 "test-new/imp918s.imp"
REGISTER[BML] = RSTATE3;
#line 3068 "test-new/imp918s.imp"
L_0267:;
// 3069 REGISTER(BFRM)=RSTATE2; ! ORDER OF THESE 3 LINES
#line 3069 "test-new/imp918s.imp"
REGISTER[BFRM] = RSTATE2;
// 3070 REGISTER(BTO)=RSTATE1; ! IMPORTANT IF BTO=BFRM!
#line 3070 "test-new/imp918s.imp"
REGISTER[BTO] = RSTATE1;
// 3071 CCSTATE=-1
#line 3071 "test-new/imp918s.imp"
CCSTATE = -1;
// 3072 %END
#line 3072 "test-new/imp918s.imp"
return;
#line 3072 "test-new/imp918s.imp"
} /* end of STRINGOP */
// 3073 %ROUTINE CSTREXP(%INTEGER MODE,REG)
#line 3073 "test-new/imp918s.imp"
void CSTREXP(int MODE, int REG) {
// 3074 {%SHORTROUTINE}
// 3075 !***********************************************************************
// 3076 !* PLANT IN-LINE CODE FOR CONCATENATION. A WORK AREA UNDER *
// 3077 !* BASE REGISTER COVER IS USUALLY REQUIRED. THE CURRENT LENGTH *
// 3078 !* OF STRING IN THE WORK AREA IS KEPT IN A REGISTER (LENREG) *
// 3079 !* WHICH IS PROTECTED THROUGH THE NORMAL INTERMEDIATE-RESULT *
// 3080 !* MECHANISMS. *
// 3081 !* ON ENTRY:- *
// 3082 !* REG > 0 %IF A REGISTER IS TO BE LEFT POINTING AT THE RESULT *
// 3083 !* MODE=0 NORMAL. REG IF GIVEN ONLY USED IF NO WK AREA NEEDED *
// 3084 !* MODE=1 AS MODE =0 BUT REG MUST BE SET AS POINTER *
// 3085 !* (AND TO COME) *
// 3086 !* MODE=3 CONCATENATE INTO LHS OF =ASSNMNT (E.G. A=B.C) *
// 3087 !* MODE=4 OPTIMISE S=S.T BY NOT COPYING S *
// 3088 !* 2**4 BIT OF MODE IS SET IF WK-AREA NOT TO BE FREED ON EXIT *
// 3089 !* ON EXIT:- *
// 3090 !* BASE,DISP & INDEX DEFINE RESULT *
// 3091 !* VALUE=1 %IF RESULT IN A WORK AREA(CCOND MUST KNOW) *
// 3092 !* STRINGL SET IF STRING LENGTH KNOWN. NEST DEFINES LENREG *
// 3093 !***********************************************************************
// 3094 %INTEGER PP,WKBASE,WKAREA,LENREG,REXP,ERR,CLEN,KEEPWA
#line 3094 "test-new/imp918s.imp"
int PP;
#line 3094 "test-new/imp918s.imp"
int WKBASE;
#line 3094 "test-new/imp918s.imp"
int WKAREA;
#line 3094 "test-new/imp918s.imp"
int LENREG;
#line 3094 "test-new/imp918s.imp"
int REXP;
#line 3094 "test-new/imp918s.imp"
int ERR;
#line 3094 "test-new/imp918s.imp"
int CLEN;
#line 3094 "test-new/imp918s.imp"
int KEEPWA;
// 3095 %SHORTINTEGER SHEAD
#line 3095 "test-new/imp918s.imp"
short int SHEAD;
// 3096 %RECORD(RD)%NAME OP
#line 3096 "test-new/imp918s.imp"
struct RD *OP;
#line 3096 "test-new/imp918s.imp"
auto int STROP(int REG);
// 3097 %INTEGERFNSPEC STROP(%INTEGER REG)
// 3098 LENREG=0; SHEAD=0
#line 3098 "test-new/imp918s.imp"
LENREG = 0;
#line 3098 "test-new/imp918s.imp"
SHEAD = 0;
// 3099 KEEPWA=MODE&16; MODE=MODE&15
#line 3099 "test-new/imp918s.imp"
KEEPWA = MODE & 16;
#line 3099 "test-new/imp918s.imp"
MODE = MODE & 15;
// 3100 PP=P; STRINGL=0
#line 3100 "test-new/imp918s.imp"
PP = P;
#line 3100 "test-new/imp918s.imp"
STRINGL = 0;
// 3101 REXP=2-A(P+1+A(P+1)); ! =0 %IF ONE OPERAND EXP
#line 3101 "test-new/imp918s.imp"
REXP = 2 - A[P + 1 + A[P + 1 + 7] + 7];
// 3102 -> NORMAL %UNLESS A(P+2)=4 %AND REXP=0 %AND MODE<=1
#line 3102 "test-new/imp918s.imp"
if (A[P + 2 + 7] != 4) goto L_0268;
#line 3102 "test-new/imp918s.imp"
if (REXP != 0) goto L_0268;
#line 3102 "test-new/imp918s.imp"
if (MODE <= 1) goto L_0269;
#line 3102 "test-new/imp918s.imp"
L_0268:;
#line 3102 "test-new/imp918s.imp"
goto U_1030;
#line 3102 "test-new/imp918s.imp"
L_0269:;
// 3103 -> SIMPLE %IF A(P+3)=2
#line 3103 "test-new/imp918s.imp"
if (A[P + 3 + 7] != 2) goto L_026A;
#line 3103 "test-new/imp918s.imp"
goto U_1031;
#line 3103 "test-new/imp918s.imp"
L_026A:;
// 3104 -> NORMAL %UNLESS A(P+3)=1
#line 3104 "test-new/imp918s.imp"
if (A[P + 3 + 7] == 1) goto L_026B;
#line 3104 "test-new/imp918s.imp"
goto U_1030;
#line 3104 "test-new/imp918s.imp"
L_026B:;
// 3105 COPY TAG(A(P+4))
#line 3105 "test-new/imp918s.imp"
COPYTAG(A[P + 4 + 7]);
// 3106 %IF PTYPE=SNPT %THEN PTYPE=TSNAME(K) %AND UNPACK
#line 3106 "test-new/imp918s.imp"
if (PTYPE != 10006) goto L_026C;
#line 3106 "test-new/imp918s.imp"
PTYPE = TSNAME[K];
#line 3106 "test-new/imp918s.imp"
UNPACK();
#line 3106 "test-new/imp918s.imp"
L_026C:;
// 3107 -> NORMAL %IF ROUT#0 ; ! BEWARE OF MAP=FN
#line 3107 "test-new/imp918s.imp"
if (ROUT == 0) goto L_026D;
#line 3107 "test-new/imp918s.imp"
goto U_1030;
#line 3107 "test-new/imp918s.imp"
L_026D:;
// 3108 -> NORMAL %IF CHECKS=1 %AND(ARR#0 %OR A(P+5)=1)
#line 3108 "test-new/imp918s.imp"
if (CHECKS != 1) goto L_026E;
#line 3108 "test-new/imp918s.imp"
if (ARR != 0) goto L_026F;
#line 3108 "test-new/imp918s.imp"
if (A[P + 5 + 7] != 1) goto L_026E;
#line 3108 "test-new/imp918s.imp"
L_026F:;
#line 3108 "test-new/imp918s.imp"
goto U_1030;
#line 3108 "test-new/imp918s.imp"
L_026E:;
// 3109 SIMPLE: P=P+3
#line 3109 "test-new/imp918s.imp"
U_1031:;
#line 3109 "test-new/imp918s.imp"
P = P + 3;
// 3110 %IF MODE=0 %THEN REG=-2
#line 3110 "test-new/imp918s.imp"
if (MODE != 0) goto L_0270;
#line 3110 "test-new/imp918s.imp"
REG = -2;
#line 3110 "test-new/imp918s.imp"
L_0270:;
// 3111 ERR=STROP(REG)
#line 3111 "test-new/imp918s.imp"
ERR = STROP(REG);
// 3112 -> ERROR %UNLESS ERR=0
#line 3112 "test-new/imp918s.imp"
if (ERR == 0) goto L_0271;
#line 3112 "test-new/imp918s.imp"
goto U_1032;
#line 3112 "test-new/imp918s.imp"
L_0271:;
// 3113 VALUE=0
#line 3113 "test-new/imp918s.imp"
VALUE = 0;
// 3114 P=P+1; NEST=0; ->Label99
#line 3114 "test-new/imp918s.imp"
P = P + 1;
#line 3114 "test-new/imp918s.imp"
NEST = 0;
#line 3114 "test-new/imp918s.imp"
goto U_101D;
// 3115 ERROR: FAULT(ERR,0)
#line 3115 "test-new/imp918s.imp"
U_1032:;
#line 3115 "test-new/imp918s.imp"
FAULT(ERR, 0);
// 3116 REGISTER(LENREG)=0
#line 3116 "test-new/imp918s.imp"
REGISTER[LENREG] = 0;
// 3117 BASE=11; DISP=0
#line 3117 "test-new/imp918s.imp"
BASE = 11;
#line 3117 "test-new/imp918s.imp"
DISP = 0;
// 3118 VALUE=0
#line 3118 "test-new/imp918s.imp"
VALUE = 0;
// 3119 P=PP; SKIP EXP
#line 3119 "test-new/imp918s.imp"
P = PP;
#line 3119 "test-new/imp918s.imp"
SKIPEXP();
// 3120 ->Label99
#line 3120 "test-new/imp918s.imp"
goto U_101D;
// 3121 NORMAL: PUSH(SHEAD,1<<16!9,-2)
#line 3121 "test-new/imp918s.imp"
U_1030:;
#line 3121 "test-new/imp918s.imp"
PUSH(/*?*/ &SHEAD, 1 << 16 | 9, -2);
// 3122 OP==RECORD(ADDR(ASLIST(SHEAD)));!RESULT DESCRIPTOR FOR LENREG
#line 3122 "test-new/imp918s.imp"
OP = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[SHEAD]));
// 3123 CLEN=0; P=P+3; ! LENGTH OF CONSTANT PART
#line 3123 "test-new/imp918s.imp"
CLEN = 0;
#line 3123 "test-new/imp918s.imp"
P = P + 3;
// 3124 WKBASE=RBASE
#line 3124 "test-new/imp918s.imp"
WKBASE = RBASE;
// 3125 GET WSP(WKAREA,256); ! GET NEXT OPERAND
#line 3125 "test-new/imp918s.imp"
GETWSP(/*?*/ &WKAREA, 256);
// 3126 NEXT: STRINGL=0
#line 3126 "test-new/imp918s.imp"
U_101E:;
#line 3126 "test-new/imp918s.imp"
STRINGL = 0;
// 3127 ERR=STROP(-2); ! GET NEXT OPERAND
#line 3127 "test-new/imp918s.imp"
ERR = STROP(-2);
// 3128 -> ERROR %UNLESS ERR=0
#line 3128 "test-new/imp918s.imp"
if (ERR == 0) goto L_0272;
#line 3128 "test-new/imp918s.imp"
goto U_1032;
#line 3128 "test-new/imp918s.imp"
L_0272:;
// 3129 REGISTER(BASE)=2 %IF REGISTER(BASE)=0
#line 3129 "test-new/imp918s.imp"
if (REGISTER[BASE] != 0) goto L_0273;
#line 3129 "test-new/imp918s.imp"
REGISTER[BASE] = 2;
#line 3129 "test-new/imp918s.imp"
L_0273:;
// 3130 %IF LENREG>0 %THEN %START
#line 3130 "test-new/imp918s.imp"
if (LENREG <= 0) goto L_0274;
// 3131 %IF OP_D>0 %THEN %START; ! LENREG STORED BY RT CALL
#line 3131 "test-new/imp918s.imp"
if (OP->D <= 0) goto L_0275;
// 3132 DUMP(2,-2,OP_D,0,OP_XB);! SO RELOAD IT
#line 3132 "test-new/imp918s.imp"
DUMP(2, -2, OP->D, 0, OP->XB);
// 3133 LENREG=NEST
#line 3133 "test-new/imp918s.imp"
LENREG = NEST;
// 3134 OP_XB=LENREG;OP_D=-2; ! AND RESET DESCRIPTOR
#line 3134 "test-new/imp918s.imp"
OP->XB = LENREG;
#line 3134 "test-new/imp918s.imp"
OP->D = -2;
// 3135 REGISTER(LENREG)=1
#line 3135 "test-new/imp918s.imp"
REGISTER[LENREG] = 1;
// 3136 SET USE(LENREG,1,ADDR(ASLIST(SHEAD)))
#line 3136 "test-new/imp918s.imp"
SETUSE(LENREG, 1, _imp_ADDR(/*?*/ &ASLIST[SHEAD]));
// 3137 %FINISH
#line 3137 "test-new/imp918s.imp"
L_0275:;
// 3138 DUMP(0,-2,0,RBASE,LENREG); ! LA O(RBASE,LENREG)
#line 3138 "test-new/imp918s.imp"
DUMP(0, -2, 0, RBASE, LENREG);
// 3139 WKBASE=NEST; FORGET(WKBASE)
#line 3139 "test-new/imp918s.imp"
WKBASE = NEST;
#line 3139 "test-new/imp918s.imp"
FORGET(WKBASE);
// 3140 %FINISH
#line 3140 "test-new/imp918s.imp"
L_0274:;
// 3141 REGISTER(BASE)=0 %IF REGISTER(BASE)=2
#line 3141 "test-new/imp918s.imp"
if (REGISTER[BASE] != 2) goto L_0276;
#line 3141 "test-new/imp918s.imp"
REGISTER[BASE] = 0;
#line 3141 "test-new/imp918s.imp"
L_0276:;
// 3142 STRINGOP(2,STRINGL,WKBASE,WKAREA+CLEN+1,BASE,DISP,-1,255,-2)
#line 3142 "test-new/imp918s.imp"
STRINGOP(2, STRINGL, WKBASE, WKAREA + CLEN + 1, BASE, DISP, -1, 255, -2);
// 3143 !
// 3144 ! STRINGOP MOVES STRING INTO WORK AREA. IF LENGTH UNKNOWN THEN NEST
// 3145 ! IS SET TO THE REGISTER CONTAINING THE LENGTH OF THE STRING
// 3146 !
// 3147 %IF LENREG>0 %THEN %START; ! REGISTER SET UP
#line 3147 "test-new/imp918s.imp"
if (LENREG <= 0) goto L_0277;
// 3148 %IF STRINGL>0 %THEN %START;! DESCRIPTOR WAS A CONSTANT
#line 3148 "test-new/imp918s.imp"
if (STRINGL <= 0) goto L_0278;
// 3149 PRX(X'41',LENREG,LENREG,0,STRINGL);! LA LENREG,STRING(LENREG)
#line 3149 "test-new/imp918s.imp"
PRX(65, LENREG, LENREG, 0, STRINGL);
// 3150 %FINISH %ELSE %START
#line 3150 "test-new/imp918s.imp"
goto L_0279;
#line 3150 "test-new/imp918s.imp"
L_0278:;
// 3151 PRR(X'1A',LENREG,NEST); ! AR LENREG,NEST
#line 3151 "test-new/imp918s.imp"
PRR(26, LENREG, NEST);
// 3152 %FINISH
#line 3152 "test-new/imp918s.imp"
L_0279:;
// 3153 %FINISH %ELSE %START; ! NOW SET LENREG
#line 3153 "test-new/imp918s.imp"
goto L_027A;
#line 3153 "test-new/imp918s.imp"
L_0277:;
// 3154 %IF STRINGL=0 %THEN %START
#line 3154 "test-new/imp918s.imp"
if (STRINGL != 0) goto L_027B;
// 3155 LENREG=NEST; ! USE ONE SET BY STRINGOP
#line 3155 "test-new/imp918s.imp"
LENREG = NEST;
// 3156 REGISTER(LENREG)=1; ! CLAIM IT
#line 3156 "test-new/imp918s.imp"
REGISTER[LENREG] = 1;
// 3157 SET USE(LENREG,1,ADDR(ASLIST(SHEAD)));! PROTECT IT
#line 3157 "test-new/imp918s.imp"
SETUSE(LENREG, 1, _imp_ADDR(/*?*/ &ASLIST[SHEAD]));
// 3158 OP_XB=LENREG; ! AND UPDATE RESULT DESCRIPTOR
#line 3158 "test-new/imp918s.imp"
OP->XB = LENREG;
// 3159 PRX(X'41',LENREG,LENREG,0,CLEN) %UNLESS CLEN=0
#line 3159 "test-new/imp918s.imp"
if (CLEN == 0) goto L_027C;
#line 3159 "test-new/imp918s.imp"
PRX(65, LENREG, LENREG, 0, CLEN);
#line 3159 "test-new/imp918s.imp"
L_027C:;
// 3160 CLEN=0
#line 3160 "test-new/imp918s.imp"
CLEN = 0;
// 3161 %FINISH %ELSE CLEN=CLEN+STRINGL
#line 3161 "test-new/imp918s.imp"
goto L_027D;
#line 3161 "test-new/imp918s.imp"
L_027B:;
#line 3161 "test-new/imp918s.imp"
CLEN = CLEN + STRINGL;
#line 3161 "test-new/imp918s.imp"
L_027D:;
// 3162 %FINISH
#line 3162 "test-new/imp918s.imp"
L_027A:;
// 3163 %IF A(P)=2 %THEN -> TIDY; ! NO MORE OPERATIONS
#line 3163 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_027E;
#line 3163 "test-new/imp918s.imp"
goto U_101F;
#line 3163 "test-new/imp918s.imp"
L_027E:;
// 3164 ERR=72; -> ERROR %UNLESS A(P+1)=12; ! CONCATENATE
#line 3164 "test-new/imp918s.imp"
ERR = 72;
#line 3164 "test-new/imp918s.imp"
if (A[P + 1 + 7] == 12) goto L_027F;
#line 3164 "test-new/imp918s.imp"
goto U_1032;
#line 3164 "test-new/imp918s.imp"
L_027F:;
// 3165 P=P+2; -> NEXT
#line 3165 "test-new/imp918s.imp"
P = P + 2;
#line 3165 "test-new/imp918s.imp"
goto U_101E;
// 3166 TIDY: ! FINISH OFF
#line 3166 "test-new/imp918s.imp"
U_101F:;
// 3167 VALUE=WKAREA
#line 3167 "test-new/imp918s.imp"
VALUE = WKAREA;
// 3168 %IF LENREG=0 %THEN %START
#line 3168 "test-new/imp918s.imp"
if (LENREG != 0) goto L_0280;
// 3169 DUMPSI(X'92',CLEN,RBASE,WKAREA); ! MAX LENGTH KNOWN
#line 3169 "test-new/imp918s.imp"
DUMPSI(146, CLEN, RBASE, WKAREA);
// 3170 STRINGL=CLEN; NEST=0
#line 3170 "test-new/imp918s.imp"
STRINGL = CLEN;
#line 3170 "test-new/imp918s.imp"
NEST = 0;
// 3171 %FINISH %ELSE %START
#line 3171 "test-new/imp918s.imp"
goto L_0281;
#line 3171 "test-new/imp918s.imp"
L_0280:;
// 3172 DUMP(X'42',LENREG,WKAREA,0,RBASE); ! MAX LENGTH NOT KNOWN
#line 3172 "test-new/imp918s.imp"
DUMP(66, LENREG, WKAREA, 0, RBASE);
// 3173 PREC=1; TYPE=1; ! FOR CHECK CAPACITY
#line 3173 "test-new/imp918s.imp"
PREC = 1;
#line 3173 "test-new/imp918s.imp"
TYPE = 1;
// 3174 %IF CHECKSP=1 %THEN CHECK CAPACITY(LENREG,WKAREA,0,RBASE)
#line 3174 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_0282;
#line 3174 "test-new/imp918s.imp"
CHECKCAPACITY(LENREG, WKAREA, 0, RBASE);
#line 3174 "test-new/imp918s.imp"
L_0282:;
// 3175 REGISTER(LENREG)=0; ! FREE THE REGISTER
#line 3175 "test-new/imp918s.imp"
REGISTER[LENREG] = 0;
// 3176 STRINGL=0; ! LENGTH UNKNOWN
#line 3176 "test-new/imp918s.imp"
STRINGL = 0;
// 3177 %FINISH
#line 3177 "test-new/imp918s.imp"
L_0281:;
// 3178 P=P+1; ! PAST REST OF EXPRN
#line 3178 "test-new/imp918s.imp"
P = P + 1;
// 3179 RETURN WSP(WKAREA,256) %IF KEEPWA=0
#line 3179 "test-new/imp918s.imp"
if (KEEPWA != 0) goto L_0283;
#line 3179 "test-new/imp918s.imp"
RETURNWSP(WKAREA, 256);
#line 3179 "test-new/imp918s.imp"
L_0283:;
// 3180 %IF MODE=0 %THEN %START
#line 3180 "test-new/imp918s.imp"
if (MODE != 0) goto L_0284;
// 3181 BASE=RBASE; DISP=WKAREA
#line 3181 "test-new/imp918s.imp"
BASE = RBASE;
#line 3181 "test-new/imp918s.imp"
DISP = WKAREA;
// 3182 %FINISH %ELSE %START
#line 3182 "test-new/imp918s.imp"
goto L_0285;
#line 3182 "test-new/imp918s.imp"
L_0284:;
// 3183 DUMP(0,REG,WKAREA,0,RBASE)
#line 3183 "test-new/imp918s.imp"
DUMP(0, REG, WKAREA, 0, RBASE);
// 3184 BASE=REG; DISP=0
#line 3184 "test-new/imp918s.imp"
BASE = REG;
#line 3184 "test-new/imp918s.imp"
DISP = 0;
// 3185 %FINISH
#line 3185 "test-new/imp918s.imp"
L_0285:;
// 3186 INDEX=0
#line 3186 "test-new/imp918s.imp"
INDEX = 0;
// 3187 CLEAR LIST(SHEAD)
#line 3187 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &SHEAD);
// 3188 CCSTATE=-1
#line 3188 "test-new/imp918s.imp"
CCSTATE = -1;
// 3189 NEST=LENREG; ->Label99
#line 3189 "test-new/imp918s.imp"
NEST = LENREG;
#line 3189 "test-new/imp918s.imp"
goto U_101D;
// 3190 %INTEGERFN STROP(%INTEGER REG)
#line 3190 "test-new/imp918s.imp"
int STROP(int REG) {
// 3191 !***********************************************************************
// 3192 !* DEALS WITH OPERAND FOR CONCATENATION. RETURN RESULT=0 FOR *
// 3193 !* VALID OPERAND OTHERWISE AN ERROR NUMBER. *
// 3194 !***********************************************************************
// 3195 %BYTEINTEGER CTYPE
#line 3195 "test-new/imp918s.imp"
unsigned char CTYPE;
// 3196 %INTEGER VAL,MODE,REGMODE
#line 3196 "test-new/imp918s.imp"
int VAL;
#line 3196 "test-new/imp918s.imp"
int MODE;
#line 3196 "test-new/imp918s.imp"
int REGMODE;
// 3197 %IF CHECKSP#0 %THEN REGMODE=SAFE %ELSE REGMODE=ADDREG
#line 3197 "test-new/imp918s.imp"
if (CHECKSP == 0) goto L_0286;
#line 3197 "test-new/imp918s.imp"
REGMODE = -61948;
#line 3197 "test-new/imp918s.imp"
goto L_0287;
#line 3197 "test-new/imp918s.imp"
L_0286:;
#line 3197 "test-new/imp918s.imp"
REGMODE = -61951;
#line 3197 "test-new/imp918s.imp"
L_0287:;
// 3198 MODE=A(P); ! ALTERNATIVE OF OPERAND
#line 3198 "test-new/imp918s.imp"
MODE = A[P + 7];
// 3199 %RESULT=75 %IF MODE>2
#line 3199 "test-new/imp918s.imp"
if (MODE <= 2) goto L_0288;
#line 3199 "test-new/imp918s.imp"
return 75;
#line 3199 "test-new/imp918s.imp"
L_0288:;
// 3200 %IF MODE#1 %THEN %START
#line 3200 "test-new/imp918s.imp"
if (MODE == 1) goto L_0289;
// 3201 CTYPE=A(P+1)&7; ! GET CONST TYPE & LOSE AMCK FLAGS
#line 3201 "test-new/imp918s.imp"
CTYPE = A[P + 1 + 7] & 7;
// 3202 %IF CTYPE=5 %THEN %START
#line 3202 "test-new/imp918s.imp"
if (CTYPE != 5) goto L_028A;
// 3203 STRINGL=A(P+2); P=P+2
#line 3203 "test-new/imp918s.imp"
STRINGL = A[P + 2 + 7];
#line 3203 "test-new/imp918s.imp"
P = P + 2;
// 3204 %IF REG<0 %THEN FINDREG(REGMODE,BASE) %ELSE BASE=REG
#line 3204 "test-new/imp918s.imp"
if (REG >= 0) goto L_028B;
#line 3204 "test-new/imp918s.imp"
FINDREG(REGMODE, /*?*/ &BASE);
#line 3204 "test-new/imp918s.imp"
goto L_028C;
#line 3204 "test-new/imp918s.imp"
L_028B:;
#line 3204 "test-new/imp918s.imp"
BASE = REG;
#line 3204 "test-new/imp918s.imp"
L_028C:;
// 3205 TEXTOUT(BASE)
#line 3205 "test-new/imp918s.imp"
TEXTOUT(BASE);
// 3206 %IF A(P)=1 %THEN %RESULT=72
#line 3206 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_028D;
#line 3206 "test-new/imp918s.imp"
return 72;
#line 3206 "test-new/imp918s.imp"
L_028D:;
// 3207 P=P+1; DISP=0
#line 3207 "test-new/imp918s.imp"
P = P + 1;
#line 3207 "test-new/imp918s.imp"
DISP = 0;
// 3208 %FINISH %ELSE %START
#line 3208 "test-new/imp918s.imp"
goto L_028E;
#line 3208 "test-new/imp918s.imp"
L_028A:;
// 3209 FROM AR4(P+2,VAL)
#line 3209 "test-new/imp918s.imp"
FROMAR4(P + 2, /*?*/ &VAL);
// 3210 %RESULT=72 %UNLESS CTYPE=1 %AND 0<=VAL<127 %AND A(P+4)=2
#line 3210 "test-new/imp918s.imp"
if (CTYPE != 1) goto L_028F;
#line 3210 "test-new/imp918s.imp"
{
// Double-sided test on VAL (Part I)
#line 3210 "test-new/imp918s.imp"
int tmp;
#line 3210 "test-new/imp918s.imp"
if (0 > (tmp = VAL)) goto L_028F;
// Double-sided test on VAL (Part II)
#line 3210 "test-new/imp918s.imp"
if (tmp >= 127) goto L_028F;
#line 3210 "test-new/imp918s.imp"
}
#line 3210 "test-new/imp918s.imp"
if (A[P + 4 + 7] == 2) goto L_0290;
#line 3210 "test-new/imp918s.imp"
L_028F:;
#line 3210 "test-new/imp918s.imp"
return 72;
#line 3210 "test-new/imp918s.imp"
L_0290:;
// 3211 P=P+5
#line 3211 "test-new/imp918s.imp"
P = P + 5;
// 3212 %IF VAL=0 %THEN %START
#line 3212 "test-new/imp918s.imp"
if (VAL != 0) goto L_0291;
// 3213 BASE=CODER; DISP=X'C0'
#line 3213 "test-new/imp918s.imp"
BASE = 12;
#line 3213 "test-new/imp918s.imp"
DISP = 192;
// 3214 %FINISH %ELSE %START
#line 3214 "test-new/imp918s.imp"
goto L_0292;
#line 3214 "test-new/imp918s.imp"
L_0291:;
// 3215 VAL=VAL+256; STRINGL=1
#line 3215 "test-new/imp918s.imp"
VAL = VAL + 256;
#line 3215 "test-new/imp918s.imp"
STRINGL = 1;
// 3216 STORE CONST(BASE,DISP,2,ADDR(VAL)+2)
#line 3216 "test-new/imp918s.imp"
STORECONST(/*?*/ &BASE, /*?*/ &DISP, 2, _imp_ADDR(/*?*/ &VAL) + 2);
// 3217 %FINISH
#line 3217 "test-new/imp918s.imp"
L_0292:;
// 3218 %FINISH
#line 3218 "test-new/imp918s.imp"
L_028E:;
// 3219 INDEX=0
#line 3219 "test-new/imp918s.imp"
INDEX = 0;
// 3220 %FINISH %ELSE %START
#line 3220 "test-new/imp918s.imp"
goto L_0293;
#line 3220 "test-new/imp918s.imp"
L_0289:;
// 3221 P=P+1; CNAME(5,REG)
#line 3221 "test-new/imp918s.imp"
P = P + 1;
#line 3221 "test-new/imp918s.imp"
CNAME(5, REG);
// 3222 STRINGL=0
#line 3222 "test-new/imp918s.imp"
STRINGL = 0;
// 3223 %RESULT=71 %IF TYPE#5
#line 3223 "test-new/imp918s.imp"
if (TYPE == 5) goto L_0294;
#line 3223 "test-new/imp918s.imp"
return 71;
#line 3223 "test-new/imp918s.imp"
L_0294:;
// 3224 %FINISH
#line 3224 "test-new/imp918s.imp"
L_0293:;
// 3225 %IF REG>0 %OR INDEX>0 %OR BASE>4095 %THEN %START
#line 3225 "test-new/imp918s.imp"
if (REG > 0) goto L_0295;
#line 3225 "test-new/imp918s.imp"
if (INDEX > 0) goto L_0295;
#line 3225 "test-new/imp918s.imp"
if (BASE <= 4095) goto L_0296;
#line 3225 "test-new/imp918s.imp"
L_0295:;
// 3226 DUMP(0,REG,DISP,INDEX,BASE)
#line 3226 "test-new/imp918s.imp"
DUMP(0, REG, DISP, INDEX, BASE);
// 3227 REG=NEST %IF REG<0
#line 3227 "test-new/imp918s.imp"
if (REG >= 0) goto L_0297;
#line 3227 "test-new/imp918s.imp"
REG = NEST;
#line 3227 "test-new/imp918s.imp"
L_0297:;
// 3228 FORGET(REG)
#line 3228 "test-new/imp918s.imp"
FORGET(REG);
// 3229 BASE=REG; INDEX=0;DISP=0
#line 3229 "test-new/imp918s.imp"
BASE = REG;
#line 3229 "test-new/imp918s.imp"
INDEX = 0;
#line 3229 "test-new/imp918s.imp"
DISP = 0;
// 3230 %FINISH
#line 3230 "test-new/imp918s.imp"
L_0296:;
// 3231 %IF MODE=1 %AND UNASS=1 %THEN %START
#line 3231 "test-new/imp918s.imp"
if (MODE != 1) goto L_0298;
#line 3231 "test-new/imp918s.imp"
if (UNASS != 1) goto L_0298;
// 3232 DUMPSS(X'D5',2,BASE,DISP,CODER,216);! CLC =X'8080'
#line 3232 "test-new/imp918s.imp"
DUMPSS(213, 2, BASE, DISP, 12, 216);
// 3233 PCONST(X'4780C028'); ! BE UNASS USED
#line 3233 "test-new/imp918s.imp"
PCONST(1199620136);
// 3234 %FINISH
#line 3234 "test-new/imp918s.imp"
L_0298:;
// 3235 %RESULT=0
#line 3235 "test-new/imp918s.imp"
return 0;
// 3236 %END; ! OF INTEGERFN STROP
#line 3236 "test-new/imp918s.imp"
} /* end of STROP */
// 3237 Label99: %END; ! OF ROUTINE CSTREXP
#line 3237 "test-new/imp918s.imp"
U_101D:;
#line 3237 "test-new/imp918s.imp"
return;
#line 3237 "test-new/imp918s.imp"
} /* end of CSTREXP */
// 3238 %ROUTINE CRES (%INTEGER LAB)
#line 3238 "test-new/imp918s.imp"
void CRES(int LAB) {
// 3239 {%SHORTROUTINE}
// 3240 !**********************************************************************
// 3241 !* COMPILES A RESOLUTION E.G A->B.(C).D.(E).F AND JUMPS TO LAB *
// 3242 !* ON FAILURE. (LAB=0 FOR UNCONDITIONAL RESOLUTION TO PERM ON *
// 3243 !* FAILURE ). *
// 3244 !* THE METHOD IS TO SET UP A 4 WORD WORK AREA AS FOLLOWS:- *
// 3245 !* W1 POINTS TO LHS(A) *
// 3246 !* W2 HAS COUNT OF BYTES OF A USED IN PREVIOUS RESOLUTIONS *
// 3247 !* W3 PRIVATE SPACE FOR PERM *
// 3248 !* W4 STRING TO CONTAIN FRAGMENT (PASSED BY NAME) *
// 3249 !* PERM IS ENTERED WITH R1 POINTING TO C AND R2 TO W1 AND THE *
// 3250 !* SUBROUTINE TRIES TO PERFORM THE RESOLUYION AND SETS THE *
// 3251 !* CONDITION CODE =8 IF IT SUCCEEDS. *
// 3252 !* *
// 3253 !* ON ENTRY LHS IS DEFINED BY DISP,INDEX AND BASE. *
// 3254 !* P POINTS TO P(+') OF RHS DEFINED AS (+')(OPERAND)(RESTOFEXP) *
// 3255 !* *
// 3256 !$ THE ROUTINE IS COMPACT BUT DIFFICULT TO FOLLOW (OR ALTER) *
// 3257 !* THE TIME IN PERM IS LARGE SO IT IS NOT WORTHWHILE TO PERSUE *
// 3258 !* CODE EFFICIENCY TOO INDUSTRIOUSLY . *
// 3259 !**********************************************************************
// 3260 %INTEGER P1,P2,R1,R2,SEXPRN,W,LAST
#line 3260 "test-new/imp918s.imp"
int P1;
#line 3260 "test-new/imp918s.imp"
int P2;
#line 3260 "test-new/imp918s.imp"
int R1;
#line 3260 "test-new/imp918s.imp"
int R2;
#line 3260 "test-new/imp918s.imp"
int SEXPRN;
#line 3260 "test-new/imp918s.imp"
int W;
#line 3260 "test-new/imp918s.imp"
int LAST;
// 3261 LAST=0; ! =1 WHEN END OF EXPRNSN FOUND
#line 3261 "test-new/imp918s.imp"
LAST = 0;
// 3262 SEXPRN=0; ! RESOLUTION(BRKTD) EXPRESSNS
#line 3262 "test-new/imp918s.imp"
SEXPRN = 0;
// 3263 GET WSP(W,4); ! 4 WORD WORK AREA FOR W1-W4
#line 3263 "test-new/imp918s.imp"
GETWSP(/*?*/ &W, 4);
// 3264 P1=P; P=P+2
#line 3264 "test-new/imp918s.imp"
P1 = P;
#line 3264 "test-new/imp918s.imp"
P = P + 2;
// 3265 ->Label1 %IF A(P)=4 %AND TYPE=5; ! LHS MUST BE A STRING
#line 3265 "test-new/imp918s.imp"
if (A[P + 7] != 4) goto L_0299;
#line 3265 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0299;
#line 3265 "test-new/imp918s.imp"
goto U_1033;
#line 3265 "test-new/imp918s.imp"
L_0299:;
// 3266 ERROR: P=P1; SKIP EXP
#line 3266 "test-new/imp918s.imp"
U_1016:;
#line 3266 "test-new/imp918s.imp"
P = P1;
#line 3266 "test-new/imp918s.imp"
SKIPEXP();
// 3267 FAULT(74,0); ->Label99
#line 3267 "test-new/imp918s.imp"
FAULT(74, 0);
#line 3267 "test-new/imp918s.imp"
goto U_1017;
// 3268 Label1: FIND SEQ(R1,R2); ! 2 ADJACENT REGISTERS
#line 3268 "test-new/imp918s.imp"
U_1033:;
#line 3268 "test-new/imp918s.imp"
FINDSEQ(/*?*/ &R1, /*?*/ &R2);
// 3269 DUMP(0,R1,DISP,INDEX,BASE); ! ADDR LHS
#line 3269 "test-new/imp918s.imp"
DUMP(0, R1, DISP, INDEX, BASE);
// 3270 REGISTER(R1)=1
#line 3270 "test-new/imp918s.imp"
REGISTER[R1] = 1;
// 3271 PRR(X'1B',R2,R2); ! ZERO R2
#line 3271 "test-new/imp918s.imp"
PRR(27, R2, R2);
// 3272 REGISTER(R2)=1
#line 3272 "test-new/imp918s.imp"
REGISTER[R2] = 1;
// 3273 DUMPM(X'90',R1,R2,RBASE,W); ! SET W1 & W2
#line 3273 "test-new/imp918s.imp"
DUMPM(144, R1, R2, RBASE, W);
// 3274 FREE AND FORGET(R1)
#line 3274 "test-new/imp918s.imp"
FREEANDFORGET(R1);
// 3275 FREE AND FORGET(R2)
#line 3275 "test-new/imp918s.imp"
FREEANDFORGET(R2);
// 3276 RES: P=P+1; ! TO P(OPERAND)
#line 3276 "test-new/imp918s.imp"
U_1018:;
#line 3276 "test-new/imp918s.imp"
P = P + 1;
// 3277 P2=-1; ! B OMITTED (>0 IF B GIVEN)
#line 3277 "test-new/imp918s.imp"
P2 = -1;
// 3278 !
// 3279 ! THE CODING HERAFTER IS OBSCURE. NOTE HOWEVER:-
// 3280 ! 1) IF B OMITTED THEN 0(WSPR) IS PASSED AS ADDR(B)
// 3281 ! 2) THE LAST STRING F IS TREATED AS B OR D BUT PERM29 IS
// 3282 ! USED INSTEAD OF PERM 28
// 3283 !
// 3284 %IF A(P)=3 %THEN NEST=WSPR %ELSE %START;! B OMITTED
#line 3284 "test-new/imp918s.imp"
if (A[P + 7] != 3) goto L_029A;
#line 3284 "test-new/imp918s.imp"
NEST = 11;
#line 3284 "test-new/imp918s.imp"
goto L_029B;
#line 3284 "test-new/imp918s.imp"
L_029A:;
// 3285 ->ERROR %UNLESS A(P)=1; ! P(OPERAND)=NAME
#line 3285 "test-new/imp918s.imp"
if (A[P + 7] == 1) goto L_029C;
#line 3285 "test-new/imp918s.imp"
goto U_1016;
#line 3285 "test-new/imp918s.imp"
L_029C:;
// 3286 P=P+1; P2=P
#line 3286 "test-new/imp918s.imp"
P = P + 1;
#line 3286 "test-new/imp918s.imp"
P2 = P;
// 3287 !
// 3288 ! NORMALLY CNAME(3,REG) USED TO PASS B BY NAME TO PERM
// 3289 ! IN OPTIMISING DONT WASTE TIME SETTING FLAGS BYTE INTO ADDRESS
// 3290 ! SO USE CNAME(4,REG). PERM SKIPS CHECK IF FLAGS MISSING
// 3291 !
// 3292 CNAME(4-CHECKSP,-2)
#line 3292 "test-new/imp918s.imp"
CNAME(4 - CHECKSP, -2);
// 3293 ->ERROR %UNLESS TYPE=5
#line 3293 "test-new/imp918s.imp"
if (TYPE == 5) goto L_029D;
#line 3293 "test-new/imp918s.imp"
goto U_1016;
#line 3293 "test-new/imp918s.imp"
L_029D:;
// 3294 %IF A(P)=2 %AND SEXPRN>0 %THEN LAST=1 %ELSE %START
#line 3294 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_029E;
#line 3294 "test-new/imp918s.imp"
if (SEXPRN <= 0) goto L_029E;
#line 3294 "test-new/imp918s.imp"
LAST = 1;
#line 3294 "test-new/imp918s.imp"
goto L_029F;
#line 3294 "test-new/imp918s.imp"
L_029E:;
// 3295 ->ERROR %UNLESS A(P+1)=12;! DOT OPERATOR
#line 3295 "test-new/imp918s.imp"
if (A[P + 1 + 7] == 12) goto L_02A0;
#line 3295 "test-new/imp918s.imp"
goto U_1016;
#line 3295 "test-new/imp918s.imp"
L_02A0:;
// 3296 P=P+2
#line 3296 "test-new/imp918s.imp"
P = P + 2;
// 3297 %FINISH
#line 3297 "test-new/imp918s.imp"
L_029F:;
// 3298 %FINISH
#line 3298 "test-new/imp918s.imp"
L_029B:;
// 3299 REGISTER(NEST)=1 %IF REGISTER(NEST)=0;! IN CASE 4K MULTIPLE REQD
#line 3299 "test-new/imp918s.imp"
if (REGISTER[NEST] != 0) goto L_02A1;
#line 3299 "test-new/imp918s.imp"
REGISTER[NEST] = 1;
#line 3299 "test-new/imp918s.imp"
L_02A1:;
// 3300 DUMP(X'50',NEST,W+12,0,RBASE);! B (OR DUMMY) TO W4
#line 3300 "test-new/imp918s.imp"
DUMP(80, NEST, W + 12, 0, RBASE);
// 3301 REGISTER(NEST)=0 %IF REGISTER(NEST)>0; ! NB NEST CAN BE R11 HERE!
#line 3301 "test-new/imp918s.imp"
if (REGISTER[NEST] <= 0) goto L_02A2;
#line 3301 "test-new/imp918s.imp"
REGISTER[NEST] = 0;
#line 3301 "test-new/imp918s.imp"
L_02A2:;
// 3302 %IF LAST=0 %THEN %START
#line 3302 "test-new/imp918s.imp"
if (LAST != 0) goto L_02A3;
// 3303 ->ERROR %UNLESS A(P)=3; ! P(OPERAND)='('(EXPR)')'
#line 3303 "test-new/imp918s.imp"
if (A[P + 7] == 3) goto L_02A4;
#line 3303 "test-new/imp918s.imp"
goto U_1016;
#line 3303 "test-new/imp918s.imp"
L_02A4:;
// 3304 SEXPRN=SEXPRN+1; P=P+1
#line 3304 "test-new/imp918s.imp"
SEXPRN = SEXPRN + 1;
#line 3304 "test-new/imp918s.imp"
P = P + 1;
// 3305 CSTREXP(1,1); ! TO REGISTER 1
#line 3305 "test-new/imp918s.imp"
CSTREXP(1, 1);
// 3306 %FINISH
#line 3306 "test-new/imp918s.imp"
L_02A3:;
// 3307 !
// 3308 REGISTER(1)=1
#line 3308 "test-new/imp918s.imp"
REGISTER[1] = 1;
// 3309 DUMP(0,2,W,0,RBASE) %UNLESS GRUSE(2)=16 %AND GRINF(2)=W
#line 3309 "test-new/imp918s.imp"
if (GRUSE[2] != 16) goto L_02A5;
#line 3309 "test-new/imp918s.imp"
if (GRINF[2] == W) goto L_02A6;
#line 3309 "test-new/imp918s.imp"
L_02A5:;
#line 3309 "test-new/imp918s.imp"
DUMP(0, 2, W, 0, RBASE);
#line 3309 "test-new/imp918s.imp"
L_02A6:;
// 3310 REGISTER(1)=0
#line 3310 "test-new/imp918s.imp"
REGISTER[1] = 0;
// 3311 PPJ(LAST+28); ! 28 TO RESOLVE 29 TO FINISH OFF
#line 3311 "test-new/imp918s.imp"
PPJ(LAST + 28);
// 3312 SET USE(2,16,W); ! USE 16='HOLDS RESLN PARAM'
#line 3312 "test-new/imp918s.imp"
SETUSE(2, 16, W);
// 3313 -> END %IF LAST#0
#line 3313 "test-new/imp918s.imp"
if (LAST == 0) goto L_02A7;
#line 3313 "test-new/imp918s.imp"
goto U_102E;
#line 3313 "test-new/imp918s.imp"
L_02A7:;
// 3314 FTEST: ! DEAL WITH CC#8 IE RESLN FAILED
#line 3314 "test-new/imp918s.imp"
U_1030:;
// 3315 %IF LAB#0 %THEN ENTER JUMP(7,LAB,B'11') %ELSE %START
#line 3315 "test-new/imp918s.imp"
if (LAB == 0) goto L_02A8;
#line 3315 "test-new/imp918s.imp"
ENTERJUMP(7, LAB, 3);
#line 3315 "test-new/imp918s.imp"
goto L_02A9;
#line 3315 "test-new/imp918s.imp"
L_02A8:;
// 3316 PCONST(X'4770C098')
#line 3316 "test-new/imp918s.imp"
PCONST(1198571672);
// 3317 CYC BITS=CYC BITS!4; ! JUMP TO PERM BIT
#line 3317 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 4;
// 3318 %FINISH
#line 3318 "test-new/imp918s.imp"
L_02A9:;
// 3319 !
// 3320 %IF P2<0 %THEN %START; ! B WAS OMIITED SO CHECK THAT
#line 3320 "test-new/imp918s.imp"
if (P2 >= 0) goto L_02AA;
// 3321 PSI(X'95',0,WSPR,0); ! B WOULD HAVE BEEN NULL
#line 3321 "test-new/imp918s.imp"
PSI(149, 0, 11, 0);
// 3322 P2=1; ->FTEST; %FINISH
#line 3322 "test-new/imp918s.imp"
P2 = 1;
#line 3322 "test-new/imp918s.imp"
goto U_1030;
#line 3322 "test-new/imp918s.imp"
L_02AA:;
// 3323 !
// 3324 -> END %IF A(P)=2
#line 3324 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_02AB;
#line 3324 "test-new/imp918s.imp"
goto U_102E;
#line 3324 "test-new/imp918s.imp"
L_02AB:;
// 3325 ->ERROR %UNLESS A(P+1)=12
#line 3325 "test-new/imp918s.imp"
if (A[P + 1 + 7] == 12) goto L_02AC;
#line 3325 "test-new/imp918s.imp"
goto U_1016;
#line 3325 "test-new/imp918s.imp"
L_02AC:;
// 3326 P=P+1; ->RES
#line 3326 "test-new/imp918s.imp"
P = P + 1;
#line 3326 "test-new/imp918s.imp"
goto U_1018;
// 3327 END:
#line 3327 "test-new/imp918s.imp"
U_102E:;
// 3328 P=P+1
#line 3328 "test-new/imp918s.imp"
P = P + 1;
// 3329 Label99: %END
#line 3329 "test-new/imp918s.imp"
U_1017:;
#line 3329 "test-new/imp918s.imp"
return;
#line 3329 "test-new/imp918s.imp"
} /* end of CRES */
// 3330 %ROUTINE CUCI
#line 3330 "test-new/imp918s.imp"
void CUCI(void) {
#line 3330 "test-new/imp918s.imp"
auto void DXB(void);
#line 3330 "test-new/imp918s.imp"
auto void DLB(void);
#line 3330 "test-new/imp918s.imp"
auto void DB(void);
#line 3330 "test-new/imp918s.imp"
auto void CUCS(void);
// 3331 {%SHORTROUTINE}
// 3332 !***********************************************************************
// 3333 !* COMPILE USERCODE INSTRUCTION. MOST WORK IS DONE BY HAIRY *
// 3334 !* BUILT-IN PHRASE IN COMPARE. SINCE ALMOST ANYTHING IS LEGAL *
// 3335 !* IN USERCODE THIS ROUTINE HAS ONLT TO ASSEMBLE AND PLANT THE *
// 3336 !* THE INSTRUCTION. *
// 3337 !***********************************************************************
// 3338 %ROUTINESPEC DXB
// 3339 %ROUTINESPEC DLB
// 3340 %ROUTINESPEC DB
// 3341 %ROUTINESPEC CUCS
// 3342 %OWNINTEGER USING,AT
#line 3342 "test-new/imp918s.imp"
static int USING;
#line 3342 "test-new/imp918s.imp"
static int AT;
// 3343 %INTEGER Z,KK,X,OPCODE,REG,OPNUM
#line 3343 "test-new/imp918s.imp"
int Z;
#line 3343 "test-new/imp918s.imp"
int KK;
#line 3343 "test-new/imp918s.imp"
int X;
#line 3343 "test-new/imp918s.imp"
int OPCODE;
#line 3343 "test-new/imp918s.imp"
int REG;
#line 3343 "test-new/imp918s.imp"
int OPNUM;
// 3344 %SWITCH UCITYPE(1:6),OPTYPE(1:8)
#line 3344 "test-new/imp918s.imp"
int UCITYPE_index;
#line 3344 "test-new/imp918s.imp"
int UCITYPE_line;
#line 3344 "test-new/imp918s.imp"
char *UCITYPE_file;
#line 3344 "test-new/imp918s.imp"
static const void *UCITYPE[6] = {&&case_UCITYPE_missing, &&case_UCITYPE_missing, &&case_UCITYPE_missing,
&&case_UCITYPE_missing, &&case_UCITYPE_missing, &&case_UCITYPE_missing};
#line 3344 "test-new/imp918s.imp"
int OPTYPE_index;
#line 3344 "test-new/imp918s.imp"
int OPTYPE_line;
#line 3344 "test-new/imp918s.imp"
char *OPTYPE_file;
#line 3344 "test-new/imp918s.imp"
static const void *OPTYPE[8] = {&&case_OPTYPE_missing, &&case_OPTYPE_missing, &&case_OPTYPE_missing,
&&case_OPTYPE_missing, &&case_OPTYPE_missing, &&case_OPTYPE_missing,
&&case_OPTYPE_missing, &&case_OPTYPE_missing};
// 3345 CCSTATE=-1
#line 3345 "test-new/imp918s.imp"
CCSTATE = -1;
// 3346 FORGETM(8); ! ALL UC INSTRNS DANGEROUS
#line 3346 "test-new/imp918s.imp"
FORGETM(8);
// 3347 -> UCITYPE(A(P))
#line 3347 "test-new/imp918s.imp"
UCITYPE_line = __LINE__;
UCITYPE_file = __FILE__;
UCITYPE_index = A[P + 7];
goto case_UCITYPE_dispatch;
// 3348 UCITYPE(1): ! **(N),(@')(NAME)(APP)
#line 3348 "test-new/imp918s.imp"
case_UCITYPE_1:;
// 3349 NEST=A(P+1); Z=A(P+2); P=P+3
#line 3349 "test-new/imp918s.imp"
NEST = A[P + 1 + 7];
#line 3349 "test-new/imp918s.imp"
Z = A[P + 2 + 7];
#line 3349 "test-new/imp918s.imp"
P = P + 3;
// 3350 Z=4 %IF Z=1; CNAME(Z,NEST)
#line 3350 "test-new/imp918s.imp"
if (Z != 1) goto L_02AE;
#line 3350 "test-new/imp918s.imp"
Z = 4;
#line 3350 "test-new/imp918s.imp"
L_02AE:;
#line 3350 "test-new/imp918s.imp"
CNAME(Z, NEST);
// 3351 ->Label99
#line 3351 "test-new/imp918s.imp"
goto U_1031;
// 3352 UCITYPE(2): ! *-> P<N> =JUMP TO PERM
#line 3352 "test-new/imp918s.imp"
case_UCITYPE_2:;
// 3353 PPJ(A(P+1)); ->Label99
#line 3353 "test-new/imp918s.imp"
PPJ(A[P + 1 + 7]);
#line 3353 "test-new/imp918s.imp"
goto U_1031;
// 3354 UCITYPE(4): ! *PUT_<CONST>
#line 3354 "test-new/imp918s.imp"
case_UCITYPE_4:;
// 3355 PLANT(A(P+3)); ! LEAST SIGNIFICANT 16 BITS ONLY
#line 3355 "test-new/imp918s.imp"
PLANT(A[P + 3 + 7]);
// 3356 P=P+4; ->Label99
#line 3356 "test-new/imp918s.imp"
P = P + 4;
#line 3356 "test-new/imp918s.imp"
goto U_1031;
// 3357 UCITYPE(3): ! '*'<SETUCN>'_' <UCOP>
#line 3357 "test-new/imp918s.imp"
case_UCITYPE_3:;
// 3358 OPCODE=A(P+2); OPNUM=A(P+1)
#line 3358 "test-new/imp918s.imp"
OPCODE = A[P + 2 + 7];
#line 3358 "test-new/imp918s.imp"
OPNUM = A[P + 1 + 7];
// 3359 P=P+3; ->OPTYPE(OPNUM)
#line 3359 "test-new/imp918s.imp"
P = P + 3;
#line 3359 "test-new/imp918s.imp"
OPTYPE_line = __LINE__;
OPTYPE_file = __FILE__;
OPTYPE_index = OPNUM;
goto case_OPTYPE_dispatch;
// 3360 UCITYPE(5): ! 'USING' '*,'<N>
#line 3360 "test-new/imp918s.imp"
case_UCITYPE_5:;
// 3361 Z=A(P+1)
#line 3361 "test-new/imp918s.imp"
Z = A[P + 1 + 7];
// 3362 %IF 1<=Z<=15 %THEN %START
#line 3362 "test-new/imp918s.imp"
{
// Double-sided test on Z (Part I)
#line 3362 "test-new/imp918s.imp"
int tmp;
#line 3362 "test-new/imp918s.imp"
if (1 > (tmp = Z)) goto L_02B0;
// Double-sided test on Z (Part II)
#line 3362 "test-new/imp918s.imp"
if (tmp > 15) goto L_02B0;
#line 3362 "test-new/imp918s.imp"
}
// 3363 USING=Z; AT=CA
#line 3363 "test-new/imp918s.imp"
USING = Z;
#line 3363 "test-new/imp918s.imp"
AT = CA;
// 3364 %FINISH %ELSE FAULT(33,0); ->Label99
#line 3364 "test-new/imp918s.imp"
goto L_02B1;
#line 3364 "test-new/imp918s.imp"
L_02B0:;
#line 3364 "test-new/imp918s.imp"
FAULT(33, 0);
#line 3364 "test-new/imp918s.imp"
L_02B1:;
#line 3364 "test-new/imp918s.imp"
goto U_1031;
// 3365 UCITYPE(6): ! 'DROP' <N>
#line 3365 "test-new/imp918s.imp"
case_UCITYPE_6:;
// 3366 Z=A(P+1)
#line 3366 "test-new/imp918s.imp"
Z = A[P + 1 + 7];
// 3367 %IF Z=USING %THEN %START
#line 3367 "test-new/imp918s.imp"
if (Z != USING) goto L_02B2;
// 3368 USING=0; AT=0
#line 3368 "test-new/imp918s.imp"
USING = 0;
#line 3368 "test-new/imp918s.imp"
AT = 0;
// 3369 %FINISH %ELSE FAULT(33,0); ->Label99
#line 3369 "test-new/imp918s.imp"
goto L_02B3;
#line 3369 "test-new/imp918s.imp"
L_02B2:;
#line 3369 "test-new/imp918s.imp"
FAULT(33, 0);
#line 3369 "test-new/imp918s.imp"
L_02B3:;
#line 3369 "test-new/imp918s.imp"
goto U_1031;
// 3370 OPTYPE(1): ! RR FORMAT INSTRUCTION
#line 3370 "test-new/imp918s.imp"
case_OPTYPE_1:;
// 3371 %IF OPCODE=0 %THEN CNOP(A(P),A(P+1)) %ELSE %C
#line 3371 "test-new/imp918s.imp"
if (OPCODE != 0) goto L_02B4;
#line 3371 "test-new/imp918s.imp"
CNOP(A[P + 7], A[P + 1 + 7]);
#line 3371 "test-new/imp918s.imp"
goto L_02B5;
#line 3371 "test-new/imp918s.imp"
L_02B4:;
#line 3371 "test-new/imp918s.imp"
PRR(OPCODE, A[P + 7], A[P + 1 + 7]);
#line 3371 "test-new/imp918s.imp"
L_02B5:;
// 3372+ PRR(OPCODE,A(P),A(P+1))
// 3373 P=P+2; ->Label99
#line 3373 "test-new/imp918s.imp"
P = P + 2;
#line 3373 "test-new/imp918s.imp"
goto U_1031;
// 3374 OPTYPE(2): ! RX FORMAT INSTRUCTION
#line 3374 "test-new/imp918s.imp"
case_OPTYPE_2:;
// 3375 OPTYPE(3): ! RS FORMAT INSTRUCION
#line 3375 "test-new/imp918s.imp"
case_OPTYPE_3:;
// 3376 OPTYPE(5): ! SHIFT INSTRUCTION
#line 3376 "test-new/imp918s.imp"
case_OPTYPE_5:;
// 3377 REG=A(P)
#line 3377 "test-new/imp918s.imp"
REG = A[P + 7];
// 3378 %IF OPNUM=2 %THEN P=P+1 %AND DXB %ELSE %START
#line 3378 "test-new/imp918s.imp"
if (OPNUM != 2) goto L_02B6;
#line 3378 "test-new/imp918s.imp"
P = P + 1;
#line 3378 "test-new/imp918s.imp"
DXB();
#line 3378 "test-new/imp918s.imp"
goto L_02B7;
#line 3378 "test-new/imp918s.imp"
L_02B6:;
// 3379 %IF OPNUM=5 %THEN X=0 %AND P=P+1 %ELSE X=A(P+1) %AND P=P+2
#line 3379 "test-new/imp918s.imp"
if (OPNUM != 5) goto L_02B8;
#line 3379 "test-new/imp918s.imp"
X = 0;
#line 3379 "test-new/imp918s.imp"
P = P + 1;
#line 3379 "test-new/imp918s.imp"
goto L_02B9;
#line 3379 "test-new/imp918s.imp"
L_02B8:;
#line 3379 "test-new/imp918s.imp"
X = A[P + 1 + 7];
#line 3379 "test-new/imp918s.imp"
P = P + 2;
#line 3379 "test-new/imp918s.imp"
L_02B9:;
// 3380 DB
#line 3380 "test-new/imp918s.imp"
DB();
// 3381 %FINISH
#line 3381 "test-new/imp918s.imp"
L_02B7:;
// 3382 PRX(OPCODE,REG,X,I,K);->Label99
#line 3382 "test-new/imp918s.imp"
PRX(OPCODE, REG, X, I, K);
#line 3382 "test-new/imp918s.imp"
goto U_1031;
// 3383 OPTYPE(4): ! STORE-IMMEDIATE FORMAT
#line 3383 "test-new/imp918s.imp"
case_OPTYPE_4:;
// 3384 DB
#line 3384 "test-new/imp918s.imp"
DB();
// 3385 %IF A(P)=2 %THEN Z=0 %ELSE %START
#line 3385 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_02BA;
#line 3385 "test-new/imp918s.imp"
Z = 0;
#line 3385 "test-new/imp918s.imp"
goto L_02BB;
#line 3385 "test-new/imp918s.imp"
L_02BA:;
// 3386 FROM AR4(P+2,Z)
#line 3386 "test-new/imp918s.imp"
FROMAR4(P + 2, /*?*/ &Z);
// 3387 FAULT(32,0) %UNLESS 0<=Z<=255
#line 3387 "test-new/imp918s.imp"
{
// Double-sided test on Z (Part I)
#line 3387 "test-new/imp918s.imp"
int tmp;
#line 3387 "test-new/imp918s.imp"
if (0 > (tmp = Z)) goto L_02BC;
// Double-sided test on Z (Part II)
#line 3387 "test-new/imp918s.imp"
if (tmp <= 255) goto L_02BD;
#line 3387 "test-new/imp918s.imp"
}
#line 3387 "test-new/imp918s.imp"
L_02BC:;
#line 3387 "test-new/imp918s.imp"
FAULT(32, 0);
#line 3387 "test-new/imp918s.imp"
L_02BD:;
// 3388 P=P+4
#line 3388 "test-new/imp918s.imp"
P = P + 4;
// 3389 %FINISH
#line 3389 "test-new/imp918s.imp"
L_02BB:;
// 3390 PSI(OPCODE,Z,I,K);P=P+1; ->Label99
#line 3390 "test-new/imp918s.imp"
PSI(OPCODE, Z, I, K);
#line 3390 "test-new/imp918s.imp"
P = P + 1;
#line 3390 "test-new/imp918s.imp"
goto U_1031;
// 3391 OPTYPE(6): ! SS FORMAT
#line 3391 "test-new/imp918s.imp"
case_OPTYPE_6:;
// 3392 OPTYPE(7): ! PACKED DECIMAL FORMAT
#line 3392 "test-new/imp918s.imp"
case_OPTYPE_7:;
// 3393 DLB; KK=K; Z=X
#line 3393 "test-new/imp918s.imp"
DLB();
#line 3393 "test-new/imp918s.imp"
KK = K;
#line 3393 "test-new/imp918s.imp"
Z = X;
// 3394 REG=I; Z=1 %IF Z=0
#line 3394 "test-new/imp918s.imp"
REG = I;
#line 3394 "test-new/imp918s.imp"
if (Z != 0) goto L_02BE;
#line 3394 "test-new/imp918s.imp"
Z = 1;
#line 3394 "test-new/imp918s.imp"
L_02BE:;
// 3395 %IF OPNUM=6 %THEN DB %ELSE %START
#line 3395 "test-new/imp918s.imp"
if (OPNUM != 6) goto L_02BF;
#line 3395 "test-new/imp918s.imp"
DB();
#line 3395 "test-new/imp918s.imp"
goto L_02C0;
#line 3395 "test-new/imp918s.imp"
L_02BF:;
// 3396 DLB; X=1 %IF X=0
#line 3396 "test-new/imp918s.imp"
DLB();
#line 3396 "test-new/imp918s.imp"
if (X != 0) goto L_02C1;
#line 3396 "test-new/imp918s.imp"
X = 1;
#line 3396 "test-new/imp918s.imp"
L_02C1:;
// 3397 Z=(Z-1)<<4!X
#line 3397 "test-new/imp918s.imp"
Z = Z - 1 << 4 | X;
// 3398 %FINISH
#line 3398 "test-new/imp918s.imp"
L_02C0:;
// 3399 PSS(OPCODE,Z,REG,KK,I,K); ->Label99
#line 3399 "test-new/imp918s.imp"
PSS(OPCODE, Z, REG, KK, I, K);
#line 3399 "test-new/imp918s.imp"
goto U_1031;
// 3400 OPTYPE(8): ! FUNNIES
#line 3400 "test-new/imp918s.imp"
case_OPTYPE_8:;
// 3401 REG=A(P); P=P+1
#line 3401 "test-new/imp918s.imp"
REG = A[P + 7];
#line 3401 "test-new/imp918s.imp"
P = P + 1;
// 3402 %IF OPCODE=X'80' %THEN PSI(OPCODE,REG,0,0) %ELSE %START
#line 3402 "test-new/imp918s.imp"
if (OPCODE != 128) goto L_02C2;
#line 3402 "test-new/imp918s.imp"
PSI(OPCODE, REG, 0, 0);
#line 3402 "test-new/imp918s.imp"
goto L_02C3;
#line 3402 "test-new/imp918s.imp"
L_02C2:;
// 3403 %IF OPCODE=10 %THEN PLANT(X'A00'!REG) %ELSE PRR(OPCODE,REG,0)
#line 3403 "test-new/imp918s.imp"
if (OPCODE != 10) goto L_02C4;
#line 3403 "test-new/imp918s.imp"
PLANT(2560 | REG);
#line 3403 "test-new/imp918s.imp"
goto L_02C5;
#line 3403 "test-new/imp918s.imp"
L_02C4:;
#line 3403 "test-new/imp918s.imp"
PRR(OPCODE, REG, 0);
#line 3403 "test-new/imp918s.imp"
L_02C5:;
// 3404 %FINISH
#line 3404 "test-new/imp918s.imp"
L_02C3:;
// 3405 ->Label99
#line 3405 "test-new/imp918s.imp"
goto U_1031;
// 3406 %ROUTINE DB
#line 3406 "test-new/imp918s.imp"
void DB(void) {
// 3407 !***********************************************************************
// 3408 !* DEAL WITH OPERANDS FOR A DB INSTRUCTION. P ON ALT OF P<DB> *
// 3409 !* P<DB>=<UCS>,<N><RESTOFDB> *
// 3410 !* P<RESTOFDB>='('<N>')',%NULL *
// 3411 !***********************************************************************
// 3412 %IF A(P)=1 %THEN CUCS %ELSE %START
#line 3412 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_02C6;
#line 3412 "test-new/imp918s.imp"
CUCS();
#line 3412 "test-new/imp918s.imp"
goto L_02C7;
#line 3412 "test-new/imp918s.imp"
L_02C6:;
// 3413 K=A(P+1); I=A(P+2); P=P+3; ! I IS ALT OF P<RESTOFDB>
#line 3413 "test-new/imp918s.imp"
K = A[P + 1 + 7];
#line 3413 "test-new/imp918s.imp"
I = A[P + 2 + 7];
#line 3413 "test-new/imp918s.imp"
P = P + 3;
// 3414 %IF I=2 %THEN I=0 %ELSE I=A(P) %AND P=P+1
#line 3414 "test-new/imp918s.imp"
if (I != 2) goto L_02C8;
#line 3414 "test-new/imp918s.imp"
I = 0;
#line 3414 "test-new/imp918s.imp"
goto L_02C9;
#line 3414 "test-new/imp918s.imp"
L_02C8:;
#line 3414 "test-new/imp918s.imp"
I = A[P + 7];
#line 3414 "test-new/imp918s.imp"
P = P + 1;
#line 3414 "test-new/imp918s.imp"
L_02C9:;
// 3415 %FINISH
#line 3415 "test-new/imp918s.imp"
L_02C7:;
// 3416 FAULT(99,0) %UNLESS 0<=K<=4095
#line 3416 "test-new/imp918s.imp"
{
// Double-sided test on K (Part I)
#line 3416 "test-new/imp918s.imp"
short int tmp;
#line 3416 "test-new/imp918s.imp"
if (0 > (tmp = K)) goto L_02CA;
// Double-sided test on K (Part II)
#line 3416 "test-new/imp918s.imp"
if (tmp <= 4095) goto L_02CB;
#line 3416 "test-new/imp918s.imp"
}
#line 3416 "test-new/imp918s.imp"
L_02CA:;
#line 3416 "test-new/imp918s.imp"
FAULT(99, 0);
#line 3416 "test-new/imp918s.imp"
L_02CB:;
// 3417 %END
#line 3417 "test-new/imp918s.imp"
return;
#line 3417 "test-new/imp918s.imp"
} /* end of DB */
// 3418 %ROUTINE DXB
#line 3418 "test-new/imp918s.imp"
void DXB(void) {
// 3419 !***********************************************************************
// 3420 !* DEAL WITH OPERANDS FOR A DXB INSTRN. P ON ALT OF P<DXB> *
// 3421 !* P<DXB>=<UCS><RESTOFDB>,<N><RESTOFDXB> *
// 3422 !* P<RESTOFDXB>='('<N>','<N>')','('<N>')',%NULL *
// 3423 !***********************************************************************
// 3424 %INTEGER ALT
#line 3424 "test-new/imp918s.imp"
int ALT;
// 3425 X=0
#line 3425 "test-new/imp918s.imp"
X = 0;
// 3426 %IF A(P)=1 %THEN %START
#line 3426 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_02CC;
// 3427 CUCS
#line 3427 "test-new/imp918s.imp"
CUCS();
// 3428 %IF A(P)=1 %THEN X=A(P+1) %AND P=P+1
#line 3428 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_02CD;
#line 3428 "test-new/imp918s.imp"
X = A[P + 1 + 7];
#line 3428 "test-new/imp918s.imp"
P = P + 1;
#line 3428 "test-new/imp918s.imp"
L_02CD:;
// 3429 %FINISH %ELSE %START
#line 3429 "test-new/imp918s.imp"
goto L_02CE;
#line 3429 "test-new/imp918s.imp"
L_02CC:;
// 3430 K=A(P+1); I=0
#line 3430 "test-new/imp918s.imp"
K = A[P + 1 + 7];
#line 3430 "test-new/imp918s.imp"
I = 0;
// 3431 ALT=A(P+2); P=P+2
#line 3431 "test-new/imp918s.imp"
ALT = A[P + 2 + 7];
#line 3431 "test-new/imp918s.imp"
P = P + 2;
// 3432 %IF ALT=1 %THEN X=A(P+1) %AND P=P+1
#line 3432 "test-new/imp918s.imp"
if (ALT != 1) goto L_02CF;
#line 3432 "test-new/imp918s.imp"
X = A[P + 1 + 7];
#line 3432 "test-new/imp918s.imp"
P = P + 1;
#line 3432 "test-new/imp918s.imp"
L_02CF:;
// 3433 %IF ALT<=2 %THEN I=A(P+1) %AND P=P+1
#line 3433 "test-new/imp918s.imp"
if (ALT > 2) goto L_02D0;
#line 3433 "test-new/imp918s.imp"
I = A[P + 1 + 7];
#line 3433 "test-new/imp918s.imp"
P = P + 1;
#line 3433 "test-new/imp918s.imp"
L_02D0:;
// 3434 %FINISH
#line 3434 "test-new/imp918s.imp"
L_02CE:;
// 3435 P=P+1
#line 3435 "test-new/imp918s.imp"
P = P + 1;
// 3436 FAULT(99,0) %UNLESS 0<=K<=4095
#line 3436 "test-new/imp918s.imp"
{
// Double-sided test on K (Part I)
#line 3436 "test-new/imp918s.imp"
short int tmp;
#line 3436 "test-new/imp918s.imp"
if (0 > (tmp = K)) goto L_02D1;
// Double-sided test on K (Part II)
#line 3436 "test-new/imp918s.imp"
if (tmp <= 4095) goto L_02D2;
#line 3436 "test-new/imp918s.imp"
}
#line 3436 "test-new/imp918s.imp"
L_02D1:;
#line 3436 "test-new/imp918s.imp"
FAULT(99, 0);
#line 3436 "test-new/imp918s.imp"
L_02D2:;
// 3437 %END
#line 3437 "test-new/imp918s.imp"
return;
#line 3437 "test-new/imp918s.imp"
} /* end of DXB */
// 3438 %ROUTINE DLB
#line 3438 "test-new/imp918s.imp"
void DLB(void) {
// 3439 !***********************************************************************
// 3440 !* DEAL WITH OPERAND FOR A DB INSTRUCTION. P ON ALT OF P<DB> *
// 3441 !* P<DB>=<N>'('<N>','<N>')',<UCS>'('<N>')' *
// 3442 !***********************************************************************
// 3443 %IF A(P)=1 %THEN %START; ! EXPLICT FORM
#line 3443 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_02D3;
// 3444 K=A(P+1); X=A(P+2)
#line 3444 "test-new/imp918s.imp"
K = A[P + 1 + 7];
#line 3444 "test-new/imp918s.imp"
X = A[P + 2 + 7];
// 3445 I=A(P+3); P=P+4
#line 3445 "test-new/imp918s.imp"
I = A[P + 3 + 7];
#line 3445 "test-new/imp918s.imp"
P = P + 4;
// 3446 %FINISH %ELSE %START
#line 3446 "test-new/imp918s.imp"
goto L_02D4;
#line 3446 "test-new/imp918s.imp"
L_02D3:;
// 3447 CUCS; X=A(P); P=P+1
#line 3447 "test-new/imp918s.imp"
CUCS();
#line 3447 "test-new/imp918s.imp"
X = A[P + 7];
#line 3447 "test-new/imp918s.imp"
P = P + 1;
// 3448 %FINISH
#line 3448 "test-new/imp918s.imp"
L_02D4:;
// 3449 FAULT(99,0) %UNLESS 0<=K<=4095
#line 3449 "test-new/imp918s.imp"
{
// Double-sided test on K (Part I)
#line 3449 "test-new/imp918s.imp"
short int tmp;
#line 3449 "test-new/imp918s.imp"
if (0 > (tmp = K)) goto L_02D5;
// Double-sided test on K (Part II)
#line 3449 "test-new/imp918s.imp"
if (tmp <= 4095) goto L_02D6;
#line 3449 "test-new/imp918s.imp"
}
#line 3449 "test-new/imp918s.imp"
L_02D5:;
#line 3449 "test-new/imp918s.imp"
FAULT(99, 0);
#line 3449 "test-new/imp918s.imp"
L_02D6:;
// 3450 %END
#line 3450 "test-new/imp918s.imp"
return;
#line 3450 "test-new/imp918s.imp"
} /* end of DLB */
// 3451 %ROUTINE CUCS
#line 3451 "test-new/imp918s.imp"
void CUCS(void) {
// 3452 !***********************************************************************
// 3453 !* DEAL WITH SYMBOLIC REFERENCES IN USERCODE STATEMENTS *
// 3454 !* P<UCS>=<NAME><DISPP>,'<'<LABEL>'>','*'<DISPP> *
// 3455 !* P<DISPP>='+'<N>,'-'<N>,%NULL *
// 3456 !***********************************************************************
// 3457 %INTEGER X,Y,AD,ALT
#line 3457 "test-new/imp918s.imp"
int X;
#line 3457 "test-new/imp918s.imp"
int Y;
#line 3457 "test-new/imp918s.imp"
int AD;
#line 3457 "test-new/imp918s.imp"
int ALT;
// 3458 X=USING; Y=AT
#line 3458 "test-new/imp918s.imp"
X = USING;
#line 3458 "test-new/imp918s.imp"
Y = AT;
// 3459 %IF X=0 %THEN X=10 %AND Y=CODEBASE
#line 3459 "test-new/imp918s.imp"
if (X != 0) goto L_02D7;
#line 3459 "test-new/imp918s.imp"
X = 10;
#line 3459 "test-new/imp918s.imp"
Y = CODEBASE;
#line 3459 "test-new/imp918s.imp"
L_02D7:;
// 3460 ALT=A(P+1); ! ALT OF P<UCS>
#line 3460 "test-new/imp918s.imp"
ALT = A[P + 1 + 7];
// 3461 %IF ALT=2 %THEN %START
#line 3461 "test-new/imp918s.imp"
if (ALT != 2) goto L_02D8;
// 3462 !
// 3463 ! OPERAND IS AN IMP LABEL WHICH MAY OR MAY NOT BE SET BUT MUST BE WITHIN
// 3464 ! 4095 OF THE BASE REGISTER WHETHER IMPLIED OR SET BY 'USING'
// 3465 !
// 3466 K=A(P+3)+(A(P+2)-1)<<14
#line 3466 "test-new/imp918s.imp"
K = A[P + 3 + 7] + (A[P + 2 + 7] - 1 << 14);
// 3467 P=P+4
#line 3467 "test-new/imp918s.imp"
P = P + 4;
// 3468 J=FIND3(K,LABEL(LEVEL))
#line 3468 "test-new/imp918s.imp"
J = FIND3(K, LABEL[LEVEL]);
// 3469 %IF J<0 %THEN PUSH123(LABEL(LEVEL),0,0,K) %AND %C
#line 3469 "test-new/imp918s.imp"
if (J >= 0) goto L_02D9;
#line 3469 "test-new/imp918s.imp"
PUSH123(/*?*/ &LABEL[LEVEL], 0, 0, K);
#line 3469 "test-new/imp918s.imp"
J = LABEL[LEVEL];
#line 3469 "test-new/imp918s.imp"
L_02D9:;
// 3470+ J=LABEL(LEVEL)
// 3471 AD=FROM1(J)
#line 3471 "test-new/imp918s.imp"
AD = FROM1(J);
// 3472 REPLACE1(J,AD!X'01000000')
#line 3472 "test-new/imp918s.imp"
REPLACE1(J, AD | 16777216);
// 3473 %IF AD&X'FFFFFF'#0 %THEN K<-AD-Y %AND I=X %ELSE %START
#line 3473 "test-new/imp918s.imp"
if (AD & 16777215 == 0) goto L_02DA;
#line 3473 "test-new/imp918s.imp"
K = (short int)(AD - Y);
#line 3473 "test-new/imp918s.imp"
I = X;
#line 3473 "test-new/imp918s.imp"
goto L_02DB;
#line 3473 "test-new/imp918s.imp"
L_02DA:;
// 3474 K=0; I=0
#line 3474 "test-new/imp918s.imp"
K = 0;
#line 3474 "test-new/imp918s.imp"
I = 0;
// 3475 PUSH(SHORT INTEGER(ADDR(ASLIST(J+6))),CA,X<<24!Y)
#line 3475 "test-new/imp918s.imp"
PUSH(_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[J + 6])), CA, X << 24 | Y);
// 3476 %FINISH
#line 3476 "test-new/imp918s.imp"
L_02DB:;
// 3477 %FINISH %ELSE %START
#line 3477 "test-new/imp918s.imp"
goto L_02DC;
#line 3477 "test-new/imp918s.imp"
L_02D8:;
// 3478 %IF ALT=1 %THEN %START
#line 3478 "test-new/imp918s.imp"
if (ALT != 1) goto L_02DD;
// 3479 FNAME=A(P+2)
#line 3479 "test-new/imp918s.imp"
FNAME = A[P + 2 + 7];
// 3480 COPY TAG(FNAME)
#line 3480 "test-new/imp918s.imp"
COPYTAG(FNAME);
// 3481 P=P+3
#line 3481 "test-new/imp918s.imp"
P = P + 3;
// 3482 FAULT(33,FNAME) %IF ROUT=1 %OR TYPE=4 %OR TYPE>=6
#line 3482 "test-new/imp918s.imp"
if (ROUT == 1) goto L_02DE;
#line 3482 "test-new/imp918s.imp"
if (TYPE == 4) goto L_02DE;
#line 3482 "test-new/imp918s.imp"
if (TYPE < 6) goto L_02DF;
#line 3482 "test-new/imp918s.imp"
L_02DE:;
#line 3482 "test-new/imp918s.imp"
FAULT(33, FNAME);
#line 3482 "test-new/imp918s.imp"
L_02DF:;
// 3483 %FINISH %ELSE %START
#line 3483 "test-new/imp918s.imp"
goto L_02E0;
#line 3483 "test-new/imp918s.imp"
L_02DD:;
// 3484 I=X; K=CA-Y
#line 3484 "test-new/imp918s.imp"
I = X;
#line 3484 "test-new/imp918s.imp"
K = CA - Y;
// 3485 P=P+2
#line 3485 "test-new/imp918s.imp"
P = P + 2;
// 3486 %FINISH
#line 3486 "test-new/imp918s.imp"
L_02E0:;
// 3487 ALT=A(P); P=P+1
#line 3487 "test-new/imp918s.imp"
ALT = A[P + 7];
#line 3487 "test-new/imp918s.imp"
P = P + 1;
// 3488 %IF ALT#3 %THEN %START
#line 3488 "test-new/imp918s.imp"
if (ALT == 3) goto L_02E1;
// 3489 %IF ALT=1 %THEN K=K+A(P) %ELSE K=K-A(P)
#line 3489 "test-new/imp918s.imp"
if (ALT != 1) goto L_02E2;
#line 3489 "test-new/imp918s.imp"
K = K + A[P + 7];
#line 3489 "test-new/imp918s.imp"
goto L_02E3;
#line 3489 "test-new/imp918s.imp"
L_02E2:;
#line 3489 "test-new/imp918s.imp"
K = K - A[P + 7];
#line 3489 "test-new/imp918s.imp"
L_02E3:;
// 3490 P=P+1
#line 3490 "test-new/imp918s.imp"
P = P + 1;
// 3491 %FINISH
#line 3491 "test-new/imp918s.imp"
L_02E1:;
// 3492 %FINISH
#line 3492 "test-new/imp918s.imp"
L_02DC:;
// 3493 %END
#line 3493 "test-new/imp918s.imp"
return;
#line 3493 "test-new/imp918s.imp"
} /* end of CUCS */
// 3494 Label99: %END
#line 3494 "test-new/imp918s.imp"
U_1031:;
#line 3494 "test-new/imp918s.imp"
return;
#line 3494 "test-new/imp918s.imp"
case_UCITYPE_dispatch:
#line 3494 "test-new/imp918s.imp"
if (UCITYPE_index < 1 || UCITYPE_index > 6)
_imp_signalf(6, 3, UCITYPE_index, "->UCITYPE(%d) out of bounds at %s line %d", UCITYPE_index, UCITYPE_file,
UCITYPE_line);
#line 3494 "test-new/imp918s.imp"
goto *UCITYPE[UCITYPE_index - 1];
#line 3494 "test-new/imp918s.imp"
case_UCITYPE_missing:
_imp_signalf(8, 2, UCITYPE_index, "switch jump to undefined label UCITYPE(%d): at %s line %d", UCITYPE_index,
UCITYPE_file, UCITYPE_line);
#line 3494 "test-new/imp918s.imp"
case_OPTYPE_dispatch:
#line 3494 "test-new/imp918s.imp"
if (OPTYPE_index < 1 || OPTYPE_index > 8)
_imp_signalf(6, 3, OPTYPE_index, "->OPTYPE(%d) out of bounds at %s line %d", OPTYPE_index, OPTYPE_file,
OPTYPE_line);
#line 3494 "test-new/imp918s.imp"
goto *OPTYPE[OPTYPE_index - 1];
#line 3494 "test-new/imp918s.imp"
case_OPTYPE_missing:
_imp_signalf(8, 2, OPTYPE_index, "switch jump to undefined label OPTYPE(%d): at %s line %d", OPTYPE_index,
OPTYPE_file, OPTYPE_line);
#line 3494 "test-new/imp918s.imp"
} /* end of CUCI */
// 3495 %ROUTINE LAB LOOK(%INTEGERNAME FLAG,%INTEGER LAB)
#line 3495 "test-new/imp918s.imp"
void LABLOOK(int *FLAG, int LAB) {
// 3496 ! THIS ROUTINE LOOKS THRO THE STATEMENTS HELD IN THE CYCLIC BUFFER
// 3497 ! TO TRY TO FIND LABEL 'LAB'.
// 3498
// 3499 {%SHORTROUTINE}
// 3500 %INTEGER I,J,K,F,MUI,ME
#line 3500 "test-new/imp918s.imp"
int I;
#line 3500 "test-new/imp918s.imp"
int J;
#line 3500 "test-new/imp918s.imp"
int K;
#line 3500 "test-new/imp918s.imp"
int F;
#line 3500 "test-new/imp918s.imp"
int MUI;
#line 3500 "test-new/imp918s.imp"
int ME;
// 3501 FLAG=0
#line 3501 "test-new/imp918s.imp"
*FLAG = 0;
// 3502 %RETURN %UNLESS STMTSHELD>1
#line 3502 "test-new/imp918s.imp"
if (STMTSHELD > 1) goto L_02E4;
#line 3502 "test-new/imp918s.imp"
return;
#line 3502 "test-new/imp918s.imp"
L_02E4:;
// 3503 %IF |LAB-SFLABEL|<=1 %THEN F=1 %ELSE F=0
#line 3503 "test-new/imp918s.imp"
if (_imp_IMOD(LAB - SFLABEL) > 1) goto L_02E5;
#line 3503 "test-new/imp918s.imp"
F = 1;
#line 3503 "test-new/imp918s.imp"
goto L_02E6;
#line 3503 "test-new/imp918s.imp"
L_02E5:;
#line 3503 "test-new/imp918s.imp"
F = 0;
#line 3503 "test-new/imp918s.imp"
L_02E6:;
// 3504 %CYCLE I=2,1,STMTSHELD; ! CYCLE THROUGH STATEMENTS
#line 3504 "test-new/imp918s.imp"
// %for I = 2, 1, STMTSHELD %cycle
#line 3504 "test-new/imp918s.imp"
{
int _control, _initial = 2, _increment = 1, _final = STMTSHELD;
#line 3504 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 2, 1, STMTSHELD");
_control = I = _initial - _increment;
#line 3504 "test-new/imp918s.imp"
L_02E7:
#line 3504 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 3504 "test-new/imp918s.imp"
if (I == _final) goto L_02E8;
#line 3504 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 3505 J=STPTRS(I)
#line 3505 "test-new/imp918s.imp"
J = STPTRS[I - 1];
// 3506 %IF F>0 %THEN %START
#line 3506 "test-new/imp918s.imp"
if (F <= 0) goto L_02EA;
// 3507 -> FIN %IF A(J)=14
#line 3507 "test-new/imp918s.imp"
if (A[J + 7] != 14) goto L_02EB;
#line 3507 "test-new/imp918s.imp"
goto U_1033;
#line 3507 "test-new/imp918s.imp"
L_02EB:;
// 3508 -> AGN %UNLESS A(J)=5
#line 3508 "test-new/imp918s.imp"
if (A[J + 7] == 5) goto L_02EC;
#line 3508 "test-new/imp918s.imp"
goto U_1016;
#line 3508 "test-new/imp918s.imp"
L_02EC:;
// 3509 MUI=J+2+A(J+2); ME=MUI+1+A(MUI+1)
#line 3509 "test-new/imp918s.imp"
MUI = J + 2 + A[J + 2 + 7];
#line 3509 "test-new/imp918s.imp"
ME = MUI + 1 + A[MUI + 1 + 7];
// 3510 F=F+1 %IF A(MUI)<=2 %OR A(ME)=1
#line 3510 "test-new/imp918s.imp"
if (A[MUI + 7] <= 2) goto L_02ED;
#line 3510 "test-new/imp918s.imp"
if (A[ME + 7] != 1) goto L_02EE;
#line 3510 "test-new/imp918s.imp"
L_02ED:;
#line 3510 "test-new/imp918s.imp"
F = F + 1;
#line 3510 "test-new/imp918s.imp"
L_02EE:;
// 3511 -> AGN
#line 3511 "test-new/imp918s.imp"
goto U_1016;
// 3512 FIN: %IF F=1 %THEN %START
#line 3512 "test-new/imp918s.imp"
U_1033:;
#line 3512 "test-new/imp918s.imp"
if (F != 1) goto L_02EF;
// 3513 FLAG=1; %RETURN; %FINISH
#line 3513 "test-new/imp918s.imp"
*FLAG = 1;
#line 3513 "test-new/imp918s.imp"
return;
#line 3513 "test-new/imp918s.imp"
L_02EF:;
// 3514 F=F-1
#line 3514 "test-new/imp918s.imp"
F = F - 1;
// 3515 F=F+1 %IF A(J+1)=1
#line 3515 "test-new/imp918s.imp"
if (A[J + 1 + 7] != 1) goto L_02F0;
#line 3515 "test-new/imp918s.imp"
F = F + 1;
#line 3515 "test-new/imp918s.imp"
L_02F0:;
// 3516 -> AGN; %FINISH
#line 3516 "test-new/imp918s.imp"
goto U_1016;
#line 3516 "test-new/imp918s.imp"
L_02EA:;
// 3517 -> numeric LAB %IF A(J)=4; ! NUMERIC LAB
#line 3517 "test-new/imp918s.imp"
if (A[J + 7] != 4) goto L_02F1;
#line 3517 "test-new/imp918s.imp"
goto U_1017;
#line 3517 "test-new/imp918s.imp"
L_02F1:;
// 3518 -> AGN %UNLESS A(J)=1 %AND A(J+2)=1 %AND A(J+5)=2
#line 3518 "test-new/imp918s.imp"
if (A[J + 7] != 1) goto L_02F2;
#line 3518 "test-new/imp918s.imp"
if (A[J + 2 + 7] != 1) goto L_02F2;
#line 3518 "test-new/imp918s.imp"
if (A[J + 5 + 7] == 2) goto L_02F3;
#line 3518 "test-new/imp918s.imp"
L_02F2:;
#line 3518 "test-new/imp918s.imp"
goto U_1016;
#line 3518 "test-new/imp918s.imp"
L_02F3:;
// 3519 K=J+1+A(J+1); -> AGN %UNLESS A(K)=1
#line 3519 "test-new/imp918s.imp"
K = J + 1 + A[J + 1 + 7];
#line 3519 "test-new/imp918s.imp"
if (A[K + 7] == 1) goto L_02F4;
#line 3519 "test-new/imp918s.imp"
goto U_1016;
#line 3519 "test-new/imp918s.imp"
L_02F4:;
// 3520 K=16384+A(J+4)
#line 3520 "test-new/imp918s.imp"
K = 16384 + A[J + 4 + 7];
// 3521 SUCC: -> AGN %UNLESS K=LAB
#line 3521 "test-new/imp918s.imp"
U_1018:;
#line 3521 "test-new/imp918s.imp"
if (K == LAB) goto L_02F5;
#line 3521 "test-new/imp918s.imp"
goto U_1016;
#line 3521 "test-new/imp918s.imp"
L_02F5:;
// 3522 FLAG=1; %RETURN
#line 3522 "test-new/imp918s.imp"
*FLAG = 1;
#line 3522 "test-new/imp918s.imp"
return;
// 3523 numeric LAB: K=A(J+1); -> SUCC
#line 3523 "test-new/imp918s.imp"
U_1017:;
#line 3523 "test-new/imp918s.imp"
K = A[J + 1 + 7];
#line 3523 "test-new/imp918s.imp"
goto U_1018;
// 3524 AGN: %REPEAT
#line 3524 "test-new/imp918s.imp"
U_1016:;
#line 3524 "test-new/imp918s.imp"
goto L_02E7;
#line 3524 "test-new/imp918s.imp"
}
#line 3524 "test-new/imp918s.imp"
L_02E8:;
// 3525 %END
#line 3525 "test-new/imp918s.imp"
return;
#line 3525 "test-new/imp918s.imp"
} /* end of LABLOOK */
// 3526 {%RECORDFORMAT F(%INTEGER VAL,S1,S2,S3)}
// 3527 ! %RECORDFORMAT OPTFORM(%BYTEINTEGER COUNT,TYPE,%INTEGER BITS,%C
// 3528 ! PTYPE,XTRA)
// 3529 ! %RECORD(OPTFORM)%ARRAY OPTINF(0:25)
// 3530 !!%ROUTINE QSORT(%RECORD(F)%ARRAYNAME A,%INTEGER I,J)
// 3531 %ROUTINE QSORT(%RECORD(OPTFORM)%ARRAYNAME A,%INTEGER I,J)
#line 3531 "test-new/imp918s.imp"
void QSORT(struct OPTFORM * A, int I, int J) {
// 3532 {This is totally incompatible with where it was called. Wrong record format entirely.}
// 3533 {%RECORDSPEC A(F)}
// 3534 !!%RECORD (F)D
// 3535 %RECORD (OPTFORM)D
#line 3535 "test-new/imp918s.imp"
struct OPTFORM D;
// 3536 %INTEGER L,U
#line 3536 "test-new/imp918s.imp"
int L;
#line 3536 "test-new/imp918s.imp"
int U;
// 3537 %IF I>=J %THEN %RETURN
#line 3537 "test-new/imp918s.imp"
if (I < J) goto L_02F6;
#line 3537 "test-new/imp918s.imp"
return;
#line 3537 "test-new/imp918s.imp"
L_02F6:;
// 3538 L=I; U=J; D=A(J); ->FIND
#line 3538 "test-new/imp918s.imp"
L = I;
#line 3538 "test-new/imp918s.imp"
U = J;
#line 3538 "test-new/imp918s.imp"
D = [/*BUG*/ 0];
#line 3538 "test-new/imp918s.imp"
goto U_1034;
// 3539 UP:
#line 3539 "test-new/imp918s.imp"
U_1033:;
// 3540 L=L+1
#line 3540 "test-new/imp918s.imp"
L = L + 1;
// 3541 %IF L=U %THEN ->FOUND
#line 3541 "test-new/imp918s.imp"
if (L != U) goto L_02F7;
#line 3541 "test-new/imp918s.imp"
goto U_1016;
#line 3541 "test-new/imp918s.imp"
L_02F7:;
// 3542 FIND:
#line 3542 "test-new/imp918s.imp"
U_1034:;
// 3543 {%UNLESS A(L)_VAL>D_VAL %THEN ->UP}
// 3544 %UNLESS A(L)_count>D_count %THEN ->UP
#line 3544 "test-new/imp918s.imp"
if ([/*BUG*/ 0] -> COUNT > D.COUNT) goto L_02F8;
#line 3544 "test-new/imp918s.imp"
goto U_1033;
#line 3544 "test-new/imp918s.imp"
L_02F8:;
// 3545 A(U)=A(L)
#line 3545 "test-new/imp918s.imp"
[/*BUG*/ 0] = [/*BUG*/ 0];
// 3546 DOWN:
#line 3546 "test-new/imp918s.imp"
U_1017:;
// 3547 U=U-1
#line 3547 "test-new/imp918s.imp"
U = U - 1;
// 3548 %IF L=U %THEN ->FOUND
#line 3548 "test-new/imp918s.imp"
if (L != U) goto L_02F9;
#line 3548 "test-new/imp918s.imp"
goto U_1016;
#line 3548 "test-new/imp918s.imp"
L_02F9:;
// 3549 {%UNLESS A(U)_VAL<D_VAL %THEN ->DOWN}
// 3550 %UNLESS A(U)_count<D_count %THEN ->DOWN
#line 3550 "test-new/imp918s.imp"
if ([/*BUG*/ 0] -> COUNT < D.COUNT) goto L_02FA;
#line 3550 "test-new/imp918s.imp"
goto U_1017;
#line 3550 "test-new/imp918s.imp"
L_02FA:;
// 3551 A(L)=A(U); ->UP
#line 3551 "test-new/imp918s.imp"
[/*BUG*/ 0] = [/*BUG*/ 0];
#line 3551 "test-new/imp918s.imp"
goto U_1033;
// 3552 FOUND:
#line 3552 "test-new/imp918s.imp"
U_1016:;
// 3553 A(U)=D
#line 3553 "test-new/imp918s.imp"
[/*BUG*/ 0] = D;
// 3554 QSORT(A,I,L-1)
#line 3554 "test-new/imp918s.imp"
QSORT(A, I, L - 1);
// 3555 QSORT(A,U+1,J)
#line 3555 "test-new/imp918s.imp"
QSORT(A, U + 1, J);
// 3556 %END
#line 3556 "test-new/imp918s.imp"
return;
#line 3556 "test-new/imp918s.imp"
} /* end of QSORT */
// 3557 %ROUTINE OPTSAVE(%INTEGER TYPE,Z,PTYPE,XTRA)
#line 3557 "test-new/imp918s.imp"
void OPTSAVE(int TYPE, int Z, int PTYPE, int XTRA) {
// 3558 %RECORD(OPTFORM)%NAME OPTE
#line 3558 "test-new/imp918s.imp"
struct OPTFORM *OPTE;
// 3559 %INTEGER I
#line 3559 "test-new/imp918s.imp"
int I;
// 3560 %IF OPTPTR>=24 %THEN %RETURN
#line 3560 "test-new/imp918s.imp"
if (OPTPTR < 24) goto L_02FB;
#line 3560 "test-new/imp918s.imp"
return;
#line 3560 "test-new/imp918s.imp"
L_02FB:;
// 3561 I=1
#line 3561 "test-new/imp918s.imp"
I = 1;
// 3562 %WHILE I<=OPTPTR %CYCLE
#line 3562 "test-new/imp918s.imp"
L_02FC:;
#line 3562 "test-new/imp918s.imp"
if (I > OPTPTR) goto L_02FD;
// 3563 OPTE==OPTINF(I)
#line 3563 "test-new/imp918s.imp"
OPTE = (struct OPTFORM *)/*?*/ &OPTINF[I];
// 3564 %IF TYPE=OPTE_TYPE %AND XTRA=OPTE_XTRA %START
#line 3564 "test-new/imp918s.imp"
if (TYPE != OPTE->TYPE) goto L_02FE;
#line 3564 "test-new/imp918s.imp"
if (XTRA != OPTE->XTRA) goto L_02FE;
// 3565 OPTE_COUNT=OPTE_COUNT+1
#line 3565 "test-new/imp918s.imp"
OPTE->COUNT = OPTE->COUNT + 1;
// 3566 OPTE_BITS=OPTE_BITS!1<<Z
#line 3566 "test-new/imp918s.imp"
OPTE->BITS = OPTE->BITS | 1 << Z;
// 3567 %RETURN
#line 3567 "test-new/imp918s.imp"
return;
// 3568 %FINISH
#line 3568 "test-new/imp918s.imp"
L_02FE:;
// 3569 I=I+1
#line 3569 "test-new/imp918s.imp"
I = I + 1;
// 3570 %REPEAT
#line 3570 "test-new/imp918s.imp"
goto L_02FC;
#line 3570 "test-new/imp918s.imp"
L_02FD:;
// 3571 OPTPTR=OPTPTR+1
#line 3571 "test-new/imp918s.imp"
OPTPTR = OPTPTR + 1;
// 3572 OPTE==OPTINF(OPTPTR)
#line 3572 "test-new/imp918s.imp"
OPTE = (struct OPTFORM *)/*?*/ &OPTINF[OPTPTR];
// 3573 OPTE_COUNT=1
#line 3573 "test-new/imp918s.imp"
OPTE->COUNT = 1;
// 3574 OPTE_TYPE=TYPE
#line 3574 "test-new/imp918s.imp"
OPTE->TYPE = TYPE;
// 3575 OPTE_BITS=1<<Z
#line 3575 "test-new/imp918s.imp"
OPTE->BITS = 1 << Z;
// 3576 OPTE_PTYPE=PTYPE
#line 3576 "test-new/imp918s.imp"
OPTE->PTYPE = PTYPE;
// 3577 OPTE_XTRA=XTRA
#line 3577 "test-new/imp918s.imp"
OPTE->XTRA = XTRA;
// 3578 %END
#line 3578 "test-new/imp918s.imp"
return;
#line 3578 "test-new/imp918s.imp"
} /* end of OPTSAVE */
// 3579 %ROUTINE VALLOC(%INTEGER REG,TN)
#line 3579 "test-new/imp918s.imp"
void VALLOC(int REG, int TN) {
// 3580 {%SHORTROUTINE}
// 3581 !***********************************************************************
// 3582 !* ALLOCATE A VARIABLE (TAGS=TN) TO REGISTER REG BY LOADING *
// 3583 !* THE REGISTER AND FRIGGING THE TAGS. ONLY SIMPLE INTEGERS *
// 3584 !* (PTYPE=1) CAN BE ALLOCATED TO REGISTERS. *
// 3585 !* BYTES AND SHORTS ARE TRUNCATED BY <- ASSIGNMENTS. *
// 3586 !* NAME-TYPES MAY HAVE AN ALTER EGO *
// 3587 !* THE ALLOCATION CAN ONLY BE MADE FOR SECTIONS OF CODE THAT *
// 3588 !* HAVE NO RT-CALLS OR LABELS/JUMPS *
// 3589 !********-**************************************************************
// 3590 %INTEGER S1,S2,S3,I,Q
#line 3590 "test-new/imp918s.imp"
int S1;
#line 3590 "test-new/imp918s.imp"
int S2;
#line 3590 "test-new/imp918s.imp"
int S3;
#line 3590 "test-new/imp918s.imp"
int I;
#line 3590 "test-new/imp918s.imp"
int Q;
// 3591 FROM123(TN,S1,S2,S3)
#line 3591 "test-new/imp918s.imp"
FROM123(TN, /*?*/ &S1, /*?*/ &S2, /*?*/ &S3);
// 3592 %IF CUR CYC VAR>=0 %AND TN=TAGS(CUR CYC VAR) %START
#line 3592 "test-new/imp918s.imp"
if (CURCYCVAR < 0) goto L_02FF;
#line 3592 "test-new/imp918s.imp"
if (TN != TAGS[CURCYCVAR]) goto L_02FF;
// 3593 P=STPTRS(1)+5; ! CHECK INITIAL EXPRSN
#line 3593 "test-new/imp918s.imp"
P = STPTRS[0] + 5;
// 3594 Q=TSEXP(I,0)
#line 3594 "test-new/imp918s.imp"
Q = TSEXP(/*?*/ &I, 0);
// 3595 %FINISH %ELSE Q=0
#line 3595 "test-new/imp918s.imp"
goto L_0300;
#line 3595 "test-new/imp918s.imp"
L_02FF:;
#line 3595 "test-new/imp918s.imp"
Q = 0;
#line 3595 "test-new/imp918s.imp"
L_0300:;
// 3596 %IF Q=0 %OR Q>=100 %OR (Q=10 %AND I=CUR CYC VAR)%START
#line 3596 "test-new/imp918s.imp"
if (Q == 0) goto L_02E9;
#line 3596 "test-new/imp918s.imp"
if (Q >= 100) goto L_02E9;
#line 3596 "test-new/imp918s.imp"
if (Q != 10) goto L_0301;
#line 3596 "test-new/imp918s.imp"
if (I != CURCYCVAR) goto L_0301;
#line 3596 "test-new/imp918s.imp"
L_02E9:;
// 3597 FIND USE(I,1,3,TN)
#line 3597 "test-new/imp918s.imp"
FINDUSE(/*?*/ &I, 1, 3, TN);
// 3598 %IF I>=0 %THEN %START
#line 3598 "test-new/imp918s.imp"
if (I < 0) goto L_0302;
// 3599 PRR(X'18',REG,I) %UNLESS REG=I
#line 3599 "test-new/imp918s.imp"
if (REG == I) goto L_0303;
#line 3599 "test-new/imp918s.imp"
PRR(24, REG, I);
#line 3599 "test-new/imp918s.imp"
L_0303:;
// 3600 %FINISH %ELSE DUMP(X'58',REG,S3>>16,0,S1>>4&15)
#line 3600 "test-new/imp918s.imp"
goto L_0304;
#line 3600 "test-new/imp918s.imp"
L_0302:;
#line 3600 "test-new/imp918s.imp"
DUMP(88, REG, (unsigned int)S3 >> 16, 0, (unsigned int)S1 >> 4 & 15);
#line 3600 "test-new/imp918s.imp"
L_0304:;
// 3601 %FINISH
#line 3601 "test-new/imp918s.imp"
L_0301:;
// 3602 SET USE(REG,3,TN)
#line 3602 "test-new/imp918s.imp"
SETUSE(REG, 3, TN);
// 3603 REGISTER(REG)=-1; ! LOCK THE REG
#line 3603 "test-new/imp918s.imp"
REGISTER[REG] = -1;
// 3604 S1=S1+7<<16; ! PTYPE FROM1 TO 8
#line 3604 "test-new/imp918s.imp"
S1 = S1 + (7 << 16);
// 3605 S2=S2&X'FFFF'!S3&X'FFFF0000' ; ! K TO SNDISP
#line 3605 "test-new/imp918s.imp"
S2 = S2 & 65535 | S3 & -65536;
// 3606 REPLACE123(TN,S1,S2,REG<<16)
#line 3606 "test-new/imp918s.imp"
REPLACE123(TN, S1, S2, REG << 16);
// 3607 %END
#line 3607 "test-new/imp918s.imp"
return;
#line 3607 "test-new/imp918s.imp"
} /* end of VALLOC */
// 3608 %ROUTINE VDALLOC(%INTEGER REG,REGP)
#line 3608 "test-new/imp918s.imp"
void VDALLOC(int REG, int REGP) {
// 3609 {%SHORTROUTINE}
// 3610 !***********************************************************************
// 3611 !* DE-ALLOCATE REG WHICH WAS ALLOCATED BY VALLOC(Q.V.). STORE REG*
// 3612 !* INTO CORE AND RESTORE CORE COPY FROM REGP. REGP<=0 NO RESTORE *
// 3613 !* OFTEN REG=REGP *
// 3614 !***********************************************************************
// 3615 %INTEGER TN,S1,S2,S3
#line 3615 "test-new/imp918s.imp"
int TN;
#line 3615 "test-new/imp918s.imp"
int S1;
#line 3615 "test-new/imp918s.imp"
int S2;
#line 3615 "test-new/imp918s.imp"
int S3;
// 3616 TN=GRINF(REG)
#line 3616 "test-new/imp918s.imp"
TN = GRINF[REG];
// 3617 FROM123(TN,S1,S2,S3)
#line 3617 "test-new/imp918s.imp"
FROM123(TN, /*?*/ &S1, /*?*/ &S2, /*?*/ &S3);
// 3618 S3=S2>>16<<16
#line 3618 "test-new/imp918s.imp"
S3 = (unsigned int)S2 >> 16 << 16;
// 3619 S1=S1-7<<16; ! BACK TO INTEGER
#line 3619 "test-new/imp918s.imp"
S1 = S1 - (7 << 16);
// 3620 %IF REGP#0 %THEN DUMP(X'50',REGP,S3>>16,0,S1>>4&15)
#line 3620 "test-new/imp918s.imp"
if (REGP == 0) goto L_0305;
#line 3620 "test-new/imp918s.imp"
DUMP(80, REGP, (unsigned int)S3 >> 16, 0, (unsigned int)S1 >> 4 & 15);
#line 3620 "test-new/imp918s.imp"
L_0305:;
// 3621 REGISTER(REG)=0
#line 3621 "test-new/imp918s.imp"
REGISTER[REG] = 0;
// 3622 REPLACE123(TN,S1,S2,S3)
#line 3622 "test-new/imp918s.imp"
REPLACE123(TN, S1, S2, S3);
// 3623 %END
#line 3623 "test-new/imp918s.imp"
return;
#line 3623 "test-new/imp918s.imp"
} /* end of VDALLOC */
// 3624 %ROUTINE LOADUP(%INTEGER REGINFO)
#line 3624 "test-new/imp918s.imp"
void LOADUP(int REGINFO) {
// 3625 {%SHORTROUTINE}
// 3626 !***********************************************************************
// 3627 !* REGINFO IS BIT MASK OF AVAILABLE REGS *
// 3628 !* CYC BITS HAS INFORMATION ON OPERATIONS IN THE CYCLE *
// 3629 !* THIS ROUTINE PRELOADS ANY FREE REGISTERS FROM THE INFORMATION *
// 3630 !* IN THE LIST HEADED BY 'SFHEAD' WHICH WAS ORDERED BY ROUTINE *
// 3631 !* 'ORDER' SO THAT THE TOP HAS THE MOST USED ITEMS *
// 3632 !***********************************************************************
// 3633 {%SHORTROUTINE}
// 3634 %RECORD(OPTFORM)%NAME OPTE
#line 3634 "test-new/imp918s.imp"
struct OPTFORM *OPTE;
// 3635 %INTEGER I,USE,NEXTREG,INF,X,Y,Z,PTR
#line 3635 "test-new/imp918s.imp"
int I;
#line 3635 "test-new/imp918s.imp"
int USE;
#line 3635 "test-new/imp918s.imp"
int NEXTREG;
#line 3635 "test-new/imp918s.imp"
int INF;
#line 3635 "test-new/imp918s.imp"
int X;
#line 3635 "test-new/imp918s.imp"
int Y;
#line 3635 "test-new/imp918s.imp"
int Z;
#line 3635 "test-new/imp918s.imp"
int PTR;
// 3636 PTR=OPTPTR+1
#line 3636 "test-new/imp918s.imp"
PTR = OPTPTR + 1;
// 3637 AGN: PTR=PTR-1
#line 3637 "test-new/imp918s.imp"
U_1030:;
#line 3637 "test-new/imp918s.imp"
PTR = PTR - 1;
// 3638 ->Label99 %IF PTR=0
#line 3638 "test-new/imp918s.imp"
if (PTR != 0) goto L_0306;
#line 3638 "test-new/imp918s.imp"
goto U_1031;
#line 3638 "test-new/imp918s.imp"
L_0306:;
// 3639 OPTE==OPTINF(PTR)
#line 3639 "test-new/imp918s.imp"
OPTE = (struct OPTFORM *)/*?*/ &OPTINF[PTR];
// 3640 %IF REGINFO=0 %THEN ->Label99
#line 3640 "test-new/imp918s.imp"
if (REGINFO != 0) goto L_0307;
#line 3640 "test-new/imp918s.imp"
goto U_1031;
#line 3640 "test-new/imp918s.imp"
L_0307:;
// 3641 %CYCLE I=4,1,15
#line 3641 "test-new/imp918s.imp"
// %for I = 4, 1, 15 %cycle
#line 3641 "test-new/imp918s.imp"
{
int _control, _initial = 4, _increment = 1, _final = 15;
#line 3641 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 4, 1, 15");
_control = I = _initial - _increment;
#line 3641 "test-new/imp918s.imp"
L_0308:
#line 3641 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 3641 "test-new/imp918s.imp"
if (I == _final) goto L_0309;
#line 3641 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 3642 ->Label1 %IF REGINFO&(1<<I)#0
#line 3642 "test-new/imp918s.imp"
if (REGINFO & 1 << I == 0) goto L_030B;
#line 3642 "test-new/imp918s.imp"
goto U_1032;
#line 3642 "test-new/imp918s.imp"
L_030B:;
// 3643 %REPEAT
#line 3643 "test-new/imp918s.imp"
goto L_0308;
#line 3643 "test-new/imp918s.imp"
}
#line 3643 "test-new/imp918s.imp"
L_0309:;
// 3644 %MONITOR ; %STOP
#line 3644 "test-new/imp918s.imp"
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
#line 3644 "test-new/imp918s.imp"
_imp_stop(0);
// 3645 Label1: REGINFO=REGINFO!!(1<<I)
#line 3645 "test-new/imp918s.imp"
U_1032:;
#line 3645 "test-new/imp918s.imp"
REGINFO = REGINFO ^ 1 << I;
// 3646 Label2: NEXTREG=I
#line 3646 "test-new/imp918s.imp"
U_101D:;
#line 3646 "test-new/imp918s.imp"
NEXTREG = I;
// 3647 Label3: %IF OPTE_TYPE=12 %THEN ->CODEB
#line 3647 "test-new/imp918s.imp"
U_101E:;
#line 3647 "test-new/imp918s.imp"
if (OPTE->TYPE != 12) goto L_030C;
#line 3647 "test-new/imp918s.imp"
goto U_101F;
#line 3647 "test-new/imp918s.imp"
L_030C:;
// 3648 %IF OPTE_TYPE=0 %THEN ->CONST
#line 3648 "test-new/imp918s.imp"
if (OPTE->TYPE != 0) goto L_030D;
#line 3648 "test-new/imp918s.imp"
goto U_1020;
#line 3648 "test-new/imp918s.imp"
L_030D:;
// 3649 %IF OPTE_TYPE=2 %THEN %START
#line 3649 "test-new/imp918s.imp"
if (OPTE->TYPE != 2) goto L_030E;
// 3650 INF=TAGS(OPTE_XTRA)
#line 3650 "test-new/imp918s.imp"
INF = TAGS[OPTE->XTRA];
// 3651 PTYPE=OPTE_PTYPE; UNPACK
#line 3651 "test-new/imp918s.imp"
PTYPE = OPTE->PTYPE;
#line 3651 "test-new/imp918s.imp"
UNPACK();
// 3652 %IF PTYPE=1 %AND CYCBITS&X'40F'=0 %AND OPTE_BITS&3<<3=0 %C
#line 3652 "test-new/imp918s.imp"
if (PTYPE != 1) goto L_030F;
#line 3652 "test-new/imp918s.imp"
if (CYCBITS & 1039 != 0) goto L_030F;
#line 3652 "test-new/imp918s.imp"
if (OPTE->BITS & 3 << 3 != 0) goto L_030F;
#line 3652 "test-new/imp918s.imp"
if (CYCBITS & 32 == 0) goto L_0310;
#line 3652 "test-new/imp918s.imp"
if (OPTE->XTRA == CURCYCVAR) goto L_030F;
#line 3652 "test-new/imp918s.imp"
L_0310:;
#line 3652 "test-new/imp918s.imp"
VALLOC(NEXTREG, INF);
#line 3652 "test-new/imp918s.imp"
USE = 3;
#line 3652 "test-new/imp918s.imp"
goto U_1035;
#line 3652 "test-new/imp918s.imp"
L_030F:;
// 3653+ %AND(CYC BITS&X'20'=0 %OR OPTE_XTRA#CUR CYC VAR) %THEN %C
// 3654+ VALLOC(NEXTREG,INF) %AND USE=3 %AND ->RSET
// 3655 !
// 3656 %IF TYPE=3 %AND NAM=1 %AND ARR=0 %AND OPTE_BITS&5<<14=0 %C
#line 3656 "test-new/imp918s.imp"
if (TYPE != 3) goto L_0311;
#line 3656 "test-new/imp918s.imp"
if (NAM != 1) goto L_0311;
#line 3656 "test-new/imp918s.imp"
if (ARR != 0) goto L_0311;
#line 3656 "test-new/imp918s.imp"
if (OPTE->BITS & 5 << 14 != 0) goto L_0311;
#line 3656 "test-new/imp918s.imp"
if (CYCBITS & 8 == 0) goto L_0312;
#line 3656 "test-new/imp918s.imp"
if ((unsigned int)-(1 << 20) << FROM1(INF) >> 8 & 15 & CYCBITS != 0) goto L_0311;
#line 3656 "test-new/imp918s.imp"
L_0312:;
#line 3656 "test-new/imp918s.imp"
goto U_1036;
#line 3656 "test-new/imp918s.imp"
L_0311:;
// 3657+ %AND(CYCBITS&8=0 %OR ((-1<<20)<<FROM1(INF)>>8&15) %C
// 3658+ &CYCBITS=0) %THEN ->LOAD RBASE
// 3659 !
// 3660 %IF ARR=1 %AND(NAM=0 %OR (CYCBITS&8=0 %AND OPTE_BITS %C
#line 3660 "test-new/imp918s.imp"
if (ARR != 1) goto L_0313;
#line 3660 "test-new/imp918s.imp"
if (NAM == 0) goto L_0314;
#line 3660 "test-new/imp918s.imp"
if (CYCBITS & 8 != 0) goto L_0313;
#line 3660 "test-new/imp918s.imp"
if (OPTE->BITS & 1 << 12 != 0) goto L_0313;
#line 3660 "test-new/imp918s.imp"
L_0314:;
#line 3660 "test-new/imp918s.imp"
goto U_1029;
#line 3660 "test-new/imp918s.imp"
L_0313:;
// 3661+ &(1<<12)=0)) %THEN -> LOAD ABASE
// 3662 %FINISH
#line 3662 "test-new/imp918s.imp"
L_030E:;
// 3663 PTR=PTR-1
#line 3663 "test-new/imp918s.imp"
PTR = PTR - 1;
// 3664 ->Label99 %IF PTR<=0
#line 3664 "test-new/imp918s.imp"
if (PTR > 0) goto L_0315;
#line 3664 "test-new/imp918s.imp"
goto U_1031;
#line 3664 "test-new/imp918s.imp"
L_0315:;
// 3665 OPTE==OPTINF(PTR); ->Label3
#line 3665 "test-new/imp918s.imp"
OPTE = (struct OPTFORM *)/*?*/ &OPTINF[PTR];
#line 3665 "test-new/imp918s.imp"
goto U_101E;
// 3666 LOADRBASE:USE=7
#line 3666 "test-new/imp918s.imp"
U_1036:;
#line 3666 "test-new/imp918s.imp"
USE = 7;
// 3667 LOADANY: X=FROM1(INF)>>4&15
#line 3667 "test-new/imp918s.imp"
U_102A:;
#line 3667 "test-new/imp918s.imp"
X = (unsigned int)FROM1(INF) >> 4 & 15;
// 3668 Z=FROM3(INF)>>16
#line 3668 "test-new/imp918s.imp"
Z = (unsigned int)FROM3(INF) >> 16;
// 3669 I=X'58'
#line 3669 "test-new/imp918s.imp"
I = 88;
// 3670 ->COM
#line 3670 "test-new/imp918s.imp"
goto U_102B;
// 3671 LOADABASE:USE=8; ->LOADANY
#line 3671 "test-new/imp918s.imp"
U_1029:;
#line 3671 "test-new/imp918s.imp"
USE = 8;
#line 3671 "test-new/imp918s.imp"
goto U_102A;
// 3672 CODEB: ! BASE REGISTER FOR REPEATING NEEDED
#line 3672 "test-new/imp918s.imp"
U_101F:;
// 3673 PRR(5,NEXTREG,0); ! BALR NEXTREG,0
#line 3673 "test-new/imp918s.imp"
PRR(5, NEXTREG, 0);
// 3674 CYC BASE=NEXT REG; CYC ADDR=CA
#line 3674 "test-new/imp918s.imp"
CYCBASE = NEXTREG;
#line 3674 "test-new/imp918s.imp"
CYCADDR = CA;
// 3675 USE=12
#line 3675 "test-new/imp918s.imp"
USE = 12;
// 3676 INF=CYC ADDR; ->SETU
#line 3676 "test-new/imp918s.imp"
INF = CYCADDR;
#line 3676 "test-new/imp918s.imp"
goto U_102C;
// 3677 COM: DUMP(I,NEXTREG,Z,0,X)
#line 3677 "test-new/imp918s.imp"
U_102B:;
#line 3677 "test-new/imp918s.imp"
DUMP(I, NEXTREG, Z, 0, X);
// 3678 SETU: SET USE(NEXTREG,USE,INF)
#line 3678 "test-new/imp918s.imp"
U_102C:;
#line 3678 "test-new/imp918s.imp"
SETUSE(NEXTREG, USE, INF);
// 3679 REGISTER(NEXTREG)=-1
#line 3679 "test-new/imp918s.imp"
REGISTER[NEXTREG] = -1;
// 3680 RSET: CYC REGS=CYC REGS!1<<NEXTREG
#line 3680 "test-new/imp918s.imp"
U_1035:;
#line 3680 "test-new/imp918s.imp"
CYCREGS = CYCREGS | 1 << NEXTREG;
// 3681 ! %IF DCOMP=1 %THEN %START
// 3682 ! printstring("
// 3683 !LOADS REGISTER")
// 3684 ! WRITE(NEXTREG,3)
// 3685 ! WRITE(USE,3)
// 3686 ! WRITE(INF,5)
// 3687 ! %FINISH
// 3688 -> AGN
#line 3688 "test-new/imp918s.imp"
goto U_1030;
// 3689 CONST: I=0; Z=OPTE_XTRA
#line 3689 "test-new/imp918s.imp"
U_1020:;
#line 3689 "test-new/imp918s.imp"
I = 0;
#line 3689 "test-new/imp918s.imp"
Z = OPTE->XTRA;
// 3690 INF=Z
#line 3690 "test-new/imp918s.imp"
INF = Z;
// 3691 USE=2; X=0; -> COM
#line 3691 "test-new/imp918s.imp"
USE = 2;
#line 3691 "test-new/imp918s.imp"
X = 0;
#line 3691 "test-new/imp918s.imp"
goto U_102B;
// 3692 Label99: %END
#line 3692 "test-new/imp918s.imp"
U_1031:;
#line 3692 "test-new/imp918s.imp"
return;
#line 3692 "test-new/imp918s.imp"
} /* end of LOADUP */
// ?LABEL2 unused
// ?Y unused
// 3693 %ROUTINE CYCOPT(%INTEGERNAME FLAG,%INTEGER WU)
#line 3693 "test-new/imp918s.imp"
void CYCOPT(int *FLAG, int WU) {
// 3694 {%SHORTROUTINE}
// 3695 ! EXAMINE THE STATEMENTS IN THE CYCLIC BUFFER FOR A '%REPEAT' AND
// 3696 ! COMPUTE IF REGISTERS CAN BE ALLOCATED FOR INCREMENT AND FINAL VALUE.
// 3697 ! WU=0 FOR OLD TYPE CYCLE =1 FOR WHILE OR UNTIL =2 FOR OPEN CYCLE
// 3698 %INTEGER I,J,K,CREGS,SCCSTATE
#line 3698 "test-new/imp918s.imp"
int I;
#line 3698 "test-new/imp918s.imp"
int J;
#line 3698 "test-new/imp918s.imp"
int K;
#line 3698 "test-new/imp918s.imp"
int CREGS;
#line 3698 "test-new/imp918s.imp"
int SCCSTATE;
// 3699 FLAG=0; CREGS=0; CYC ASS=0; CYC REGS=0; CYC BASE=0
#line 3699 "test-new/imp918s.imp"
*FLAG = 0;
#line 3699 "test-new/imp918s.imp"
CREGS = 0;
#line 3699 "test-new/imp918s.imp"
CYCASS = 0;
#line 3699 "test-new/imp918s.imp"
CYCREGS = 0;
#line 3699 "test-new/imp918s.imp"
CYCBASE = 0;
// 3700 %RETURN %UNLESS STMTSHELD>1; ! NO STATEMENTS IN BUFFER
#line 3700 "test-new/imp918s.imp"
if (STMTSHELD > 1) goto L_0316;
#line 3700 "test-new/imp918s.imp"
return;
#line 3700 "test-new/imp918s.imp"
L_0316:;
// 3701 %RETURN %IF WU=0 %AND FFLAG#0;! FNS IN P,Q,R
#line 3701 "test-new/imp918s.imp"
if (WU != 0) goto L_0317;
#line 3701 "test-new/imp918s.imp"
if (FFLAG == 0) goto L_0317;
#line 3701 "test-new/imp918s.imp"
return;
#line 3701 "test-new/imp918s.imp"
L_0317:;
// 3702 %CYCLE I=2,1,STMTSHELD
#line 3702 "test-new/imp918s.imp"
// %for I = 2, 1, STMTSHELD %cycle
#line 3702 "test-new/imp918s.imp"
{
int _control, _initial = 2, _increment = 1, _final = STMTSHELD;
#line 3702 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 2, 1, STMTSHELD");
_control = I = _initial - _increment;
#line 3702 "test-new/imp918s.imp"
L_0318:
#line 3702 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 3702 "test-new/imp918s.imp"
if (I == _final) goto L_0319;
#line 3702 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 3703 J=STPTRS(I)
#line 3703 "test-new/imp918s.imp"
J = STPTRS[I - 1];
// 3704 ->NESTED %IF A(J)=2; ! CONTAINS NESTED CYCLE DONT OPTIMISE
#line 3704 "test-new/imp918s.imp"
if (A[J + 7] != 2) goto L_031A;
#line 3704 "test-new/imp918s.imp"
goto U_1017;
#line 3704 "test-new/imp918s.imp"
L_031A:;
// 3705 ->NESTED %IF A(J)=6 %AND A(J+2+A(J+2))<=2;! WU CYCLE
#line 3705 "test-new/imp918s.imp"
if (A[J + 7] != 6) goto L_031B;
#line 3705 "test-new/imp918s.imp"
if (A[J + 2 + A[J + 2 + 7] + 7] > 2) goto L_031B;
#line 3705 "test-new/imp918s.imp"
goto U_1017;
#line 3705 "test-new/imp918s.imp"
L_031B:;
// 3706 -> CR %IF A(J)=3; ! CORRESPONDING REPEAT FOUND!
#line 3706 "test-new/imp918s.imp"
if (A[J + 7] != 3) goto L_031C;
#line 3706 "test-new/imp918s.imp"
goto U_1018;
#line 3706 "test-new/imp918s.imp"
L_031C:;
// 3707 %REPEAT
#line 3707 "test-new/imp918s.imp"
goto L_0318;
#line 3707 "test-new/imp918s.imp"
}
#line 3707 "test-new/imp918s.imp"
L_0319:;
// 3708 NESTED: %RETURN
#line 3708 "test-new/imp918s.imp"
U_1017:;
#line 3708 "test-new/imp918s.imp"
return;
// 3709 CR: K=16; ->REGS %IF WU#0
#line 3709 "test-new/imp918s.imp"
U_1018:;
#line 3709 "test-new/imp918s.imp"
K = 16;
#line 3709 "test-new/imp918s.imp"
if (WU == 0) goto L_031D;
#line 3709 "test-new/imp918s.imp"
goto U_102E;
#line 3709 "test-new/imp918s.imp"
L_031D:;
// 3710 K=6; ->REGS %IF REGISTER(6)=0 %AND REGISTER(7)=0
#line 3710 "test-new/imp918s.imp"
K = 6;
#line 3710 "test-new/imp918s.imp"
if (REGISTER[6] != 0) goto L_031E;
#line 3710 "test-new/imp918s.imp"
if (REGISTER[7] != 0) goto L_031E;
#line 3710 "test-new/imp918s.imp"
goto U_102E;
#line 3710 "test-new/imp918s.imp"
L_031E:;
// 3711 K=4; ->REGS %IF REGISTER(4)=REGISTER(5)=0
#line 3711 "test-new/imp918s.imp"
K = 4;
#line 3711 "test-new/imp918s.imp"
{
// Double-sided test on REGISTER[5] (Part I)
#line 3711 "test-new/imp918s.imp"
int tmp;
#line 3711 "test-new/imp918s.imp"
if (REGISTER[4] != (tmp = REGISTER[5])) goto L_031F;
// Double-sided test on REGISTER[5] (Part II)
#line 3711 "test-new/imp918s.imp"
if (tmp != 0) goto L_031F;
#line 3711 "test-new/imp918s.imp"
}
#line 3711 "test-new/imp918s.imp"
goto U_102E;
#line 3711 "test-new/imp918s.imp"
L_031F:;
// 3712 FLAG=-1; ! WORTH TRYING TO USE GRS2&3
#line 3712 "test-new/imp918s.imp"
*FLAG = -1;
// 3713 %RETURN
#line 3713 "test-new/imp918s.imp"
return;
// 3714 REGS: FLAG=K
#line 3714 "test-new/imp918s.imp"
U_102E:;
#line 3714 "test-new/imp918s.imp"
*FLAG = K;
// 3715 ! %IF DCOMP=1 %THEN %START
// 3716 ! printstring("
// 3717 !CYCLE OPTIMISABLE")
// 3718 ! WRITE(FLAG,2)
// 3719 ! %FINISH
// 3720 EXTRA PASS(2-WU&1,I-1,FLAG)
#line 3720 "test-new/imp918s.imp"
EXTRAPASS(2 - (WU & 1), I - 1, *FLAG);
// 3721 %END
#line 3721 "test-new/imp918s.imp"
return;
#line 3721 "test-new/imp918s.imp"
} /* end of CYCOPT */
// ?SCCSTATE unused
// 3722 %ROUTINE EXTRA PASS(%INTEGER FST,LST,FLAG)
#line 3722 "test-new/imp918s.imp"
void EXTRAPASS(int FST, int LST, int FLAG) {
// 3723 {%SHORTROUTINE}
// 3724 %INTEGER SAVECA,USE,INF,BITS,J,CREGS,SCCSTATE
#line 3724 "test-new/imp918s.imp"
int SAVECA;
#line 3724 "test-new/imp918s.imp"
int USE;
#line 3724 "test-new/imp918s.imp"
int INF;
#line 3724 "test-new/imp918s.imp"
int BITS;
#line 3724 "test-new/imp918s.imp"
int J;
#line 3724 "test-new/imp918s.imp"
int CREGS;
#line 3724 "test-new/imp918s.imp"
int SCCSTATE;
// 3725 %SHORTINTEGER HEAD
#line 3725 "test-new/imp918s.imp"
short int HEAD;
// 3726 CREGS=0
#line 3726 "test-new/imp918s.imp"
CREGS = 0;
// 3727 %CYCLE J=4,1,14
#line 3727 "test-new/imp918s.imp"
// %for J = 4, 1, 14 %cycle
#line 3727 "test-new/imp918s.imp"
{
int _control, _initial = 4, _increment = 1, _final = 14;
#line 3727 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 4, 1, 14");
_control = J = _initial - _increment;
#line 3727 "test-new/imp918s.imp"
L_0320:
#line 3727 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3727 "test-new/imp918s.imp"
if (J == _final) goto L_0321;
#line 3727 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 3728 %IF REGISTER(J)=0 %THEN %START
#line 3728 "test-new/imp918s.imp"
if (REGISTER[J] != 0) goto L_0322;
// 3729 CREGS=CREGS!1<<J %UNLESS FLAG<=J<=FLAG+1
#line 3729 "test-new/imp918s.imp"
{
// Double-sided test on J (Part I)
#line 3729 "test-new/imp918s.imp"
int tmp;
#line 3729 "test-new/imp918s.imp"
if (FLAG > (tmp = J)) goto L_0323;
// Double-sided test on J (Part II)
#line 3729 "test-new/imp918s.imp"
if (tmp <= FLAG + 1) goto L_0324;
#line 3729 "test-new/imp918s.imp"
}
#line 3729 "test-new/imp918s.imp"
L_0323:;
#line 3729 "test-new/imp918s.imp"
CREGS = CREGS | 1 << J;
#line 3729 "test-new/imp918s.imp"
L_0324:;
// 3730 %FINISH
#line 3730 "test-new/imp918s.imp"
L_0322:;
// 3731 %REPEAT
#line 3731 "test-new/imp918s.imp"
goto L_0320;
#line 3731 "test-new/imp918s.imp"
}
#line 3731 "test-new/imp918s.imp"
L_0321:;
// 3732 %RETURN %UNLESS LST>=FST
#line 3732 "test-new/imp918s.imp"
if (LST >= FST) goto L_0325;
#line 3732 "test-new/imp918s.imp"
return;
#line 3732 "test-new/imp918s.imp"
L_0325:;
// 3733 CODE OUT; ! EMPTY CODE BUFFER
#line 3733 "test-new/imp918s.imp"
CODEOUT();
// 3734 SAVECA=CA; ! AND PRESERVE CURRENT ADDRESS
#line 3734 "test-new/imp918s.imp"
SAVECA = CA;
// 3735 INF=0; OPTPTR=0
#line 3735 "test-new/imp918s.imp"
INF = 0;
#line 3735 "test-new/imp918s.imp"
OPTPTR = 0;
// 3736 SCCSTATE=CCSTATE
#line 3736 "test-new/imp918s.imp"
SCCSTATE = CCSTATE;
// 3737 HEAD=0; GET ENV(HEAD); ! AND THE REGISTER CONTENTS
#line 3737 "test-new/imp918s.imp"
HEAD = 0;
#line 3737 "test-new/imp918s.imp"
GETENV(/*?*/ &HEAD);
// 3738 FORGETM(14)
#line 3738 "test-new/imp918s.imp"
FORGETM(14);
// 3739 %IF 4<=FLAG<=14 %THEN OPTSAVE(2,2,1,CURCYCVAR)
#line 3739 "test-new/imp918s.imp"
{
// Double-sided test on FLAG (Part I)
#line 3739 "test-new/imp918s.imp"
int tmp;
#line 3739 "test-new/imp918s.imp"
if (4 > (tmp = FLAG)) goto L_0326;
// Double-sided test on FLAG (Part II)
#line 3739 "test-new/imp918s.imp"
if (tmp > 14) goto L_0326;
#line 3739 "test-new/imp918s.imp"
}
#line 3739 "test-new/imp918s.imp"
OPTSAVE(2, 2, 1, CURCYCVAR);
#line 3739 "test-new/imp918s.imp"
L_0326:;
// 3740 ! CYCLE BITS SIGNIFY AS FOLLOWS:-
// 3741 ! 2**0 = STATEMENT CONTAINS USER LABEL
// 3742 ! 2**1 = STATEMENT CONTAINS JUMP INSTRUCTION
// 3743 ! 2**2 = STATEMENT CONTAINS PERM SUBROUTINE CALL
// 3744 ! 2**3 = STATEMENT CONTAINS NORMAL ROUTINE/FN CALL
// 3745 ! 2**4 = STATEMENT USES PERMS CONSTANT LIST
// 3746 ! 2**5 = STATEMENT CONTAINS ASSIGNMENT TO CONTROL VARIABLE
// 3747 ! 2**6 = STATEMENT REQUIRES EVEN/ODD PAIR
// 3748 ! 2**7 = STATEMENT REQUIRES A SAFE REGISTER
// 3749 ! 2**8 = STATEMENT CONTAINS == TO RECORD OR SCALAR NAME
// 3750 ! 2**9 = STATEMENT CONTAINS == TO ARRAY NAME
// 3751 ! 2**10= STATEMENT CONTAINS A STORE VIA A BUILT-IN MAP
// 3752 ! 2**20->Label2**31 GIVE TEXTUAL LEVELS OF ANY RTS CALLED
// 3753 SFHEAD=0; BITS=0
#line 3753 "test-new/imp918s.imp"
SFHEAD = 0;
#line 3753 "test-new/imp918s.imp"
BITS = 0;
// 3754 %IF SAVECA-CODEBASE>4000 %THEN BITS=X'10';! LONG BRANCH BACK
#line 3754 "test-new/imp918s.imp"
if (SAVECA - CODEBASE <= 4000) goto L_0327;
#line 3754 "test-new/imp918s.imp"
BITS = 16;
#line 3754 "test-new/imp918s.imp"
L_0327:;
// 3755 %CYCLE J=FST,1,LST; ! CYCLE THRO' ENCLOSED STMNTS
#line 3755 "test-new/imp918s.imp"
// %for J = FST, 1, LST %cycle
#line 3755 "test-new/imp918s.imp"
{
int _control, _initial = FST, _increment = 1, _final = LST;
#line 3755 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = FST, 1, LST");
_control = J = _initial - _increment;
#line 3755 "test-new/imp918s.imp"
L_0328:
#line 3755 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3755 "test-new/imp918s.imp"
if (J == _final) goto L_0329;
#line 3755 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 3756 CSS(STPTRS(J),0); ! COMPILE THEM
#line 3756 "test-new/imp918s.imp"
CSS(STPTRS[J - 1], 0);
// 3757 ! AND DISCARD ANY BINARY
// 3758 BITS=BITS!CYC BITS; ! REMEMBER SALIENT FEATURES
#line 3758 "test-new/imp918s.imp"
BITS = BITS | CYCBITS;
// 3759 FORGETM(14)
#line 3759 "test-new/imp918s.imp"
FORGETM(14);
// 3760 %REPEAT
#line 3760 "test-new/imp918s.imp"
goto L_0328;
#line 3760 "test-new/imp918s.imp"
}
#line 3760 "test-new/imp918s.imp"
L_0329:;
// 3761 %IF CA-CODEBASE<4000 %THEN CYC BASE=10 %AND CYC ADDR=CODEBASE
#line 3761 "test-new/imp918s.imp"
if (CA - CODEBASE >= 4000) goto L_032A;
#line 3761 "test-new/imp918s.imp"
CYCBASE = 10;
#line 3761 "test-new/imp918s.imp"
CYCADDR = CODEBASE;
#line 3761 "test-new/imp918s.imp"
L_032A:;
// 3762 CYC BITS=BITS
#line 3762 "test-new/imp918s.imp"
CYCBITS = BITS;
// 3763 -> NO PRELOAD %UNLESS CYC BITS&1=0; ! LABEL IN CYCLE
#line 3763 "test-new/imp918s.imp"
if (CYCBITS & 1 == 0) goto L_032B;
#line 3763 "test-new/imp918s.imp"
goto U_1031;
#line 3763 "test-new/imp918s.imp"
L_032B:;
// 3764 %IF CYC BITS&X'80'=0 %THEN ->Label5; ! IS A SAFE REG REQD?
#line 3764 "test-new/imp918s.imp"
if (CYCBITS & 128 != 0) goto L_032C;
#line 3764 "test-new/imp918s.imp"
goto U_1032;
#line 3764 "test-new/imp918s.imp"
L_032C:;
// 3765 %CYCLE J=14,-1,4
#line 3765 "test-new/imp918s.imp"
// %for J = 14, -1, 4 %cycle
#line 3765 "test-new/imp918s.imp"
{
int _control, _initial = 14, _increment = -1, _final = 4;
#line 3765 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 14, -1, 4");
_control = J = _initial - _increment;
#line 3765 "test-new/imp918s.imp"
L_032D:
#line 3765 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3765 "test-new/imp918s.imp"
if (J == _final) goto L_032E;
#line 3765 "test-new/imp918s.imp"
_control += _increment;
J -= 1;
// 3766 %IF CREGS&1<<J#0 %THEN CREGS=CREGS!!1<<J %AND ->Label5
#line 3766 "test-new/imp918s.imp"
if (CREGS & 1 << J == 0) goto L_032F;
#line 3766 "test-new/imp918s.imp"
CREGS = CREGS ^ 1 << J;
#line 3766 "test-new/imp918s.imp"
goto U_1032;
#line 3766 "test-new/imp918s.imp"
L_032F:;
// 3767 ! REMOVE 1 SAFE REGISTER
// 3768 %REPEAT
#line 3768 "test-new/imp918s.imp"
goto L_032D;
#line 3768 "test-new/imp918s.imp"
}
#line 3768 "test-new/imp918s.imp"
L_032E:;
// 3769 Label5: %IF CYCBITS&X'C'=0 %THEN CREGS=CREGS!(1<<15)
#line 3769 "test-new/imp918s.imp"
U_1032:;
#line 3769 "test-new/imp918s.imp"
if (CYCBITS & 12 != 0) goto L_0330;
#line 3769 "test-new/imp918s.imp"
CREGS = CREGS | 1 << 15;
#line 3769 "test-new/imp918s.imp"
L_0330:;
// 3770 QSORT(OPTINF,1,OPTPTR)
#line 3770 "test-new/imp918s.imp"
QSORT(OPTINF, 1, OPTPTR);
// 3771 %IF DCOMP=1 %THEN %START
#line 3771 "test-new/imp918s.imp"
if (DCOMP != 1) goto L_0331;
// 3772 %CYCLE J=1,1,OPTPTR
#line 3772 "test-new/imp918s.imp"
// %for J = 1, 1, OPTPTR %cycle
#line 3772 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = OPTPTR;
#line 3772 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, OPTPTR");
_control = J = _initial - _increment;
#line 3772 "test-new/imp918s.imp"
L_0332:
#line 3772 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3772 "test-new/imp918s.imp"
if (J == _final) goto L_0333;
#line 3772 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 3773 NEWLINE
#line 3773 "test-new/imp918s.imp"
_imp_NEWLINE();
// 3774 WRITE(OPTINF(J)_COUNT,5)
#line 3774 "test-new/imp918s.imp"
_imp_WRITE(OPTINF[J].COUNT, 5);
// 3775 WRITE(OPTINF(J)_TYPE,5)
#line 3775 "test-new/imp918s.imp"
_imp_WRITE(OPTINF[J].TYPE, 5);
// 3776 WRITE(OPTINF(J)_BITS,5)
#line 3776 "test-new/imp918s.imp"
_imp_WRITE(OPTINF[J].BITS, 5);
// 3777 WRITE(OPTINF(J)_PTYPE,5)
#line 3777 "test-new/imp918s.imp"
_imp_WRITE(OPTINF[J].PTYPE, 5);
// 3778 WRITE(OPTINF(J)_XTRA,5)
#line 3778 "test-new/imp918s.imp"
_imp_WRITE(OPTINF[J].XTRA, 5);
// 3779 %REPEAT
#line 3779 "test-new/imp918s.imp"
goto L_0332;
#line 3779 "test-new/imp918s.imp"
}
#line 3779 "test-new/imp918s.imp"
L_0333:;
// 3780 %FINISH
#line 3780 "test-new/imp918s.imp"
L_0331:;
// 3781 %IF CYCBASE=0 %THEN OPTPTR=OPTPTR+1 %AND OPTINF(OPTPTR)_TYPE=12
#line 3781 "test-new/imp918s.imp"
if (CYCBASE != 0) goto L_0335;
#line 3781 "test-new/imp918s.imp"
OPTPTR = OPTPTR + 1;
#line 3781 "test-new/imp918s.imp"
OPTINF[OPTPTR].TYPE = 12;
#line 3781 "test-new/imp918s.imp"
L_0335:;
// 3782 -> RELOAD; ! REARRANGE INFO GLEANED
#line 3782 "test-new/imp918s.imp"
goto U_101D;
// 3783 NO PRELOAD: CREGS=0
#line 3783 "test-new/imp918s.imp"
U_1031:;
#line 3783 "test-new/imp918s.imp"
CREGS = 0;
// 3784 RELOAD: RESTORE(HEAD); ! RESET REGISTERS
#line 3784 "test-new/imp918s.imp"
U_101D:;
#line 3784 "test-new/imp918s.imp"
RESTORE(HEAD);
// 3785 CCSTATE=SCCSTATE
#line 3785 "test-new/imp918s.imp"
CCSTATE = SCCSTATE;
// 3786 CA=SAVECA; CABUF=CA; PP CURR=0
#line 3786 "test-new/imp918s.imp"
CA = SAVECA;
#line 3786 "test-new/imp918s.imp"
CABUF = CA;
#line 3786 "test-new/imp918s.imp"
PPCURR = 0;
// 3787 %IF CREGS=0 %THEN %RETURN
#line 3787 "test-new/imp918s.imp"
if (CREGS != 0) goto L_0336;
#line 3787 "test-new/imp918s.imp"
return;
#line 3787 "test-new/imp918s.imp"
L_0336:;
// 3788 !
// 3789 ! LOAD BASE AND INCREMENT HERE WHEN RELEVANT IN CASE OF CYCLE I=1,1,I
// 3790 !
// 3791 %IF 4<=FLAG<=14 %START
#line 3791 "test-new/imp918s.imp"
{
// Double-sided test on FLAG (Part I)
#line 3791 "test-new/imp918s.imp"
int tmp;
#line 3791 "test-new/imp918s.imp"
if (4 > (tmp = FLAG)) goto L_0337;
// Double-sided test on FLAG (Part II)
#line 3791 "test-new/imp918s.imp"
if (tmp > 14) goto L_0337;
#line 3791 "test-new/imp918s.imp"
}
// 3792 P=STPTRS(1)+5
#line 3792 "test-new/imp918s.imp"
P = STPTRS[0] + 5;
// 3793 SKIP EXP
#line 3793 "test-new/imp918s.imp"
SKIPEXP();
// 3794 DSEXP(FLAG,0)
#line 3794 "test-new/imp918s.imp"
DSEXP(FLAG, 0);
// 3795 SET USE(FLAG,14,0)
#line 3795 "test-new/imp918s.imp"
SETUSE(FLAG, 14, 0);
// 3796 SET USE(FLAG+1,14,0)
#line 3796 "test-new/imp918s.imp"
SETUSE(FLAG + 1, 14, 0);
// 3797 %FINISH
#line 3797 "test-new/imp918s.imp"
L_0337:;
// 3798 LOAD UP (CREGS)
#line 3798 "test-new/imp918s.imp"
LOADUP(CREGS);
// 3799 %END
#line 3799 "test-new/imp918s.imp"
return;
#line 3799 "test-new/imp918s.imp"
} /* end of EXTRAPASS */
// ?USE unused
// 3800 %ROUTINE CYC RESTORE
#line 3800 "test-new/imp918s.imp"
void CYCRESTORE(void) {
// 3801 {%SHORTROUTINE}
// 3802 %INTEGER I
#line 3802 "test-new/imp918s.imp"
int I;
// 3803 %CYCLE I=4,1,15
#line 3803 "test-new/imp918s.imp"
// %for I = 4, 1, 15 %cycle
#line 3803 "test-new/imp918s.imp"
{
int _control, _initial = 4, _increment = 1, _final = 15;
#line 3803 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 4, 1, 15");
_control = I = _initial - _increment;
#line 3803 "test-new/imp918s.imp"
L_0338:
#line 3803 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 3803 "test-new/imp918s.imp"
if (I == _final) goto L_0339;
#line 3803 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 3804 %IF CYC REGS&1<<I#0 %THEN %START
#line 3804 "test-new/imp918s.imp"
if (CYCREGS & 1 << I == 0) goto L_033A;
// 3805 %IF GRUSE(I)=3 %THEN VDALLOC(I,I*(CYCASS>>I&1)) %C
#line 3805 "test-new/imp918s.imp"
if (GRUSE[I] != 3) goto L_033B;
#line 3805 "test-new/imp918s.imp"
VDALLOC(I, I * ((unsigned int)CYCASS >> I & 1));
#line 3805 "test-new/imp918s.imp"
goto L_033C;
#line 3805 "test-new/imp918s.imp"
L_033B:;
#line 3805 "test-new/imp918s.imp"
REGISTER[I] = 0;
#line 3805 "test-new/imp918s.imp"
L_033C:;
// 3806+ %ELSE REGISTER(I)=0
// 3807 %FINISH
#line 3807 "test-new/imp918s.imp"
L_033A:;
// 3808 %REPEAT
#line 3808 "test-new/imp918s.imp"
goto L_0338;
#line 3808 "test-new/imp918s.imp"
}
#line 3808 "test-new/imp918s.imp"
L_0339:;
// 3809 %END
#line 3809 "test-new/imp918s.imp"
return;
#line 3809 "test-new/imp918s.imp"
} /* end of CYCRESTORE */
// 3810 %ROUTINE CREATE AH(%INTEGER MODE,REG,BS,DP)
#line 3810 "test-new/imp918s.imp"
void CREATEAH(int MODE, int REG, int BS, int DP) {
// 3811 {%SHORTROUTINE}
// 3812 !***********************************************************************
// 3813 !* CREATES AN ARRAYHEAD IN TEMPORARY SPACE BY MODIFYING THE HEAD *
// 3814 !* AT BS&DP BY THE REGISTER REG,AS FOLLOWS:- *
// 3815 !* MODE=0 (ARRAYMAPPING) REG HAS ADDR OF FIRST ELEMENT *
// 3816 !* MODE=1 (ARRAYS IN RECORDS)-REG HAS RELOCATION FACTOR *
// 3817 !* REG IS SET AND PROTECTED BY THE CALLING ROUTINE. ON EXIT DISP *
// 3818 !* INDEX & BASE POINT TO THE NEW ARRAYHEAD *
// 3819 !***********************************************************************
// 3820 %INTEGER I,R1,R2,R3,R4,R5,WK,J
#line 3820 "test-new/imp918s.imp"
int I;
#line 3820 "test-new/imp918s.imp"
int R1;
#line 3820 "test-new/imp918s.imp"
int R2;
#line 3820 "test-new/imp918s.imp"
int R3;
#line 3820 "test-new/imp918s.imp"
int R4;
#line 3820 "test-new/imp918s.imp"
int R5;
#line 3820 "test-new/imp918s.imp"
int WK;
#line 3820 "test-new/imp918s.imp"
int J;
// 3821 GET WSP(WK,4); ! GET FOUR WORDS FOR NEW HEAD
#line 3821 "test-new/imp918s.imp"
GETWSP(/*?*/ &WK, 4);
// 3822 FIND SEQ(R1,R2); ! 2 WORK REGISTERS
#line 3822 "test-new/imp918s.imp"
FINDSEQ(/*?*/ &R1, /*?*/ &R2);
// 3823 R3=(R2+1)&15; R4=(R3+1)&15; ! TRY FOR 2 MORE
#line 3823 "test-new/imp918s.imp"
R3 = R2 + 1 & 15;
#line 3823 "test-new/imp918s.imp"
R4 = R3 + 1 & 15;
// 3824 %UNLESS REGISTER(R3)=0=REGISTER(R4) %THEN R4=R2
#line 3824 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 3824 "test-new/imp918s.imp"
int tmp;
#line 3824 "test-new/imp918s.imp"
if (REGISTER[R3] != (tmp = 0)) goto L_030A;
// Double-sided test on 0 (Part II)
#line 3824 "test-new/imp918s.imp"
if (tmp == REGISTER[R4]) goto L_033D;
#line 3824 "test-new/imp918s.imp"
}
#line 3824 "test-new/imp918s.imp"
L_030A:;
#line 3824 "test-new/imp918s.imp"
R4 = R2;
#line 3824 "test-new/imp918s.imp"
L_033D:;
// 3825 %IF R1>R4 %THEN R5=R4+16 %ELSE R5=R4
#line 3825 "test-new/imp918s.imp"
if (R1 <= R4) goto L_033E;
#line 3825 "test-new/imp918s.imp"
R5 = R4 + 16;
#line 3825 "test-new/imp918s.imp"
goto L_033F;
#line 3825 "test-new/imp918s.imp"
L_033E:;
#line 3825 "test-new/imp918s.imp"
R5 = R4;
#line 3825 "test-new/imp918s.imp"
L_033F:;
// 3826 %CYCLE J=R1,1,R5
#line 3826 "test-new/imp918s.imp"
// %for J = R1, 1, R5 %cycle
#line 3826 "test-new/imp918s.imp"
{
int _control, _initial = R1, _increment = 1, _final = R5;
#line 3826 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = R1, 1, R5");
_control = J = _initial - _increment;
#line 3826 "test-new/imp918s.imp"
L_0340:
#line 3826 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3826 "test-new/imp918s.imp"
if (J == _final) goto L_0341;
#line 3826 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 3827 I=J&15
#line 3827 "test-new/imp918s.imp"
I = J & 15;
// 3828 REGISTER(I)=1; ! CLAIM WORKING REGISTERS
#line 3828 "test-new/imp918s.imp"
REGISTER[I] = 1;
// 3829 FORGET(I)
#line 3829 "test-new/imp918s.imp"
FORGET(I);
// 3830 %REPEAT
#line 3830 "test-new/imp918s.imp"
goto L_0340;
#line 3830 "test-new/imp918s.imp"
}
#line 3830 "test-new/imp918s.imp"
L_0341:;
// 3831 DUMPM(X'98',R1,R4,BS,DP); ! PICK UP 2 OR 4 ELEMENTS
#line 3831 "test-new/imp918s.imp"
DUMPM(152, R1, R4, BS, DP);
// 3832 %IF MODE=0 %THEN PRR(X'1B',R1,R2); ! SR R1,R2
#line 3832 "test-new/imp918s.imp"
if (MODE != 0) goto L_0343;
#line 3832 "test-new/imp918s.imp"
PRR(27, R1, R2);
#line 3832 "test-new/imp918s.imp"
L_0343:;
// 3833 PRR(X'18'+2*MODE,R2,REG); ! LR R2,REG (MODE=0) OR AR R2,REG
#line 3833 "test-new/imp918s.imp"
PRR(24 + 2 * MODE, R2, REG);
// 3834 PRR(X'1A',R1,REG); ! AR R1,REG
#line 3834 "test-new/imp918s.imp"
PRR(26, R1, REG);
// 3835 DUMPM(X'90',R1,R4,RBASE,WK); ! STUFF OFF MODIFIED ELEMENTS
#line 3835 "test-new/imp918s.imp"
DUMPM(144, R1, R4, RBASE, WK);
// 3836 %IF R2=R4 %THEN %START; ! ONLY 2 WORK REGISTERS
#line 3836 "test-new/imp918s.imp"
if (R2 != R4) goto L_0344;
// 3837 DUMPM(X'98',R1,R2,BS,DP+8);! SO REPEAT ON LAST ELEMENTS
#line 3837 "test-new/imp918s.imp"
DUMPM(152, R1, R2, BS, DP + 8);
// 3838 DUMPM(X'90',R1,R2,RBASE,WK+8)
#line 3838 "test-new/imp918s.imp"
DUMPM(144, R1, R2, RBASE, WK + 8);
// 3839 %FINISH
#line 3839 "test-new/imp918s.imp"
L_0344:;
// 3840 !
// 3841 %CYCLE J=R1,1,R5
#line 3841 "test-new/imp918s.imp"
// %for J = R1, 1, R5 %cycle
#line 3841 "test-new/imp918s.imp"
{
int _control, _initial = R1, _increment = 1, _final = R5;
#line 3841 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = R1, 1, R5");
_control = J = _initial - _increment;
#line 3841 "test-new/imp918s.imp"
L_0345:
#line 3841 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3841 "test-new/imp918s.imp"
if (J == _final) goto L_0346;
#line 3841 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// 3842 REGISTER(J&15)=0; ! FREE WORK REGISTERS
#line 3842 "test-new/imp918s.imp"
REGISTER[J & 15] = 0;
// 3843 %REPEAT
#line 3843 "test-new/imp918s.imp"
goto L_0345;
#line 3843 "test-new/imp918s.imp"
}
#line 3843 "test-new/imp918s.imp"
L_0346:;
// 3844 INDEX=0; BASE=RBASE
#line 3844 "test-new/imp918s.imp"
INDEX = 0;
#line 3844 "test-new/imp918s.imp"
BASE = RBASE;
// 3845 DISP=WK; ! WK RETURNED ON EXIT FROM CSS
#line 3845 "test-new/imp918s.imp"
DISP = WK;
// 3846 CCSTATE=-1
#line 3846 "test-new/imp918s.imp"
CCSTATE = -1;
// 3847 %END; ! OF ROUTINE CREATE AH
#line 3847 "test-new/imp918s.imp"
return;
#line 3847 "test-new/imp918s.imp"
} /* end of CREATEAH */
// 3848 %INTEGERFN DOPE VECTOR(%INTEGER ELSIZE,LB,UB)
#line 3848 "test-new/imp918s.imp"
int DOPEVECTOR(int ELSIZE, int LB, int UB) {
// 3849 {%SHORTROUTINE}
// 3850 !***********************************************************************
// 3851 !* CONSTRUCTS THE DOPE-VECTOR FOR A 1-DIMENSIONAL ARRAY IN THE *
// 3852 !* SHAREABLE SYMBOL TABLES AND RETURNS ITS DISPLACEMENT AS RESULT*
// 3853 !* EVENTUALLY ALL NON DYNAMIC DOPE VECTORS SHOULD GO VIA HERE *
// 3854 !* AND AS MUCH SHARING AS POSSIBLE SHOULD GO ON. *
// 3855 !* THE LIST OF DOPE VECTORS LOOKS LIKE:- *
// 3856 !* STREAM1(32 BITS) = LOWER BOUND<<16 ! UPPER BOUND *
// 3857 !* STREAM2(32 BITS) = DISPLACEMENT OF DOPEVECTOR IN SHAREABLE ST *
// 3858 !* STREAM3(16 BITS) = THE ELEMENT SIZE IN BYTES *
// 3859 !* A CHECK IS REQUIRED THAT EACH BOUND FITS INTO 16 BITS *
// 3860 !***********************************************************************
// 3861 %INTEGER RANGE,I,J,K,W1,HEAD
#line 3861 "test-new/imp918s.imp"
int RANGE;
#line 3861 "test-new/imp918s.imp"
int I;
#line 3861 "test-new/imp918s.imp"
int J;
#line 3861 "test-new/imp918s.imp"
int K;
#line 3861 "test-new/imp918s.imp"
int W1;
#line 3861 "test-new/imp918s.imp"
int HEAD;
// 3862 W1=LB<<16!UB&X'FFFF'
#line 3862 "test-new/imp918s.imp"
W1 = LB << 16 | UB & 65535;
// 3863 %IF SHORTINTEGER(ADDR(W1))=LB %AND %C
#line 3863 "test-new/imp918s.imp"
if (*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &W1)) != LB) goto L_0347;
#line 3863 "test-new/imp918s.imp"
if (*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &W1) + 2) != UB) goto L_0347;
// 3864+ SHORTINTEGER(ADDR(W1)+2)=UB %START
// 3865 HEAD=DVHEAD
#line 3865 "test-new/imp918s.imp"
HEAD = DVHEAD;
// 3866 %WHILE HEAD#0 %CYCLE; ! SEARCH THE PREVIOUS DVS
#line 3866 "test-new/imp918s.imp"
L_0348:;
#line 3866 "test-new/imp918s.imp"
if (HEAD == 0) goto L_0349;
// 3867 FROM123(HEAD,I,J,K); ! FOR ONE THAT IS IDENTICAL
#line 3867 "test-new/imp918s.imp"
FROM123(HEAD, /*?*/ &I, /*?*/ &J, /*?*/ &K);
// 3868 MLINK(HEAD)
#line 3868 "test-new/imp918s.imp"
MLINK(/*?*/ &HEAD);
// 3869 %IF I=W1 %AND K=ELSIZE %THEN %RESULT=J
#line 3869 "test-new/imp918s.imp"
if (I != W1) goto L_034A;
#line 3869 "test-new/imp918s.imp"
if (K != ELSIZE) goto L_034A;
#line 3869 "test-new/imp918s.imp"
return J;
#line 3869 "test-new/imp918s.imp"
L_034A:;
// 3870 %REPEAT
#line 3870 "test-new/imp918s.imp"
goto L_0348;
#line 3870 "test-new/imp918s.imp"
L_0349:;
// 3871 PUSH123(DVHEAD,W1,SSTL,ELSIZE);! INSERT NEW DOPE VECR INTO LIST
#line 3871 "test-new/imp918s.imp"
PUSH123(/*?*/ &DVHEAD, W1, SSTL, ELSIZE);
// 3872 %FINISH
#line 3872 "test-new/imp918s.imp"
L_0347:;
// 3873 RANGE=UB-LB+1
#line 3873 "test-new/imp918s.imp"
RANGE = UB - LB + 1;
// 3874 I=SSTL; ELSIZE=ELSIZE!1<<16
#line 3874 "test-new/imp918s.imp"
I = SSTL;
#line 3874 "test-new/imp918s.imp"
ELSIZE = ELSIZE | 1 << 16;
// 3875 LPUT(4,16,SSTL,ADDR(ELSIZE))%IF INHCODE=0
#line 3875 "test-new/imp918s.imp"
if (INHCODE != 0) goto L_034B;
#line 3875 "test-new/imp918s.imp"
LPUT(4, 16, SSTL, _imp_ADDR(/*?*/ &ELSIZE));
#line 3875 "test-new/imp918s.imp"
L_034B:;
// 3876 SSTL=SSTL+16
#line 3876 "test-new/imp918s.imp"
SSTL = SSTL + 16;
// 3877 %RESULT=I
#line 3877 "test-new/imp918s.imp"
return I;
// 3878 %END
#line 3878 "test-new/imp918s.imp"
} /* end of DOPEVECTOR */
// 3879 %ROUTINE CLAIM ST FRAME(%INTEGER AT,VALUE)
#line 3879 "test-new/imp918s.imp"
void CLAIMSTFRAME(int AT, int VALUE) {
// 3880 {%SHORTROUTINE}
// 3881 !***********************************************************************
// 3882 !* FILL THE LA INSTN IT RT ENTRY SEQUENCE TO CLAIM THE STACKFRAME*
// 3883 !* DIFFICULT WHEN THE FRAME IS>4095 *
// 3884 !***********************************************************************
// 3885 %INTEGER PLUG2
#line 3885 "test-new/imp918s.imp"
int PLUG2;
// 3886 %IF 4096>VALUE %THEN PLUG(1,AT,VALUE) %AND %RETURN
#line 3886 "test-new/imp918s.imp"
if (4096 <= VALUE) goto L_034C;
#line 3886 "test-new/imp918s.imp"
PLUG(1, AT, VALUE);
#line 3886 "test-new/imp918s.imp"
return;
#line 3886 "test-new/imp918s.imp"
L_034C:;
// 3887 !
// 3888 ! IF THE FRAME IS >4096 THE WHOLE INSTRN IS OVERWRITTEN WITH AN ADD
// 3889 !
// 3890 %IF GLACA<4092 %THEN %START
#line 3890 "test-new/imp918s.imp"
if (GLACA >= 4092) goto L_034D;
// 3891 PGLA(2,2,ADDR(VALUE)+2)
#line 3891 "test-new/imp918s.imp"
PGLA(2, 2, _imp_ADDR(/*?*/ &VALUE) + 2);
// 3892 PLUG2=X'D000'!(GLACA-2)
#line 3892 "test-new/imp918s.imp"
PLUG2 = 53248 | GLACA - 2;
// 3893 %FINISH %ELSE PLUG2=X'C000'!(PTBASE+6+VALUE>>12<<2)
#line 3893 "test-new/imp918s.imp"
goto L_034E;
#line 3893 "test-new/imp918s.imp"
L_034D:;
#line 3893 "test-new/imp918s.imp"
PLUG2 = 49152 | 256 + 6 + ((unsigned int)VALUE >> 12 << 2);
#line 3893 "test-new/imp918s.imp"
L_034E:;
// 3894 PLUG(1,AT-2,X'4AB0')
#line 3894 "test-new/imp918s.imp"
PLUG(1, AT - 2, 19120);
// 3895 PLUG(1,AT,PLUG2)
#line 3895 "test-new/imp918s.imp"
PLUG(1, AT, PLUG2);
// 3896 %END
#line 3896 "test-new/imp918s.imp"
return;
#line 3896 "test-new/imp918s.imp"
} /* end of CLAIMSTFRAME */
// 3897 %ROUTINE CEND (%INTEGER KKK)
#line 3897 "test-new/imp918s.imp"
void CEND(int KKK) {
// 3898 !***********************************************************************
// 3899 !* DEAL WITH ALL OCCURENCES OF '%END' *
// 3900 !* KKK=PTYPE(>=10000) FOR ROUTINES,FNS AND MAPS *
// 3901 !* KKK=0 FOR ENDS OF '%BEGIN' BLOCKS *
// 3902 !* KKK=1 FOR '%ENDOFPROGRAM' *
// 3903 !* %ENDOFPROGRAM IS REALLY TWO ENDS. THE FIRST IS THE USERS *
// 3904 !* AND THE SECOND IS PERMS. KKK=2 FOR A RECURSIVE CALL OF CEND *
// 3905 !* ON END OF PROGRAM TO DEAL WITH THE %END CORRESPONDING TO *
// 3906 !* THE %BEGIN COMPILED IN THE INITIALISATION SEQUENCE *
// 3907 !***********************************************************************
// 3908 {%SHORT %ROUTINE}
// 3909 %INTEGER KP
#line 3909 "test-new/imp918s.imp"
int KP;
// 3910 %SHORTINTEGERNAME THEAD
#line 3910 "test-new/imp918s.imp"
short int *THEAD;
#line 3910 "test-new/imp918s.imp"
auto void DTABLE(int LEVEL, int GLOBAL);
// 3911 %ROUTINESPEC DTABLE(%INTEGER LEVEL,GLOBAL)
// 3912 SET LINE; MONE=1; FORGETM(14)
#line 3912 "test-new/imp918s.imp"
SETLINE();
#line 3912 "test-new/imp918s.imp"
MONE = 1;
#line 3912 "test-new/imp918s.imp"
FORGETM(14);
// 3913 CUR CYC VAR=0; CCSTATE=-1
#line 3913 "test-new/imp918s.imp"
CURCYCVAR = 0;
#line 3913 "test-new/imp918s.imp"
CCSTATE = -1;
// 3914 !
// 3915 ! FIRST CHECK FOR ANY '%STARTS' WITHOUT FINISHES
// 3916 !
// 3917 %WHILE SBR(LEVEL)#0 %CYCLE
#line 3917 "test-new/imp918s.imp"
L_034F:;
#line 3917 "test-new/imp918s.imp"
if (SBR[LEVEL] == 0) goto L_0350;
// 3918 FROM12 (SBR(LEVEL),J,KP)
#line 3918 "test-new/imp918s.imp"
FROM12(SBR[LEVEL], /*?*/ &J, /*?*/ &KP);
// 3919 FAULT(53,0); ! FINISH MISSING
#line 3919 "test-new/imp918s.imp"
FAULT(53, 0);
// 3920 A(2)=14; A(3)=3; CSS(2,0); ! SO COMPILE IT IN
#line 3920 "test-new/imp918s.imp"
A[9] = 14;
#line 3920 "test-new/imp918s.imp"
A[10] = 3;
#line 3920 "test-new/imp918s.imp"
CSS(2, 0);
// 3921 %REPEAT
#line 3921 "test-new/imp918s.imp"
goto L_034F;
#line 3921 "test-new/imp918s.imp"
L_0350:;
// 3922 !
// 3923 ! NOW PLANT AN ERROR EXIT FOR FNS AND MAPS - CONTROL SHOULD BE RETURNED
// 3924 ! VIA %RESULT= AN SHOULD NEVVER REACH THE %END INSTRUCTION
// 3925 !
// 3926 %IF KKK>10000 %AND COMPILER=0 %AND LAST INST=0 %THEN %START
#line 3926 "test-new/imp918s.imp"
if (KKK <= 10000) goto L_0351;
#line 3926 "test-new/imp918s.imp"
if (COMPILER != 0) goto L_0351;
#line 3926 "test-new/imp918s.imp"
if (LASTINST != 0) goto L_0351;
// 3927 PCONST(X'4100000B'); ! LA 0,11
#line 3927 "test-new/imp918s.imp"
PCONST(1090519051);
// 3928 PPJ(21); ! RUN FAULT 11
#line 3928 "test-new/imp918s.imp"
PPJ(21);
// 3929 %FINISH
#line 3929 "test-new/imp918s.imp"
L_0351:;
// 3930 NMAX=N %IF N>NMAX; ! WORK SPACE POINTER
#line 3930 "test-new/imp918s.imp"
if (N <= NMAX) goto L_0352;
#line 3930 "test-new/imp918s.imp"
NMAX = N;
#line 3930 "test-new/imp918s.imp"
L_0352:;
// 3931 !
// 3932 ! CLEAR OUT THE LABEL LIST FAULTING LABELS WITH JUMPS OUTSTANDING
// 3933 ! AS NOT SET AND COMMENTING ON LABELS NOT USED
// 3934 !
// 3935 %WHILE LABEL(LEVEL)#0 %CYCLE
#line 3935 "test-new/imp918s.imp"
L_0353:;
#line 3935 "test-new/imp918s.imp"
if (LABEL[LEVEL] == 0) goto L_0354;
// 3936 POP123(LABEL(LEVEL),I,J,KP)
#line 3936 "test-new/imp918s.imp"
POP123(/*?*/ &LABEL[LEVEL], /*?*/ &I, /*?*/ &J, /*?*/ &KP);
// 3937 I=I>>24
#line 3937 "test-new/imp918s.imp"
I = (unsigned int)I >> 24;
// 3938 %IF J&X'FFFF'#0 %THEN %START
#line 3938 "test-new/imp918s.imp"
if (J & 65535 == 0) goto L_0355;
// 3939 CLEAR LIST(SHORT INTEGER(ADDR(J)+2))
#line 3939 "test-new/imp918s.imp"
CLEARLIST(_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &J) + 2));
// 3940 %IF 0<KP<=MAX ULAB %THEN FAULT(11,-KP)
#line 3940 "test-new/imp918s.imp"
{
// Double-sided test on KP (Part I)
#line 3940 "test-new/imp918s.imp"
int tmp;
#line 3940 "test-new/imp918s.imp"
if (0 >= (tmp = KP)) goto L_0356;
// Double-sided test on KP (Part II)
#line 3940 "test-new/imp918s.imp"
if (tmp > MAXULAB) goto L_0356;
#line 3940 "test-new/imp918s.imp"
}
#line 3940 "test-new/imp918s.imp"
FAULT(11, -KP);
#line 3940 "test-new/imp918s.imp"
L_0356:;
// 3941 %FINISH %ELSE %START
#line 3941 "test-new/imp918s.imp"
goto L_0357;
#line 3941 "test-new/imp918s.imp"
L_0355:;
// 3942 %IF I=0 %AND KP<MAX ULAB %THEN printstring("
#line 3942 "test-new/imp918s.imp"
if (I != 0) goto L_0358;
#line 3942 "test-new/imp918s.imp"
if (KP >= MAXULAB) goto L_0358;
#line 3942 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n? UNUSED LABEL"));
#line 3942 "test-new/imp918s.imp"
PRINTNAME(-KP);
#line 3942 "test-new/imp918s.imp"
L_0358:;
// 3943+ ? UNUSED LABEL") %AND PRINTNAME(-KP)
// 3944 %FINISH
#line 3944 "test-new/imp918s.imp"
L_0357:;
// 3945 %REPEAT
#line 3945 "test-new/imp918s.imp"
goto L_0353;
#line 3945 "test-new/imp918s.imp"
L_0354:;
// 3946 !
// 3947 %CYCLE J=0,1,6
#line 3947 "test-new/imp918s.imp"
// %for J = 0, 1, 6 %cycle
#line 3947 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 6;
#line 3947 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle J = 0, 1, 6");
_control = J = _initial - _increment;
#line 3947 "test-new/imp918s.imp"
L_0359:
#line 3947 "test-new/imp918s.imp"
if (J != _control) _imp_signal(4, 2, 0, "Corrupt control variable J");
#line 3947 "test-new/imp918s.imp"
if (J == _final) goto L_035A;
#line 3947 "test-new/imp918s.imp"
_control += _increment;
J += _increment;
// ?Non-local
// 3948 THEAD==AVL WSP(J,LEVEL); ! RELEASE TEMPORARY LOCATIONS
#line 3948 "test-new/imp918s.imp"
THEAD = (short int *)/*?*/ &AVLWSP[J][LEVEL];
// 3949 %IF THEAD#0 %THEN CLEAR LIST(THEAD)
#line 3949 "test-new/imp918s.imp"
if (*THEAD == 0) goto L_035B;
#line 3949 "test-new/imp918s.imp"
CLEARLIST(THEAD);
#line 3949 "test-new/imp918s.imp"
L_035B:;
// 3950 %REPEAT
#line 3950 "test-new/imp918s.imp"
goto L_0359;
#line 3950 "test-new/imp918s.imp"
}
#line 3950 "test-new/imp918s.imp"
L_035A:;
// 3951 !
// 3952 DTABLE(LEVEL,0); ! OUTPUT DIAGNOSTIC TABLES
#line 3952 "test-new/imp918s.imp"
DTABLE(LEVEL, 0);
// 3953 !
// 3954 ! CLEAR DECLARATIONS - POP UP ANY GLOBAL NAMES THAT WERE REDECLARED
// 3955 ! DESTROY SIDE CHAINS FOR ROUTINES,FORMATS AND SWITCHES
// 3956 !
// 3957 JJ=NAMES(LEVEL)
#line 3957 "test-new/imp918s.imp"
JJ = NAMES[LEVEL];
// 3958 %WHILE JJ>=0 %CYCLE
#line 3958 "test-new/imp918s.imp"
L_035C:;
#line 3958 "test-new/imp918s.imp"
if (JJ < 0) goto L_035D;
// 3959 ! FIND A LOCAL NAME
// 3960 I=SHORTINTEGER(ADDR(ASLIST(TAGS(JJ)))+12)
#line 3960 "test-new/imp918s.imp"
I = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[TAGS[JJ]]) + 12);
// 3961 POP123(TAGS(JJ),KK,INTEGER(ADDR(SNDISP)),INTEGER(ADDR(K)))
#line 3961 "test-new/imp918s.imp"
POP123(/*?*/ &TAGS[JJ], /*?*/ &KK, _imp_INTEGER(_imp_ADDR(/*?*/ &SNDISP)), _imp_INTEGER(_imp_ADDR(/*?*/ &K)));
// 3962 PTYPE=KK>>16
#line 3962 "test-new/imp918s.imp"
PTYPE = (unsigned int)KK >> 16;
// 3963 %IF PTYPE =8 %THEN REGISTER(K)=0 %AND UVARREG(K)=0
#line 3963 "test-new/imp918s.imp"
if (PTYPE != 8) goto L_035E;
#line 3963 "test-new/imp918s.imp"
REGISTER[K] = 0;
#line 3963 "test-new/imp918s.imp"
UVARREG[K - 5] = 0;
#line 3963 "test-new/imp918s.imp"
L_035E:;
// 3964 %IF KK&15=15 %THEN FAULT(28,JJ);! SPEC BUT NO BODY GIVEN
#line 3964 "test-new/imp918s.imp"
if (KK & 15 != 15) goto L_035F;
#line 3964 "test-new/imp918s.imp"
FAULT(28, JJ);
#line 3964 "test-new/imp918s.imp"
L_035F:;
// 3965 %IF PTYPE>=10000 %OR PTYPE=4 %OR PTYPE=106 %OR %C
#line 3965 "test-new/imp918s.imp"
if (PTYPE >= 10000) goto L_0334;
#line 3965 "test-new/imp918s.imp"
if (PTYPE == 4) goto L_0334;
#line 3965 "test-new/imp918s.imp"
if (PTYPE == 106) goto L_0334;
#line 3965 "test-new/imp918s.imp"
if (PTYPE != 126) goto L_0360;
#line 3965 "test-new/imp918s.imp"
L_0334:;
#line 3965 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &K);
#line 3965 "test-new/imp918s.imp"
L_0360:;
// 3966+ PTYPE=126 %THEN CLEAR LIST(K)
// 3967 JJ=I
#line 3967 "test-new/imp918s.imp"
JJ = I;
// 3968 %REPEAT
#line 3968 "test-new/imp918s.imp"
goto L_035C;
#line 3968 "test-new/imp918s.imp"
L_035D:;
// 3969 NAMES(LEVEL)=-1
#line 3969 "test-new/imp918s.imp"
NAMES[LEVEL] = -1;
// 3970 %IF LEVEL=2 %THEN DTABLE(1,1); ! DO GLOBALS TO EXTERNALRTS
#line 3970 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_0361;
#line 3970 "test-new/imp918s.imp"
DTABLE(1, 1);
#line 3970 "test-new/imp918s.imp"
L_0361:;
// 3971 !
// 3972 ! CHECK FOR MISSING REPEATS
// 3973 !
// 3974 %WHILE CYCLE(LEVEL)#0 %THEN FAULT(13,0)%AND POP(CYCLE(LEVEL),I,I)
#line 3974 "test-new/imp918s.imp"
L_0362:;
#line 3974 "test-new/imp918s.imp"
if (CYCLE[LEVEL] == 0) goto L_0363;
#line 3974 "test-new/imp918s.imp"
FAULT(13, 0);
#line 3974 "test-new/imp918s.imp"
POP(/*?*/ &CYCLE[LEVEL], /*?*/ &I, /*?*/ &I);
#line 3974 "test-new/imp918s.imp"
goto L_0362;
#line 3974 "test-new/imp918s.imp"
L_0363:;
// 3975 !
// 3976 ! REMOVE TEXT OF ANY LOCAL NAMES FROM WORD AND LETT
// 3977 !
// 3978 %IF NEXT#RNEXT %THEN %START
#line 3978 "test-new/imp918s.imp"
if (NEXT == RNEXT) goto L_0364;
// 3979 NEXT=RNEXT
#line 3979 "test-new/imp918s.imp"
NEXT = RNEXT;
// 3980 ! %CYCLE I=0,1,NNAMES
// 3981 ! WORD(I)=0 %IF WORD(I)>=NEXT
// 3982 ! %REPEAT
// 3983 !%if USE MC = 1 %start
// 3984 ! *L_0,NEXT; *SR_15,15; *SR_1,1; *LA_2,2
// 3985 ! *L_3,NNAMES; *AR_3,3; *L_4,WORD
// 3986 !AGN: *CH_0,0(1,4); *BC_2,*+8
// 3987 ! *STH_15,0(1,4); *BXLE_1,2,<AGN>
// 3988 !%finish
// 3989 %FINISH
#line 3989 "test-new/imp918s.imp"
L_0364:;
// 3990 !
// 3991 ! NOW CLAIM THE STACK FRAME BY FILING THE LA 11,0(11) IN THE BLOCK ENTRY
// 3992 ! CODING. IF MORE THAN 4095 BYTES OF LOCAL VARIABLES ARE NEEDED THEN
// 3993 ! THE WHOLE INSTRUCTION MUST BE OVERWRITTEN
// 3994 !
// 3995 NMAX=(NMAX+7)&(-8)
#line 3995 "test-new/imp918s.imp"
NMAX = NMAX + 7 & -8;
// 3996 %IF KKK=2 %THEN %RETURN
#line 3996 "test-new/imp918s.imp"
if (KKK != 2) goto L_0365;
#line 3996 "test-new/imp918s.imp"
return;
#line 3996 "test-new/imp918s.imp"
L_0365:;
// 3997 %IF KKK>=10000 %OR KKK=1 %THEN CLAIM ST FRAME(SET(RLEVEL),NMAX)
#line 3997 "test-new/imp918s.imp"
if (KKK >= 10000) goto L_0342;
#line 3997 "test-new/imp918s.imp"
if (KKK != 1) goto L_0366;
#line 3997 "test-new/imp918s.imp"
L_0342:;
#line 3997 "test-new/imp918s.imp"
CLAIMSTFRAME(SET[RLEVEL], NMAX);
#line 3997 "test-new/imp918s.imp"
L_0366:;
// 3998 !
// 3999 ! NOW PLANT THE BLOCK EXIT SEQUENCE
// 4000 !
// 4001 %IF KKK=10000 %AND LAST INST=0 %THEN RT EXIT
#line 4001 "test-new/imp918s.imp"
if (KKK != 10000) goto L_0367;
#line 4001 "test-new/imp918s.imp"
if (LASTINST != 0) goto L_0367;
#line 4001 "test-new/imp918s.imp"
RTEXIT();
#line 4001 "test-new/imp918s.imp"
L_0367:;
// 4002 PPJ(6) %IF KKK=1 %AND LAST INST=0;! %STOP AT %ENDOFPROGRAM
#line 4002 "test-new/imp918s.imp"
if (KKK != 1) goto L_0368;
#line 4002 "test-new/imp918s.imp"
if (LASTINST != 0) goto L_0368;
#line 4002 "test-new/imp918s.imp"
PPJ(6);
#line 4002 "test-new/imp918s.imp"
L_0368:;
// 4003 %IF KKK=0 %THEN %START; ! BEGIN BLOCK EXIT
#line 4003 "test-new/imp918s.imp"
if (KKK != 0) goto L_0369;
// 4004 JJ=FROM2(LEVELINF)&X'FFF'; ! DISP OF SAVE AREA
#line 4004 "test-new/imp918s.imp"
JJ = FROM2(LEVELINF) & 4095;
// 4005 DUMPM(X'98',10,11,RBASE,JJ); ! RESTORE R11 & R10
#line 4005 "test-new/imp918s.imp"
DUMPM(152, 10, 11, RBASE, JJ);
// 4006 %IF DIAGS1=1 %THEN %START; ! RESTORE DIAGS POINTERS
#line 4006 "test-new/imp918s.imp"
if (DIAGS1 != 1) goto L_036A;
// 4007 DUMP(X'58',0,JJ+8,0,RBASE)
#line 4007 "test-new/imp918s.imp"
DUMP(88, 0, JJ + 8, 0, RBASE);
// 4008 PRX(X'50',0,0,GLA,20)
#line 4008 "test-new/imp918s.imp"
PRX(80, 0, 0, 13, 20);
// 4009 %FINISH
#line 4009 "test-new/imp918s.imp"
L_036A:;
// 4010 %FINISH
#line 4010 "test-new/imp918s.imp"
L_0369:;
// 4011 !
// 4012 ! OUTPUT ANYTHING RELEVANT ONTO THE PROGRAM LISTING
// 4013 !
// 4014 NEWLINE
#line 4014 "test-new/imp918s.imp"
_imp_NEWLINE();
// 4015 %IF PRINTMAP=1 %AND KKK#0 %THEN %START
#line 4015 "test-new/imp918s.imp"
if (PRINTMAP != 1) goto L_036B;
#line 4015 "test-new/imp918s.imp"
if (KKK == 0) goto L_036B;
// 4016 printstring(" LOCALS EXTEND TO ")
#line 4016 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal(" LOCALS EXTEND TO "));
// 4017 WRITE(NMAX,2)
#line 4017 "test-new/imp918s.imp"
_imp_WRITE(NMAX, 2);
// 4018 NEWLINE
#line 4018 "test-new/imp918s.imp"
_imp_NEWLINE();
// 4019 ! CHECK ASL
// 4020 %FINISH
#line 4020 "test-new/imp918s.imp"
L_036B:;
// 4021 %IF LIST=0 %THEN %START; ! SHORT LISTING REQD
#line 4021 "test-new/imp918s.imp"
if (LIST != 0) goto L_036C;
// 4022 WRITE(LINE,5)
#line 4022 "test-new/imp918s.imp"
_imp_WRITE(LINE, 5);
// 4023 %IF PRINTMAP=1 %THEN SPACES(3) %AND PRHEX(CA,5)
#line 4023 "test-new/imp918s.imp"
if (PRINTMAP != 1) goto L_036D;
#line 4023 "test-new/imp918s.imp"
_imp_SPACES(3);
#line 4023 "test-new/imp918s.imp"
PRHEX(CA, 5);
#line 4023 "test-new/imp918s.imp"
L_036D:;
// 4024 SPACES(3*LEVEL-3)
#line 4024 "test-new/imp918s.imp"
_imp_SPACES(3 * LEVEL - 3);
// 4025 PRINTSTRING("END")
#line 4025 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("END"));
// 4026 %FINISH
#line 4026 "test-new/imp918s.imp"
L_036C:;
// 4027 !
// 4028 ! RETURN TO PREVIOUS LEVEL PROVIDED THERE IS A VALID ONE !
// 4029 !
// 4030 %UNLESS LEVEL>2 %OR (LEVEL=2 %AND CPRMODE=2) %THEN %START
#line 4030 "test-new/imp918s.imp"
if (LEVEL > 2) goto L_036E;
#line 4030 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_036F;
#line 4030 "test-new/imp918s.imp"
if (CPRMODE == 2) goto L_036E;
#line 4030 "test-new/imp918s.imp"
L_036F:;
// 4031 %IF KKK=1 %AND LEVEL=2 %THEN KKK=2 %ELSE %C
#line 4031 "test-new/imp918s.imp"
if (KKK != 1) goto L_0370;
#line 4031 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_0370;
#line 4031 "test-new/imp918s.imp"
KKK = 2;
#line 4031 "test-new/imp918s.imp"
goto L_0371;
#line 4031 "test-new/imp918s.imp"
L_0370:;
#line 4031 "test-new/imp918s.imp"
FAULT(14, 0);
#line 4031 "test-new/imp918s.imp"
_imp_stop(0);
#line 4031 "test-new/imp918s.imp"
L_0371:;
// 4032+ FAULT(14,0) %AND %STOP
// 4033 %FINISH
#line 4033 "test-new/imp918s.imp"
L_036E:;
// 4034 LEVEL=LEVEL-1
#line 4034 "test-new/imp918s.imp"
LEVEL = LEVEL - 1;
// 4035 %IF KKK>=10000 %THEN %START
#line 4035 "test-new/imp918s.imp"
if (KKK < 10000) goto L_0372;
// 4036 RLEVEL=RLEVEL-1
#line 4036 "test-new/imp918s.imp"
RLEVEL = RLEVEL - 1;
// 4037 RBASE=10-RLEVEL
#line 4037 "test-new/imp918s.imp"
RBASE = 10 - RLEVEL;
// 4038 REGISTER(9-RLEVEL)=0
#line 4038 "test-new/imp918s.imp"
REGISTER[9 - RLEVEL] = 0;
// 4039 %FINISH
#line 4039 "test-new/imp918s.imp"
L_0372:;
// 4040 !
// 4041 ! RESTORE INFORMATION ABOUT THE (NEW) CURRENT LEVEL
// 4042 !
// 4043 POP123(LEVELINF,CODEBASE,N,FLAG)
#line 4043 "test-new/imp918s.imp"
POP123(/*?*/ &LEVELINF, /*?*/ &CODEBASE, /*?*/ &N, /*?*/ &FLAG);
// 4044 NMDECS=CODEBASE>>24
#line 4044 "test-new/imp918s.imp"
NMDECS = (unsigned int)CODEBASE >> 24;
// 4045 CODEBASE=CODEBASE&X'FFFFFF'
#line 4045 "test-new/imp918s.imp"
CODEBASE = CODEBASE & 16777215;
// 4046 GRINF(10)=CODEBASE
#line 4046 "test-new/imp918s.imp"
GRINF[10] = CODEBASE;
// 4047 SBFLAG=N>>15&1
#line 4047 "test-new/imp918s.imp"
SBFLAG = (unsigned int)N >> 15 & 1;
// 4048 RNEXT=FLAG>>16
#line 4048 "test-new/imp918s.imp"
RNEXT = (unsigned int)FLAG >> 16;
// 4049 FLAG=FLAG&X'FFFF'
#line 4049 "test-new/imp918s.imp"
FLAG = FLAG & 65535;
// 4050 NMAX=N>>16 %IF KKK>=10000
#line 4050 "test-new/imp918s.imp"
if (KKK < 10000) goto L_0373;
#line 4050 "test-new/imp918s.imp"
NMAX = (unsigned int)N >> 16;
#line 4050 "test-new/imp918s.imp"
L_0373:;
// 4051 N=N&X'7FFF'
#line 4051 "test-new/imp918s.imp"
N = N & 32767;
// 4052 %IF KKK=2 %THEN CEND(KKK); ! ROUND AGAIN FOR 'ENDOFPROGRAM'
#line 4052 "test-new/imp918s.imp"
if (KKK != 2) goto L_0374;
#line 4052 "test-new/imp918s.imp"
CEND(KKK);
#line 4052 "test-new/imp918s.imp"
L_0374:;
// 4053 !
// 4054 ! COMPLETE THE JUMP AROUND ALL NON-EXTERNAL ROUTINES EXCEPT WHEN
// 4055 ! %TRUSTEDPROGRAM IS IN OPERATION.
// 4056 !
// 4057 %IF KKK>=10000 %AND COMPILER=0 %AND (RLEVEL#1 %OR CPRMODE#2)%C
#line 4057 "test-new/imp918s.imp"
if (KKK < 10000) goto L_0375;
#line 4057 "test-new/imp918s.imp"
if (COMPILER != 0) goto L_0375;
#line 4057 "test-new/imp918s.imp"
if (RLEVEL != 1) goto L_0376;
#line 4057 "test-new/imp918s.imp"
if (CPRMODE == 2) goto L_0375;
#line 4057 "test-new/imp918s.imp"
L_0376:;
#line 4057 "test-new/imp918s.imp"
ENTERLAB(FROM3(LABEL[LEVEL]), 0);
#line 4057 "test-new/imp918s.imp"
L_0375:;
// 4058+ %THEN ENTER LAB(FROM3(LABEL(LEVEL)),0)
// 4059 ->Label99
#line 4059 "test-new/imp918s.imp"
goto U_1033;
// 4060 %ROUTINE DTABLE(%INTEGER LEVEL,GLOBAL)
#line 4060 "test-new/imp918s.imp"
void DTABLE(int LEVEL, int GLOBAL) {
// 4061 !***********************************************************************
// 4062 !* THIS ROUTINE LOOKS AT THE DECLARATIONS FOR THE CURRENT LEVEL & *
// 4063 !* SETS UP THE SEGMENT OF SHARABLE SYMBOL TABLES TO DESCRIBE THEM.*
// 4064 !* FOR MAIN PROGRAMS OR EXTERNAL ROUTINES THE 'GLOBAL' VARIABLES *
// 4065 !* (IF ANY) ARE ALSO INCLUDED. *
// 4066 !***********************************************************************
// 4067 %STRING(32) RT NAME
#line 4067 "test-new/imp918s.imp"
_imp_string32 RTNAME;
// 4068 %STRING(8) LOCAL NAME
#line 4068 "test-new/imp918s.imp"
_imp_string8 LOCALNAME;
// 4069 %INTEGER DPTR,LNUM,ML,KK,JJ,Q,DEND,OL,LC
#line 4069 "test-new/imp918s.imp"
int DPTR;
#line 4069 "test-new/imp918s.imp"
int LNUM;
#line 4069 "test-new/imp918s.imp"
int ML;
#line 4069 "test-new/imp918s.imp"
int KK;
#line 4069 "test-new/imp918s.imp"
int JJ;
#line 4069 "test-new/imp918s.imp"
int Q;
#line 4069 "test-new/imp918s.imp"
int DEND;
#line 4069 "test-new/imp918s.imp"
int OL;
#line 4069 "test-new/imp918s.imp"
int LC;
// 4070 %INTEGERARRAY DD(0:300); ! BUFFER FOR SEGMENT OF SST
#line 4070 "test-new/imp918s.imp"
int DD[301];
// 4071 %IF GLOBAL#0 %THEN DPTR=0 %AND ->START
#line 4071 "test-new/imp918s.imp"
if (GLOBAL == 0) goto L_0377;
#line 4071 "test-new/imp918s.imp"
DPTR = 0;
#line 4071 "test-new/imp918s.imp"
goto U_102A;
#line 4071 "test-new/imp918s.imp"
L_0377:;
// 4072 DD(0)=X'C2C2C2C2'; ! MARKER ==M'BBBB' IN EBCDIC
#line 4072 "test-new/imp918s.imp"
DD[0] = -1027423550;
// 4073 ML=M(LEVEL); ! ROUTINE NAME(=0 FOR %BEGIN)
#line 4073 "test-new/imp918s.imp"
ML = M[LEVEL];
// 4074 LNUM=LETT(ML); ! LENGTH OF THE NAME
#line 4074 "test-new/imp918s.imp"
LNUM = LETT[ML];
// 4075 DD(1)=L(LEVEL)<<16!RBASE<<8; ! RT WORD TO TABLE
#line 4075 "test-new/imp918s.imp"
DD[1] = L[LEVEL] << 16 | RBASE << 8;
// 4076 OL=L(LEVEL-1)
#line 4076 "test-new/imp918s.imp"
OL = L[LEVEL - 1];
// 4077 DPTR=3; DEND=0
#line 4077 "test-new/imp918s.imp"
DPTR = 3;
#line 4077 "test-new/imp918s.imp"
DEND = 0;
// 4078 %IF LNUM=0 %THEN DD(2)=L(LEVEL-1) %ELSE %START
#line 4078 "test-new/imp918s.imp"
if (LNUM != 0) goto L_0378;
#line 4078 "test-new/imp918s.imp"
DD[2] = L[LEVEL - 1];
#line 4078 "test-new/imp918s.imp"
goto L_0379;
#line 4078 "test-new/imp918s.imp"
L_0378:;
// 4079 Q=ADDR(LETT(ML))
#line 4079 "test-new/imp918s.imp"
Q = _imp_ADDR(/*?*/ &LETT[ML]);
// 4080 RT NAME<-STRING(Q); ! FOR RTS MOVE IN 1ST 32 CHARS
#line 4080 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &RTNAME, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = *_imp_STRING(Q);
(void *)&tmp;
}),
/*max:*/ 32);
#line 4080 "test-new/imp918s.imp"
/* truncated copy of no more than 32 chars */
#line 4080 "test-new/imp918s.imp"
if (*_imp_LENGTH((_imp_string *)/*?*/ &RTNAME) > 32) *_imp_LENGTH((_imp_string *)/*?*/ &RTNAME) = 32;
// 4081 STRING(ADDR(DD(1))+3)=RTNAME;! AND UPDATE POINTER PAST
#line 4081 "test-new/imp918s.imp"
*_imp_STRING(_imp_ADDR(/*?*/ &DD[1]) + 3) = RTNAME;
// 4082 DPTR=DPTR+(LNUM-1)>>2; ! ACTUAL NO OF CHARS
#line 4082 "test-new/imp918s.imp"
DPTR = DPTR + ((unsigned int)LNUM - 1 >> 2);
// 4083 %FINISH
#line 4083 "test-new/imp918s.imp"
L_0379:;
// 4084 START:
#line 4084 "test-new/imp918s.imp"
U_102A:;
// 4085 JJ=NAMES(LEVEL)
#line 4085 "test-new/imp918s.imp"
JJ = NAMES[LEVEL];
// 4086 %CYCLE LC=0,1,NNAMES
#line 4086 "test-new/imp918s.imp"
// %for LC = 0, 1, NNAMES %cycle
#line 4086 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = NNAMES;
#line 4086 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle LC = 0, 1, NNAMES");
_control = LC = _initial - _increment;
#line 4086 "test-new/imp918s.imp"
L_037A:
#line 4086 "test-new/imp918s.imp"
if (LC != _control) _imp_signal(4, 2, 0, "Corrupt control variable LC");
#line 4086 "test-new/imp918s.imp"
if (LC == _final) goto L_037B;
#line 4086 "test-new/imp918s.imp"
_control += _increment;
LC += _increment;
// 4087 %EXIT %IF JJ<0
#line 4087 "test-new/imp918s.imp"
if (JJ >= 0) goto L_037D;
#line 4087 "test-new/imp918s.imp"
goto L_037B;
#line 4087 "test-new/imp918s.imp"
L_037D:;
// 4088 %IF GLOBAL=0 %THEN %START
#line 4088 "test-new/imp918s.imp"
if (GLOBAL != 0) goto L_037E;
// 4089 KK=INTEGER(ADDR(ASLIST(TAGS(JJ))))
#line 4089 "test-new/imp918s.imp"
KK = *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[TAGS[JJ]]));
// 4090 %IF KK&X'F000'=0 %THEN %START
#line 4090 "test-new/imp918s.imp"
if (KK & 61440 != 0) goto L_037F;
// 4091 printstring("
#line 4091 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("\n? UNUSED NAME "));
// 4092+ ? UNUSED NAME ")
// 4093 PRINTNAME(JJ)
#line 4093 "test-new/imp918s.imp"
PRINTNAME(JJ);
// 4094 %FINISH
#line 4094 "test-new/imp918s.imp"
L_037F:;
// 4095 %FINISH
#line 4095 "test-new/imp918s.imp"
L_037E:;
// 4096 ->REP %IF DIAGS1=0 %OR LINENOS=0
#line 4096 "test-new/imp918s.imp"
if (DIAGS1 == 0) goto L_0380;
#line 4096 "test-new/imp918s.imp"
if (LINENOS != 0) goto L_0381;
#line 4096 "test-new/imp918s.imp"
L_0380:;
#line 4096 "test-new/imp918s.imp"
goto U_102B;
#line 4096 "test-new/imp918s.imp"
L_0381:;
// 4097 COPY TAG(JJ); ! GET DETAILS
#line 4097 "test-new/imp918s.imp"
COPYTAG(JJ);
// 4098 %IF ARR=0 %AND ROUT=0 %AND DPTR<297 %ANDC
#line 4098 "test-new/imp918s.imp"
if (ARR != 0) goto L_0382;
#line 4098 "test-new/imp918s.imp"
if (ROUT != 0) goto L_0382;
#line 4098 "test-new/imp918s.imp"
if (DPTR >= 297) goto L_0382;
#line 4098 "test-new/imp918s.imp"
if (PREC >= 4) goto L_0382;
#line 4098 "test-new/imp918s.imp"
if (TYPE == 1) goto L_0383;
#line 4098 "test-new/imp918s.imp"
if (TYPE == 2) goto L_0383;
#line 4098 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0382;
#line 4098 "test-new/imp918s.imp"
L_0383:;
#line 4098 "test-new/imp918s.imp"
if (GLOBAL == 0) goto L_0384;
#line 4098 "test-new/imp918s.imp"
if (OLDI != 1) goto L_0382;
#line 4098 "test-new/imp918s.imp"
L_0384:;
// 4099+ PREC<4 %AND (TYPE=1 %OR TYPE=2 %OR TYPE=5) %C
// 4100+ %AND (GLOBAL=0 %OR OLDI=1) %THEN %START
// 4101 Q=ADDR(LETT(WORD(JJ))); ! ADDRESS OF NAME
#line 4101 "test-new/imp918s.imp"
Q = _imp_ADDR(/*?*/ &LETT[WORD[JJ]]);
// 4102 DD(DPTR)=NAM<<30!PREC<<27!TYPE<<24!I<<20!K<<8
#line 4102 "test-new/imp918s.imp"
DD[DPTR] = NAM << 30 | PREC << 27 | TYPE << 24 | I << 20 | K << 8;
// 4103 LOCAL NAME<-STRING(Q); ! TEXT OF NAME FROM DICTIONARY
#line 4103 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &LOCALNAME, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = *_imp_STRING(Q);
(void *)&tmp;
}),
/*max:*/ 8);
#line 4103 "test-new/imp918s.imp"
/* truncated copy of no more than 8 chars */
#line 4103 "test-new/imp918s.imp"
if (*_imp_LENGTH((_imp_string *)/*?*/ &LOCALNAME) > 8) *_imp_LENGTH((_imp_string *)/*?*/ &LOCALNAME) = 8;
// 4104 LNUM=BYTE INTEGER(ADDR(LOCAL NAME))
#line 4104 "test-new/imp918s.imp"
LNUM = *_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &LOCALNAME));
// 4105 STRING(ADDR(DD(DPTR))+3)=LOCAL NAME;! MOVE IN NAME
#line 4105 "test-new/imp918s.imp"
*_imp_STRING(_imp_ADDR(/*?*/ &DD[DPTR]) + 3) = LOCALNAME;
// 4106 DPTR=DPTR+(LNUM+7)>>2
#line 4106 "test-new/imp918s.imp"
DPTR = DPTR + ((unsigned int)LNUM + 7 >> 2);
// 4107 %FINISH
#line 4107 "test-new/imp918s.imp"
L_0382:;
// 4108 REP: JJ=SHORTINTEGER(ADDR(ASLIST(TAGS(JJ)))+12)
#line 4108 "test-new/imp918s.imp"
U_102B:;
#line 4108 "test-new/imp918s.imp"
JJ = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[TAGS[JJ]]) + 12);
// 4109 %REPEAT
#line 4109 "test-new/imp918s.imp"
goto L_037A;
#line 4109 "test-new/imp918s.imp"
}
#line 4109 "test-new/imp918s.imp"
L_037B:;
// 4110 %IF LEVEL=2 %THEN %START; ! GLOBALS TO FOLLOW
#line 4110 "test-new/imp918s.imp"
if (LEVEL != 2) goto L_0385;
// 4111 DD(DPTR)=-2; ! GLOBAL TO COME MARKER
#line 4111 "test-new/imp918s.imp"
DD[DPTR] = -2;
// 4112 DPTR=DPTR+1
#line 4112 "test-new/imp918s.imp"
DPTR = DPTR + 1;
// 4113 %FINISH %ELSE %START
#line 4113 "test-new/imp918s.imp"
goto L_0386;
#line 4113 "test-new/imp918s.imp"
L_0385:;
// 4114 DD(DPTR)=-1; ! 'END OF SEGMENT' MARK
#line 4114 "test-new/imp918s.imp"
DD[DPTR] = -1;
// 4115 DD(DPTR+1)=OL; ! SO DEBUG CAN FIND GLOBALS
#line 4115 "test-new/imp918s.imp"
DD[DPTR + 1] = OL;
// 4116 DPTR=DPTR+2
#line 4116 "test-new/imp918s.imp"
DPTR = DPTR + 2;
// 4117 %FINISH
#line 4117 "test-new/imp918s.imp"
L_0386:;
// 4118 DPTR=DPTR<<2
#line 4118 "test-new/imp918s.imp"
DPTR = DPTR << 2;
// 4119 %IF DIAGS1=1 %THEN %START
#line 4119 "test-new/imp918s.imp"
if (DIAGS1 != 1) goto L_0387;
// 4120 %IF GLOBAL=1 %AND DPTR=8 %THEN SSTL=SSTL-4;! PUT -1 ONTOP OF -2
#line 4120 "test-new/imp918s.imp"
if (GLOBAL != 1) goto L_0388;
#line 4120 "test-new/imp918s.imp"
if (DPTR != 8) goto L_0388;
#line 4120 "test-new/imp918s.imp"
SSTL = SSTL - 4;
#line 4120 "test-new/imp918s.imp"
L_0388:;
// 4121 LPUT(4,DPTR,SSTL,ADDR(DD(0)));! ADD TO SHARABLE SYM TABS
#line 4121 "test-new/imp918s.imp"
LPUT(4, DPTR, SSTL, _imp_ADDR(/*?*/ &DD[0]));
// 4122 SSTL=SSTL+DPTR
#line 4122 "test-new/imp918s.imp"
SSTL = SSTL + DPTR;
// 4123 %FINISH
#line 4123 "test-new/imp918s.imp"
L_0387:;
// 4124 %END; ! OF ROUTINE DTABLE
#line 4124 "test-new/imp918s.imp"
return;
#line 4124 "test-new/imp918s.imp"
} /* end of DTABLE */
// 4125 Label99: %END
#line 4125 "test-new/imp918s.imp"
U_1033:;
#line 4125 "test-new/imp918s.imp"
return;
#line 4125 "test-new/imp918s.imp"
} /* end of CEND */
// 4126 !***********************************************************************
// 4127 !* VARIOUS ROUTINE THAT ARE REQUIRED ONLY AT BLOCK START *
// 4128 !* AND BLOCK END ARE GATHERED HERE. HOPEFULLY THEY WILL BE PAGED *
// 4129 !* OUT EXCEPT WHEN NEEDED. *
// 4130 !***********************************************************************
// 4131 !
// 4132 %ROUTINE TEST NST
#line 4132 "test-new/imp918s.imp"
void TESTNST(void) {
// 4133 !***********************************************************************
// 4134 !* SEE IF NAME 'K' HAS BEEN DECLARED BEFORE AT THIS LEVEL *
// 4135 !***********************************************************************
// 4136 FNAME=K
#line 4136 "test-new/imp918s.imp"
FNAME = K;
// 4137 FAULT(7,FNAME) %IF FROM1(TAGS(FNAME))>>8&15=LEVEL
#line 4137 "test-new/imp918s.imp"
if ((unsigned int)FROM1(TAGS[FNAME]) >> 8 & 15 != LEVEL) goto L_0389;
#line 4137 "test-new/imp918s.imp"
FAULT(7, FNAME);
#line 4137 "test-new/imp918s.imp"
L_0389:;
// 4138 %END
#line 4138 "test-new/imp918s.imp"
return;
#line 4138 "test-new/imp918s.imp"
} /* end of TESTNST */
// 4139 %ROUTINE RELOCATE(%INTEGER GLARAD,VALUE,AREA)
#line 4139 "test-new/imp918s.imp"
void RELOCATE(int GLARAD, int VALUE, int AREA) {
// 4140 {%SHORTROUTINE}
// 4141 !***********************************************************************
// 4142 !* PLANTS A WORD IN THE GLA (IF GLARAD<0) AND ARRANGES TO *
// 4143 !* RELOCATE IT RELATIVE TO AN AREA(CODE=1,GLA=2,CST=4,GST=5 *
// 4144 !* RELOCATION RELATIVE TO SYMBOL TABLES CAN NOW BE DONE HERE *
// 4145 !***********************************************************************
// 4146 %IF GLARAD<0 %THEN PGLA(4,4,ADDR(VALUE)) %AND GLARAD=GLACA-4
#line 4146 "test-new/imp918s.imp"
if (GLARAD >= 0) goto L_038A;
#line 4146 "test-new/imp918s.imp"
PGLA(4, 4, _imp_ADDR(/*?*/ &VALUE));
#line 4146 "test-new/imp918s.imp"
GLARAD = GLACA - 4;
#line 4146 "test-new/imp918s.imp"
L_038A:;
// 4147 %IF AREA<3 %THEN LPUT(AREA+19,0,GLARAD,0) %ELSE %C
#line 4147 "test-new/imp918s.imp"
if (AREA >= 3) goto L_038B;
#line 4147 "test-new/imp918s.imp"
LPUT(AREA + 19, 0, GLARAD, 0);
#line 4147 "test-new/imp918s.imp"
goto L_038C;
#line 4147 "test-new/imp918s.imp"
L_038B:;
#line 4147 "test-new/imp918s.imp"
LPUT(AREA + 14, 0, GLARAD, 0);
#line 4147 "test-new/imp918s.imp"
L_038C:;
// 4148+ LPUT(AREA+14,0,GLARAD,0)
// 4149 ! PUSH123(RELHEAD,GLARAD,VALUE,AREA)
// 4150 %END
#line 4150 "test-new/imp918s.imp"
return;
#line 4150 "test-new/imp918s.imp"
} /* end of RELOCATE */
// 4151 %ROUTINE GXREF(%INTEGER MODE,NAME,XTRA,AT)
#line 4151 "test-new/imp918s.imp"
void GXREF(int MODE, int NAME, int XTRA, int AT) {
// 4152 {%SHORTROUTINE}
// 4153 !***********************************************************************
// 4154 !* ASK LPUT TO ARRANGE TO RELOCATE 1 OR MORE WORDS AT 'AT' *
// 4155 !* IN THE GLA BY EXTERNAL NAME 'NAME'. *
// 4156 !* MODE DEFINES ENTITY:- *
// 4157 !* MODE=0 FOR STATIC XREFS (XTRA='S' OR 'I' FOR #IDENS) *
// 4158 !* MODE=1 FOR DYNAMIC XREFS *
// 4159 !* MODE=2 FOR DATA REFS XTRA=LMIN *
// 4160 !* NAME=0 FOR IOCP REFERENCES *
// 4161 !***********************************************************************
// 4162 %INTEGER J,LPUTNO
#line 4162 "test-new/imp918s.imp"
int J;
#line 4162 "test-new/imp918s.imp"
int LPUTNO;
// 4163 %STRING(8) ID
#line 4163 "test-new/imp918s.imp"
_imp_string8 ID;
// 4164 %IF NAME<0 %THEN %START
#line 4164 "test-new/imp918s.imp"
if (NAME >= 0) goto L_038D;
// 4165 %IF NAME=-1 %THEN J=ADDR(IOCP1)+3 %ELSE J=ADDR(IMPMON1)+3
#line 4165 "test-new/imp918s.imp"
if (NAME != -1) goto L_038E;
#line 4165 "test-new/imp918s.imp"
J = _imp_ADDR(/*?*/ &IOCP1) + 3;
#line 4165 "test-new/imp918s.imp"
goto L_038F;
#line 4165 "test-new/imp918s.imp"
L_038E:;
#line 4165 "test-new/imp918s.imp"
J = _imp_ADDR(/*?*/ &IMPMON1) + 3;
#line 4165 "test-new/imp918s.imp"
L_038F:;
// 4166 %FINISH %ELSE J=ADDR(LETT(WORD(NAME)));! J TO NAME TEXT
#line 4166 "test-new/imp918s.imp"
goto L_0390;
#line 4166 "test-new/imp918s.imp"
L_038D:;
#line 4166 "test-new/imp918s.imp"
J = _imp_ADDR(/*?*/ &LETT[WORD[NAME]]);
#line 4166 "test-new/imp918s.imp"
L_0390:;
// 4167 ID<-STRING(J); ! MOVE IN NAME
#line 4167 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = *_imp_STRING(J);
(void *)&tmp;
}),
/*max:*/ 8);
#line 4167 "test-new/imp918s.imp"
/* truncated copy of no more than 8 chars */
#line 4167 "test-new/imp918s.imp"
if (*_imp_LENGTH((_imp_string *)/*?*/ &ID) > 8) *_imp_LENGTH((_imp_string *)/*?*/ &ID) = 8;
// 4168 %IF MODE<=1 %AND XTRA>0 %THEN %C
#line 4168 "test-new/imp918s.imp"
if (MODE > 1) goto L_0391;
#line 4168 "test-new/imp918s.imp"
if (XTRA <= 0) goto L_0391;
#line 4168 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &*({
_imp_string255 tmp =
_imp_join(({
__typeof__(_imp_string1) tmp; /*D*/
tmp = _imp_TOSTRING(XTRA);
(void *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr("#"));
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ &ID);
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 8);
#line 4168 "test-new/imp918s.imp"
/* truncated copy of no more than 8 chars */
#line 4168 "test-new/imp918s.imp"
if (*_imp_LENGTH((_imp_string *)/*?*/ &ID) > 8) *_imp_LENGTH((_imp_string *)/*?*/ &ID) = 8;
#line 4168 "test-new/imp918s.imp"
L_0391:;
// 4169+ ID<-TOSTRING(XTRA)."#".ID
// 4170 %IF MODE=2 %THEN LPUTNO=15 %ELSE LPUTNO=MODE+12
#line 4170 "test-new/imp918s.imp"
if (MODE != 2) goto L_0392;
#line 4170 "test-new/imp918s.imp"
LPUTNO = 15;
#line 4170 "test-new/imp918s.imp"
goto L_0393;
#line 4170 "test-new/imp918s.imp"
L_0392:;
#line 4170 "test-new/imp918s.imp"
LPUTNO = MODE + 12;
#line 4170 "test-new/imp918s.imp"
L_0393:;
// 4171 LPUT(LPUTNO,XTRA,AT,ADDR(ID))
#line 4171 "test-new/imp918s.imp"
LPUT(LPUTNO, XTRA, AT, _imp_ADDR(/*?*/ &ID));
// 4172 %END
#line 4172 "test-new/imp918s.imp"
return;
#line 4172 "test-new/imp918s.imp"
} /* end of GXREF */
// 4173
// 4174 %ROUTINE CXREF(%INTEGER MODE,NAME,XTRA,%INTEGERNAME AT)
#line 4174 "test-new/imp918s.imp"
void CXREF(int MODE, int NAME, int XTRA, int *AT) {
// 4175 {%SHORTROUTINE}
// 4176 !***********************************************************************
// 4177 !* CREATE A ZEROED AREA IN THE GLA AND CALL GXREF TO GET *
// 4178 !* IT FILLED AT LOAD TIME WITH INFORMATION ON AN EXTERNAL OBJECT *
// 4179 !* PARAMETERS ARE AS FOR GXREF. *
// 4180 !***********************************************************************
// 4181 %INTEGER L
#line 4181 "test-new/imp918s.imp"
int L;
// 4182 %IF MODE=2 %THEN L=4 %ELSE L=16; ! DATA OR ROUTINE
#line 4182 "test-new/imp918s.imp"
if (MODE != 2) goto L_0394;
#line 4182 "test-new/imp918s.imp"
L = 4;
#line 4182 "test-new/imp918s.imp"
goto L_0395;
#line 4182 "test-new/imp918s.imp"
L_0394:;
#line 4182 "test-new/imp918s.imp"
L = 16;
#line 4182 "test-new/imp918s.imp"
L_0395:;
// 4183 PGLA(4,L,ADDR(FIXED GLA(7))); ! 1 OR 4 ZERO WORDS
#line 4183 "test-new/imp918s.imp"
PGLA(4, L, _imp_ADDR(/*?*/ &FIXEDGLA[7]));
// 4184 AT=GLACA-L
#line 4184 "test-new/imp918s.imp"
*AT = GLACA - L;
// 4185 GXREF(MODE,NAME,XTRA,AT)
#line 4185 "test-new/imp918s.imp"
GXREF(MODE, NAME, XTRA, *AT);
// 4186 %END
#line 4186 "test-new/imp918s.imp"
return;
#line 4186 "test-new/imp918s.imp"
} /* end of CXREF */
// 4187 %ROUTINE CLT
#line 4187 "test-new/imp918s.imp"
void CLT(void) {
// 4188 {%SHORTROUTINE}
// 4189 !***********************************************************************
// 4190 !* DEAL WITH PHRASE TYPE AND SET PREC,TYPE & ACC *
// 4191 !* ONLY PROBLEM IS STRING WHICH HAS OPTIONAL MAX LENGTH ALSO *
// 4192 !* P ON PHRASE TYPE AT ENTRY - TO NEXT PHRASE AT EXIT. *
// 4193 !***********************************************************************
// 4194 TYPE=TYPEFLAG(A(P)); ! TYPEFLAG HOLDS PREC & TYPE
#line 4194 "test-new/imp918s.imp"
TYPE = TYPEFLAG[A[P + 7] - 1];
// 4195 PREC=TYPE>>3
#line 4195 "test-new/imp918s.imp"
PREC = (unsigned int)TYPE >> 3;
// 4196 TYPE=TYPE&7
#line 4196 "test-new/imp918s.imp"
TYPE = TYPE & 7;
// 4197 %IF PREC=2 %THEN WARN(LINE); ! WARNING FOR SHORTS
#line 4197 "test-new/imp918s.imp"
if (PREC != 2) goto L_0396;
#line 4197 "test-new/imp918s.imp"
WARN(LINE);
#line 4197 "test-new/imp918s.imp"
L_0396:;
// 4198 PREC=3 %IF TYPE=2 %AND ALL LONG#0;! DEAL WITH '%REALSLONG'
#line 4198 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0397;
#line 4198 "test-new/imp918s.imp"
if (ALLLONG == 0) goto L_0397;
#line 4198 "test-new/imp918s.imp"
PREC = 3;
#line 4198 "test-new/imp918s.imp"
L_0397:;
// 4199 ACC=BYTES(PREC)
#line 4199 "test-new/imp918s.imp"
ACC = BYTES[PREC];
// 4200 %IF TYPE=5 %THEN %START; ! P<TYPE>='%STRING'
#line 4200 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0398;
// 4201 %IF A(P+1)=1 %THEN %START;! MAX LENGTH GIVEN
#line 4201 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_0399;
// 4202 P=P+2
#line 4202 "test-new/imp918s.imp"
P = P + 2;
// 4203 ACC=A(P)+1
#line 4203 "test-new/imp918s.imp"
ACC = A[P + 7] + 1;
// 4204 FAULT(70,0) %UNLESS 2<=ACC<=256
#line 4204 "test-new/imp918s.imp"
{
// Double-sided test on ACC (Part I)
#line 4204 "test-new/imp918s.imp"
short int tmp;
#line 4204 "test-new/imp918s.imp"
if (2 > (tmp = ACC)) goto L_039A;
// Double-sided test on ACC (Part II)
#line 4204 "test-new/imp918s.imp"
if (tmp <= 256) goto L_039B;
#line 4204 "test-new/imp918s.imp"
}
#line 4204 "test-new/imp918s.imp"
L_039A:;
#line 4204 "test-new/imp918s.imp"
FAULT(70, 0);
#line 4204 "test-new/imp918s.imp"
L_039B:;
// 4205 %FINISH %ELSE ACC=0 %AND P=P+1
#line 4205 "test-new/imp918s.imp"
goto L_039C;
#line 4205 "test-new/imp918s.imp"
L_0399:;
#line 4205 "test-new/imp918s.imp"
ACC = 0;
#line 4205 "test-new/imp918s.imp"
P = P + 1;
#line 4205 "test-new/imp918s.imp"
L_039C:;
// 4206 %FINISH
#line 4206 "test-new/imp918s.imp"
L_0398:;
// 4207 P=P+1
#line 4207 "test-new/imp918s.imp"
P = P + 1;
// 4208 %END
#line 4208 "test-new/imp918s.imp"
return;
#line 4208 "test-new/imp918s.imp"
} /* end of CLT */
// 4209 %ROUTINE CQN(%INTEGER P)
#line 4209 "test-new/imp918s.imp"
void CQN(int P) {
// 4210 {%SHORTROUTINE}
// 4211 !***********************************************************************
// 4212 !* SET NAM,ARR & ACC FROM ALTERNATIVE OF PHRASE <QNAME'> *
// 4213 !* P<QNAME'>='%ARRAYNAME','%NAME',<%NULL> *
// 4214 !* P POINTS TO THE ANALYSIS RECORD ENTRY AS IS NOT UPDATED *
// 4215 !***********************************************************************
// 4216 %BYTEINTEGER I
#line 4216 "test-new/imp918s.imp"
unsigned char I;
// 4217 I=A(P);NAM=0;ARR=0
#line 4217 "test-new/imp918s.imp"
I = A[P + 7];
#line 4217 "test-new/imp918s.imp"
NAM = 0;
#line 4217 "test-new/imp918s.imp"
ARR = 0;
// 4218 %IF I=1 %THEN ARR=1 %AND ACC=16; ! ARRAYNAMES
#line 4218 "test-new/imp918s.imp"
if (I != 1) goto L_039D;
#line 4218 "test-new/imp918s.imp"
ARR = 1;
#line 4218 "test-new/imp918s.imp"
ACC = 16;
#line 4218 "test-new/imp918s.imp"
L_039D:;
// 4219 %IF I<=2 %THEN NAM=1; ! ARRAYNAMES & NAMES
#line 4219 "test-new/imp918s.imp"
if (I > 2) goto L_039E;
#line 4219 "test-new/imp918s.imp"
NAM = 1;
#line 4219 "test-new/imp918s.imp"
L_039E:;
// 4220 %IF I=2 %THEN ACC=4; ! NAMES USE 4-BYTE POINTER
#line 4220 "test-new/imp918s.imp"
if (I != 2) goto L_039F;
#line 4220 "test-new/imp918s.imp"
ACC = 4;
#line 4220 "test-new/imp918s.imp"
L_039F:;
// 4221 %END
#line 4221 "test-new/imp918s.imp"
return;
#line 4221 "test-new/imp918s.imp"
} /* end of CQN */
// 4222 %ROUTINE RHEAD(%INTEGER KK)
#line 4222 "test-new/imp918s.imp"
void RHEAD(int KK) {
// 4223 {%SHORTROUTINE}
// 4224 !***********************************************************************
// 4225 !* COMPILES CODE FOR BLOCK AND ROUTINE ENTRY *
// 4226 !* KK IS THE RT/FN/MAP NAME (=-1 FOR %BEGIN BLOCKS) *
// 4227 !* FLAGP IS AS KK EXCEPT FLAGP=10000 IS USED TO DISTINGUISH *
// 4228 !* THE FIRST (PERM) BEGIN WHICH HAS TO BE TREATED AS A ROUTINE *
// 4229 !* ROUTINE TAGS ARE AS FOLLOWS:- *
// 4230 !* SNDISP = WORD(!) DISPLACEMENT OF EP(REF)FROM HEAD OF CODE(GLA)*
// 4231 !* (OR) = LISTHEAD OF OUTSTANDING FORWARD REFS *
// 4232 !* KFORM = PSIMPLE<<12 ! NO OF PARAMS *
// 4233 !* K = LIST OF FORMAL PARAMETER DESCRIPTIONS *
// 4234 !***********************************************************************
// 4235 %INTEGER FLAGP,W1,W2,W3,BASED,AT,WK
#line 4235 "test-new/imp918s.imp"
int FLAGP;
#line 4235 "test-new/imp918s.imp"
int W1;
#line 4235 "test-new/imp918s.imp"
int W2;
#line 4235 "test-new/imp918s.imp"
int W3;
#line 4235 "test-new/imp918s.imp"
int BASED;
#line 4235 "test-new/imp918s.imp"
int AT;
#line 4235 "test-new/imp918s.imp"
int WK;
// 4236 PUSH123(LEVELINF,NMDECS<<24!CODEBASE,NMAX<<16!SBFLAG<<15!N,%C
#line 4236 "test-new/imp918s.imp"
PUSH123(/*?*/ &LEVELINF, NMDECS << 24 | CODEBASE, NMAX << 16 | SBFLAG << 15 | N, RNEXT << 16 | FLAG);
// 4237+ RNEXT<<16!FLAG)
// 4238 FLAGP=KK;FLAGP=10000 %IF RLEVEL=0
#line 4238 "test-new/imp918s.imp"
FLAGP = KK;
#line 4238 "test-new/imp918s.imp"
if (RLEVEL != 0) goto L_03A0;
#line 4238 "test-new/imp918s.imp"
FLAGP = 10000;
#line 4238 "test-new/imp918s.imp"
L_03A0:;
// 4239 %IF LIST=0 %AND RLEVEL#0 %THEN %START; ! OUTPUT HEADER
#line 4239 "test-new/imp918s.imp"
if (LIST != 0) goto L_03A1;
#line 4239 "test-new/imp918s.imp"
if (RLEVEL == 0) goto L_03A1;
// 4240 NEWLINE;WRITE(LINE,5)
#line 4240 "test-new/imp918s.imp"
_imp_NEWLINE();
#line 4240 "test-new/imp918s.imp"
_imp_WRITE(LINE, 5);
// 4241 %IF PRINTMAP=1 %THEN SPACES(3) %AND PRHEX(CA,5)
#line 4241 "test-new/imp918s.imp"
if (PRINTMAP != 1) goto L_03A2;
#line 4241 "test-new/imp918s.imp"
_imp_SPACES(3);
#line 4241 "test-new/imp918s.imp"
PRHEX(CA, 5);
#line 4241 "test-new/imp918s.imp"
L_03A2:;
// 4242 SPACES(3*LEVEL)
#line 4242 "test-new/imp918s.imp"
_imp_SPACES(3 * LEVEL);
// 4243 %IF KK<0 %THEN printstring("BEGIN") %ELSE %START
#line 4243 "test-new/imp918s.imp"
if (KK >= 0) goto L_03A3;
#line 4243 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("BEGIN"));
#line 4243 "test-new/imp918s.imp"
goto L_03A4;
#line 4243 "test-new/imp918s.imp"
L_03A3:;
// 4244 %IF PTYPE=10000 %THEN printstring("RT ") %ELSE %C
#line 4244 "test-new/imp918s.imp"
if (PTYPE != 10000) goto L_03A5;
#line 4244 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("RT "));
#line 4244 "test-new/imp918s.imp"
goto L_03A6;
#line 4244 "test-new/imp918s.imp"
L_03A5:;
#line 4244 "test-new/imp918s.imp"
_imp_PRINTSTRING(_imp_str_literal("FN/MAP "));
#line 4244 "test-new/imp918s.imp"
L_03A6:;
// 4245+ printstring("FN/MAP ")
// 4246 PRINTNAME(KK)
#line 4246 "test-new/imp918s.imp"
PRINTNAME(KK);
// 4247 %FINISH
#line 4247 "test-new/imp918s.imp"
L_03A4:;
// 4248 %FINISH
#line 4248 "test-new/imp918s.imp"
L_03A1:;
// 4249 LEVEL=LEVEL+1
#line 4249 "test-new/imp918s.imp"
LEVEL = LEVEL + 1;
// 4250 NAMES(LEVEL)=-1
#line 4250 "test-new/imp918s.imp"
NAMES[LEVEL] = -1;
// 4251 %IF FLAGP>=0 %THEN %START
#line 4251 "test-new/imp918s.imp"
if (FLAGP < 0) goto L_03A7;
// 4252 RLEVEL=RLEVEL+1; RBASE=10-RLEVEL
#line 4252 "test-new/imp918s.imp"
RLEVEL = RLEVEL + 1;
#line 4252 "test-new/imp918s.imp"
RBASE = 10 - RLEVEL;
// 4253 FAULT(35,0) %IF RBASE=4 %OR REGISTER(RBASE)#0
#line 4253 "test-new/imp918s.imp"
if (RBASE == 4) goto L_03A8;
#line 4253 "test-new/imp918s.imp"
if (REGISTER[RBASE] == 0) goto L_03A9;
#line 4253 "test-new/imp918s.imp"
L_03A8:;
#line 4253 "test-new/imp918s.imp"
FAULT(35, 0);
#line 4253 "test-new/imp918s.imp"
L_03A9:;
// 4254 FORGET(RBASE); REGISTER(RBASE)=-1
#line 4254 "test-new/imp918s.imp"
FORGET(RBASE);
#line 4254 "test-new/imp918s.imp"
REGISTER[RBASE] = -1;
// 4255 %FINISH
#line 4255 "test-new/imp918s.imp"
L_03A7:;
// 4256 FAULT(34,0) %IF LEVEL=10
#line 4256 "test-new/imp918s.imp"
if (LEVEL != 10) goto L_03AA;
#line 4256 "test-new/imp918s.imp"
FAULT(34, 0);
#line 4256 "test-new/imp918s.imp"
L_03AA:;
// 4257 FAULT(105,0) %IF LEVEL>MAX LEVELS
#line 4257 "test-new/imp918s.imp"
if (LEVEL <= 11) goto L_03AB;
#line 4257 "test-new/imp918s.imp"
FAULT(105, 0);
#line 4257 "test-new/imp918s.imp"
L_03AB:;
// 4258 NMDECS=0
#line 4258 "test-new/imp918s.imp"
NMDECS = 0;
// 4259 %IF FLAGP<0 %THEN %START; ! BEGIN BLOCKS
#line 4259 "test-new/imp918s.imp"
if (FLAGP >= 0) goto L_03AC;
// 4260 PRX(X'90',10,11,RBASE,N); ! STM 10,11,?
#line 4260 "test-new/imp918s.imp"
PRX(144, 10, 11, RBASE, N);
// 4261 N=N+12; W2=N-4
#line 4261 "test-new/imp918s.imp"
N = N + 12;
#line 4261 "test-new/imp918s.imp"
W2 = N - 4;
// 4262 %FINISH
#line 4262 "test-new/imp918s.imp"
L_03AC:;
// 4263 %IF KK>=0 %THEN %START; ! ROUTINE ENTRY
#line 4263 "test-new/imp918s.imp"
if (KK < 0) goto L_03AD;
// 4264 %IF SNDISP=0 %AND EXTRN=4 %START; ! REPLACE 'NOT USED' BIT
#line 4264 "test-new/imp918s.imp"
if (SNDISP != 0) goto L_03AE;
#line 4264 "test-new/imp918s.imp"
if (EXTRN != 4) goto L_03AE;
// 4265 REPLACE1(TAGS(KK),FROM1(TAGS(KK))&X'FFFF0FFF')
#line 4265 "test-new/imp918s.imp"
REPLACE1(TAGS[KK], FROM1(TAGS[KK]) & -61441);
// 4266 %FINISH
#line 4266 "test-new/imp918s.imp"
L_03AE:;
// 4267 !
// 4268 ! NOW FILL ANY JUMPS TO THIS ROUTINE PLANTED SINCE
// 4269 ! THE ROUTINESPEC WAS COMPILED. SEE ALSO 'RT JUMP'
// 4270 !
// 4271 %WHILE SNDISP#0 %CYCLE
#line 4271 "test-new/imp918s.imp"
L_03AF:;
#line 4271 "test-new/imp918s.imp"
if (SNDISP == 0) goto L_03B0;
// 4272 POP123(SNDISP,BASED,AT,W1)
#line 4272 "test-new/imp918s.imp"
POP123(/*?*/ &SNDISP, /*?*/ &BASED, /*?*/ &AT, /*?*/ &W1);
// 4273 W2=CA-BASED
#line 4273 "test-new/imp918s.imp"
W2 = CA - BASED;
// 4274 %IF W1=0 %THEN %START
#line 4274 "test-new/imp918s.imp"
if (W1 != 0) goto L_03B1;
// 4275 WK=PTBASE+W2>>12<<2
#line 4275 "test-new/imp918s.imp"
WK = 256 + ((unsigned int)W2 >> 12 << 2);
// 4276 %IF W2<=4095 %THEN %START
#line 4276 "test-new/imp918s.imp"
if (W2 > 4095) goto L_03B2;
// 4277 PLUG(1,AT,X'41DD'); ! OVERWRITE THE ADD
#line 4277 "test-new/imp918s.imp"
PLUG(1, AT, 16861);
// 4278 WK=0; ! WITH LA 13,0(13) AS NO-OP
#line 4278 "test-new/imp918s.imp"
WK = 0;
// 4279 %FINISH
#line 4279 "test-new/imp918s.imp"
L_03B2:;
// 4280 PLUG(1,AT+2,WK)
#line 4280 "test-new/imp918s.imp"
PLUG(1, AT + 2, WK);
// 4281 AT=AT+4
#line 4281 "test-new/imp918s.imp"
AT = AT + 4;
// 4282
// 4283 %FINISH %ELSE %START
#line 4283 "test-new/imp918s.imp"
goto L_03B3;
#line 4283 "test-new/imp918s.imp"
L_03B1:;
// 4284 FAULT(99,0) %IF W2>4095
#line 4284 "test-new/imp918s.imp"
if (W2 <= 4095) goto L_03B4;
#line 4284 "test-new/imp918s.imp"
FAULT(99, 0);
#line 4284 "test-new/imp918s.imp"
L_03B4:;
// 4285 %FINISH
#line 4285 "test-new/imp918s.imp"
L_03B3:;
// 4286 PLUG(1,AT+2,W2&4095)
#line 4286 "test-new/imp918s.imp"
PLUG(1, AT + 2, W2 & 4095);
// 4287 %REPEAT
#line 4287 "test-new/imp918s.imp"
goto L_03AF;
#line 4287 "test-new/imp918s.imp"
L_03B0:;
// 4288 SNDISP<-CA>>2
#line 4288 "test-new/imp918s.imp"
SNDISP = (short int)((unsigned int)CA >> 2);
// 4289 REPLACE2(TCELL,INTEGER(ADDR(SNDISP)));! NOTE ADDR FOR FUTURE CALLS
#line 4289 "test-new/imp918s.imp"
REPLACE2(TCELL, *_imp_INTEGER(_imp_ADDR(/*?*/ &SNDISP)));
// 4290 PCONST(X'50FB003C'); ! SAVE LINK -- ST 15,60(11)
#line 4290 "test-new/imp918s.imp"
PCONST(1358626876);
// 4291 W2=0
#line 4291 "test-new/imp918s.imp"
W2 = 0;
// 4292 %FINISH
#line 4292 "test-new/imp918s.imp"
L_03AD:;
// 4293 PRR(X'18',RBASE,WSPR) %UNLESS FLAGP<0
#line 4293 "test-new/imp918s.imp"
if (FLAGP < 0) goto L_03B5;
#line 4293 "test-new/imp918s.imp"
PRR(24, RBASE, 11);
#line 4293 "test-new/imp918s.imp"
L_03B5:;
// 4294 %IF KK<0 %THEN W3=0 %ELSE W3=WORD(KK)
#line 4294 "test-new/imp918s.imp"
if (KK >= 0) goto L_03B6;
#line 4294 "test-new/imp918s.imp"
W3 = 0;
#line 4294 "test-new/imp918s.imp"
goto L_03B7;
#line 4294 "test-new/imp918s.imp"
L_03B6:;
#line 4294 "test-new/imp918s.imp"
W3 = WORD[KK];
#line 4294 "test-new/imp918s.imp"
L_03B7:;
// 4295 L(LEVEL)=LINE;M(LEVEL)=W3
#line 4295 "test-new/imp918s.imp"
L[LEVEL] = LINE;
#line 4295 "test-new/imp918s.imp"
M[LEVEL] = W3;
// 4296 RNEXT=NEXT
#line 4296 "test-new/imp918s.imp"
RNEXT = NEXT;
// 4297 FLAG=PTYPE; ! CURRENT BLOCK TYPE MARKER
#line 4297 "test-new/imp918s.imp"
FLAG = PTYPE;
// 4298 %IF FLAGP>=0 %THEN %START
#line 4298 "test-new/imp918s.imp"
if (FLAGP < 0) goto L_03B8;
// 4299 SET(RLEVEL)=CA+2
#line 4299 "test-new/imp918s.imp"
SET[RLEVEL] = CA + 2;
// 4300 PCONST(X'41BB0000'); ! LA WSP, ?(WSP)
#line 4300 "test-new/imp918s.imp"
PCONST(1102774272);
// 4301 N=64; NMAX=N;
#line 4301 "test-new/imp918s.imp"
N = 64;
#line 4301 "test-new/imp918s.imp"
NMAX = N;
// 4302 FORGETM(14); ! START NEW RT W CLEAN SLATE
#line 4302 "test-new/imp918s.imp"
FORGETM(14);
// 4303 CCSTATE=-1
#line 4303 "test-new/imp918s.imp"
CCSTATE = -1;
// 4304 %FINISH
#line 4304 "test-new/imp918s.imp"
L_03B8:;
// 4305 !
// 4306 ! IF IN DIAGNOSTIC MODE PLANT CODE TO SAVE THE LINE & ROUTINE NO OF
// 4307 ! THE CALLING ROUTINE AND SET UP THE NEW BLOCK/ROUTINE IDENT NO.
// 4308 !
// 4309 %IF DIAGS1#0 %AND LINE>0 %THEN %START
#line 4309 "test-new/imp918s.imp"
if (DIAGS1 == 0) goto L_03B9;
#line 4309 "test-new/imp918s.imp"
if (LINE <= 0) goto L_03B9;
// 4310 PRX(X'58',0,GLA,0,20); ! L 0,OLD DIAGS INF
#line 4310 "test-new/imp918s.imp"
PRX(88, 0, 13, 0, 20);
// 4311 DUMP(X'50',0,W2,0,RBASE); ! ST 0,SAFE PLACE
#line 4311 "test-new/imp918s.imp"
DUMP(80, 0, W2, 0, RBASE);
// 4312 DUMP(X'41',0,LINE,0,0); ! LA 0,LINE NO
#line 4312 "test-new/imp918s.imp"
DUMP(65, 0, LINE, 0, 0);
// 4313 PCONST(X'4000D014'); ! STH 0,20(GLA)
#line 4313 "test-new/imp918s.imp"
PCONST(1073795092);
// 4314 FORGET(0); ! NEEDED FOR %BEGIN BLOCKS
#line 4314 "test-new/imp918s.imp"
FORGET(0);
// 4315 %FINISH
#line 4315 "test-new/imp918s.imp"
L_03B9:;
// 4316 MONE=1; SET LINE; ! NOW UPDATE LINE NUMBER
#line 4316 "test-new/imp918s.imp"
MONE = 1;
#line 4316 "test-new/imp918s.imp"
SETLINE();
// 4317 %END; ! OF ROUTINE RHEAD
#line 4317 "test-new/imp918s.imp"
return;
#line 4317 "test-new/imp918s.imp"
} /* end of RHEAD */
// 4318 %ROUTINE DEFINE EP(%INTEGER MODE,NAME,ADR,XTRA)
#line 4318 "test-new/imp918s.imp"
void DEFINEEP(int MODE, int NAME, int ADR, int XTRA) {
// 4319 {%SHORTROUTINE}
// 4320 !***********************************************************************
// 4321 !* ENTER AN ENTRY POINT ON THE ENTRY POINT LIST *
// 4322 !* AN ENTRY POINT LOOKS LIKE:- *
// 4323 !* S1 = FLAG<<24 ! ENTRY POINT ADDRESS RELATIVE TO START OF AREA *
// 4324 !* S2 = XTRA INFO (PRIMARILY LENGTH OF DATA 'COMMON' AREAS) *
// 4325 !* S3 = LINK TO SINGLE CELL SIDECHAIN CONTAINING NAME AS STRING *
// 4326 !* FLAG = 0 FOR PROGRAM ENTRY POINT *
// 4327 !* = 1 FOR DATA IN GLA (%EXTERNAL) *
// 4328 !* = 2 FOR DATA IN GLA SYMBOL TABLE (%EXTERNAL %ARRAY) *
// 4329 !* MODE=0 FOR S#GO, =1 SYSTEM ROUTINES,=2 EXTERNAL ROUTINES *
// 4330 !* MODE=3 FOR DATA IN ADDRESSABLE GLA,=4 BACK OF GLA *
// 4331 !***********************************************************************
// 4332 %SHORTINTEGER HEAD
#line 4332 "test-new/imp918s.imp"
short int HEAD;
// 4333 %INTEGER JJ,FLAG,ID1,ID2,ID3
#line 4333 "test-new/imp918s.imp"
int JJ;
#line 4333 "test-new/imp918s.imp"
int FLAG;
#line 4333 "test-new/imp918s.imp"
int ID1;
#line 4333 "test-new/imp918s.imp"
int ID2;
#line 4333 "test-new/imp918s.imp"
int ID3;
// 4334 %STRING(8) ID
#line 4334 "test-new/imp918s.imp"
_imp_string8 ID;
// 4335 ID=""; FLAG=0
#line 4335 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 8);
#line 4335 "test-new/imp918s.imp"
FLAG = 0;
// 4336 HEAD=0
#line 4336 "test-new/imp918s.imp"
HEAD = 0;
// 4337 %IF MODE=0 %THEN JJ=ADDR(MAINEP1)+3 %ELSE %C
#line 4337 "test-new/imp918s.imp"
if (MODE != 0) goto L_03BA;
#line 4337 "test-new/imp918s.imp"
JJ = _imp_ADDR(/*?*/ &MAINEP1) + 3;
#line 4337 "test-new/imp918s.imp"
goto L_03BB;
#line 4337 "test-new/imp918s.imp"
L_03BA:;
#line 4337 "test-new/imp918s.imp"
JJ = _imp_ADDR(/*?*/ &LETT[WORD[NAME]]);
#line 4337 "test-new/imp918s.imp"
L_03BB:;
// 4338+ JJ=ADDR(LETT(WORD(NAME)))
// 4339 %IF MODE>=3 %THEN FLAG=MODE-2
#line 4339 "test-new/imp918s.imp"
if (MODE < 3) goto L_03BC;
#line 4339 "test-new/imp918s.imp"
FLAG = MODE - 2;
#line 4339 "test-new/imp918s.imp"
L_03BC:;
// 4340 %IF MODE=1 %THEN ID="S#"
#line 4340 "test-new/imp918s.imp"
if (MODE != 1) goto L_03BD;
#line 4340 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("S#");
(void *)&tmp;
}),
/*max:*/ 8);
#line 4340 "test-new/imp918s.imp"
L_03BD:;
// 4341 ID<-ID.STRING(JJ)
#line 4341 "test-new/imp918s.imp"
_imp_strncpy(/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &ID, ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = *_imp_STRING(JJ);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 8);
#line 4341 "test-new/imp918s.imp"
/* truncated copy of no more than 8 chars */
#line 4341 "test-new/imp918s.imp"
if (*_imp_LENGTH((_imp_string *)/*?*/ &ID) > 8) *_imp_LENGTH((_imp_string *)/*?*/ &ID) = 8;
// 4342 STRING(ADDR(ID1))=ID
#line 4342 "test-new/imp918s.imp"
*_imp_STRING(_imp_ADDR(/*?*/ &ID1)) = ID;
// 4343 %IF FLAG=0 %THEN JJ=11 %ELSE JJ=14
#line 4343 "test-new/imp918s.imp"
if (FLAG != 0) goto L_03BE;
#line 4343 "test-new/imp918s.imp"
JJ = 11;
#line 4343 "test-new/imp918s.imp"
goto L_03BF;
#line 4343 "test-new/imp918s.imp"
L_03BE:;
#line 4343 "test-new/imp918s.imp"
JJ = 14;
#line 4343 "test-new/imp918s.imp"
L_03BF:;
// 4344 %IF FLAG<=1 %THEN LPUT(JJ,XTRA,ADR,ADDR(ID)) %ELSE %START
#line 4344 "test-new/imp918s.imp"
if (FLAG > 1) goto L_03C0;
#line 4344 "test-new/imp918s.imp"
LPUT(JJ, XTRA, ADR, _imp_ADDR(/*?*/ &ID));
#line 4344 "test-new/imp918s.imp"
goto L_03C1;
#line 4344 "test-new/imp918s.imp"
L_03C0:;
// 4345 PUSH123(HEAD,ID1,ID2,ID3>>16)
#line 4345 "test-new/imp918s.imp"
PUSH123(/*?*/ &HEAD, ID1, ID2, (unsigned int)ID3 >> 16);
// 4346 PUSH123(EPLINK,FLAG<<24!ADR,XTRA,HEAD)
#line 4346 "test-new/imp918s.imp"
PUSH123(/*?*/ &EPLINK, FLAG << 24 | ADR, XTRA, HEAD);
// 4347 %FINISH
#line 4347 "test-new/imp918s.imp"
L_03C1:;
// 4348 %END
#line 4348 "test-new/imp918s.imp"
return;
#line 4348 "test-new/imp918s.imp"
} /* end of DEFINEEP */
// 4349 %ROUTINE CRSPEC (%INTEGER M)
#line 4349 "test-new/imp918s.imp"
void CRSPEC(int M) {
// 4350 {%SHORTROUTINE}
// 4351 !***********************************************************************
// 4352 !* MODE=0 FOR NORMAL ROUTINE SPEC *
// 4353 !* MODE=1 FOR EXTERNAL(ETC) ROUTINE SPECS XREF NEEDED *
// 4354 !* MODE=2 FOR %SPEC FOR RT PARAMS *
// 4355 !* ROUTINE TAGS ARE AS FOLLOWS:- *
// 4356 !* SNDISP = WORD(!) DISPLACEMENT OF EP(REF)FROM HEAD OF CODE(GLA)*
// 4357 !* (OR) = LISTHEAD OF OUTSTANDING FORWARD REFS *
// 4358 !* KFORM = PSIMPLE<<12 ! NO OF PARAMS *
// 4359 !* K = LIST OF FORMAL PARAMETER DESCRIPTIONS *
// 4360 !***********************************************************************
// 4361 %INTEGER PP,KK,JJ,JJJ,Q,TYPEP,PREFIX,INC,PSIMPLE,PPOSN
#line 4361 "test-new/imp918s.imp"
int PP;
#line 4361 "test-new/imp918s.imp"
int KK;
#line 4361 "test-new/imp918s.imp"
int JJ;
#line 4361 "test-new/imp918s.imp"
int JJJ;
#line 4361 "test-new/imp918s.imp"
int Q;
#line 4361 "test-new/imp918s.imp"
int TYPEP;
#line 4361 "test-new/imp918s.imp"
int PREFIX;
#line 4361 "test-new/imp918s.imp"
int INC;
#line 4361 "test-new/imp918s.imp"
int PSIMPLE;
#line 4361 "test-new/imp918s.imp"
int PPOSN;
// 4362 %SHORTINTEGER OPHEAD,OPBOT
#line 4362 "test-new/imp918s.imp"
short int OPHEAD;
#line 4362 "test-new/imp918s.imp"
short int OPBOT;
// 4363 Q=0
#line 4363 "test-new/imp918s.imp"
Q = 0;
// 4364 %IF M#2 %THEN %START
#line 4364 "test-new/imp918s.imp"
if (M == 2) goto L_03C2;
// 4365 !
// 4366 ! WORK OUT TYPEP IE TYPE OF ENTITITY BY INSPECTING AR FOR P<RT>
// 4367 !
// 4368 %IF A(P+1)=1 %THEN %START; ! P<RT>=%ROUTINE
#line 4368 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_03C3;
// 4369 TYPEP=10000; P=P+3
#line 4369 "test-new/imp918s.imp"
TYPEP = 10000;
#line 4369 "test-new/imp918s.imp"
P = P + 3;
// 4370 %FINISH %ELSE %START; ! P<RT>=<TYPE><FNORMAP>
#line 4370 "test-new/imp918s.imp"
goto L_03C4;
#line 4370 "test-new/imp918s.imp"
L_03C3:;
// 4371 ROUT=1; ARR=0; P=P+2
#line 4371 "test-new/imp918s.imp"
ROUT = 1;
#line 4371 "test-new/imp918s.imp"
ARR = 0;
#line 4371 "test-new/imp918s.imp"
P = P + 2;
// 4372 CLT; NAM=(A(P)-1)<<1
#line 4372 "test-new/imp918s.imp"
CLT();
#line 4372 "test-new/imp918s.imp"
NAM = A[P + 7] - 1 << 1;
// 4373 PACK(TYPEP)
#line 4373 "test-new/imp918s.imp"
PACK(/*?*/ &TYPEP);
// 4374 P=P+2
#line 4374 "test-new/imp918s.imp"
P = P + 2;
// 4375 %FINISH
#line 4375 "test-new/imp918s.imp"
L_03C4:;
// 4376 %FINISH
#line 4376 "test-new/imp918s.imp"
L_03C2:;
// 4377 KK=A(P); COPYTAG(KK)
#line 4377 "test-new/imp918s.imp"
KK = A[P + 7];
#line 4377 "test-new/imp918s.imp"
COPYTAG(KK);
// 4378 !
// 4379 ! IF KK IS A VALID RT TYPE PARAM IT MUST BE DECLARED AT THE CURRENT
// 4380 ! LEVEL AND HAVE 1000 PARAMS. IF KK IS A NEW DECLARATION '%SPEC' CANNOT
// 4381 ! BE USED AND THE NAME MUST NOT BE SET AT THE CURRENT LEVEL.
// 4382 !
// 4383 %IF SNPT#PTYPE>=10000 %THEN Q=KFORM&4095 %AND %C
#line 4383 "test-new/imp918s.imp"
{
// Double-sided test on PTYPE (Part I)
#line 4383 "test-new/imp918s.imp"
int tmp;
#line 4383 "test-new/imp918s.imp"
if (10006 == (tmp = PTYPE)) goto L_03C5;
// Double-sided test on PTYPE (Part II)
#line 4383 "test-new/imp918s.imp"
if (tmp < 10000) goto L_03C5;
#line 4383 "test-new/imp918s.imp"
}
#line 4383 "test-new/imp918s.imp"
Q = KFORM & 4095;
#line 4383 "test-new/imp918s.imp"
JJ = (SNDISP & 65535) << 2;
#line 4383 "test-new/imp918s.imp"
L_03C5:;
// 4384+ JJ=(SNDISP&X'FFFF')<<2
// 4385 %UNLESS OLDI=LEVEL %AND Q=1000 %AND %C
#line 4385 "test-new/imp918s.imp"
if (OLDI != LEVEL) goto L_037C;
#line 4385 "test-new/imp918s.imp"
if (Q != 1000) goto L_037C;
#line 4385 "test-new/imp918s.imp"
if (M == 2) goto L_03C6;
#line 4385 "test-new/imp918s.imp"
if (PTYPE - 1000 == TYPEP) goto L_03C6;
#line 4385 "test-new/imp918s.imp"
L_037C:;
// 4386+ (M=2 %OR PTYPE-1000=TYPEP) %THEN %START
// 4387 !
// 4388 ! KK IS NOT A VALID RT TYPE PARAM
// 4389 !
// 4390 %UNLESS OLDI#LEVEL %AND M<=1 %THEN %START;! KK VALID DECLN
#line 4390 "test-new/imp918s.imp"
if (OLDI == LEVEL) goto L_03C7;
#line 4390 "test-new/imp918s.imp"
if (M <= 1) goto L_03C8;
#line 4390 "test-new/imp918s.imp"
L_03C7:;
// 4391 FAULT(7-M>>1<<2,KK); ! FAULT 3(SPEC?)OR 7(SET TWICE)
#line 4391 "test-new/imp918s.imp"
FAULT(7 - ((unsigned int)M >> 1 << 2), KK);
// 4392 %RETURN %UNLESS M=0
#line 4392 "test-new/imp918s.imp"
if (M == 0) goto L_03C9;
#line 4392 "test-new/imp918s.imp"
return;
#line 4392 "test-new/imp918s.imp"
L_03C9:;
// 4393 %FINISH
#line 4393 "test-new/imp918s.imp"
L_03C8:;
// 4394 JJ=0; ! SO MAKE DECLARATION
#line 4394 "test-new/imp918s.imp"
JJ = 0;
// 4395 J=15-M; PTYPE=TYPEP
#line 4395 "test-new/imp918s.imp"
J = 15 - M;
#line 4395 "test-new/imp918s.imp"
PTYPE = TYPEP;
// 4396 KFORM=0
#line 4396 "test-new/imp918s.imp"
KFORM = 0;
// 4397 %IF OLDI = LEVEL %THEN %START
#line 4397 "test-new/imp918s.imp"
if (OLDI != LEVEL) goto L_03CA;
// 4398 USEBITS = INTEGER(ADDR(ASLIST(TAGS(KK)))) >> 12 & X'F'
#line 4398 "test-new/imp918s.imp"
USEBITS = (unsigned int)*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[TAGS[KK]])) >> 12 & 15;
// 4399 I = RBASE
#line 4399 "test-new/imp918s.imp"
I = RBASE;
// 4400 REPLACE TAG (KK)
#line 4400 "test-new/imp918s.imp"
REPLACETAG(KK);
// 4401 %FINISH %ELSE STORE TAG(KK,0)
#line 4401 "test-new/imp918s.imp"
goto L_03CB;
#line 4401 "test-new/imp918s.imp"
L_03CA:;
#line 4401 "test-new/imp918s.imp"
STORETAG(KK, 0);
#line 4401 "test-new/imp918s.imp"
L_03CB:;
// 4402 %FINISH
#line 4402 "test-new/imp918s.imp"
L_03C6:;
// 4403 OPHEAD=0; OPBOT=0
#line 4403 "test-new/imp918s.imp"
OPHEAD = 0;
#line 4403 "test-new/imp918s.imp"
OPBOT = 0;
// 4404 PPOSN=64; ! DISPLCMENT OF EACH PARAM
#line 4404 "test-new/imp918s.imp"
PPOSN = 64;
// 4405 INC=1; JJJ=OPHEAD; PSIMPLE=1
#line 4405 "test-new/imp918s.imp"
INC = 1;
#line 4405 "test-new/imp918s.imp"
JJJ = OPHEAD;
#line 4405 "test-new/imp918s.imp"
PSIMPLE = 1;
// 4406 P=P+1; Q=0; ! Q COUNTS NO OF FORMAL PARAMS
#line 4406 "test-new/imp918s.imp"
P = P + 1;
#line 4406 "test-new/imp918s.imp"
Q = 0;
// 4407 %WHILE A(P)=1 %CYCLE; ! WHILE SOME(MORE) FPS
#line 4407 "test-new/imp918s.imp"
L_03CC:;
#line 4407 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_03CD;
// 4408 P=P+INC; ! P<COMMA'> BETWEEN FPDELS
#line 4408 "test-new/imp918s.imp"
P = P + INC;
// 4409 CFPDEL; ! GET TYPE & ACC FOR NEXT GROUP
#line 4409 "test-new/imp918s.imp"
CFPDEL();
// 4410 PPOSN=(PPOSN+KFORM-1)&(-KFORM)
#line 4410 "test-new/imp918s.imp"
PPOSN = PPOSN + KFORM - 1 & -KFORM;
// 4411 PSIMPLE=0 %UNLESS PTYPE=1 %OR %C
#line 4411 "test-new/imp918s.imp"
if (PTYPE == 1) goto L_03CE;
#line 4411 "test-new/imp918s.imp"
if (ROUT != 0) goto L_03CF;
#line 4411 "test-new/imp918s.imp"
if (ARR != 0) goto L_03CF;
#line 4411 "test-new/imp918s.imp"
if (NAM != 1) goto L_03CF;
#line 4411 "test-new/imp918s.imp"
if (TYPE != 0) goto L_03CE;
#line 4411 "test-new/imp918s.imp"
L_03CF:;
#line 4411 "test-new/imp918s.imp"
PSIMPLE = 0;
#line 4411 "test-new/imp918s.imp"
L_03CE:;
// 4412+ (ROUT=0 %AND ARR=0 %AND NAM=1 %AND TYPE#0)
// 4413 %CYCLE PP=1,1,A(P); ! DOWN <NAMELIST> FOR EACH DEL
#line 4413 "test-new/imp918s.imp"
// %for PP = 1, 1, A[P + 7] %cycle
#line 4413 "test-new/imp918s.imp"
{
int _control, _initial = 1, _increment = 1, _final = A[P + 7];
#line 4413 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle PP = 1, 1, A[P + 7]");
_control = PP = _initial - _increment;
#line 4413 "test-new/imp918s.imp"
L_03D0:
#line 4413 "test-new/imp918s.imp"
if (PP != _control) _imp_signal(4, 2, 0, "Corrupt control variable PP");
#line 4413 "test-new/imp918s.imp"
if (PP == _final) goto L_03D1;
#line 4413 "test-new/imp918s.imp"
_control += _increment;
PP += _increment;
// 4414 BINSERT(OPHEAD,OPBOT,PTYPE,ACC<<16!PPOSN,0)
#line 4414 "test-new/imp918s.imp"
BINSERT(/*?*/ &OPHEAD, /*?*/ &OPBOT, PTYPE, ACC << 16 | PPOSN, 0);
// 4415 Q=Q+1
#line 4415 "test-new/imp918s.imp"
Q = Q + 1;
// 4416 PPOSN=PPOSN+ACC
#line 4416 "test-new/imp918s.imp"
PPOSN = PPOSN + ACC;
// 4417 %REPEAT
#line 4417 "test-new/imp918s.imp"
goto L_03D0;
#line 4417 "test-new/imp918s.imp"
}
#line 4417 "test-new/imp918s.imp"
L_03D1:;
// 4418 P=P+PP+1; ! ASSUMES PP SET TO A(P) BY REPE
#line 4418 "test-new/imp918s.imp"
P = P + PP + 1;
// 4419 INC=2; ! TO IGNORE ALT OF P<COMMA'>
#line 4419 "test-new/imp918s.imp"
INC = 2;
// 4420 %REPEAT
#line 4420 "test-new/imp918s.imp"
goto L_03CC;
#line 4420 "test-new/imp918s.imp"
L_03CD:;
// 4421 %IF EXTRN=1 %THEN PREFIX='S' %ELSE PREFIX=0
#line 4421 "test-new/imp918s.imp"
if (EXTRN != 1) goto L_03D3;
#line 4421 "test-new/imp918s.imp"
PREFIX = 83;
#line 4421 "test-new/imp918s.imp"
goto L_03D4;
#line 4421 "test-new/imp918s.imp"
L_03D3:;
#line 4421 "test-new/imp918s.imp"
PREFIX = 0;
#line 4421 "test-new/imp918s.imp"
L_03D4:;
// 4422 %IF M=1 %THEN CXREF((EXTRN-1)>>1,KK,PREFIX,JJ)
#line 4422 "test-new/imp918s.imp"
if (M != 1) goto L_03D5;
#line 4422 "test-new/imp918s.imp"
CXREF((unsigned int)EXTRN - 1 >> 1, KK, PREFIX, /*?*/ &JJ);
#line 4422 "test-new/imp918s.imp"
L_03D5:;
// 4423 TCELL=TAGS(KK)
#line 4423 "test-new/imp918s.imp"
TCELL = TAGS[KK];
// 4424 INTEGER(ADDR(SNDISP))=FROM2(TCELL)
#line 4424 "test-new/imp918s.imp"
*_imp_INTEGER(_imp_ADDR(/*?*/ &SNDISP)) = FROM2(TCELL);
// 4425 KFORM=PSIMPLE<<12!Q
#line 4425 "test-new/imp918s.imp"
KFORM = PSIMPLE << 12 | Q;
// 4426 K=OPHEAD; SNDISP<-(JJ>>2)
#line 4426 "test-new/imp918s.imp"
K = OPHEAD;
#line 4426 "test-new/imp918s.imp"
SNDISP = (short int)((unsigned int)JJ >> 2);
// 4427 REPLACE2(TCELL,INTEGER(ADDR(SNDISP)))
#line 4427 "test-new/imp918s.imp"
REPLACE2(TCELL, *_imp_INTEGER(_imp_ADDR(/*?*/ &SNDISP)));
// 4428 REPLACE3(TCELL,INTEGER(ADDR(K)))
#line 4428 "test-new/imp918s.imp"
REPLACE3(TCELL, *_imp_INTEGER(_imp_ADDR(/*?*/ &K)));
// 4429 %END
#line 4429 "test-new/imp918s.imp"
return;
#line 4429 "test-new/imp918s.imp"
} /* end of CRSPEC */
// 4430 %ROUTINE CFPDEL
#line 4430 "test-new/imp918s.imp"
void CFPDEL(void) {
// 4431 {%SHORTROUTINE}
// 4432 !***********************************************************************
// 4433 !* SET UP PTYPE & ACC FOR A LIST OF FORMAL PARAMETERS *
// 4434 !* P<FPDEL>=<RT><%NAME'>,<TYPE><%QNAME'>,'%NAME', *
// 4435 !* '%RECORD'<%ARRAY'>'%NAME'. *
// 4436 !***********************************************************************
// 4437 %BYTEINTEGER FPALT
#line 4437 "test-new/imp918s.imp"
unsigned char FPALT;
// 4438 FPALT=A(P); P=P+1; KFORM=4
#line 4438 "test-new/imp918s.imp"
FPALT = A[P + 7];
#line 4438 "test-new/imp918s.imp"
P = P + 1;
#line 4438 "test-new/imp918s.imp"
KFORM = 4;
// 4439 %IF FPALT<=2 %THEN %START
#line 4439 "test-new/imp918s.imp"
if (FPALT > 2) goto L_03D6;
// 4440 %IF FPALT=1 %THEN %START
#line 4440 "test-new/imp918s.imp"
if (FPALT != 1) goto L_03D7;
// 4441 ACC=4; ROUT=1; ARR=0
#line 4441 "test-new/imp918s.imp"
ACC = 4;
#line 4441 "test-new/imp918s.imp"
ROUT = 1;
#line 4441 "test-new/imp918s.imp"
ARR = 0;
// 4442 %IF A(P)=2 %THEN %START; ! P<RT>=<TYPE><FNORMAP>
#line 4442 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_03D8;
// 4443 P=P+1; CLT
#line 4443 "test-new/imp918s.imp"
P = P + 1;
#line 4443 "test-new/imp918s.imp"
CLT();
// 4444 NAM=(A(P)-1)<<1+1; ! 1 FOR FN 3 FOR MAP
#line 4444 "test-new/imp918s.imp"
NAM = (A[P + 7] - 1 << 1) + 1;
// 4445 ACC=4
#line 4445 "test-new/imp918s.imp"
ACC = 4;
// 4446 %FINISH %ELSE %START; ! P<RT>='%ROUTINE'
#line 4446 "test-new/imp918s.imp"
goto L_03D9;
#line 4446 "test-new/imp918s.imp"
L_03D8:;
// 4447 NAM=1; PREC=0; TYPE=0
#line 4447 "test-new/imp918s.imp"
NAM = 1;
#line 4447 "test-new/imp918s.imp"
PREC = 0;
#line 4447 "test-new/imp918s.imp"
TYPE = 0;
// 4448 %FINISH
#line 4448 "test-new/imp918s.imp"
L_03D9:;
// 4449 P=P+2
#line 4449 "test-new/imp918s.imp"
P = P + 2;
// 4450 %FINISH %ELSE %START; ! FPALT=2
#line 4450 "test-new/imp918s.imp"
goto L_03DA;
#line 4450 "test-new/imp918s.imp"
L_03D7:;
// 4451 ROUT=0
#line 4451 "test-new/imp918s.imp"
ROUT = 0;
// 4452 CLT; CQN(P)
#line 4452 "test-new/imp918s.imp"
CLT();
#line 4452 "test-new/imp918s.imp"
CQN(P);
// 4453 FAULT(70,0) %IF TYPE=5 %AND ACC=0
#line 4453 "test-new/imp918s.imp"
if (TYPE != 5) goto L_03DB;
#line 4453 "test-new/imp918s.imp"
if (ACC != 0) goto L_03DB;
#line 4453 "test-new/imp918s.imp"
FAULT(70, 0);
#line 4453 "test-new/imp918s.imp"
L_03DB:;
// 4454 %IF NAM=0 %THEN %START
#line 4454 "test-new/imp918s.imp"
if (NAM != 0) goto L_03DC;
// 4455 %IF TYPE=5 %THEN KFORM=1 %ELSE KFORM=ACC
#line 4455 "test-new/imp918s.imp"
if (TYPE != 5) goto L_03DD;
#line 4455 "test-new/imp918s.imp"
KFORM = 1;
#line 4455 "test-new/imp918s.imp"
goto L_03DE;
#line 4455 "test-new/imp918s.imp"
L_03DD:;
#line 4455 "test-new/imp918s.imp"
KFORM = ACC;
#line 4455 "test-new/imp918s.imp"
L_03DE:;
// 4456 %FINISH
#line 4456 "test-new/imp918s.imp"
L_03DC:;
// 4457 P=P+1
#line 4457 "test-new/imp918s.imp"
P = P + 1;
// 4458 %FINISH
#line 4458 "test-new/imp918s.imp"
L_03DA:;
// 4459 %FINISH %ELSE %START
#line 4459 "test-new/imp918s.imp"
goto L_03DF;
#line 4459 "test-new/imp918s.imp"
L_03D6:;
// 4460 ROUT=0; PREC=0; NAM=1
#line 4460 "test-new/imp918s.imp"
ROUT = 0;
#line 4460 "test-new/imp918s.imp"
PREC = 0;
#line 4460 "test-new/imp918s.imp"
NAM = 1;
// 4461 %IF FPALT=3 %THEN %START; ! P<FPDEL>='%NAME'
#line 4461 "test-new/imp918s.imp"
if (FPALT != 3) goto L_03E0;
// 4462 ACC=8; ARR=0; TYPE=0
#line 4462 "test-new/imp918s.imp"
ACC = 8;
#line 4462 "test-new/imp918s.imp"
ARR = 0;
#line 4462 "test-new/imp918s.imp"
TYPE = 0;
// 4463 %FINISH %ELSE %START
#line 4463 "test-new/imp918s.imp"
goto L_03E1;
#line 4463 "test-new/imp918s.imp"
L_03E0:;
// 4464 ARR=2-A(P)
#line 4464 "test-new/imp918s.imp"
ARR = 2 - A[P + 7];
// 4465 ACC=4+12*ARR
#line 4465 "test-new/imp918s.imp"
ACC = 4 + 12 * ARR;
// 4466 TYPE=3; P=P+1
#line 4466 "test-new/imp918s.imp"
TYPE = 3;
#line 4466 "test-new/imp918s.imp"
P = P + 1;
// 4467 %FINISH
#line 4467 "test-new/imp918s.imp"
L_03E1:;
// 4468 %FINISH
#line 4468 "test-new/imp918s.imp"
L_03DF:;
// 4469 PACK(PTYPE)
#line 4469 "test-new/imp918s.imp"
PACK(/*?*/ &PTYPE);
// 4470 %END
#line 4470 "test-new/imp918s.imp"
return;
#line 4470 "test-new/imp918s.imp"
} /* end of CFPDEL */
// 4471 %ROUTINE ASSIGN(%INTEGER ASSOP,P1)
#line 4471 "test-new/imp918s.imp"
void ASSIGN(int ASSOP, int P1) {
// 4472 {%SHORTROUTINE}
// 4473 !***********************************************************************
// 4474 !* HANDLES ARITHMETIC,STRING & ADDRESS ASSIGNMENTS TO VARIABLES *
// 4475 !* FORMAL PARAMETERS AND DOPEVECTORS *
// 4476 !* ASSOP:- *
// 4477 !* 1 IS FOR '==' *
// 4478 !* 2 IS FOR '=' *
// 4479 !* 3 IS FOR '<-' (JAM TRANSFER) *
// 4480 !* 4 IS FOR '->' (UNCONDITIONAL RESOLUTION) *
// 4481 !* >4 IS A SPECIAL FOR RESOLUTION *
// 4482 !* STORE BASE&DISP INTO NAME INDEXED BY P1 (RESLN) *
// 4483 !* *
// 4484 !* P POINTS TO THE EXPRESSION. P1 TO THE NAME ON LHS OR *
// 4485 !* P1=BASE<<16!OFFSET AND TYPE+PREC SET UP FOR FORMAL PARAMETERS *
// 4486 !***********************************************************************
// 4487 %SHORTINTEGER HEAD1,NOPS,TPCELL,BOT1
#line 4487 "test-new/imp918s.imp"
short int HEAD1;
#line 4487 "test-new/imp918s.imp"
short int NOPS;
#line 4487 "test-new/imp918s.imp"
short int TPCELL;
#line 4487 "test-new/imp918s.imp"
short int BOT1;
// 4488 %INTEGER Q,QQ,KK,REG,Z,ZP,TYPEP,PRECP,PTYPEP,JJJ,P2,JJ, %C
#line 4488 "test-new/imp918s.imp"
int Q;
#line 4488 "test-new/imp918s.imp"
int QQ;
#line 4488 "test-new/imp918s.imp"
int KK;
#line 4488 "test-new/imp918s.imp"
int REG;
#line 4488 "test-new/imp918s.imp"
int Z;
#line 4488 "test-new/imp918s.imp"
int ZP;
#line 4488 "test-new/imp918s.imp"
int TYPEP;
#line 4488 "test-new/imp918s.imp"
int PRECP;
#line 4488 "test-new/imp918s.imp"
int PTYPEP;
#line 4488 "test-new/imp918s.imp"
int JJJ;
#line 4488 "test-new/imp918s.imp"
int P2;
#line 4488 "test-new/imp918s.imp"
int JJ;
#line 4488 "test-new/imp918s.imp"
int BASEP;
#line 4488 "test-new/imp918s.imp"
int DISPP;
#line 4488 "test-new/imp918s.imp"
int RHTYPE;
#line 4488 "test-new/imp918s.imp"
int ACCP;
#line 4488 "test-new/imp918s.imp"
int II;
// 4489+ BASEP,DISPP,RHTYPE,ACCP,II
// 4490 %SWITCH SW(0:3); ! TO SWITCH ON ASSOP
#line 4490 "test-new/imp918s.imp"
int SW_index;
#line 4490 "test-new/imp918s.imp"
int SW_line;
#line 4490 "test-new/imp918s.imp"
char *SW_file;
#line 4490 "test-new/imp918s.imp"
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 4491 !
// 4492 %IF ASSOP>4 %THEN %START
#line 4492 "test-new/imp918s.imp"
if (ASSOP <= 4) goto L_03E2;
// 4493 BASEP=BASE; DISPP=DISP; RHTYPE=TYPE
#line 4493 "test-new/imp918s.imp"
BASEP = BASE;
#line 4493 "test-new/imp918s.imp"
DISPP = DISP;
#line 4493 "test-new/imp918s.imp"
RHTYPE = TYPE;
// 4494 %FINISH
#line 4494 "test-new/imp918s.imp"
L_03E2:;
// 4495 P2=P
#line 4495 "test-new/imp918s.imp"
P2 = P;
// 4496 %IF P1< X'FFFF' %THEN %START
#line 4496 "test-new/imp918s.imp"
if (P1 >= 65535) goto L_03E3;
// 4497 P=P1; REDUCE TAG(1); ! LOOK AT LH SIDE
#line 4497 "test-new/imp918s.imp"
P = P1;
#line 4497 "test-new/imp918s.imp"
REDUCETAG(1);
// 4498 %FINISH
#line 4498 "test-new/imp918s.imp"
L_03E3:;
// 4499 PTYPEP=PTYPE; JJ=J
#line 4499 "test-new/imp918s.imp"
PTYPEP = PTYPE;
#line 4499 "test-new/imp918s.imp"
JJ = J;
// 4500 KK=K; II=I
#line 4500 "test-new/imp918s.imp"
KK = K;
#line 4500 "test-new/imp918s.imp"
II = I;
// 4501 TPCELL=TCELL; ACCP=ACC
#line 4501 "test-new/imp918s.imp"
TPCELL = TCELL;
#line 4501 "test-new/imp918s.imp"
ACCP = ACC;
// 4502 P=P2; TYPEP=TYPE; PRECP=PREC; ! SAVE USEFUL INFO FOR LATER
#line 4502 "test-new/imp918s.imp"
P = P2;
#line 4502 "test-new/imp918s.imp"
TYPEP = TYPE;
#line 4502 "test-new/imp918s.imp"
PRECP = PREC;
// 4503 -> SW(ASSOP&3)
#line 4503 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = ASSOP & 3;
goto case_SW_dispatch;
// 4504 !
// 4505 SW(2):SW(3): ! ARITHMETIC ASSIGNMENTS
#line 4505 "test-new/imp918s.imp"
case_SW_2:;
#line 4505 "test-new/imp918s.imp"
case_SW_3:;
// 4506 ->REGVAR %IF TYPE=8; ! LHS A REGISTER VARIABLE
#line 4506 "test-new/imp918s.imp"
if (TYPE != 8) goto L_03E5;
#line 4506 "test-new/imp918s.imp"
goto U_1037;
#line 4506 "test-new/imp918s.imp"
L_03E5:;
// 4507 %IF TYPE=3 %THEN %START; ! RECORD SO EXAMINE SUBNAME
#line 4507 "test-new/imp918s.imp"
if (TYPE != 3) goto L_03E6;
// 4508 P=P1; Q=COPY RECORD TAG(QQ)
#line 4508 "test-new/imp918s.imp"
P = P1;
#line 4508 "test-new/imp918s.imp"
Q = COPYRECORDTAG(/*?*/ &QQ);
// 4509 P=P2; %IF TYPE=3 %THEN ->RECOP; %FINISH
#line 4509 "test-new/imp918s.imp"
P = P2;
#line 4509 "test-new/imp918s.imp"
if (TYPE != 3) goto L_03E7;
#line 4509 "test-new/imp918s.imp"
goto U_1024;
#line 4509 "test-new/imp918s.imp"
L_03E7:;
#line 4509 "test-new/imp918s.imp"
L_03E6:;
// 4510 TYPE=1 %UNLESS TYPE=2 %OR TYPE=5;! IN CASE OF RUBBISHY SUBNAMES
#line 4510 "test-new/imp918s.imp"
if (TYPE == 2) goto L_03E8;
#line 4510 "test-new/imp918s.imp"
if (TYPE == 5) goto L_03E8;
#line 4510 "test-new/imp918s.imp"
TYPE = 1;
#line 4510 "test-new/imp918s.imp"
L_03E8:;
// 4511 ->Label50 %IF TYPE=5; ! LHS IS A STRING
#line 4511 "test-new/imp918s.imp"
if (TYPE != 5) goto L_03E9;
#line 4511 "test-new/imp918s.imp"
goto U_1025;
#line 4511 "test-new/imp918s.imp"
L_03E9:;
// 4512 !
// 4513 ! THE CODING BETWEEN HERE AND 'BACK' EXAMINES FOR DEGENERATE ASSIGNMENT
// 4514 ! CASES SUCH AS 'I=I!2' OR BYTE=BYTE&7. THESE CAN BE HANDLED IN ONE SI
// 4515 ! M/C INSTRUCTION. THE CODING COULD BE EXTENDED TO FIND'I=I!J'
// 4516 ! THIS WHOLE SECTION IS OMITTED FROM SERVICE IMP(AA)
// 4517 !
// 4518 %IF ASSOP<=3 %AND CHECKSP=0 %AND TYPEP=1 %AND ARR=0 %AND %C
#line 4518 "test-new/imp918s.imp"
if (ASSOP > 3) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (TYPEP != 1) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (ARR != 0) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (NAM != 0) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (P1 >= 65535) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (ROUT != 0) goto L_03EA;
#line 4518 "test-new/imp918s.imp"
if (A[P1 + 1 + 7] != 2) goto L_03EA;
// 4519+ NAM=0 %AND P1<X'FFFF' %AND ROUT=0 %AND A(P1+1)=2 %START;! NO APP
// 4520 TYPEP=PTYPE; PRECP=PREC
#line 4520 "test-new/imp918s.imp"
TYPEP = PTYPE;
#line 4520 "test-new/imp918s.imp"
PRECP = PREC;
// 4521 Q=TSEXP(JJJ,0); ! EXAMINE RHS
#line 4521 "test-new/imp918s.imp"
Q = TSEXP(/*?*/ &JJJ, 0);
// 4522 !
// 4523 ! CHECK FORM OF RHS AND THAT THE SAME NAME IS ON BOTH SIDES
// 4524 !
// 4525 %IF (Q=300 %OR Q=400 %OR (Q=800 %AND PRECP=1)) %AND %C
#line 4525 "test-new/imp918s.imp"
if (Q == 300) goto L_03D2;
#line 4525 "test-new/imp918s.imp"
if (Q == 400) goto L_03D2;
#line 4525 "test-new/imp918s.imp"
if (Q != 800) goto L_03EB;
#line 4525 "test-new/imp918s.imp"
if (PRECP != 1) goto L_03EB;
#line 4525 "test-new/imp918s.imp"
L_03D2:;
#line 4525 "test-new/imp918s.imp"
if (KK != K) goto L_03EB;
#line 4525 "test-new/imp918s.imp"
if (II != I) goto L_03EB;
#line 4525 "test-new/imp918s.imp"
if (KK > 4095) goto L_03EB;
// 4526+ KK=K %AND II=I %AND KK<=4095 %START
// 4527 KK=KK+BYTES(PRECP)-1
#line 4527 "test-new/imp918s.imp"
KK = KK + BYTES[PRECP] - 1;
// 4528 %IF Q=300 %THEN ZP=X'97' %ELSE ZP=X'96'
#line 4528 "test-new/imp918s.imp"
if (Q != 300) goto L_03EC;
#line 4528 "test-new/imp918s.imp"
ZP = 151;
#line 4528 "test-new/imp918s.imp"
goto L_03ED;
#line 4528 "test-new/imp918s.imp"
L_03EC:;
#line 4528 "test-new/imp918s.imp"
ZP = 150;
#line 4528 "test-new/imp918s.imp"
L_03ED:;
// 4529 %IF Q=800 %THEN ZP=X'94'
#line 4529 "test-new/imp918s.imp"
if (Q != 800) goto L_03EE;
#line 4529 "test-new/imp918s.imp"
ZP = 148;
#line 4529 "test-new/imp918s.imp"
L_03EE:;
// 4530 PSI(ZP,JJJ,II,KK)
#line 4530 "test-new/imp918s.imp"
PSI(ZP, JJJ, II, KK);
// 4531 CCSTATE=-1
#line 4531 "test-new/imp918s.imp"
CCSTATE = -1;
// 4532 ->NA
#line 4532 "test-new/imp918s.imp"
goto U_1026;
// 4533 %FINISH %ELSE PTYPE=TYPEP %AND UNPACK
#line 4533 "test-new/imp918s.imp"
L_03EB:;
#line 4533 "test-new/imp918s.imp"
PTYPE = TYPEP;
#line 4533 "test-new/imp918s.imp"
UNPACK();
// 4534 %FINISH
#line 4534 "test-new/imp918s.imp"
L_03EA:;
// 4535 BACK: HEAD1=0; ! CLEAR TEMPORAYRY LIST HEADS
#line 4535 "test-new/imp918s.imp"
U_1038:;
#line 4535 "test-new/imp918s.imp"
HEAD1 = 0;
// 4536 TYPE=1 %UNLESS TYPE=2; ! DEAL WITH UNSET NAMES
#line 4536 "test-new/imp918s.imp"
if (TYPE == 2) goto L_03EF;
#line 4536 "test-new/imp918s.imp"
TYPE = 1;
#line 4536 "test-new/imp918s.imp"
L_03EF:;
// 4537 ZP=TYPE; NOPS=1; P=P2+2
#line 4537 "test-new/imp918s.imp"
ZP = TYPE;
#line 4537 "test-new/imp918s.imp"
NOPS = 1;
#line 4537 "test-new/imp918s.imp"
P = P2 + 2;
// 4538 %IF TYPE=2 %THEN ZP=ZP+PREC&1
#line 4538 "test-new/imp918s.imp"
if (TYPE != 2) goto L_03F0;
#line 4538 "test-new/imp918s.imp"
ZP = ZP + (PREC & 1);
#line 4538 "test-new/imp918s.imp"
L_03F0:;
// 4539 PUSH(HEAD1,ASSOP&3+28,0); ! ASSIGNMENT OPERATOR
#line 4539 "test-new/imp918s.imp"
PUSH(/*?*/ &HEAD1, (ASSOP & 3) + 28, 0);
// 4540 BOT1=HEAD1
#line 4540 "test-new/imp918s.imp"
BOT1 = HEAD1;
// 4541 %IF P1>X'FFFF' %THEN Z=P1>>16<<8!9 %ELSE Z=2
#line 4541 "test-new/imp918s.imp"
if (P1 <= 65535) goto L_03F1;
#line 4541 "test-new/imp918s.imp"
Z = (unsigned int)P1 >> 16 << 8 | 9;
#line 4541 "test-new/imp918s.imp"
goto L_03F2;
#line 4541 "test-new/imp918s.imp"
L_03F1:;
#line 4541 "test-new/imp918s.imp"
Z = 2;
#line 4541 "test-new/imp918s.imp"
L_03F2:;
// 4542 PUSH(HEAD1,PTYPEP<<16!Z,P1&X'7FFF');! LHS
#line 4542 "test-new/imp918s.imp"
PUSH(/*?*/ &HEAD1, PTYPEP << 16 | Z, P1 & 32767);
// 4543 %IF ASSOP>4 %THEN %START
#line 4543 "test-new/imp918s.imp"
if (ASSOP <= 4) goto L_03F3;
// 4544 FAULT(24,0) %UNLESS TYPE=RHTYPE
#line 4544 "test-new/imp918s.imp"
if (TYPE == RHTYPE) goto L_03F4;
#line 4544 "test-new/imp918s.imp"
FAULT(24, 0);
#line 4544 "test-new/imp918s.imp"
L_03F4:;
// 4545 PUSH(HEAD1,RHTYPE<<16!BASEP<<8!9,DISPP)
#line 4545 "test-new/imp918s.imp"
PUSH(/*?*/ &HEAD1, RHTYPE << 16 | BASEP << 8 | 9, DISPP);
// 4546 SET USE((RHTYPE&2)<<3+BASEP,1,HEAD1) %IF DISPP<0
#line 4546 "test-new/imp918s.imp"
if (DISPP >= 0) goto L_03F5;
#line 4546 "test-new/imp918s.imp"
SETUSE(((RHTYPE & 2) << 3) + BASEP, 1, HEAD1);
#line 4546 "test-new/imp918s.imp"
L_03F5:;
// 4547 %FINISH %ELSE TORP(HEAD1,BOT1,NOPS,ZP);! RHS TO REVERSE POLISH
#line 4547 "test-new/imp918s.imp"
goto L_03F6;
#line 4547 "test-new/imp918s.imp"
L_03F3:;
#line 4547 "test-new/imp918s.imp"
TORP(/*?*/ &HEAD1, /*?*/ &BOT1, /*?*/ &NOPS, ZP);
#line 4547 "test-new/imp918s.imp"
L_03F6:;
// 4548 Q=P; EXPOP(HEAD1,-1,NOPS,16); ! PLANT CODE
#line 4548 "test-new/imp918s.imp"
Q = P;
#line 4548 "test-new/imp918s.imp"
EXPOP(HEAD1, -1, NOPS, 16);
// 4549 P=Q
#line 4549 "test-new/imp918s.imp"
P = Q;
// 4550 ! CLEARLIST(HEAD1)
// 4551 SHORTINTEGER(ADDR(ASLIST(BOT1))+14)=ASL
#line 4551 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[BOT1]) + 14) = ASL;
// 4552 ASL=HEAD1; ->Label1
#line 4552 "test-new/imp918s.imp"
ASL = HEAD1;
#line 4552 "test-new/imp918s.imp"
goto U_1039;
// 4553 NA: NOTE ASSMENT(-1,ASSOP&3,A(P1)); ->Label1
#line 4553 "test-new/imp918s.imp"
U_1026:;
#line 4553 "test-new/imp918s.imp"
NOTEASSMENT(-1, ASSOP & 3, A[P1 + 7]);
#line 4553 "test-new/imp918s.imp"
goto U_1039;
// 4554 Label50: Z=0; ! STRINGS
#line 4554 "test-new/imp918s.imp"
U_1025:;
#line 4554 "test-new/imp918s.imp"
Z = 0;
// 4555 %IF ASSOP<4 %THEN %START; ! SORT RHS
#line 4555 "test-new/imp918s.imp"
if (ASSOP >= 4) goto L_03F7;
// 4556 FIND REG(SAFE,REG)
#line 4556 "test-new/imp918s.imp"
FINDREG(-61948, /*?*/ ®);
// 4557 CSTREXP(0,REG); Z=NEST
#line 4557 "test-new/imp918s.imp"
CSTREXP(0, REG);
#line 4557 "test-new/imp918s.imp"
Z = NEST;
// 4558 %IF Z>0 %THEN SET USE(Z,13,0)
#line 4558 "test-new/imp918s.imp"
if (Z <= 0) goto L_03F8;
#line 4558 "test-new/imp918s.imp"
SETUSE(Z, 13, 0);
#line 4558 "test-new/imp918s.imp"
L_03F8:;
// 4559 DISPP=DISP; BASEP=BASE
#line 4559 "test-new/imp918s.imp"
DISPP = DISP;
#line 4559 "test-new/imp918s.imp"
BASEP = BASE;
// 4560 %UNLESS CHECKSP=0 %OR 4<=BASEP<=14 %START
#line 4560 "test-new/imp918s.imp"
if (CHECKSP == 0) goto L_03F9;
#line 4560 "test-new/imp918s.imp"
{
// Double-sided test on BASEP (Part I)
#line 4560 "test-new/imp918s.imp"
int tmp;
#line 4560 "test-new/imp918s.imp"
if (4 > (tmp = BASEP)) goto L_03FA;
// Double-sided test on BASEP (Part II)
#line 4560 "test-new/imp918s.imp"
if (tmp <= 14) goto L_03F9;
#line 4560 "test-new/imp918s.imp"
}
#line 4560 "test-new/imp918s.imp"
L_03FA:;
// 4561 PRR(X'18',REG,BASEP)
#line 4561 "test-new/imp918s.imp"
PRR(24, REG, BASEP);
// 4562 SET USE(REG,GRUSE(BASEP),GRINF(BASEP))
#line 4562 "test-new/imp918s.imp"
SETUSE(REG, GRUSE[BASEP], GRINF[BASEP]);
// 4563 BASEP=REG
#line 4563 "test-new/imp918s.imp"
BASEP = REG;
// 4564 %FINISH
#line 4564 "test-new/imp918s.imp"
L_03F9:;
// 4565 %FINISH
#line 4565 "test-new/imp918s.imp"
L_03F7:;
// 4566 REGISTER(BASEP)=1 %IF REGISTER(BASEP)=0
#line 4566 "test-new/imp918s.imp"
if (REGISTER[BASEP] != 0) goto L_03FB;
#line 4566 "test-new/imp918s.imp"
REGISTER[BASEP] = 1;
#line 4566 "test-new/imp918s.imp"
L_03FB:;
// 4567 QQ=STRINGL; Q=P
#line 4567 "test-new/imp918s.imp"
QQ = STRINGL;
#line 4567 "test-new/imp918s.imp"
Q = P;
// 4568 %IF P1>X'FFFF' %THEN %START
#line 4568 "test-new/imp918s.imp"
if (P1 <= 65535) goto L_03FC;
// 4569 BASE=P1>>16; DISP=P1&X'FFFF'
#line 4569 "test-new/imp918s.imp"
BASE = (unsigned int)P1 >> 16;
#line 4569 "test-new/imp918s.imp"
DISP = P1 & 65535;
// 4570 BML=0; DML=ACCP
#line 4570 "test-new/imp918s.imp"
BML = 0;
#line 4570 "test-new/imp918s.imp"
DML = ACCP;
// 4571 %FINISH %ELSE %START
#line 4571 "test-new/imp918s.imp"
goto L_03FD;
#line 4571 "test-new/imp918s.imp"
L_03FC:;
// 4572 P=P1; CNAME(1,0)
#line 4572 "test-new/imp918s.imp"
P = P1;
#line 4572 "test-new/imp918s.imp"
CNAME(1, 0);
// 4573 %IF INDEX>0 %THEN %START
#line 4573 "test-new/imp918s.imp"
if (INDEX <= 0) goto L_03FE;
// 4574 PRR(X'1A',INDEX,BASE)
#line 4574 "test-new/imp918s.imp"
PRR(26, INDEX, BASE);
// 4575 FORGET(INDEX)
#line 4575 "test-new/imp918s.imp"
FORGET(INDEX);
// 4576 BASE=INDEX; INDEX=0
#line 4576 "test-new/imp918s.imp"
BASE = INDEX;
#line 4576 "test-new/imp918s.imp"
INDEX = 0;
// 4577 %FINISH
#line 4577 "test-new/imp918s.imp"
L_03FE:;
// 4578 %FINISH
#line 4578 "test-new/imp918s.imp"
L_03FD:;
// 4579 !
// 4580
// 4581 %IF DISPP=X'C0' %AND BASEP=CODER %THEN %START
#line 4581 "test-new/imp918s.imp"
if (DISPP != 192) goto L_03FF;
#line 4581 "test-new/imp918s.imp"
if (BASEP != 12) goto L_03FF;
// 4582 DUMPSI(X'92',0,BASE,DISP); ! MVI IF RHS NULL
#line 4582 "test-new/imp918s.imp"
DUMPSI(146, 0, BASE, DISP);
// 4583 %FINISH %ELSE %START
#line 4583 "test-new/imp918s.imp"
goto L_0400;
#line 4583 "test-new/imp918s.imp"
L_03FF:;
// 4584 REG=(ASSOP&3-1)^^2
#line 4584 "test-new/imp918s.imp"
REG = _imp_IEXP((ASSOP & 3) - 1, 2);
// 4585 %IF REG#1 %OR Z<=0 %OR GRUSE(Z)#13 %THEN Z=-2
#line 4585 "test-new/imp918s.imp"
if (REG != 1) goto L_0401;
#line 4585 "test-new/imp918s.imp"
if (Z <= 0) goto L_0401;
#line 4585 "test-new/imp918s.imp"
if (GRUSE[Z] == 13) goto L_0402;
#line 4585 "test-new/imp918s.imp"
L_0401:;
#line 4585 "test-new/imp918s.imp"
Z = -2;
#line 4585 "test-new/imp918s.imp"
L_0402:;
// 4586 STRINGOP(REG,QQ,BASE,DISP,BASEP,DISPP,BML,DML,Z)
#line 4586 "test-new/imp918s.imp"
STRINGOP(REG, QQ, BASE, DISP, BASEP, DISPP, BML, DML, Z);
// 4587 %IF Z>0 %AND GRUSE(Z)=13 %THEN SET USE(Z,2,-2)
#line 4587 "test-new/imp918s.imp"
if (Z <= 0) goto L_0403;
#line 4587 "test-new/imp918s.imp"
if (GRUSE[Z] != 13) goto L_0403;
#line 4587 "test-new/imp918s.imp"
SETUSE(Z, 2, -2);
#line 4587 "test-new/imp918s.imp"
L_0403:;
// 4588 REGISTER(BASEP)=0 %IF REGISTER(BASEP)>0
#line 4588 "test-new/imp918s.imp"
if (REGISTER[BASEP] <= 0) goto L_0404;
#line 4588 "test-new/imp918s.imp"
REGISTER[BASEP] = 0;
#line 4588 "test-new/imp918s.imp"
L_0404:;
// 4589 %FINISH
#line 4589 "test-new/imp918s.imp"
L_0400:;
// 4590 P=Q; ->Label1
#line 4590 "test-new/imp918s.imp"
P = Q;
#line 4590 "test-new/imp918s.imp"
goto U_1039;
// 4591 REGVAR: FAULT(59,0) %UNLESS A(P1+1)=2=A(P1+2)
#line 4591 "test-new/imp918s.imp"
U_1037:;
#line 4591 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 4591 "test-new/imp918s.imp"
int tmp;
#line 4591 "test-new/imp918s.imp"
if (A[P1 + 1 + 7] != (tmp = 2)) goto L_0405;
// Double-sided test on 2 (Part II)
#line 4591 "test-new/imp918s.imp"
if (tmp == A[P1 + 2 + 7]) goto L_0406;
#line 4591 "test-new/imp918s.imp"
}
#line 4591 "test-new/imp918s.imp"
L_0405:;
#line 4591 "test-new/imp918s.imp"
FAULT(59, 0);
#line 4591 "test-new/imp918s.imp"
L_0406:;
// 4592 KK=1<<K
#line 4592 "test-new/imp918s.imp"
KK = 1 << K;
// 4593 %IF REGISTER(K)>=0 %THEN ABORT
#line 4593 "test-new/imp918s.imp"
if (REGISTER[K] < 0) goto L_0407;
#line 4593 "test-new/imp918s.imp"
ABORT();
#line 4593 "test-new/imp918s.imp"
L_0407:;
// 4594 %IF CYC REGS&KK#0 %THEN CYC ASS=CYC ASS!KK %ELSE NMDECS=NMDECS!4
#line 4594 "test-new/imp918s.imp"
if (CYCREGS & KK == 0) goto L_0408;
#line 4594 "test-new/imp918s.imp"
CYCASS = CYCASS | KK;
#line 4594 "test-new/imp918s.imp"
goto L_0409;
#line 4594 "test-new/imp918s.imp"
L_0408:;
#line 4594 "test-new/imp918s.imp"
NMDECS = NMDECS | 4;
#line 4594 "test-new/imp918s.imp"
L_0409:;
// 4595 CSEXP(K,1); ->NA
#line 4595 "test-new/imp918s.imp"
CSEXP(K, 1);
#line 4595 "test-new/imp918s.imp"
goto U_1026;
// 4596
// 4597 ! THIS SECTION DEALS WITH OPERATIONS ON COMPLETE RECORDS
// 4598 RECOP: ! LHS IS RECORD WITHOUT SUBNAME
#line 4598 "test-new/imp918s.imp"
U_1024:;
// 4599 Q=TSEXP(JJJ,0)
#line 4599 "test-new/imp918s.imp"
Q = TSEXP(/*?*/ &JJJ, 0);
// 4600 -> RZ %IF Q=1=TYPE %AND JJJ=0; ! CLEAR ENTIRE RECORD TO ZERO
#line 4600 "test-new/imp918s.imp"
{
// Double-sided test on 1 (Part I)
#line 4600 "test-new/imp918s.imp"
int tmp;
#line 4600 "test-new/imp918s.imp"
if (Q != (tmp = 1)) goto L_040A;
// Double-sided test on 1 (Part II)
#line 4600 "test-new/imp918s.imp"
if (tmp != TYPE) goto L_040A;
#line 4600 "test-new/imp918s.imp"
}
#line 4600 "test-new/imp918s.imp"
if (JJJ != 0) goto L_040A;
#line 4600 "test-new/imp918s.imp"
goto U_103A;
#line 4600 "test-new/imp918s.imp"
L_040A:;
// 4601 -> BACK %UNLESS Q=30; ! ASSIGN RECORD TO RECORD
#line 4601 "test-new/imp918s.imp"
if (Q == 30) goto L_040B;
#line 4601 "test-new/imp918s.imp"
goto U_1038;
#line 4601 "test-new/imp918s.imp"
L_040B:;
// 4602 P=P2+4; CNAME(16,-2); ! SET BASE &DISP FOR RHS
#line 4602 "test-new/imp918s.imp"
P = P2 + 4;
#line 4602 "test-new/imp918s.imp"
CNAME(16, -2);
// 4603 BASEP=BASE; DISPP=DISP
#line 4603 "test-new/imp918s.imp"
BASEP = BASE;
#line 4603 "test-new/imp918s.imp"
DISPP = DISP;
// 4604 ZP=ACC
#line 4604 "test-new/imp918s.imp"
ZP = ACC;
// 4605 CYC BITS=CYC BITS!128 %IF COMPILER=0; ! SAFE REG NEEDED
#line 4605 "test-new/imp918s.imp"
if (COMPILER != 0) goto L_040C;
#line 4605 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 128;
#line 4605 "test-new/imp918s.imp"
L_040C:;
// 4606 %UNLESS COMPILER=1 %OR 4<=BASE<=14 %START
#line 4606 "test-new/imp918s.imp"
if (COMPILER == 1) goto L_040D;
#line 4606 "test-new/imp918s.imp"
{
// Double-sided test on BASE (Part I)
#line 4606 "test-new/imp918s.imp"
int tmp;
#line 4606 "test-new/imp918s.imp"
if (4 > (tmp = BASE)) goto L_040E;
// Double-sided test on BASE (Part II)
#line 4606 "test-new/imp918s.imp"
if (tmp <= 14) goto L_040D;
#line 4606 "test-new/imp918s.imp"
}
#line 4606 "test-new/imp918s.imp"
L_040E:;
// 4607 FINDREG(SAFE,NEST)
#line 4607 "test-new/imp918s.imp"
FINDREG(-61948, /*?*/ &NEST);
// 4608 PRR(X'18',NEST,BASE)
#line 4608 "test-new/imp918s.imp"
PRR(24, NEST, BASE);
// 4609 SET USE(NEST,GRUSE(BASE),GRINF(BASE))
#line 4609 "test-new/imp918s.imp"
SETUSE(NEST, GRUSE[BASE], GRINF[BASE]);
// 4610 BASEP=NEST
#line 4610 "test-new/imp918s.imp"
BASEP = NEST;
// 4611 %FINISH
#line 4611 "test-new/imp918s.imp"
L_040D:;
// 4612 REG=BASEP
#line 4612 "test-new/imp918s.imp"
REG = BASEP;
// 4613 REGISTER(BASEP)=1 %IF REGISTER(BASEP)=0
#line 4613 "test-new/imp918s.imp"
if (REGISTER[BASEP] != 0) goto L_040F;
#line 4613 "test-new/imp918s.imp"
REGISTER[BASEP] = 1;
#line 4613 "test-new/imp918s.imp"
L_040F:;
// 4614 RZ: P=P1; CNAME(16,-2); ! BASE & DISP FOR LHS
#line 4614 "test-new/imp918s.imp"
U_103A:;
#line 4614 "test-new/imp918s.imp"
P = P1;
#line 4614 "test-new/imp918s.imp"
CNAME(16, -2);
// 4615 KK=DISP; JJ=BASE; ACCP=ACC
#line 4615 "test-new/imp918s.imp"
KK = DISP;
#line 4615 "test-new/imp918s.imp"
JJ = BASE;
#line 4615 "test-new/imp918s.imp"
ACCP = ACC;
// 4616 !
// 4617 %IF Q=1 %THEN %START
#line 4617 "test-new/imp918s.imp"
if (Q != 1) goto L_0410;
// 4618 BASEP=0; DISPP=0
#line 4618 "test-new/imp918s.imp"
BASEP = 0;
#line 4618 "test-new/imp918s.imp"
DISPP = 0;
// 4619 %FINISH %ELSE %START
#line 4619 "test-new/imp918s.imp"
goto L_0411;
#line 4619 "test-new/imp918s.imp"
L_0410:;
// 4620 ->F66 %IF ASSOP=2 %AND ACCP#ZP; ! '=' OPRN BOTH RECORD MUST
#line 4620 "test-new/imp918s.imp"
if (ASSOP != 2) goto L_0412;
#line 4620 "test-new/imp918s.imp"
if (ACCP == ZP) goto L_0412;
#line 4620 "test-new/imp918s.imp"
goto U_103B;
#line 4620 "test-new/imp918s.imp"
L_0412:;
// 4621 ! HAVE THE SAME LENGTH
// 4622 %IF ZP<ACCP %THEN ACCP=ZP; ! ON'<-' MOVE SMALLER
#line 4622 "test-new/imp918s.imp"
if (ZP >= ACCP) goto L_0413;
#line 4622 "test-new/imp918s.imp"
ACCP = ZP;
#line 4622 "test-new/imp918s.imp"
L_0413:;
// 4623 %FINISH
#line 4623 "test-new/imp918s.imp"
L_0411:;
// 4624 REGISTER(JJ)=1 %IF REGISTER(JJ)=0
#line 4624 "test-new/imp918s.imp"
if (REGISTER[JJ] != 0) goto L_0414;
#line 4624 "test-new/imp918s.imp"
REGISTER[JJ] = 1;
#line 4624 "test-new/imp918s.imp"
L_0414:;
// 4625 !
// 4626 BULKM(Q-1,ACCP,JJ,KK,BASEP,DISPP)
#line 4626 "test-new/imp918s.imp"
BULKM(Q - 1, ACCP, JJ, KK, BASEP, DISPP);
// 4627 %IF REGISTER(JJ)>0 %THEN REGISTER(JJ)=0
#line 4627 "test-new/imp918s.imp"
if (REGISTER[JJ] <= 0) goto L_0415;
#line 4627 "test-new/imp918s.imp"
REGISTER[JJ] = 0;
#line 4627 "test-new/imp918s.imp"
L_0415:;
// 4628 %IF Q=30 %AND REGISTER(BASEP)>0 %THEN REGISTER(BASEP)=0
#line 4628 "test-new/imp918s.imp"
if (Q != 30) goto L_0416;
#line 4628 "test-new/imp918s.imp"
if (REGISTER[BASEP] <= 0) goto L_0416;
#line 4628 "test-new/imp918s.imp"
REGISTER[BASEP] = 0;
#line 4628 "test-new/imp918s.imp"
L_0416:;
// 4629 P=P2; SKIP EXP; ->Label1
#line 4629 "test-new/imp918s.imp"
P = P2;
#line 4629 "test-new/imp918s.imp"
SKIPEXP();
#line 4629 "test-new/imp918s.imp"
goto U_1039;
// 4630 SW(0): ! RESOLUTION
#line 4630 "test-new/imp918s.imp"
case_SW_0:;
// 4631 P=P1; CNAME(5,1); ! LOAD UP LHS
#line 4631 "test-new/imp918s.imp"
P = P1;
#line 4631 "test-new/imp918s.imp"
CNAME(5, 1);
// 4632 P=P2; CRES(0); ->Label1; ! PERFORM UNCONDITIONAL RESOLUTIO
#line 4632 "test-new/imp918s.imp"
P = P2;
#line 4632 "test-new/imp918s.imp"
CRES(0);
#line 4632 "test-new/imp918s.imp"
goto U_1039;
// 4633 SW(1): ! '==' AND %NAME PARAMETERS
#line 4633 "test-new/imp918s.imp"
case_SW_1:;
// 4634 ->F2 %UNLESS A(P2+2)=4 %AND A(P2+3)=1;! DISALLOW EXPRESSIONS
#line 4634 "test-new/imp918s.imp"
if (A[P2 + 2 + 7] != 4) goto L_0417;
#line 4634 "test-new/imp918s.imp"
if (A[P2 + 3 + 7] == 1) goto L_0418;
#line 4634 "test-new/imp918s.imp"
L_0417:;
#line 4634 "test-new/imp918s.imp"
goto U_103C;
#line 4634 "test-new/imp918s.imp"
L_0418:;
// 4635 REG=-2
#line 4635 "test-new/imp918s.imp"
REG = -2;
// 4636 %UNLESS ROUT=0 %AND ARR=0 %AND (P1>X'FFFF' %OR %C
#line 4636 "test-new/imp918s.imp"
if (ROUT != 0) goto L_0419;
#line 4636 "test-new/imp918s.imp"
if (ARR != 0) goto L_0419;
#line 4636 "test-new/imp918s.imp"
if (P1 > 65535) goto L_041A;
#line 4636 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 4636 "test-new/imp918s.imp"
int tmp;
#line 4636 "test-new/imp918s.imp"
if (A[P1 + 1 + 7] != (tmp = 2)) goto L_0419;
// Double-sided test on 2 (Part II)
#line 4636 "test-new/imp918s.imp"
if (tmp == A[P1 + 2 + 7]) goto L_041A;
#line 4636 "test-new/imp918s.imp"
}
#line 4636 "test-new/imp918s.imp"
L_0419:;
#line 4636 "test-new/imp918s.imp"
CLAIM(-61948, /*?*/ ®);
#line 4636 "test-new/imp918s.imp"
FORGET(REG);
#line 4636 "test-new/imp918s.imp"
L_041A:;
// 4637+ A(P1+1)=2=A(P1+2)) %THEN CLAIM(SAFE,REG) %AND FORGET(REG)
// 4638 %IF TYPE=3 %THEN %START
#line 4638 "test-new/imp918s.imp"
if (TYPE != 3) goto L_041B;
// 4639 ->RECNAME %IF P1>X'FFFF'; ! RECORD NAME PARAMETERS
#line 4639 "test-new/imp918s.imp"
if (P1 <= 65535) goto L_041C;
#line 4639 "test-new/imp918s.imp"
goto U_103D;
#line 4639 "test-new/imp918s.imp"
L_041C:;
// 4640 P=P1; Q=COPY RECORD TAG(QQ)
#line 4640 "test-new/imp918s.imp"
P = P1;
#line 4640 "test-new/imp918s.imp"
Q = COPYRECORDTAG(/*?*/ &QQ);
// 4641 TYPEP=TYPE; PRECP=PREC; JJ=J
#line 4641 "test-new/imp918s.imp"
TYPEP = TYPE;
#line 4641 "test-new/imp918s.imp"
PRECP = PREC;
#line 4641 "test-new/imp918s.imp"
JJ = J;
// 4642 -> RECNAME %IF Q=0 %AND NAM=1
#line 4642 "test-new/imp918s.imp"
if (Q != 0) goto L_041D;
#line 4642 "test-new/imp918s.imp"
if (NAM != 1) goto L_041D;
#line 4642 "test-new/imp918s.imp"
goto U_103D;
#line 4642 "test-new/imp918s.imp"
L_041D:;
// 4643 %FINISH
#line 4643 "test-new/imp918s.imp"
L_041B:;
// 4644 -> F1 %UNLESS NAM=1; ! LHS MUST BE A POINTER
#line 4644 "test-new/imp918s.imp"
if (NAM == 1) goto L_041E;
#line 4644 "test-new/imp918s.imp"
goto U_103E;
#line 4644 "test-new/imp918s.imp"
L_041E:;
// 4645 P=P2+4
#line 4645 "test-new/imp918s.imp"
P = P2 + 4;
// 4646 ->ARRNAME %IF ARR=1
#line 4646 "test-new/imp918s.imp"
if (ARR != 1) goto L_041F;
#line 4646 "test-new/imp918s.imp"
goto U_103F;
#line 4646 "test-new/imp918s.imp"
L_041F:;
// 4647 CNAME(3,REG)
#line 4647 "test-new/imp918s.imp"
CNAME(3, REG);
// 4648 Z=I; ZP=K
#line 4648 "test-new/imp918s.imp"
Z = I;
#line 4648 "test-new/imp918s.imp"
ZP = K;
// 4649 REG=NEST %IF REG<0
#line 4649 "test-new/imp918s.imp"
if (REG >= 0) goto L_0420;
#line 4649 "test-new/imp918s.imp"
REG = NEST;
#line 4649 "test-new/imp918s.imp"
L_0420:;
// 4650 %IF A(P2+5)=2=A(P2+6) %THEN %C
#line 4650 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 4650 "test-new/imp918s.imp"
int tmp;
#line 4650 "test-new/imp918s.imp"
if (A[P2 + 5 + 7] != (tmp = 2)) goto L_0421;
// Double-sided test on 2 (Part II)
#line 4650 "test-new/imp918s.imp"
if (tmp != A[P2 + 6 + 7]) goto L_0421;
#line 4650 "test-new/imp918s.imp"
}
#line 4650 "test-new/imp918s.imp"
NOTEASSMENT(-1, 1, A[P2 + 4 + 7]);
#line 4650 "test-new/imp918s.imp"
L_0421:;
// 4651+ NOTE ASSMENT(-1,1,A(P2+4)); ! RHS VARIAVBLE MAY BE CHANGED
// 4652 ! BY ASSIGNING TO LHS
// 4653 KK=6
#line 4653 "test-new/imp918s.imp"
KK = 6;
// 4654 COMM: ->F3 %UNLESS TYPEP=0 %OR TYPE=0 %OR %C
#line 4654 "test-new/imp918s.imp"
U_1040:;
#line 4654 "test-new/imp918s.imp"
if (TYPEP == 0) goto L_0422;
#line 4654 "test-new/imp918s.imp"
if (TYPE == 0) goto L_0422;
#line 4654 "test-new/imp918s.imp"
if (TYPE != TYPEP) goto L_0423;
#line 4654 "test-new/imp918s.imp"
if (PREC & 3 == PRECP) goto L_0422;
#line 4654 "test-new/imp918s.imp"
L_0423:;
#line 4654 "test-new/imp918s.imp"
goto U_1041;
#line 4654 "test-new/imp918s.imp"
L_0422:;
// 4655+ (TYPE=TYPEP %AND (PREC&3)=PRECP)
// 4656 ->F2 %UNLESS A(P)=2; ! NO REST OF EXPRSSN
#line 4656 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0424;
#line 4656 "test-new/imp918s.imp"
goto U_103C;
#line 4656 "test-new/imp918s.imp"
L_0424:;
// 4657 Q=P+1; P=P1
#line 4657 "test-new/imp918s.imp"
Q = P + 1;
#line 4657 "test-new/imp918s.imp"
P = P1;
// 4658 %IF P<X'FFFF' %THEN %START
#line 4658 "test-new/imp918s.imp"
if (P >= 65535) goto L_0425;
// 4659 CNAME(KK,REG)
#line 4659 "test-new/imp918s.imp"
CNAME(KK, REG);
// 4660 %IF A(P1+1)=2=A(P1+2) %THEN NOTE ASSMENT(REG,1,A(P1))
#line 4660 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 4660 "test-new/imp918s.imp"
int tmp;
#line 4660 "test-new/imp918s.imp"
if (A[P1 + 1 + 7] != (tmp = 2)) goto L_0426;
// Double-sided test on 2 (Part II)
#line 4660 "test-new/imp918s.imp"
if (tmp != A[P1 + 2 + 7]) goto L_0426;
#line 4660 "test-new/imp918s.imp"
}
#line 4660 "test-new/imp918s.imp"
NOTEASSMENT(REG, 1, A[P1 + 7]);
#line 4660 "test-new/imp918s.imp"
L_0426:;
// 4661 %FINISH %ELSE %START
#line 4661 "test-new/imp918s.imp"
goto L_0427;
#line 4661 "test-new/imp918s.imp"
L_0425:;
// 4662 BASE=P>>16; DISP=P&X'7FFF'
#line 4662 "test-new/imp918s.imp"
BASE = (unsigned int)P >> 16;
#line 4662 "test-new/imp918s.imp"
DISP = P & 32767;
// 4663 DUMP(1,REG,DISP,0,BASE) %UNLESS KK=12
#line 4663 "test-new/imp918s.imp"
if (KK == 12) goto L_0428;
#line 4663 "test-new/imp918s.imp"
DUMP(1, REG, DISP, 0, BASE);
#line 4663 "test-new/imp918s.imp"
L_0428:;
// 4664 %IF TYPEP=0 %THEN %START; ! TO A %NAME PARAM
#line 4664 "test-new/imp918s.imp"
if (TYPEP != 0) goto L_0429;
// 4665 %IF TYPE=0 %THEN %START; ! %NAME TO %NAME
#line 4665 "test-new/imp918s.imp"
if (TYPE != 0) goto L_042A;
// 4666 JJJ=X'58'; ZP=ZP+4; ! LOAD INFO WORD
#line 4666 "test-new/imp918s.imp"
JJJ = 88;
#line 4666 "test-new/imp918s.imp"
ZP = ZP + 4;
// 4667 %FINISH %ELSE %START; ! NORMAL VARIABLE TO %NAME
#line 4667 "test-new/imp918s.imp"
goto L_042B;
#line 4667 "test-new/imp918s.imp"
L_042A:;
// 4668 PSI(X'92',PREC<<3!TYPE,BASE,DISP); ! FLAGS BYTE
#line 4668 "test-new/imp918s.imp"
PSI(146, PREC << 3 | TYPE, BASE, DISP);
// 4669 %IF TYPE=5 %THEN JJJ=X'88' %AND ZP=24 %ELSE %START
#line 4669 "test-new/imp918s.imp"
if (TYPE != 5) goto L_042C;
#line 4669 "test-new/imp918s.imp"
JJJ = 136;
#line 4669 "test-new/imp918s.imp"
ZP = 24;
#line 4669 "test-new/imp918s.imp"
goto L_042D;
#line 4669 "test-new/imp918s.imp"
L_042C:;
// 4670 JJJ=X'41'
#line 4670 "test-new/imp918s.imp"
JJJ = 65;
// 4671 %IF TYPE>=3 %THEN ZP=ACC %ELSE ZP=BYTES(PREC)
#line 4671 "test-new/imp918s.imp"
if (TYPE < 3) goto L_042E;
#line 4671 "test-new/imp918s.imp"
ZP = ACC;
#line 4671 "test-new/imp918s.imp"
goto L_042F;
#line 4671 "test-new/imp918s.imp"
L_042E:;
#line 4671 "test-new/imp918s.imp"
ZP = BYTES[PREC];
#line 4671 "test-new/imp918s.imp"
L_042F:;
// 4672 ZP=ZP-1
#line 4672 "test-new/imp918s.imp"
ZP = ZP - 1;
// 4673 %FINISH
#line 4673 "test-new/imp918s.imp"
L_042D:;
// 4674 Z=0
#line 4674 "test-new/imp918s.imp"
Z = 0;
// 4675 %FINISH
#line 4675 "test-new/imp918s.imp"
L_042B:;
// 4676 DUMP(JJJ,REG,ZP,0,Z)
#line 4676 "test-new/imp918s.imp"
DUMP(JJJ, REG, ZP, 0, Z);
// 4677 FORGET(REG)
#line 4677 "test-new/imp918s.imp"
FORGET(REG);
// 4678 DUMP(X'50',REG,DISP+4,0,BASE);! STORE XTRA WORD
#line 4678 "test-new/imp918s.imp"
DUMP(80, REG, DISP + 4, 0, BASE);
// 4679 %FINISH
#line 4679 "test-new/imp918s.imp"
L_0429:;
// 4680 %FINISH
#line 4680 "test-new/imp918s.imp"
L_0427:;
// 4681 REGISTER(REG)=0 %IF REGISTER(REG)>=0; P=Q
#line 4681 "test-new/imp918s.imp"
if (REGISTER[REG] < 0) goto L_0430;
#line 4681 "test-new/imp918s.imp"
REGISTER[REG] = 0;
#line 4681 "test-new/imp918s.imp"
L_0430:;
#line 4681 "test-new/imp918s.imp"
P = Q;
// 4682 %IF KK=12 %THEN %START; ! == TO ARRAY NAME
#line 4682 "test-new/imp918s.imp"
if (KK != 12) goto L_0431;
// 4683 FORGET(REG)
#line 4683 "test-new/imp918s.imp"
FORGET(REG);
// 4684 CYC BITS=CYC BITS!512; ! ARRAYNAME == BIT
#line 4684 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 512;
// 4685 PMVC(16,BASE,DISP,Z,ZP); ! MOVE IN ARRAYHEAD
#line 4685 "test-new/imp918s.imp"
PMVC(16, BASE, DISP, Z, ZP);
// 4686 ! DISP>4095 SORTED IN CNAME
// 4687 REGISTER(Z)=0 %IF REGISTER(Z)=2
#line 4687 "test-new/imp918s.imp"
if (REGISTER[Z] != 2) goto L_0432;
#line 4687 "test-new/imp918s.imp"
REGISTER[Z] = 0;
#line 4687 "test-new/imp918s.imp"
L_0432:;
// 4688 ->F3 %UNLESS P1>X'FFFF' %OR ARR=1 %OR ARR=2
#line 4688 "test-new/imp918s.imp"
if (P1 > 65535) goto L_0433;
#line 4688 "test-new/imp918s.imp"
if (ARR == 1) goto L_0433;
#line 4688 "test-new/imp918s.imp"
if (ARR == 2) goto L_0433;
#line 4688 "test-new/imp918s.imp"
goto U_1041;
#line 4688 "test-new/imp918s.imp"
L_0433:;
// 4689 ! ALLOW ARRAYS&VECTORS \FORMATS
// 4690 %FINISH %ELSE CYC BITS=CYC BITS!256;! REC/SCALAR == BIT
#line 4690 "test-new/imp918s.imp"
goto L_0434;
#line 4690 "test-new/imp918s.imp"
L_0431:;
#line 4690 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 256;
#line 4690 "test-new/imp918s.imp"
L_0434:;
// 4691 ->Label1
#line 4691 "test-new/imp918s.imp"
goto U_1039;
// 4692 ARRNAME: CNAME(12,REG); ! SET BASE & DISP
#line 4692 "test-new/imp918s.imp"
U_103F:;
#line 4692 "test-new/imp918s.imp"
CNAME(12, REG);
// 4693 Z=BASE; ZP=DISP; ! AND SAVE THEM
#line 4693 "test-new/imp918s.imp"
Z = BASE;
#line 4693 "test-new/imp918s.imp"
ZP = DISP;
// 4694 ->F3 %UNLESS 1<=ARR<=2
#line 4694 "test-new/imp918s.imp"
{
// Double-sided test on ARR (Part I)
#line 4694 "test-new/imp918s.imp"
unsigned char tmp;
#line 4694 "test-new/imp918s.imp"
if (1 > (tmp = ARR)) goto L_0435;
// Double-sided test on ARR (Part II)
#line 4694 "test-new/imp918s.imp"
if (tmp <= 2) goto L_0436;
#line 4694 "test-new/imp918s.imp"
}
#line 4694 "test-new/imp918s.imp"
L_0435:;
#line 4694 "test-new/imp918s.imp"
goto U_1041;
#line 4694 "test-new/imp918s.imp"
L_0436:;
// 4695 %IF JJ=0 %THEN %START
#line 4695 "test-new/imp918s.imp"
if (JJ != 0) goto L_0437;
// 4696 JJ=J; %IF P1<X'FFFF' %THEN %START
#line 4696 "test-new/imp918s.imp"
JJ = J;
#line 4696 "test-new/imp918s.imp"
if (P1 >= 65535) goto L_0438;
// 4697 KK=FROM1(TPCELL); ! DEDUDCE NO OF DIMENS
#line 4697 "test-new/imp918s.imp"
KK = FROM1(TPCELL);
// 4698 REPLACE1(TPCELL,KK!JJ); %FINISH; %FINISH
#line 4698 "test-new/imp918s.imp"
REPLACE1(TPCELL, KK | JJ);
#line 4698 "test-new/imp918s.imp"
L_0438:;
#line 4698 "test-new/imp918s.imp"
L_0437:;
// 4699 FAULT(85,0) %UNLESS J=JJ %OR J=0
#line 4699 "test-new/imp918s.imp"
if (J == JJ) goto L_0439;
#line 4699 "test-new/imp918s.imp"
if (J == 0) goto L_0439;
#line 4699 "test-new/imp918s.imp"
FAULT(85, 0);
#line 4699 "test-new/imp918s.imp"
L_0439:;
// 4700 REGISTER(Z)=2 %IF REGISTER(Z)=0
#line 4700 "test-new/imp918s.imp"
if (REGISTER[Z] != 0) goto L_043A;
#line 4700 "test-new/imp918s.imp"
REGISTER[Z] = 2;
#line 4700 "test-new/imp918s.imp"
L_043A:;
// 4701 KK=12; ->COMM
#line 4701 "test-new/imp918s.imp"
KK = 12;
#line 4701 "test-new/imp918s.imp"
goto U_1040;
// 4702 RECNAME: P=P2+4
#line 4702 "test-new/imp918s.imp"
U_103D:;
#line 4702 "test-new/imp918s.imp"
P = P2 + 4;
// 4703 ->ARRNAME %IF ARR=1 %AND (P1>X'FFFF' %OR A(P1+1)=2);
#line 4703 "test-new/imp918s.imp"
if (ARR != 1) goto L_043B;
#line 4703 "test-new/imp918s.imp"
if (P1 > 65535) goto L_043C;
#line 4703 "test-new/imp918s.imp"
if (A[P1 + 1 + 7] != 2) goto L_043B;
#line 4703 "test-new/imp918s.imp"
L_043C:;
#line 4703 "test-new/imp918s.imp"
goto U_103F;
#line 4703 "test-new/imp918s.imp"
L_043B:;
// 4704 CNAME(15,REG); ! FETCH/SET POINTER
#line 4704 "test-new/imp918s.imp"
CNAME(15, REG);
// 4705 REG=NEST %IF REG<0
#line 4705 "test-new/imp918s.imp"
if (REG >= 0) goto L_043D;
#line 4705 "test-new/imp918s.imp"
REG = NEST;
#line 4705 "test-new/imp918s.imp"
L_043D:;
// 4706 KK=14; ->COMM
#line 4706 "test-new/imp918s.imp"
KK = 14;
#line 4706 "test-new/imp918s.imp"
goto U_1040;
// 4707 F66: Q=66; ->F00
#line 4707 "test-new/imp918s.imp"
U_103B:;
#line 4707 "test-new/imp918s.imp"
Q = 66;
#line 4707 "test-new/imp918s.imp"
goto U_1042;
// 4708 F1: Q=82; ->F00; ! LHS NOT A POINTER VARIABLE
#line 4708 "test-new/imp918s.imp"
U_103E:;
#line 4708 "test-new/imp918s.imp"
Q = 82;
#line 4708 "test-new/imp918s.imp"
goto U_1042;
// 4709 F0: P=P2; SKIP EXP; ! SKIP RHS
#line 4709 "test-new/imp918s.imp"
U_1043:;
#line 4709 "test-new/imp918s.imp"
P = P2;
#line 4709 "test-new/imp918s.imp"
SKIPEXP();
// 4710 %IF 0<=REG<=15 %AND REGISTER(REG)>0 %THEN REGISTER(REG)=0
#line 4710 "test-new/imp918s.imp"
{
// Double-sided test on REG (Part I)
#line 4710 "test-new/imp918s.imp"
int tmp;
#line 4710 "test-new/imp918s.imp"
if (0 > (tmp = REG)) goto L_043E;
// Double-sided test on REG (Part II)
#line 4710 "test-new/imp918s.imp"
if (tmp > 15) goto L_043E;
#line 4710 "test-new/imp918s.imp"
}
#line 4710 "test-new/imp918s.imp"
if (REGISTER[REG] <= 0) goto L_043E;
#line 4710 "test-new/imp918s.imp"
REGISTER[REG] = 0;
#line 4710 "test-new/imp918s.imp"
L_043E:;
// 4711 ->Label1
#line 4711 "test-new/imp918s.imp"
goto U_1039;
// 4712 F2: Q=81; ! RHS AN EXPRSSN
#line 4712 "test-new/imp918s.imp"
U_103C:;
#line 4712 "test-new/imp918s.imp"
Q = 81;
// 4713 F00: %IF P1>X'FFFF' %THEN Q=22; ! IF PARAM GIVE 'ACTUAL PARAM FLT
#line 4713 "test-new/imp918s.imp"
U_1042:;
#line 4713 "test-new/imp918s.imp"
if (P1 <= 65535) goto L_043F;
#line 4713 "test-new/imp918s.imp"
Q = 22;
#line 4713 "test-new/imp918s.imp"
L_043F:;
// 4714 %IF Q=82 %THEN JJ=A(P1) %ELSE JJ=0
#line 4714 "test-new/imp918s.imp"
if (Q != 82) goto L_0440;
#line 4714 "test-new/imp918s.imp"
JJ = A[P1 + 7];
#line 4714 "test-new/imp918s.imp"
goto L_0441;
#line 4714 "test-new/imp918s.imp"
L_0440:;
#line 4714 "test-new/imp918s.imp"
JJ = 0;
#line 4714 "test-new/imp918s.imp"
L_0441:;
// 4715 FAULT(Q,JJ)
#line 4715 "test-new/imp918s.imp"
FAULT(Q, JJ);
// 4716 ->F0
#line 4716 "test-new/imp918s.imp"
goto U_1043;
// 4717 F3: Q=83; ->F00; ! NON-EQUIVALENCE'
#line 4717 "test-new/imp918s.imp"
U_1041:;
#line 4717 "test-new/imp918s.imp"
Q = 83;
#line 4717 "test-new/imp918s.imp"
goto U_1042;
// 4718 Label1: %END
#line 4718 "test-new/imp918s.imp"
U_1039:;
#line 4718 "test-new/imp918s.imp"
return;
#line 4718 "test-new/imp918s.imp"
case_SW_dispatch:
#line 4718 "test-new/imp918s.imp"
if (SW_index < 0 || SW_index > 3)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 4718 "test-new/imp918s.imp"
goto *SW[SW_index - 0];
#line 4718 "test-new/imp918s.imp"
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
#line 4718 "test-new/imp918s.imp"
} /* end of ASSIGN */
// 4719 %ROUTINE CUI(%INTEGER CODE)
#line 4719 "test-new/imp918s.imp"
void CUI(int CODE) {
// 4720 {%SHORTROUTINE}
// 4721 %INTEGER KK,JJ,QQ
#line 4721 "test-new/imp918s.imp"
int KK;
#line 4721 "test-new/imp918s.imp"
int JJ;
#line 4721 "test-new/imp918s.imp"
int QQ;
// 4722 %BYTEINTEGER TYPEP,PRECP
#line 4722 "test-new/imp918s.imp"
unsigned char TYPEP;
#line 4722 "test-new/imp918s.imp"
unsigned char PRECP;
// 4723 %SWITCH SW(1:8)
#line 4723 "test-new/imp918s.imp"
int SW_index;
#line 4723 "test-new/imp918s.imp"
int SW_line;
#line 4723 "test-new/imp918s.imp"
char *SW_file;
#line 4723 "test-new/imp918s.imp"
static const void *SW[8] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 4724 REPORTUI=0; ! =0 CONTINUE,=1 UNCOND JUMP
#line 4724 "test-new/imp918s.imp"
REPORTUI = 0;
// 4725 ->SW(A(P))
#line 4725 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 7];
goto case_SW_dispatch;
// 4726 SW(1): P=P+1; MARKER1=P+A(P); !(NAME)(APP)(RESTOFUI)
#line 4726 "test-new/imp918s.imp"
case_SW_1:;
#line 4726 "test-new/imp918s.imp"
P = P + 1;
#line 4726 "test-new/imp918s.imp"
MARKER1 = P + A[P + 7];
// 4727 ->Label3 %IF A(MARKER 1)=1
#line 4727 "test-new/imp918s.imp"
if (A[MARKER1 + 7] != 1) goto L_0443;
#line 4727 "test-new/imp918s.imp"
goto U_1018;
#line 4727 "test-new/imp918s.imp"
L_0443:;
// 4728 P=P+1; CNAME(0,0); P=P+1; -> AUI
#line 4728 "test-new/imp918s.imp"
P = P + 1;
#line 4728 "test-new/imp918s.imp"
CNAME(0, 0);
#line 4728 "test-new/imp918s.imp"
P = P + 1;
#line 4728 "test-new/imp918s.imp"
goto U_102E;
// 4729 Label3: KK=P+1; P=MARKER1+2
#line 4729 "test-new/imp918s.imp"
U_1018:;
#line 4729 "test-new/imp918s.imp"
KK = P + 1;
#line 4729 "test-new/imp918s.imp"
P = MARKER1 + 2;
// 4730 ASSIGN(A(MARKER1+1),KK)
#line 4730 "test-new/imp918s.imp"
ASSIGN(A[MARKER1 + 1 + 7], KK);
// 4731 AUI: P=P+1
#line 4731 "test-new/imp918s.imp"
U_102E:;
#line 4731 "test-new/imp918s.imp"
P = P + 1;
// 4732 %IF A(P-1)=1 %THEN CUI(CODE); ->Label1
#line 4732 "test-new/imp918s.imp"
if (A[P - 1 + 7] != 1) goto L_0444;
#line 4732 "test-new/imp918s.imp"
CUI(CODE);
#line 4732 "test-new/imp918s.imp"
L_0444:;
#line 4732 "test-new/imp918s.imp"
goto U_1030;
// 4733 SW(2): !-><NAME><EXRN>
#line 4733 "test-new/imp918s.imp"
case_SW_2:;
// 4734 CURR INST=1 %IF CODE=0
#line 4734 "test-new/imp918s.imp"
if (CODE != 0) goto L_0445;
#line 4734 "test-new/imp918s.imp"
CURRINST = 1;
#line 4734 "test-new/imp918s.imp"
L_0445:;
// 4735 NMDECS=NMDECS!1
#line 4735 "test-new/imp918s.imp"
NMDECS = NMDECS | 1;
// 4736 CYC BITS=CYC BITS!2; ! SET 'JUMP' BIT
#line 4736 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 2;
// 4737 ->NLAB %IF A(P+1)=1; ! NUMERIC
#line 4737 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_0446;
#line 4737 "test-new/imp918s.imp"
goto U_1031;
#line 4737 "test-new/imp918s.imp"
L_0446:;
// 4738 ->SLAB %IF A(P+3)=2; ! SIMPLE NAME
#line 4738 "test-new/imp918s.imp"
if (A[P + 3 + 7] != 2) goto L_0447;
#line 4738 "test-new/imp918s.imp"
goto U_1032;
#line 4738 "test-new/imp918s.imp"
L_0447:;
// 4739 COPYTAG(A(P+2))
#line 4739 "test-new/imp918s.imp"
COPYTAG(A[P + 2 + 7]);
// 4740 KK=K; P=P+2
#line 4740 "test-new/imp918s.imp"
KK = K;
#line 4740 "test-new/imp918s.imp"
P = P + 2;
// 4741 PTYPEP=PTYPE
#line 4741 "test-new/imp918s.imp"
PTYPEP = PTYPE;
// 4742 %UNLESS OLDI=LEVEL %AND TYPE=6 %THEN %START
#line 4742 "test-new/imp918s.imp"
if (OLDI != LEVEL) goto L_0448;
#line 4742 "test-new/imp918s.imp"
if (TYPE == 6) goto L_0449;
#line 4742 "test-new/imp918s.imp"
L_0448:;
// 4743 FAULT(4,0); P=P+1; SKIP APP; ->Label1
#line 4743 "test-new/imp918s.imp"
FAULT(4, 0);
#line 4743 "test-new/imp918s.imp"
P = P + 1;
#line 4743 "test-new/imp918s.imp"
SKIPAPP();
#line 4743 "test-new/imp918s.imp"
goto U_1030;
// 4744 %FINISH
#line 4744 "test-new/imp918s.imp"
L_0449:;
// 4745 FROM12(KK,QQ,JJ)
#line 4745 "test-new/imp918s.imp"
FROM12(KK, /*?*/ &QQ, /*?*/ &JJ);
// 4746 JJ=QQ+8-JJ*BYTES(PREC); ! DISP OF SW(0)
#line 4746 "test-new/imp918s.imp"
JJ = QQ + 8 - JJ * BYTES[PREC];
// 4747 CANAME(1,GLA,0,QQ)
#line 4747 "test-new/imp918s.imp"
CANAME(1, 13, 0, QQ);
// 4748 %IF CHECKS=0 %THEN %START; ! OPTIMISING PUT JUMP INLINE
#line 4748 "test-new/imp918s.imp"
if (CHECKS != 0) goto L_044A;
// 4749 DUMP(2*PREC+2,-2,DISP+JJ,BASE,INDEX)
#line 4749 "test-new/imp918s.imp"
DUMP(2 * PREC + 2, -2, DISP + JJ, BASE, INDEX);
// 4750 PRX(X'47',15,NEST,10,0)
#line 4750 "test-new/imp918s.imp"
PRX(71, 15, NEST, 10, 0);
// 4751 FORGET(NEST)
#line 4751 "test-new/imp918s.imp"
FORGET(NEST);
// 4752 %FINISH; REPORTUI=1; ->Label1
#line 4752 "test-new/imp918s.imp"
L_044A:;
#line 4752 "test-new/imp918s.imp"
REPORTUI = 1;
#line 4752 "test-new/imp918s.imp"
goto U_1030;
// 4753 NLAB: K=A(P+2); P=P+3
#line 4753 "test-new/imp918s.imp"
U_1031:;
#line 4753 "test-new/imp918s.imp"
K = A[P + 2 + 7];
#line 4753 "test-new/imp918s.imp"
P = P + 3;
// 4754 LCOM: ENTER JUMP(MASK,K,0)
#line 4754 "test-new/imp918s.imp"
U_101D:;
#line 4754 "test-new/imp918s.imp"
ENTERJUMP(MASK, K, 0);
// 4755 REPORTUI=1 %IF MASK=15; ->Label1
#line 4755 "test-new/imp918s.imp"
if (MASK != 15) goto L_044B;
#line 4755 "test-new/imp918s.imp"
REPORTUI = 1;
#line 4755 "test-new/imp918s.imp"
L_044B:;
#line 4755 "test-new/imp918s.imp"
goto U_1030;
// 4756 SLAB: K=16384+A(P+2); P=P+4; ->LCOM
#line 4756 "test-new/imp918s.imp"
U_1032:;
#line 4756 "test-new/imp918s.imp"
K = 16384 + A[P + 2 + 7];
#line 4756 "test-new/imp918s.imp"
P = P + 4;
#line 4756 "test-new/imp918s.imp"
goto U_101D;
// 4757 SW(3): ! printstring("TEXTTEXT")
#line 4757 "test-new/imp918s.imp"
case_SW_3:;
// 4758 WARN(LINE)
#line 4758 "test-new/imp918s.imp"
WARN(LINE);
// 4759 P=P+1; TEXTOUT(0); ->AUI
#line 4759 "test-new/imp918s.imp"
P = P + 1;
#line 4759 "test-new/imp918s.imp"
TEXTOUT(0);
#line 4759 "test-new/imp918s.imp"
goto U_102E;
// 4760 SW(4): ! %RETURN
#line 4760 "test-new/imp918s.imp"
case_SW_4:;
// 4761 FAULT(30,0) %UNLESS FLAG=10000 %OR COMPILER=1
#line 4761 "test-new/imp918s.imp"
if (FLAG == 10000) goto L_044C;
#line 4761 "test-new/imp918s.imp"
if (COMPILER == 1) goto L_044C;
#line 4761 "test-new/imp918s.imp"
FAULT(30, 0);
#line 4761 "test-new/imp918s.imp"
L_044C:;
// 4762 P=P+1
#line 4762 "test-new/imp918s.imp"
P = P + 1;
// 4763 Label6: RT EXIT
#line 4763 "test-new/imp918s.imp"
U_101E:;
#line 4763 "test-new/imp918s.imp"
RTEXIT();
// 4764 CYC BITS=CYC BITS!2; ! SET 'JUMP OUT' BIT
#line 4764 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 2;
// 4765 REPORTUI=1
#line 4765 "test-new/imp918s.imp"
REPORTUI = 1;
// 4766 CURR INST=1 %IF CODE=0; ->Label1
#line 4766 "test-new/imp918s.imp"
if (CODE != 0) goto L_044D;
#line 4766 "test-new/imp918s.imp"
CURRINST = 1;
#line 4766 "test-new/imp918s.imp"
L_044D:;
#line 4766 "test-new/imp918s.imp"
goto U_1030;
// 4767 SW(5): ! %RESULT(ASSOP)(EXPR)
#line 4767 "test-new/imp918s.imp"
case_SW_5:;
// 4768 PTYPE=FLAG;! UNPACK
#line 4768 "test-new/imp918s.imp"
PTYPE = FLAG;
// 4769 !%if USE MC = 1 %start
// 4770 ! *L_1,PTYPE; *CVD_1,0(11)
// 4771 ! *UNPK_ROUT(5),5(3,11)
// 4772 ! *NC_ROUT(5),MASK1
// 4773 !%finish
// 4774 %IF PTYPE>10000 %AND A(P+1)#3 %THEN %START;! ASSOP #'->'
#line 4774 "test-new/imp918s.imp"
if (PTYPE <= 10000) goto L_044E;
#line 4774 "test-new/imp918s.imp"
if (A[P + 1 + 7] == 3) goto L_044E;
// 4775 %IF A(P+1)=1 %AND NAM#0 %AND A(P+4)=4 %AND A(P+5)=1 %START
#line 4775 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 1) goto L_044F;
#line 4775 "test-new/imp918s.imp"
if (NAM == 0) goto L_044F;
#line 4775 "test-new/imp918s.imp"
if (A[P + 4 + 7] != 4) goto L_044F;
#line 4775 "test-new/imp918s.imp"
if (A[P + 5 + 7] != 1) goto L_044F;
// 4776 P=P+6; TYPEP=TYPE; PRECP=PREC
#line 4776 "test-new/imp918s.imp"
P = P + 6;
#line 4776 "test-new/imp918s.imp"
TYPEP = TYPE;
#line 4776 "test-new/imp918s.imp"
PRECP = PREC;
// 4777 CNAME(3,1)
#line 4777 "test-new/imp918s.imp"
CNAME(3, 1);
// 4778 FAULT(81,0) %UNLESS A(P)=2; P=P+1
#line 4778 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0450;
#line 4778 "test-new/imp918s.imp"
FAULT(81, 0);
#line 4778 "test-new/imp918s.imp"
L_0450:;
#line 4778 "test-new/imp918s.imp"
P = P + 1;
// 4779 FAULT(83,0) %UNLESS TYPEP=TYPE %AND PRECP=PREC
#line 4779 "test-new/imp918s.imp"
if (TYPEP != TYPE) goto L_0451;
#line 4779 "test-new/imp918s.imp"
if (PRECP == PREC) goto L_0452;
#line 4779 "test-new/imp918s.imp"
L_0451:;
#line 4779 "test-new/imp918s.imp"
FAULT(83, 0);
#line 4779 "test-new/imp918s.imp"
L_0452:;
// 4780 ->Label6
#line 4780 "test-new/imp918s.imp"
goto U_101E;
// 4781 %FINISH
#line 4781 "test-new/imp918s.imp"
L_044F:;
// 4782 %IF A(P+1)=2 %THEN %START; ! ASSOP='='
#line 4782 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0453;
// 4783 P=P+2
#line 4783 "test-new/imp918s.imp"
P = P + 2;
// 4784 %IF NAM#0 %THEN TYPE=1; ! MAPS HAVE INTEGER RESULTS
#line 4784 "test-new/imp918s.imp"
if (NAM == 0) goto L_0454;
#line 4784 "test-new/imp918s.imp"
TYPE = 1;
#line 4784 "test-new/imp918s.imp"
L_0454:;
// 4785 %IF TYPE=5 %THEN CSTREXP(1,1) %ELSE %START
#line 4785 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0455;
#line 4785 "test-new/imp918s.imp"
CSTREXP(1, 1);
#line 4785 "test-new/imp918s.imp"
goto L_0456;
#line 4785 "test-new/imp918s.imp"
L_0455:;
// 4786 PREC=TYPE %UNLESS PREC=3 %AND NAM=0
#line 4786 "test-new/imp918s.imp"
if (PREC != 3) goto L_0457;
#line 4786 "test-new/imp918s.imp"
if (NAM == 0) goto L_0458;
#line 4786 "test-new/imp918s.imp"
L_0457:;
#line 4786 "test-new/imp918s.imp"
PREC = TYPE;
#line 4786 "test-new/imp918s.imp"
L_0458:;
// 4787 CSEXP(TYPE,PREC)
#line 4787 "test-new/imp918s.imp"
CSEXP(TYPE, PREC);
// 4788 %FINISH; ->Label6
#line 4788 "test-new/imp918s.imp"
L_0456:;
#line 4788 "test-new/imp918s.imp"
goto U_101E;
// 4789 %FINISH
#line 4789 "test-new/imp918s.imp"
L_0453:;
// 4790 %FINISH
#line 4790 "test-new/imp918s.imp"
L_044E:;
// 4791 FAULT(31,0)
#line 4791 "test-new/imp918s.imp"
FAULT(31, 0);
// 4792 P=P+2; SKIP EXP; ->Label1; ! IGNORE SPURIOUS RESULT
#line 4792 "test-new/imp918s.imp"
P = P + 2;
#line 4792 "test-new/imp918s.imp"
SKIPEXP();
#line 4792 "test-new/imp918s.imp"
goto U_1030;
// 4793 SW(6): ->Label601 %IF A(P+1)=2; ! %MONITOR (SOMETHING)
#line 4793 "test-new/imp918s.imp"
case_SW_6:;
#line 4793 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0459;
#line 4793 "test-new/imp918s.imp"
goto U_101F;
#line 4793 "test-new/imp918s.imp"
L_0459:;
// 4794 %IF DIAGS1=1 %THEN PPJ(31); P=P+1
#line 4794 "test-new/imp918s.imp"
if (DIAGS1 != 1) goto L_045A;
#line 4794 "test-new/imp918s.imp"
PPJ(31);
#line 4794 "test-new/imp918s.imp"
L_045A:;
#line 4794 "test-new/imp918s.imp"
P = P + 1;
// 4795 ->Label701 %IF A(P)=1; P=P+1; ->Label1
#line 4795 "test-new/imp918s.imp"
if (A[P + 7] != 1) goto L_045B;
#line 4795 "test-new/imp918s.imp"
goto U_1020;
#line 4795 "test-new/imp918s.imp"
L_045B:;
#line 4795 "test-new/imp918s.imp"
P = P + 1;
#line 4795 "test-new/imp918s.imp"
goto U_1030;
// 4796 Label601: PRX(X'41',0,0,0,A(P+2))
#line 4796 "test-new/imp918s.imp"
U_101F:;
#line 4796 "test-new/imp918s.imp"
PRX(65, 0, 0, 0, A[P + 2 + 7]);
// 4797 WARN(LINE)
#line 4797 "test-new/imp918s.imp"
WARN(LINE);
// 4798 PPJ(21); P=P+3; ->Label1
#line 4798 "test-new/imp918s.imp"
PPJ(21);
#line 4798 "test-new/imp918s.imp"
P = P + 3;
#line 4798 "test-new/imp918s.imp"
goto U_1030;
// 4799 Label701: WARN(LINE)
#line 4799 "test-new/imp918s.imp"
U_1020:;
#line 4799 "test-new/imp918s.imp"
WARN(LINE);
// 4800 SW(7): ! %STOP
#line 4800 "test-new/imp918s.imp"
case_SW_7:;
// 4801 PPJ(6); P=P+1; CURR INST=1 %IF CODE=0
#line 4801 "test-new/imp918s.imp"
PPJ(6);
#line 4801 "test-new/imp918s.imp"
P = P + 1;
#line 4801 "test-new/imp918s.imp"
if (CODE != 0) goto L_045C;
#line 4801 "test-new/imp918s.imp"
CURRINST = 1;
#line 4801 "test-new/imp918s.imp"
L_045C:;
// 4802 REPORTUI=1; ->Label1
#line 4802 "test-new/imp918s.imp"
REPORTUI = 1;
#line 4802 "test-new/imp918s.imp"
goto U_1030;
// 4803 SW(8): ! %EXIT
#line 4803 "test-new/imp918s.imp"
case_SW_8:;
// 4804 CYC BITS=CYCBITS!2; ! SET JUMP BIT
#line 4804 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 2;
// 4805 KK=FROM2(CYCLE(LEVEL))
#line 4805 "test-new/imp918s.imp"
KK = FROM2(CYCLE[LEVEL]);
// 4806 %IF KK=-1 %THEN %START
#line 4806 "test-new/imp918s.imp"
if (KK != -1) goto L_045D;
// 4807 FAULT(54,0) %UNLESS CSSMODE=0; ->Label1; %FINISH
#line 4807 "test-new/imp918s.imp"
if (CSSMODE == 0) goto L_045E;
#line 4807 "test-new/imp918s.imp"
FAULT(54, 0);
#line 4807 "test-new/imp918s.imp"
L_045E:;
#line 4807 "test-new/imp918s.imp"
goto U_1030;
#line 4807 "test-new/imp918s.imp"
L_045D:;
// 4808 REPLACE2(CYCLE(LEVEL),KK!X'80000000')
#line 4808 "test-new/imp918s.imp"
REPLACE2(CYCLE[LEVEL], KK | -2147483648);
// 4809 ENTER JUMP(MASK,KK>>16&X'7FFF',B'10')
#line 4809 "test-new/imp918s.imp"
ENTERJUMP(MASK, (unsigned int)KK >> 16 & 32767, 2);
// 4810 REPORTUI=1 %IF MASK=15
#line 4810 "test-new/imp918s.imp"
if (MASK != 15) goto L_045F;
#line 4810 "test-new/imp918s.imp"
REPORTUI = 1;
#line 4810 "test-new/imp918s.imp"
L_045F:;
// 4811 Label1: %END
#line 4811 "test-new/imp918s.imp"
U_1030:;
#line 4811 "test-new/imp918s.imp"
return;
#line 4811 "test-new/imp918s.imp"
case_SW_dispatch:
#line 4811 "test-new/imp918s.imp"
if (SW_index < 1 || SW_index > 8)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 4811 "test-new/imp918s.imp"
goto *SW[SW_index - 1];
#line 4811 "test-new/imp918s.imp"
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
#line 4811 "test-new/imp918s.imp"
} /* end of CUI */
// 4812 %ROUTINE RT EXIT
#line 4812 "test-new/imp918s.imp"
void RTEXIT(void) {
// 4813 {%SHORTROUTINE}
// 4814 !***********************************************************************
// 4815 !* THIS ROUTINE COMPILES CODE FOR ROUTINE EXIT(IE '%RETURN') *
// 4816 !* THE ONLY PROBLEM IS REGISTER VARIABLES WHICH ARE GLOBAL *
// 4817 !* THE SAVE AREA MUST BE UPDATED TO PREVENT THE RETURN RESTORING *
// 4818 !* THE REGISTER VARIABLE TO ITS VALUE AT THE TIME OF THE CALL *
// 4819 !***********************************************************************
// 4820 %INTEGER KK
#line 4820 "test-new/imp918s.imp"
int KK;
// 4821 PSS(X'D2',4,GLA,20,RBASE,0) %IF DIAGS1=1;! RESET DIAGS PTRS
#line 4821 "test-new/imp918s.imp"
if (DIAGS1 != 1) goto L_0460;
#line 4821 "test-new/imp918s.imp"
PSS(210, 4, 13, 20, RBASE, 0);
#line 4821 "test-new/imp918s.imp"
L_0460:;
// 4822 %CYCLE KK=5,1,14; ! CHECK FOR REGISTER VAR
#line 4822 "test-new/imp918s.imp"
// %for KK = 5, 1, 14 %cycle
#line 4822 "test-new/imp918s.imp"
{
int _control, _initial = 5, _increment = 1, _final = 14;
#line 4822 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle KK = 5, 1, 14");
_control = KK = _initial - _increment;
#line 4822 "test-new/imp918s.imp"
L_0461:
#line 4822 "test-new/imp918s.imp"
if (KK != _control) _imp_signal(4, 2, 0, "Corrupt control variable KK");
#line 4822 "test-new/imp918s.imp"
if (KK == _final) goto L_0462;
#line 4822 "test-new/imp918s.imp"
_control += _increment;
KK += _increment;
// 4823 %IF 0#UVARREG(KK)<LEVEL %AND(COMPILER=0 %OR NMDECS&X'FE'#0)%C
#line 4823 "test-new/imp918s.imp"
{
// Double-sided test on UVARREG[KK - 5] (Part I)
#line 4823 "test-new/imp918s.imp"
int tmp;
#line 4823 "test-new/imp918s.imp"
if (0 == (tmp = UVARREG[KK - 5])) goto L_0464;
// Double-sided test on UVARREG[KK - 5] (Part II)
#line 4823 "test-new/imp918s.imp"
if (tmp >= LEVEL) goto L_0464;
#line 4823 "test-new/imp918s.imp"
}
#line 4823 "test-new/imp918s.imp"
if (COMPILER == 0) goto L_0465;
#line 4823 "test-new/imp918s.imp"
if (NMDECS & 254 == 0) goto L_0464;
#line 4823 "test-new/imp918s.imp"
L_0465:;
#line 4823 "test-new/imp918s.imp"
PRX(80, KK, 0, RBASE, KK << 2);
#line 4823 "test-new/imp918s.imp"
L_0464:;
// 4824+ %THEN PRX(X'50',KK,0,RBASE,KK<<2); ! UPDATE CORE COPY
// 4825 %REPEAT
#line 4825 "test-new/imp918s.imp"
goto L_0461;
#line 4825 "test-new/imp918s.imp"
}
#line 4825 "test-new/imp918s.imp"
L_0462:;
// 4826 PRX(X'98',4,15,RBASE,16); ! LM OLD REGISTERS
#line 4826 "test-new/imp918s.imp"
PRX(152, 4, 15, RBASE, 16);
// 4827 PLANT(X'7FF')
#line 4827 "test-new/imp918s.imp"
PLANT(2047);
// 4828 %END
#line 4828 "test-new/imp918s.imp"
return;
#line 4828 "test-new/imp918s.imp"
} /* end of RTEXIT */
// 4829 %ROUTINE CSTART(%INTEGER CODE)
#line 4829 "test-new/imp918s.imp"
void CSTART(int CODE) {
// 4830 {%SHORTROUTINE}
// 4831 %INTEGER KK
#line 4831 "test-new/imp918s.imp"
int KK;
// 4832 SFLABEL=SFLABEL-1
#line 4832 "test-new/imp918s.imp"
SFLABEL = SFLABEL - 1;
// 4833 FIND USE(KK,1,11,\SFLABEL)
#line 4833 "test-new/imp918s.imp"
FINDUSE(/*?*/ &KK, 1, 11, (~SFLABEL));
// 4834 %IF KK>0 %THEN FORGET(KK) ;! FORGET MULT OF 4K FOR SFLAB
#line 4834 "test-new/imp918s.imp"
if (KK <= 0) goto L_0466;
#line 4834 "test-new/imp918s.imp"
FORGET(KK);
#line 4834 "test-new/imp918s.imp"
L_0466:;
// 4835 PUSH123(SBR(LEVEL),CODE,SFLABEL,CYCLE(LEVEL))
#line 4835 "test-new/imp918s.imp"
PUSH123(/*?*/ &SBR[LEVEL], CODE, SFLABEL, CYCLE[LEVEL]);
// 4836 %END
#line 4836 "test-new/imp918s.imp"
return;
#line 4836 "test-new/imp918s.imp"
} /* end of CSTART */
// 4837 %ROUTINE TEXTOUT(%INTEGER REG)
#line 4837 "test-new/imp918s.imp"
void TEXTOUT(int REG) {
// 4838 {%SHORTROUTINE}
// 4839 !***********************************************************************
// 4840 !* PLANT A JUMP ROUND THE TEXT WHICH IS PUT IN THE CODE. *
// 4841 !* REG IS LEFT POINTING AT THE TEXT. *
// 4842 !* REG=0 IS SPECIAL CASE PRINTTEXT *
// 4843 !***********************************************************************
// 4844 %INTEGER KK,Q,L
#line 4844 "test-new/imp918s.imp"
int KK;
#line 4844 "test-new/imp918s.imp"
int Q;
#line 4844 "test-new/imp918s.imp"
int L;
// 4845 L=A(P); ! NO OF CHARS IN TEXT
#line 4845 "test-new/imp918s.imp"
L = A[P + 7];
// 4846 %IF REG=0 %THEN PPJ(30) %ELSE %START
#line 4846 "test-new/imp918s.imp"
if (REG != 0) goto L_0467;
#line 4846 "test-new/imp918s.imp"
PPJ(30);
#line 4846 "test-new/imp918s.imp"
goto L_0468;
#line 4846 "test-new/imp918s.imp"
L_0467:;
// 4847 SET LOCAL BASE
#line 4847 "test-new/imp918s.imp"
SETLOCALBASE();
// 4848 KK=(CA+6+L-LOCAL ADDR)&(-2)
#line 4848 "test-new/imp918s.imp"
KK = CA + 6 + L - LOCALADDR & -2;
// 4849 PRX(X'45',REG,LOCAL BASE,0,KK);! BAL ROUND TEXT
#line 4849 "test-new/imp918s.imp"
PRX(69, REG, LOCALBASE, 0, KK);
// 4850 FORGET(REG)
#line 4850 "test-new/imp918s.imp"
FORGET(REG);
// 4851 %FINISH
#line 4851 "test-new/imp918s.imp"
L_0468:;
// 4852 Q=ADDR(A(P))+1; ! ADDR OF LENGTH BYTE
#line 4852 "test-new/imp918s.imp"
Q = _imp_ADDR(/*?*/ &A[P + 7]) + 1;
// 4853 P=P+(L+3)>>1; ! P ON ROUND TEXT
#line 4853 "test-new/imp918s.imp"
P = P + ((unsigned int)L + 3 >> 1);
// 4854 %CYCLE KK=Q,2,Q+L>>1<<1
#line 4854 "test-new/imp918s.imp"
// %for KK = Q, 2, Q + ((unsigned int)L >> 1 << 1) %cycle
#line 4854 "test-new/imp918s.imp"
{
int _control, _initial = Q, _increment = 2, _final = Q + ((unsigned int)L >> 1 << 1);
#line 4854 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0)
_imp_signal(5, 1, 0, "Illegal cycle KK = Q, 2, Q + ((unsigned int)L >> 1 << 1)");
_control = KK = _initial - _increment;
#line 4854 "test-new/imp918s.imp"
L_0469:
#line 4854 "test-new/imp918s.imp"
if (KK != _control) _imp_signal(4, 2, 0, "Corrupt control variable KK");
#line 4854 "test-new/imp918s.imp"
if (KK == _final) goto L_046A;
#line 4854 "test-new/imp918s.imp"
_control += _increment;
KK += _increment;
// 4855 BYTE INTEGER(ADDR(J)+2)=BYTE INTEGER (KK)
#line 4855 "test-new/imp918s.imp"
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &J) + 2) = *_imp_BYTEINTEGER(KK);
// 4856 BYTE INTEGER(ADDR(J)+3)=BYTE INTEGER (KK+1)
#line 4856 "test-new/imp918s.imp"
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &J) + 3) = *_imp_BYTEINTEGER(KK + 1);
// 4857 PLANT(J)
#line 4857 "test-new/imp918s.imp"
PLANT(J);
// 4858 %REPEAT
#line 4858 "test-new/imp918s.imp"
goto L_0469;
#line 4858 "test-new/imp918s.imp"
}
#line 4858 "test-new/imp918s.imp"
L_046A:;
// 4859 %IF SBFLAG#0 %AND CA-CODEBASE>4096 %THEN FAULT(99,0)
#line 4859 "test-new/imp918s.imp"
if (SBFLAG == 0) goto L_046B;
#line 4859 "test-new/imp918s.imp"
if (CA - CODEBASE <= 4096) goto L_046B;
#line 4859 "test-new/imp918s.imp"
FAULT(99, 0);
#line 4859 "test-new/imp918s.imp"
L_046B:;
// 4860 %IF REG=0 %AND SBFLAG=0 %AND CA-CODEBASE>4095-MARGIN %C
#line 4860 "test-new/imp918s.imp"
if (REG != 0) goto L_046C;
#line 4860 "test-new/imp918s.imp"
if (SBFLAG != 0) goto L_046C;
#line 4860 "test-new/imp918s.imp"
if (CA - CODEBASE <= 4095 - MARGIN) goto L_046C;
#line 4860 "test-new/imp918s.imp"
SETUSE(15, 12, CA);
#line 4860 "test-new/imp918s.imp"
L_046C:;
// 4861+ %THEN SET USE(15,12,CA)
// 4862 %END
#line 4862 "test-new/imp918s.imp"
return;
#line 4862 "test-new/imp918s.imp"
} /* end of TEXTOUT */
// 4863
// 4864 %ROUTINE CSEXP(%INTEGER REG,MODE)
#line 4864 "test-new/imp918s.imp"
void CSEXP(int REG, int MODE) {
// 4865 {%SHORTROUTINE}
// 4866 !***********************************************************************
// 4867 !* COMPILE A SIGNED EXPRESSION TO REGISTER 'REG' IN MODE 'MODE' *
// 4868 !* MODE=1 FOR %INTEGER, =2 REAL, =3 LONG,=0 INTEGER %IF POSSIBLE *
// 4869 !* MODE=5 FOR ADDRESS EXPRESSNS(IE LEAVE ANY CONSTANT IN 'ADISP')*
// 4870 !***********************************************************************
// 4871 %SHORTINTEGER EXPHEAD,NOPS,EXPBOT
#line 4871 "test-new/imp918s.imp"
short int EXPHEAD;
#line 4871 "test-new/imp918s.imp"
short int NOPS;
#line 4871 "test-new/imp918s.imp"
short int EXPBOT;
// 4872 %BYTEINTEGER ADDREXP
#line 4872 "test-new/imp918s.imp"
unsigned char ADDREXP;
// 4873 %INTEGER PP,BDISP,PPP
#line 4873 "test-new/imp918s.imp"
int PP;
#line 4873 "test-new/imp918s.imp"
int BDISP;
#line 4873 "test-new/imp918s.imp"
int PPP;
// 4874 EXPHEAD=0; ADDREXP=0
#line 4874 "test-new/imp918s.imp"
EXPHEAD = 0;
#line 4874 "test-new/imp918s.imp"
ADDREXP = 0;
// 4875 NOPS=0; EXPBOT=0
#line 4875 "test-new/imp918s.imp"
NOPS = 0;
#line 4875 "test-new/imp918s.imp"
EXPBOT = 0;
// 4876 ADDREXP=MODE>>2&1
#line 4876 "test-new/imp918s.imp"
ADDREXP = (unsigned int)MODE >> 2 & 1;
// 4877 P=P+2
#line 4877 "test-new/imp918s.imp"
P = P + 2;
// 4878 TORP(EXPHEAD,EXPBOT,NOPS,MODE)
#line 4878 "test-new/imp918s.imp"
TORP(/*?*/ &EXPHEAD, /*?*/ &EXPBOT, /*?*/ &NOPS, MODE);
// 4879 %IF EXPHEAD=0 %THEN NEST=0 %AND %RETURN;! EXPR CONSTANT ONLY
#line 4879 "test-new/imp918s.imp"
if (EXPHEAD != 0) goto L_046D;
#line 4879 "test-new/imp918s.imp"
NEST = 0;
#line 4879 "test-new/imp918s.imp"
return;
#line 4879 "test-new/imp918s.imp"
L_046D:;
// 4880 !
// 4881 ! MODE=13 IS A SPECIAL FOR THE BUILT IN MAPS. TO ALLOW INTEGER (ADDR(J))
// 4882 ! TO BE COMPILE AS QUICKLY AS POSSIBLE IT LOOKS FOR 'ADDR'
// 4883 ! AND USES CNAME TO OBTAIN 'BASE' & 'DISP' OF THE NAME AND RETURNS THESE
// 4884 ! AS THE RESULT OMITTING THE 'LA' THAT ADDR USES INVOKES
// 4885 !
// 4886 %IF MODE=13 %AND NOPS=0 %AND CHECKSP=0 %THEN %START
#line 4886 "test-new/imp918s.imp"
if (MODE != 13) goto L_046E;
#line 4886 "test-new/imp918s.imp"
if (NOPS != 0) goto L_046E;
#line 4886 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_046E;
// 4887 FROM12(EXPHEAD,PP,BDISP)
#line 4887 "test-new/imp918s.imp"
FROM12(EXPHEAD, /*?*/ &PP, /*?*/ &BDISP);
// 4888 %IF PP&255=2 %THEN %START; ! ONLY OPERAND IS A NAME
#line 4888 "test-new/imp918s.imp"
if (PP & 255 != 2) goto L_046F;
// 4889 COPY TAG (A(BDISP))
#line 4889 "test-new/imp918s.imp"
COPYTAG(A[BDISP + 7]);
// 4890 !
// 4891 ! CHECK THE NAME TO SEE IF IT IS OF THE FORM 'ADDR(<NAME><APP>)'
// 4892 !
// 4893 %IF PTYPE=SNPT %AND K=14 %AND A(BDISP+1)=1 %AND %C
#line 4893 "test-new/imp918s.imp"
if (PTYPE != 10006) goto L_0470;
#line 4893 "test-new/imp918s.imp"
if (K != 14) goto L_0470;
#line 4893 "test-new/imp918s.imp"
if (A[BDISP + 1 + 7] != 1) goto L_0470;
#line 4893 "test-new/imp918s.imp"
if (A[BDISP + 4 + 7] != 4) goto L_0470;
#line 4893 "test-new/imp918s.imp"
if (A[BDISP + 5 + 7] != 1) goto L_0470;
// 4894+ A(BDISP+4)=4 %AND A(BDISP+5)=1 %THEN %START
// 4895 PP=P; P=BDISP+6
#line 4895 "test-new/imp918s.imp"
PP = P;
#line 4895 "test-new/imp918s.imp"
P = BDISP + 6;
// 4896 BDISP=ADISP; PPP=P
#line 4896 "test-new/imp918s.imp"
BDISP = ADISP;
#line 4896 "test-new/imp918s.imp"
PPP = P;
// 4897 CNAME(1,99); ! SPECIAL SET 'BASE'&'DISP'
#line 4897 "test-new/imp918s.imp"
CNAME(1, 99);
// 4898 FAULT(22,0) %UNLESS A(P)=2
#line 4898 "test-new/imp918s.imp"
if (A[P + 7] == 2) goto L_0471;
#line 4898 "test-new/imp918s.imp"
FAULT(22, 0);
#line 4898 "test-new/imp918s.imp"
L_0471:;
// 4899 %IF BIMSTR#0 %THEN NOTE ASSMENT(-1,2,A(PPP))
#line 4899 "test-new/imp918s.imp"
if (BIMSTR == 0) goto L_0472;
#line 4899 "test-new/imp918s.imp"
NOTEASSMENT(-1, 2, A[PPP + 7]);
#line 4899 "test-new/imp918s.imp"
L_0472:;
// 4900 P=PP; DISP=DISP+BDISP
#line 4900 "test-new/imp918s.imp"
P = PP;
#line 4900 "test-new/imp918s.imp"
DISP = DISP + BDISP;
// 4901 CLEAR LIST(EXPHEAD)
#line 4901 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &EXPHEAD);
// 4902 ADISP=0; NEST=-1
#line 4902 "test-new/imp918s.imp"
ADISP = 0;
#line 4902 "test-new/imp918s.imp"
NEST = -1;
// 4903 %RETURN
#line 4903 "test-new/imp918s.imp"
return;
// 4904 %FINISH
#line 4904 "test-new/imp918s.imp"
L_0470:;
// 4905 %FINISH
#line 4905 "test-new/imp918s.imp"
L_046F:;
// 4906 %FINISH
#line 4906 "test-new/imp918s.imp"
L_046E:;
// 4907 !
// 4908 BDISP=ADISP
#line 4908 "test-new/imp918s.imp"
BDISP = ADISP;
// 4909 PP=P
#line 4909 "test-new/imp918s.imp"
PP = P;
// 4910 EXPOP(EXPHEAD,REG,NOPS,MODE&7)
#line 4910 "test-new/imp918s.imp"
EXPOP(EXPHEAD, REG, NOPS, MODE & 7);
// 4911 P=PP
#line 4911 "test-new/imp918s.imp"
P = PP;
// 4912 ADISP=BDISP
#line 4912 "test-new/imp918s.imp"
ADISP = BDISP;
// 4913 ! CLEARLIST(EXPHEAD)
// 4914 SHORTINTEGER(ADDR(ASLIST(EXPBOT))+14)=ASL
#line 4914 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[EXPBOT]) + 14) = ASL;
// 4915 ASL=EXPHEAD
#line 4915 "test-new/imp918s.imp"
ASL = EXPHEAD;
// 4916 %END
#line 4916 "test-new/imp918s.imp"
return;
#line 4916 "test-new/imp918s.imp"
} /* end of CSEXP */
// 4917 %ROUTINE DSEXP(%INTEGER REG,MODE)
#line 4917 "test-new/imp918s.imp"
void DSEXP(int REG, int MODE) {
// 4918 {%SHORTROUTINE}
// 4919 %COMMENT COMPILES TWO INTEGER EXPRESSIONS TO REG & REG+1
// 4920 %COMMENT REGISTERS LEFT CLAIMED
// 4921 %SHORTINTEGER SRD
#line 4921 "test-new/imp918s.imp"
short int SRD;
// 4922 SRD=0
#line 4922 "test-new/imp918s.imp"
SRD = 0;
// 4923 CSEXP(REG,1)
#line 4923 "test-new/imp918s.imp"
CSEXP(REG, 1);
// 4924 REGISTER(REG)=1
#line 4924 "test-new/imp918s.imp"
REGISTER[REG] = 1;
// 4925 PUSH(SRD,1<<16!9!REG<<8,-2)
#line 4925 "test-new/imp918s.imp"
PUSH(/*?*/ &SRD, 1 << 16 | 9 | REG << 8, -2);
// 4926 SET USE(REG,1,ADDR(ASLIST(SRD)))
#line 4926 "test-new/imp918s.imp"
SETUSE(REG, 1, _imp_ADDR(/*?*/ &ASLIST[SRD]));
// 4927 P=P+MODE
#line 4927 "test-new/imp918s.imp"
P = P + MODE;
// 4928 CSEXP(REG+1,1)
#line 4928 "test-new/imp918s.imp"
CSEXP(REG + 1, 1);
// 4929 REGISTER(REG+1)=1
#line 4929 "test-new/imp918s.imp"
REGISTER[REG + 1] = 1;
// 4930 EXPOP(SRD,REG,0,100)
#line 4930 "test-new/imp918s.imp"
EXPOP(SRD, REG, 0, 100);
// 4931 REGISTER(REG)=1
#line 4931 "test-new/imp918s.imp"
REGISTER[REG] = 1;
// 4932 GRINF(REG)=0
#line 4932 "test-new/imp918s.imp"
GRINF[REG] = 0;
// 4933 CLEAR LIST(SRD)
#line 4933 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &SRD);
// 4934 %END
#line 4934 "test-new/imp918s.imp"
return;
#line 4934 "test-new/imp918s.imp"
} /* end of DSEXP */
// 4935 %ROUTINE TORP(%SHORTINTEGERNAME HEAD,BOT,NOPS,%INTEGER MODE)
#line 4935 "test-new/imp918s.imp"
void TORP(short int *HEAD, short int *BOT, short int *NOPS, int MODE) {
// 4936 !***********************************************************************
// 4937 !* CONVERT THE SIGNED EXPRESSION INDEXED BY P INTO REVERSE *
// 4938 !* POLISH NOTATION. THE REVERSE POLISH LIST IS ADDED TO 'HEAD' *
// 4939 !* WHICH MAY CONTAIN ANOTHER EXPRESSION. THE NUMBER OF OPERATORS *
// 4940 !* IS ADDED TO NOPS. MODE SIGNIFIES :- *
// 4941 !* MODE=1 INTEGER EXPRESSION *
// 4942 !* MODE=2 SHORTREAL EXPRESSION *
// 4943 !* MODE=3 LONGREAL EXPRESSION *
// 4944 !* MODE=0 INTEGER IF POSIIBLE OTHERWISE REAL *
// 4945 !* N.B. AN INTEGER EXPRESSION IS A SPECIAL CASE OF A REAL EXPRSN *
// 4946 !***********************************************************************
// 4947 {%SHORTROUTINE}
// 4948 %SWITCH OPERAND(1:4)
#line 4948 "test-new/imp918s.imp"
int OPERAND_index;
#line 4948 "test-new/imp918s.imp"
int OPERAND_line;
#line 4948 "test-new/imp918s.imp"
char *OPERAND_file;
#line 4948 "test-new/imp918s.imp"
static const void *OPERAND[4] = {&&case_OPERAND_missing, &&case_OPERAND_missing, &&case_OPERAND_missing,
&&case_OPERAND_missing};
// 4949 %SHORTINTEGER ORHEAD,RPHEAD,PASSHEAD,SAVEHEAD,OPBOT, %C
#line 4949 "test-new/imp918s.imp"
short int ORHEAD;
#line 4949 "test-new/imp918s.imp"
short int RPHEAD;
#line 4949 "test-new/imp918s.imp"
short int PASSHEAD;
#line 4949 "test-new/imp918s.imp"
short int SAVEHEAD;
#line 4949 "test-new/imp918s.imp"
short int OPBOT;
#line 4949 "test-new/imp918s.imp"
short int RPBOT;
#line 4949 "test-new/imp918s.imp"
short int PASSBOT;
#line 4949 "test-new/imp918s.imp"
short int SAVEBOT;
// 4950+ RPBOT,PASSBOT,SAVEBOT
// 4951 %BYTEINTEGER REAL,LONGREAL,REALOP,COMPLEX
#line 4951 "test-new/imp918s.imp"
unsigned char REAL;
#line 4951 "test-new/imp918s.imp"
unsigned char LONGREAL;
#line 4951 "test-new/imp918s.imp"
unsigned char REALOP;
#line 4951 "test-new/imp918s.imp"
unsigned char COMPLEX;
// 4952 %INTEGER OPERATOR,LASTOP,OPPREC,OPND,C,D,E,RPTYPE,RPINF,RPXTRA
#line 4952 "test-new/imp918s.imp"
int OPERATOR;
#line 4952 "test-new/imp918s.imp"
int LASTOP;
#line 4952 "test-new/imp918s.imp"
int OPPREC;
#line 4952 "test-new/imp918s.imp"
int OPND;
#line 4952 "test-new/imp918s.imp"
int C;
#line 4952 "test-new/imp918s.imp"
int D;
#line 4952 "test-new/imp918s.imp"
int E;
#line 4952 "test-new/imp918s.imp"
int RPTYPE;
#line 4952 "test-new/imp918s.imp"
int RPINF;
#line 4952 "test-new/imp918s.imp"
int RPXTRA;
// 4953 %BYTEINTEGER ADDREXP
#line 4953 "test-new/imp918s.imp"
unsigned char ADDREXP;
// 4954 %INTEGER BDISP,OPSTK,OPPSTK,RPNAM
#line 4954 "test-new/imp918s.imp"
int BDISP;
#line 4954 "test-new/imp918s.imp"
int OPSTK;
#line 4954 "test-new/imp918s.imp"
int OPPSTK;
#line 4954 "test-new/imp918s.imp"
int RPNAM;
// 4955 %SHORTINTEGERNAME DUPHEAD,NEXTHEAD
#line 4955 "test-new/imp918s.imp"
short int *DUPHEAD;
#line 4955 "test-new/imp918s.imp"
short int *NEXTHEAD;
// 4956 !%if USE MC = 1 %start
// 4957 ! *XC_ORHEAD(76),ORHEAD
// 4958 !%finish
// 4959 LONGREAL=ALL LONG ; ! IN CASE INTEGER SUBXPRS
#line 4959 "test-new/imp918s.imp"
LONGREAL = ALLLONG;
// 4960 ADDREXP=MODE>>2&1
#line 4960 "test-new/imp918s.imp"
ADDREXP = (unsigned int)MODE >> 2 & 1;
// 4961 C=A(P)
#line 4961 "test-new/imp918s.imp"
C = A[P + 7];
// 4962 %IF 2<=C<=3 %THEN %START; ! INITIAL '-' OR '\'
#line 4962 "test-new/imp918s.imp"
{
// Double-sided test on C (Part I)
#line 4962 "test-new/imp918s.imp"
int tmp;
#line 4962 "test-new/imp918s.imp"
if (2 > (tmp = C)) goto L_0473;
// Double-sided test on C (Part II)
#line 4962 "test-new/imp918s.imp"
if (tmp > 3) goto L_0473;
#line 4962 "test-new/imp918s.imp"
}
// 4963 NOPS=NOPS+1
#line 4963 "test-new/imp918s.imp"
*NOPS = *NOPS + 1;
// 4964 OPSTK=13-C; ! '-' =(11,3) '\' =(10,5)
#line 4964 "test-new/imp918s.imp"
OPSTK = 13 - C;
// 4965 OPPSTK=C<<1-1
#line 4965 "test-new/imp918s.imp"
OPPSTK = (C << 1) - 1;
// 4966 %FINISH
#line 4966 "test-new/imp918s.imp"
L_0473:;
// 4967 Label1: OPND=A(P+1); P=P+2
#line 4967 "test-new/imp918s.imp"
U_103E:;
#line 4967 "test-new/imp918s.imp"
OPND = A[P + 1 + 7];
#line 4967 "test-new/imp918s.imp"
P = P + 2;
// 4968 COMPLEX=0
#line 4968 "test-new/imp918s.imp"
COMPLEX = 0;
// 4969 -> OPERAND(OPND); ! SWITCH ON OPERAND
#line 4969 "test-new/imp918s.imp"
OPERAND_line = __LINE__;
OPERAND_file = __FILE__;
OPERAND_index = OPND;
goto case_OPERAND_dispatch;
// 4970 OPERAND(1): ! NAME
#line 4970 "test-new/imp918s.imp"
case_OPERAND_1:;
// 4971 RPNAM=TAGS(A(P))
#line 4971 "test-new/imp918s.imp"
RPNAM = TAGS[A[P + 7]];
// 4972 %IF RPNAM=0 %THEN PTYPE=7 %ELSE %C
#line 4972 "test-new/imp918s.imp"
if (RPNAM != 0) goto L_0474;
#line 4972 "test-new/imp918s.imp"
PTYPE = 7;
#line 4972 "test-new/imp918s.imp"
goto L_0475;
#line 4972 "test-new/imp918s.imp"
L_0474:;
#line 4972 "test-new/imp918s.imp"
PTYPE = (unsigned int)*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[RPNAM])) >> 16;
#line 4972 "test-new/imp918s.imp"
L_0475:;
// 4973+ PTYPE=INTEGER(ADDR(ASLIST(RPNAM)))>>16
// 4974 !%if USE MC = 1 %start
// 4975 ! *L_1,PTYPE; *CVD_1,0(11); ! UNPACK
// 4976 ! *UNPK_ROUT(5),5(3,11)
// 4977 ! *NC_ROUT(5),MASK1
// 4978 !%finish
// 4979 %IF TYPE=8 %THEN COMPLEX=FROM3(RPNAM)>>16
#line 4979 "test-new/imp918s.imp"
if (TYPE != 8) goto L_0476;
#line 4979 "test-new/imp918s.imp"
COMPLEX = (unsigned int)FROM3(RPNAM) >> 16;
#line 4979 "test-new/imp918s.imp"
L_0476:;
// 4980 %IF PTYPE=SNPT %THEN %START
#line 4980 "test-new/imp918s.imp"
if (PTYPE != 10006) goto L_0477;
// 4981 K=FROM3(RPNAM)>>16
#line 4981 "test-new/imp918s.imp"
K = (unsigned int)FROM3(RPNAM) >> 16;
// 4982 %IF K=38 %AND A(P+1)=2 %THEN %START; ! PICK OFF NL
#line 4982 "test-new/imp918s.imp"
if (K != 38) goto L_0478;
#line 4982 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0478;
// 4983 RPTYPE=0; RPINF=10; PTYPE=1; P=P+1; ->SKNAM
#line 4983 "test-new/imp918s.imp"
RPTYPE = 0;
#line 4983 "test-new/imp918s.imp"
RPINF = 10;
#line 4983 "test-new/imp918s.imp"
PTYPE = 1;
#line 4983 "test-new/imp918s.imp"
P = P + 1;
#line 4983 "test-new/imp918s.imp"
goto U_103F;
// 4984 %FINISH
#line 4984 "test-new/imp918s.imp"
L_0478:;
// 4985 %IF K=52 %AND A(P+1)=2 %START;! PICK OFF PI
#line 4985 "test-new/imp918s.imp"
if (K != 52) goto L_0479;
#line 4985 "test-new/imp918s.imp"
if (A[P + 1 + 7] != 2) goto L_0479;
// 4986 RPTYPE=1; PTYPE=2; RPINF=-7
#line 4986 "test-new/imp918s.imp"
RPTYPE = 1;
#line 4986 "test-new/imp918s.imp"
PTYPE = 2;
#line 4986 "test-new/imp918s.imp"
RPINF = -7;
// 4987 P=P+1; REAL=1; ->SKNAM
#line 4987 "test-new/imp918s.imp"
P = P + 1;
#line 4987 "test-new/imp918s.imp"
REAL = 1;
#line 4987 "test-new/imp918s.imp"
goto U_103F;
// 4988 %FINISH
#line 4988 "test-new/imp918s.imp"
L_0479:;
// 4989 COMPLEX=1; ! FOR INTEGER(ADDR(A(I)))
#line 4989 "test-new/imp918s.imp"
COMPLEX = 1;
// 4990 PTYPE=TSNAME(K);! UNPACK
#line 4990 "test-new/imp918s.imp"
PTYPE = TSNAME[K];
// 4991 !%if USE MC = 1 %start
// 4992 ! *L_1,PTYPE; *CVD_1,0(11)
// 4993 ! *UNPK_ROUT(5),5(3,11)
// 4994 ! *NC_ROUT(5),MASK1
// 4995 !%finish
// 4996 %FINISH
#line 4996 "test-new/imp918s.imp"
L_0477:;
// 4997 %IF ROUT=1 %THEN COMPLEX=1
#line 4997 "test-new/imp918s.imp"
if (ROUT != 1) goto L_047A;
#line 4997 "test-new/imp918s.imp"
COMPLEX = 1;
#line 4997 "test-new/imp918s.imp"
L_047A:;
// 4998 %IF ARR>=1 %AND CHECKS=1 %THEN COMPLEX=1
#line 4998 "test-new/imp918s.imp"
if (ARR < 1) goto L_047B;
#line 4998 "test-new/imp918s.imp"
if (CHECKS != 1) goto L_047B;
#line 4998 "test-new/imp918s.imp"
COMPLEX = 1;
#line 4998 "test-new/imp918s.imp"
L_047B:;
// 4999 %IF TYPE=3 %THEN %START
#line 4999 "test-new/imp918s.imp"
if (TYPE != 3) goto L_047C;
// 5000 KFORM=FROM3(RPNAM)&X'FFFF'
#line 5000 "test-new/imp918s.imp"
KFORM = FROM3(RPNAM) & 65535;
// 5001 D=P; C=COPY RECORD TAG(E); P=D;
#line 5001 "test-new/imp918s.imp"
D = P;
#line 5001 "test-new/imp918s.imp"
C = COPYRECORDTAG(/*?*/ &E);
#line 5001 "test-new/imp918s.imp"
P = D;
// 5002 %IF (ARR>=1 %OR E>1) %AND CHECKS=1 %THEN COMPLEX=1
#line 5002 "test-new/imp918s.imp"
if (ARR >= 1) goto L_047D;
#line 5002 "test-new/imp918s.imp"
if (E <= 1) goto L_047E;
#line 5002 "test-new/imp918s.imp"
L_047D:;
#line 5002 "test-new/imp918s.imp"
if (CHECKS != 1) goto L_047E;
#line 5002 "test-new/imp918s.imp"
COMPLEX = 1;
#line 5002 "test-new/imp918s.imp"
L_047E:;
// 5003 %FINISH
#line 5003 "test-new/imp918s.imp"
L_047C:;
// 5004 %IF TYPE=5 %THEN FAULT(42,0)
#line 5004 "test-new/imp918s.imp"
if (TYPE != 5) goto L_047F;
#line 5004 "test-new/imp918s.imp"
FAULT(42, 0);
#line 5004 "test-new/imp918s.imp"
L_047F:;
// 5005 %IF TYPE=2 %THEN %START
#line 5005 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0480;
// 5006 REAL=1; LONGREAL=1 %IF PREC=3
#line 5006 "test-new/imp918s.imp"
REAL = 1;
#line 5006 "test-new/imp918s.imp"
if (PREC != 3) goto L_0481;
#line 5006 "test-new/imp918s.imp"
LONGREAL = 1;
#line 5006 "test-new/imp918s.imp"
L_0481:;
// 5007 %FINISH
#line 5007 "test-new/imp918s.imp"
L_0480:;
// 5008 RPTYPE=2; RPINF=P; PTYPE=1 %IF PTYPE=7
#line 5008 "test-new/imp918s.imp"
RPTYPE = 2;
#line 5008 "test-new/imp918s.imp"
RPINF = P;
#line 5008 "test-new/imp918s.imp"
if (PTYPE != 7) goto L_0482;
#line 5008 "test-new/imp918s.imp"
PTYPE = 1;
#line 5008 "test-new/imp918s.imp"
L_0482:;
// 5009 RPTYPE=0 %AND PTYPE=1 %IF TYPE=5; ! CHANGE TO SHORT CONST
#line 5009 "test-new/imp918s.imp"
if (TYPE != 5) goto L_0483;
#line 5009 "test-new/imp918s.imp"
RPTYPE = 0;
#line 5009 "test-new/imp918s.imp"
PTYPE = 1;
#line 5009 "test-new/imp918s.imp"
L_0483:;
// 5010 P=P+1
#line 5010 "test-new/imp918s.imp"
P = P + 1;
// 5011 SKNAM: FFLAG=0
#line 5011 "test-new/imp918s.imp"
U_103F:;
#line 5011 "test-new/imp918s.imp"
FFLAG = 0;
// 5012 %CYCLE
#line 5012 "test-new/imp918s.imp"
L_0484:;
// 5013 %IF A(P)=2 %THEN P=P+1 %ELSE SKIP APP
#line 5013 "test-new/imp918s.imp"
if (A[P + 7] != 2) goto L_0485;
#line 5013 "test-new/imp918s.imp"
P = P + 1;
#line 5013 "test-new/imp918s.imp"
goto L_0486;
#line 5013 "test-new/imp918s.imp"
L_0485:;
#line 5013 "test-new/imp918s.imp"
SKIPAPP();
#line 5013 "test-new/imp918s.imp"
L_0486:;
// 5014 C=A(P); P=P+2
#line 5014 "test-new/imp918s.imp"
C = A[P + 7];
#line 5014 "test-new/imp918s.imp"
P = P + 2;
// 5015 %REPEAT %UNTIL C=2
#line 5015 "test-new/imp918s.imp"
if (C == 2) goto L_0487;
#line 5015 "test-new/imp918s.imp"
goto L_0484;
#line 5015 "test-new/imp918s.imp"
L_0487:;
// 5016 %IF FFLAG#0 %THEN COMPLEX=1
#line 5016 "test-new/imp918s.imp"
if (FFLAG == 0) goto L_0488;
#line 5016 "test-new/imp918s.imp"
COMPLEX = 1;
#line 5016 "test-new/imp918s.imp"
L_0488:;
// 5017 INS: BINSERT(RPHEAD,RPBOT,PTYPE<<16!COMPLEX<<8!RPTYPE,RPINF,0)
#line 5017 "test-new/imp918s.imp"
U_1040:;
#line 5017 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, PTYPE << 16 | COMPLEX << 8 | RPTYPE, RPINF, 0);
// 5018 ->Label50 %UNLESS OPND=2
#line 5018 "test-new/imp918s.imp"
if (OPND == 2) goto L_0489;
#line 5018 "test-new/imp918s.imp"
goto U_1041;
#line 5018 "test-new/imp918s.imp"
L_0489:;
// 5019 %IF A(P-1)=2 %THEN P=P+1 %AND ->Label50
#line 5019 "test-new/imp918s.imp"
if (A[P - 1 + 7] != 2) goto L_048A;
#line 5019 "test-new/imp918s.imp"
P = P + 1;
#line 5019 "test-new/imp918s.imp"
goto U_1041;
#line 5019 "test-new/imp918s.imp"
L_048A:;
// 5020 WARN(LINE)
#line 5020 "test-new/imp918s.imp"
WARN(LINE);
// 5021 P=P-2; OPERATOR=6; ->Label49
#line 5021 "test-new/imp918s.imp"
P = P - 2;
#line 5021 "test-new/imp918s.imp"
OPERATOR = 6;
#line 5021 "test-new/imp918s.imp"
goto U_1042;
// 5022 OPERAND(2): ! CONSTANT
#line 5022 "test-new/imp918s.imp"
case_OPERAND_2:;
// 5023 C=A(P)&7; RPINF=P
#line 5023 "test-new/imp918s.imp"
C = A[P + 7] & 7;
#line 5023 "test-new/imp918s.imp"
RPINF = P;
// 5024 %IF C=2 %THEN %START; ! REAL CONSTANT
#line 5024 "test-new/imp918s.imp"
if (C != 2) goto L_048B;
// 5025 PTYPE=2; P=P+6
#line 5025 "test-new/imp918s.imp"
PTYPE = 2;
#line 5025 "test-new/imp918s.imp"
P = P + 6;
// 5026 REAL=1; RPTYPE=1
#line 5026 "test-new/imp918s.imp"
REAL = 1;
#line 5026 "test-new/imp918s.imp"
RPTYPE = 1;
// 5027 %FINISH %ELSE %START
#line 5027 "test-new/imp918s.imp"
goto L_048C;
#line 5027 "test-new/imp918s.imp"
L_048B:;
// 5028 %IF C=5 %THEN %START; ! STRING CONSTANT
#line 5028 "test-new/imp918s.imp"
if (C != 5) goto L_048D;
// 5029 FAULT(42,0); D=1
#line 5029 "test-new/imp918s.imp"
FAULT(42, 0);
#line 5029 "test-new/imp918s.imp"
D = 1;
// 5030 P=P+(A(P+1)-1)>>1
#line 5030 "test-new/imp918s.imp"
P = P + ((unsigned int)A[P + 1 + 7] - 1 >> 1);
// 5031 %FINISH %ELSE %START
#line 5031 "test-new/imp918s.imp"
goto L_048E;
#line 5031 "test-new/imp918s.imp"
L_048D:;
// 5032 !%if USE MC = 1 %start
// 5033 ! **1,P; *AR_1,1
// 5034 ! *LA_1,A+32(1); *MVC_D(4),0(1)
// 5035 !%finish
// 5036 %FINISH
#line 5036 "test-new/imp918s.imp"
L_048E:;
// 5037 %IF D>>12=0 %THEN RPTYPE=0 %AND RPINF=D %ELSE RPTYPE=1
#line 5037 "test-new/imp918s.imp"
if ((unsigned int)D >> 12 != 0) goto L_048F;
#line 5037 "test-new/imp918s.imp"
RPTYPE = 0;
#line 5037 "test-new/imp918s.imp"
RPINF = D;
#line 5037 "test-new/imp918s.imp"
goto L_0490;
#line 5037 "test-new/imp918s.imp"
L_048F:;
#line 5037 "test-new/imp918s.imp"
RPTYPE = 1;
#line 5037 "test-new/imp918s.imp"
L_0490:;
// 5038 P=P+4; PTYPE=1
#line 5038 "test-new/imp918s.imp"
P = P + 4;
#line 5038 "test-new/imp918s.imp"
PTYPE = 1;
// 5039 %FINISH; -> INS
#line 5039 "test-new/imp918s.imp"
L_048C:;
#line 5039 "test-new/imp918s.imp"
goto U_1040;
// 5040 OPERAND(4): ! MODULUS SIGNS
#line 5040 "test-new/imp918s.imp"
case_OPERAND_4:;
// 5041 WARN(LINE)
#line 5041 "test-new/imp918s.imp"
WARN(LINE);
// 5042 OPERAND(3): ! SUB EXPRESSION
#line 5042 "test-new/imp918s.imp"
case_OPERAND_3:;
// 5043 D=0; PASSHEAD=0; PASSBOT=0
#line 5043 "test-new/imp918s.imp"
D = 0;
#line 5043 "test-new/imp918s.imp"
PASSHEAD = 0;
#line 5043 "test-new/imp918s.imp"
PASSBOT = 0;
// 5044 D=1 %IF MODE&3=1 %OR LASTOP=12
#line 5044 "test-new/imp918s.imp"
if (MODE & 3 == 1) goto L_0463;
#line 5044 "test-new/imp918s.imp"
if (LASTOP != 12) goto L_0491;
#line 5044 "test-new/imp918s.imp"
L_0463:;
#line 5044 "test-new/imp918s.imp"
D = 1;
#line 5044 "test-new/imp918s.imp"
L_0491:;
// 5045 P=P+2
#line 5045 "test-new/imp918s.imp"
P = P + 2;
// 5046 TORP(PASSHEAD,PASSBOT,NOPS,D)
#line 5046 "test-new/imp918s.imp"
TORP(/*?*/ &PASSHEAD, /*?*/ &PASSBOT, NOPS, D);
// 5047 REAL=1 %IF TYPE=2
#line 5047 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0492;
#line 5047 "test-new/imp918s.imp"
REAL = 1;
#line 5047 "test-new/imp918s.imp"
L_0492:;
// 5048 LONGREAL=1 %IF PREC=3
#line 5048 "test-new/imp918s.imp"
if (PREC != 3) goto L_0493;
#line 5048 "test-new/imp918s.imp"
LONGREAL = 1;
#line 5048 "test-new/imp918s.imp"
L_0493:;
// 5049 BINSERT(RPHEAD,RPBOT,PTYPE<<16!3,PASSHEAD,PASSBOT)
#line 5049 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, PTYPE << 16 | 3, PASSHEAD, PASSBOT);
// 5050 %IF OPND=4 %THEN BINSERT(RPHEAD,RPBOT,13,0,0) %AND NOPS=NOPS+1
#line 5050 "test-new/imp918s.imp"
if (OPND != 4) goto L_0494;
#line 5050 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, 13, 0, 0);
#line 5050 "test-new/imp918s.imp"
*NOPS = *NOPS + 1;
#line 5050 "test-new/imp918s.imp"
L_0494:;
// 5051 P=P+1
#line 5051 "test-new/imp918s.imp"
P = P + 1;
// 5052 Label50: %COMMENT DEAL WITH OPERATOR
#line 5052 "test-new/imp918s.imp"
U_1041:;
// 5053 ->Label60 %IF A(P-1)=2; ! EXPR FINISHED
#line 5053 "test-new/imp918s.imp"
if (A[P - 1 + 7] != 2) goto L_0495;
#line 5053 "test-new/imp918s.imp"
goto U_1043;
#line 5053 "test-new/imp918s.imp"
L_0495:;
// 5054 OPERATOR=A(P)
#line 5054 "test-new/imp918s.imp"
OPERATOR = A[P + 7];
// 5055 !
// 5056 ! THE STRING OPERATOR '.' CAUSES CHAOS IN AN ARITHMETIC EXPRSN
// 5057 ! SO FAULT IT AND CHANGE IT TO THE INNOCUOUS '+'
// 5058 !
// 5059 %IF OPERATOR=12 %THEN FAULT(42,0) %AND OPERATOR=2
#line 5059 "test-new/imp918s.imp"
if (OPERATOR != 12) goto L_0496;
#line 5059 "test-new/imp918s.imp"
FAULT(42, 0);
#line 5059 "test-new/imp918s.imp"
OPERATOR = 2;
#line 5059 "test-new/imp918s.imp"
L_0496:;
// 5060 REALOP=1 %IF OPERATOR=1 %OR OPERATOR=8
#line 5060 "test-new/imp918s.imp"
if (OPERATOR == 1) goto L_0497;
#line 5060 "test-new/imp918s.imp"
if (OPERATOR != 8) goto L_0498;
#line 5060 "test-new/imp918s.imp"
L_0497:;
#line 5060 "test-new/imp918s.imp"
REALOP = 1;
#line 5060 "test-new/imp918s.imp"
L_0498:;
// 5061 OPERATOR=12 %IF OPERATOR=1
#line 5061 "test-new/imp918s.imp"
if (OPERATOR != 1) goto L_0499;
#line 5061 "test-new/imp918s.imp"
OPERATOR = 12;
#line 5061 "test-new/imp918s.imp"
L_0499:;
// 5062 Label49: LASTOP=OPERATOR
#line 5062 "test-new/imp918s.imp"
U_1042:;
#line 5062 "test-new/imp918s.imp"
LASTOP = OPERATOR;
// 5063 OPPREC=PRECEDENCE(OPERATOR)
#line 5063 "test-new/imp918s.imp"
OPPREC = PRECEDENCE[OPERATOR - 1];
// 5064 OPERATOR=OPERATOR+13
#line 5064 "test-new/imp918s.imp"
OPERATOR = OPERATOR + 13;
// 5065 NOPS=NOPS+1
#line 5065 "test-new/imp918s.imp"
*NOPS = *NOPS + 1;
// 5066 !
// 5067 ! UNLOAD THE OPERATOR STACK OF ALL OPERATORS WHOSE PRECEDENCE IS
// 5068 ! NOT LOWER THAN THE CURRENT OPERATOR. AN EMPTY STACK GIVES'-1'
// 5069 ! AS PRECEDENCE.
// 5070 !
// 5071 %WHILE OPPREC<=OPPSTK&31 %CYCLE
#line 5071 "test-new/imp918s.imp"
L_049A:;
#line 5071 "test-new/imp918s.imp"
if (OPPREC > OPPSTK & 31) goto L_049B;
// 5072 BINSERT(RPHEAD,RPBOT,OPSTK&31,0,0)
#line 5072 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, OPSTK & 31, 0, 0);
// 5073 OPSTK=OPSTK>>5; OPPSTK=OPPSTK>>5
#line 5073 "test-new/imp918s.imp"
OPSTK = (unsigned int)OPSTK >> 5;
#line 5073 "test-new/imp918s.imp"
OPPSTK = (unsigned int)OPPSTK >> 5;
// 5074 %REPEAT
#line 5074 "test-new/imp918s.imp"
goto L_049A;
#line 5074 "test-new/imp918s.imp"
L_049B:;
// 5075 !
// 5076 ! THE CURRENT OPERATOR CAN NOW BE STORED
// 5077 !
// 5078 OPSTK=OPSTK<<5!OPERATOR
#line 5078 "test-new/imp918s.imp"
OPSTK = OPSTK << 5 | OPERATOR;
// 5079 OPPSTK=OPPSTK<<5!OPPREC
#line 5079 "test-new/imp918s.imp"
OPPSTK = OPPSTK << 5 | OPPREC;
// 5080 ->Label1
#line 5080 "test-new/imp918s.imp"
goto U_103E;
// 5081 Label60: ! END OF EXPRESSION
#line 5081 "test-new/imp918s.imp"
U_1043:;
// 5082 %WHILE OPSTK#0 %CYCLE
#line 5082 "test-new/imp918s.imp"
L_049C:;
#line 5082 "test-new/imp918s.imp"
if (OPSTK == 0) goto L_049D;
// 5083 BINSERT(RPHEAD,RPBOT,OPSTK&31,0,0)
#line 5083 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, OPSTK & 31, 0, 0);
// 5084 OPSTK=OPSTK>>5
#line 5084 "test-new/imp918s.imp"
OPSTK = (unsigned int)OPSTK >> 5;
// 5085 %REPEAT
#line 5085 "test-new/imp918s.imp"
goto L_049C;
#line 5085 "test-new/imp918s.imp"
L_049D:;
// 5086 REAL=1 %IF MODE&3#1 %AND REALOP=1
#line 5086 "test-new/imp918s.imp"
if (MODE & 3 == 1) goto L_049E;
#line 5086 "test-new/imp918s.imp"
if (REALOP != 1) goto L_049E;
#line 5086 "test-new/imp918s.imp"
REAL = 1;
#line 5086 "test-new/imp918s.imp"
L_049E:;
// 5087 LONGREAL=1 %IF MODE=3
#line 5087 "test-new/imp918s.imp"
if (MODE != 3) goto L_049F;
#line 5087 "test-new/imp918s.imp"
LONGREAL = 1;
#line 5087 "test-new/imp918s.imp"
L_049F:;
// 5088 FAULT(24,0) %IF REAL=1 %AND MODE&3=1
#line 5088 "test-new/imp918s.imp"
if (REAL != 1) goto L_04A0;
#line 5088 "test-new/imp918s.imp"
if (MODE & 3 != 1) goto L_04A0;
#line 5088 "test-new/imp918s.imp"
FAULT(24, 0);
#line 5088 "test-new/imp918s.imp"
L_04A0:;
// 5089 !
// 5090 ! NOW THE TYPE OF THE EXPRESSION IS KNOWN WE CAN ADD FLOAT &STRETCH
// 5091 ! OPERATORS AS NECESSARY. ALSO TAKE THE OPPORTUNITY TO REMOVE
// 5092 ! CONSTANTS FROM ADDRESS EXPRESSIONS.
// 5093 !
// 5094 DUPHEAD==RPHEAD
#line 5094 "test-new/imp918s.imp"
DUPHEAD = (short int *)/*?*/ &RPHEAD;
// 5095 %WHILE DUPHEAD#0 %CYCLE
#line 5095 "test-new/imp918s.imp"
L_04A1:;
#line 5095 "test-new/imp918s.imp"
if (*DUPHEAD == 0) goto L_04A2;
// 5096 C=INTEGER(ADDR(ASLIST(DUPHEAD)))
#line 5096 "test-new/imp918s.imp"
C = *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[*DUPHEAD]));
// 5097 NEXTHEAD==SHORTINTEGER(ADDR(ASLIST(DUPHEAD))+14)
#line 5097 "test-new/imp918s.imp"
NEXTHEAD = (short int *)_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*DUPHEAD]) + 14);
// 5098 RPTYPE=C&255
#line 5098 "test-new/imp918s.imp"
RPTYPE = C & 255;
// 5099 %IF ADDREXP=1 %AND RPTYPE=0 %AND FROM2(DUPHEAD)+BDISP<256%C
#line 5099 "test-new/imp918s.imp"
if (ADDREXP != 1) goto L_04A3;
#line 5099 "test-new/imp918s.imp"
if (RPTYPE != 0) goto L_04A3;
#line 5099 "test-new/imp918s.imp"
if (FROM2(*DUPHEAD) + BDISP >= 256) goto L_04A3;
#line 5099 "test-new/imp918s.imp"
if (*NOPS == 0) goto L_04A4;
#line 5099 "test-new/imp918s.imp"
if (FROM1(*NEXTHEAD) & 255 != 15) goto L_04A3;
#line 5099 "test-new/imp918s.imp"
L_04A4:;
// 5100+ %AND (NOPS=0 %OR FROM1(NEXTHEAD)&255=15) %START;! CHECK FOR +CONST
// 5101 POP(DUPHEAD,D,RPINF)
#line 5101 "test-new/imp918s.imp"
POP(DUPHEAD, /*?*/ &D, /*?*/ &RPINF);
// 5102 BDISP=BDISP+RPINF
#line 5102 "test-new/imp918s.imp"
BDISP = BDISP + RPINF;
// 5103 %IF NOPS#0 %THEN POP(DUPHEAD,D,D) %AND NOPS=NOPS-1
#line 5103 "test-new/imp918s.imp"
if (*NOPS == 0) goto L_04A5;
#line 5103 "test-new/imp918s.imp"
POP(DUPHEAD, /*?*/ &D, /*?*/ &D);
#line 5103 "test-new/imp918s.imp"
*NOPS = *NOPS - 1;
#line 5103 "test-new/imp918s.imp"
L_04A5:;
// 5104 NEXTHEAD==DUPHEAD
#line 5104 "test-new/imp918s.imp"
NEXTHEAD = (short int *)DUPHEAD;
// 5105 %IF DUPHEAD=0 %START
#line 5105 "test-new/imp918s.imp"
if (*DUPHEAD != 0) goto L_04A6;
// 5106 RPBOT=RPHEAD
#line 5106 "test-new/imp918s.imp"
RPBOT = RPHEAD;
// 5107 %WHILE SHORTINTEGER(ADDR(ASLIST(RPBOT))+14)#0 %THENC
#line 5107 "test-new/imp918s.imp"
L_04A7:;
#line 5107 "test-new/imp918s.imp"
if (*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[RPBOT]) + 14) == 0) goto L_04A8;
#line 5107 "test-new/imp918s.imp"
RPBOT = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[RPBOT]) + 14);
#line 5107 "test-new/imp918s.imp"
goto L_04A7;
#line 5107 "test-new/imp918s.imp"
L_04A8:;
// 5108+ RPBOT=SHORTINTEGER(ADDR(ASLIST(RPBOT))+14)
// 5109 %FINISH
#line 5109 "test-new/imp918s.imp"
L_04A6:;
// 5110 %FINISH %ELSE %START
#line 5110 "test-new/imp918s.imp"
goto L_04A9;
#line 5110 "test-new/imp918s.imp"
L_04A3:;
// 5111 %IF RPTYPE=1 %AND C>>16=2 %AND LONGREAL=1 %THEN %C
#line 5111 "test-new/imp918s.imp"
if (RPTYPE != 1) goto L_04AA;
#line 5111 "test-new/imp918s.imp"
if ((unsigned int)C >> 16 != 2) goto L_04AA;
#line 5111 "test-new/imp918s.imp"
if (LONGREAL != 1) goto L_04AA;
#line 5111 "test-new/imp918s.imp"
C = 32 << 16 | 1;
#line 5111 "test-new/imp918s.imp"
REPLACE1(*DUPHEAD, C);
#line 5111 "test-new/imp918s.imp"
L_04AA:;
// 5112+ C=32<<16!1 %AND REPLACE1(DUPHEAD,C)
// 5113 %IF RPTYPE=3 %THEN %START
#line 5113 "test-new/imp918s.imp"
if (RPTYPE != 3) goto L_04AB;
// 5114 POP123(DUPHEAD,C,RPINF,RPXTRA);! CHUCK AWAY HEADCELL
#line 5114 "test-new/imp918s.imp"
POP123(DUPHEAD, /*?*/ &C, /*?*/ &RPINF, /*?*/ &RPXTRA);
// 5115 D=DUPHEAD; ! REPLACE BY SUBEXPRESSION
#line 5115 "test-new/imp918s.imp"
D = *DUPHEAD;
// 5116 DUPHEAD=RPINF
#line 5116 "test-new/imp918s.imp"
*DUPHEAD = RPINF;
// 5117 NEXTHEAD==SHORTINTEGER(ADDR(ASLIST(RPXTRA))+14)
#line 5117 "test-new/imp918s.imp"
NEXTHEAD = (short int *)_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[RPXTRA]) + 14);
// 5118 NEXTHEAD=D
#line 5118 "test-new/imp918s.imp"
*NEXTHEAD = D;
// 5119 %IF D=0 %THEN RPBOT=RPXTRA
#line 5119 "test-new/imp918s.imp"
if (D != 0) goto L_04AC;
#line 5119 "test-new/imp918s.imp"
RPBOT = RPXTRA;
#line 5119 "test-new/imp918s.imp"
L_04AC:;
// 5120 %FINISH
#line 5120 "test-new/imp918s.imp"
L_04AB:;
// 5121 %IF RPTYPE<10 %AND REAL#0 %THEN %START
#line 5121 "test-new/imp918s.imp"
if (RPTYPE >= 10) goto L_04AD;
#line 5121 "test-new/imp918s.imp"
if (REAL == 0) goto L_04AD;
// 5122 D=0; PTYPE=C>>16;! UNPACK
#line 5122 "test-new/imp918s.imp"
D = 0;
#line 5122 "test-new/imp918s.imp"
PTYPE = (unsigned int)C >> 16;
// 5123 !%if USE MC = 1 %start
// 5124 ! *L_1,PTYPE; *CVD_1,0(11)
// 5125 ! *UNPK_ROUT(5),5(3,11)
// 5126 ! *NC_ROUT(5),MASK1
// 5127 !%finish
// 5128 %IF (TYPE=1 %OR TYPE=8) %AND FROM1(NEXTHEAD)&255#25%C
#line 5128 "test-new/imp918s.imp"
if (TYPE == 1) goto L_04AE;
#line 5128 "test-new/imp918s.imp"
if (TYPE != 8) goto L_04AF;
#line 5128 "test-new/imp918s.imp"
L_04AE:;
#line 5128 "test-new/imp918s.imp"
if (FROM1(*NEXTHEAD) & 255 == 25) goto L_04AF;
#line 5128 "test-new/imp918s.imp"
D = 12;
#line 5128 "test-new/imp918s.imp"
L_04AF:;
// 5129+ %THEN D=12
// 5130 %IF TYPE=2 %AND PREC=0 %AND LONGREAL=1 %THEN D=14
#line 5130 "test-new/imp918s.imp"
if (TYPE != 2) goto L_04B0;
#line 5130 "test-new/imp918s.imp"
if (PREC != 0) goto L_04B0;
#line 5130 "test-new/imp918s.imp"
if (LONGREAL != 1) goto L_04B0;
#line 5130 "test-new/imp918s.imp"
D = 14;
#line 5130 "test-new/imp918s.imp"
L_04B0:;
// 5131 %IF D#0 %THEN %START; ! FLOAT OR STRETCH REQD
#line 5131 "test-new/imp918s.imp"
if (D == 0) goto L_04B1;
// 5132 NOPS=NOPS+1
#line 5132 "test-new/imp918s.imp"
*NOPS = *NOPS + 1;
// 5133 PUSH(NEXTHEAD,D,LONGREAL)
#line 5133 "test-new/imp918s.imp"
PUSH(NEXTHEAD, D, LONGREAL);
// 5134 NEXTHEAD==SHORTINTEGER(ADDR(ASLIST(NEXTHEAD))+14)
#line 5134 "test-new/imp918s.imp"
NEXTHEAD = (short int *)_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*NEXTHEAD]) + 14);
// 5135 %FINISH
#line 5135 "test-new/imp918s.imp"
L_04B1:;
// 5136 %FINISH
#line 5136 "test-new/imp918s.imp"
L_04AD:;
// 5137 %FINISH
#line 5137 "test-new/imp918s.imp"
L_04A9:;
// 5138 DUPHEAD==NEXTHEAD
#line 5138 "test-new/imp918s.imp"
DUPHEAD = (short int *)NEXTHEAD;
// 5139 %REPEAT
#line 5139 "test-new/imp918s.imp"
goto L_04A1;
#line 5139 "test-new/imp918s.imp"
L_04A2:;
// 5140 %IF MODE&3>=2 %AND REAL=0 %THEN %START
#line 5140 "test-new/imp918s.imp"
if (MODE & 3 < 2) goto L_04B2;
#line 5140 "test-new/imp918s.imp"
if (REAL != 0) goto L_04B2;
// 5141 REAL=1; NOPS=NOPS+1
#line 5141 "test-new/imp918s.imp"
REAL = 1;
#line 5141 "test-new/imp918s.imp"
*NOPS = *NOPS + 1;
// 5142 BINSERT(RPHEAD,RPBOT,12,LONGREAL,0);! FLT RESULT(IF REQD)
#line 5142 "test-new/imp918s.imp"
BINSERT(/*?*/ &RPHEAD, /*?*/ &RPBOT, 12, LONGREAL, 0);
// 5143 %FINISH
#line 5143 "test-new/imp918s.imp"
L_04B2:;
// 5144 PTYPE=1+REAL+30*LONGREAL
#line 5144 "test-new/imp918s.imp"
PTYPE = 1 + REAL + 30 * LONGREAL;
// 5145 %IF HEAD=0 %THEN BOT=RPBOT %ELSE %C
#line 5145 "test-new/imp918s.imp"
if (*HEAD != 0) goto L_04B3;
#line 5145 "test-new/imp918s.imp"
*BOT = RPBOT;
#line 5145 "test-new/imp918s.imp"
goto L_04B4;
#line 5145 "test-new/imp918s.imp"
L_04B3:;
#line 5145 "test-new/imp918s.imp"
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[RPBOT]) + 14) = *HEAD;
#line 5145 "test-new/imp918s.imp"
L_04B4:;
// 5146+ SHORTINTEGER(ADDR(ASLIST(RPBOT))+14)=HEAD
// 5147 HEAD=RPHEAD; ! HEAD BACK TO TOP OF LIST
#line 5147 "test-new/imp918s.imp"
*HEAD = RPHEAD;
// 5148 ! UNPACK
// 5149 !%if USE MC = 1 %start
// 5150 ! *L_1,PTYPE; *CVD_1,0(11)
// 5151 ! *UNPK_ROUT(5),5(3,11)
// 5152 ! *NC_ROUT(5),MASK1
// 5153 !%finish
// 5154 ADISP=BDISP
#line 5154 "test-new/imp918s.imp"
ADISP = BDISP;
// 5155 %END
#line 5155 "test-new/imp918s.imp"
return;
#line 5155 "test-new/imp918s.imp"
case_OPERAND_dispatch:
#line 5155 "test-new/imp918s.imp"
if (OPERAND_index < 1 || OPERAND_index > 4)
_imp_signalf(6, 3, OPERAND_index, "->OPERAND(%d) out of bounds at %s line %d", OPERAND_index, OPERAND_file,
OPERAND_line);
#line 5155 "test-new/imp918s.imp"
goto *OPERAND[OPERAND_index - 1];
#line 5155 "test-new/imp918s.imp"
case_OPERAND_missing:
_imp_signalf(8, 2, OPERAND_index, "switch jump to undefined label OPERAND(%d): at %s line %d", OPERAND_index,
OPERAND_file, OPERAND_line);
#line 5155 "test-new/imp918s.imp"
} /* end of TORP */
// ?SAVEBOT unused
// ?OPBOT unused
// ?SAVEHEAD unused
// ?ORHEAD unused
// 5156 %ROUTINE EXPOP(%INTEGER INHEAD,REG,NOPS,MODE)
#line 5156 "test-new/imp918s.imp"
void EXPOP(int INHEAD, int REG, int NOPS, int MODE) {
// 5157 %INTEGERARRAY OPERAND(1:2),STK(0:24)
#line 5157 "test-new/imp918s.imp"
int OPERAND[2];
#line 5157 "test-new/imp918s.imp"
int STK[25];
// 5158 %BYTEINTEGER ADDREXP,RDFORM
#line 5158 "test-new/imp918s.imp"
unsigned char ADDREXP;
#line 5158 "test-new/imp918s.imp"
unsigned char RDFORM;
// 5159 %RECORD(RD)%NAME OPND1,OPND2
#line 5159 "test-new/imp918s.imp"
struct RD *OPND1;
#line 5159 "test-new/imp918s.imp"
struct RD *OPND2;
// 5160 %INTEGER C,D,E,KK,JJ,OPCODE,COMM,XTRA,STPTR
#line 5160 "test-new/imp918s.imp"
int C;
#line 5160 "test-new/imp918s.imp"
int D;
#line 5160 "test-new/imp918s.imp"
int E;
#line 5160 "test-new/imp918s.imp"
int KK;
#line 5160 "test-new/imp918s.imp"
int JJ;
#line 5160 "test-new/imp918s.imp"
int OPCODE;
#line 5160 "test-new/imp918s.imp"
int COMM;
#line 5160 "test-new/imp918s.imp"
int XTRA;
#line 5160 "test-new/imp918s.imp"
int STPTR;
// 5161 %INTEGER NEWCC,PP,PT,JJJ
#line 5161 "test-new/imp918s.imp"
int NEWCC;
#line 5161 "test-new/imp918s.imp"
int PP;
#line 5161 "test-new/imp918s.imp"
int PT;
#line 5161 "test-new/imp918s.imp"
int JJJ;
// 5162 %INTEGER SPECREG; SPECREG=REG
#line 5162 "test-new/imp918s.imp"
int SPECREG;
#line 5162 "test-new/imp918s.imp"
SPECREG = REG;
#line 5162 "test-new/imp918s.imp"
auto void FLOAT(void);
#line 5162 "test-new/imp918s.imp"
auto void CTOP(int *FLAG);
#line 5162 "test-new/imp918s.imp"
auto void CHOOSE(int *CHOICE);
#line 5162 "test-new/imp918s.imp"
auto int FINDR(void);
#line 5162 "test-new/imp918s.imp"
auto void CLAIMPAIR(int *REG);
#line 5162 "test-new/imp918s.imp"
auto void PUT(void);
#line 5162 "test-new/imp918s.imp"
auto void STARSTAR(void);
#line 5162 "test-new/imp918s.imp"
auto void UNRESERVE(int XB);
#line 5162 "test-new/imp918s.imp"
auto void LOADPAIR(int ODDEVEN);
#line 5162 "test-new/imp918s.imp"
auto void LOAD(struct RD * OPND, int REG, int MODE);
// 5163 %ROUTINESPEC FLOAT
// 5164 %ROUTINESPEC CTOP(%INTEGERNAME A)
// 5165 %ROUTINESPEC CHOOSE(%INTEGERNAME I)
// 5166 %INTEGERFNSPEC FINDR
// 5167 %ROUTINESPEC CLAIM PAIR(%INTEGERNAME REG)
// 5168 %ROUTINESPEC PUT
// 5169 %ROUTINESPEC STARSTAR
// 5170 %ROUTINESPEC UNRESERVE(%INTEGER XB)
// 5171 %ROUTINESPEC LOAD PAIR(%INTEGER I)
// 5172 %ROUTINESPEC LOAD(%RECORD(RD)%NAME OP,%INTEGER REG,MODE)
// 5173 %CONSTSHORTINTEGERARRAY MCINST(10:31)=X'297',X'193',
#line 5173 "test-new/imp918s.imp"
const short int MCINST[22] = {663, 403, 128, 400, 129, 282, 411, 535, 534, 28, 157,
157, 532, 136, 137, 132, 25, 25, 156, 137, 144, 144};
// 5174+ X'80',X'190',X'81',X'11A',X'19B',X'217',
// 5175+ X'216',X'1C',X'9D',X'9D',X'214',X'88',X'89',
// 5176+ X'84',X'19',X'19',X'9C',X'89',X'90',X'90'
// 5177 %SHORTINTEGER TEMPHEAD
#line 5177 "test-new/imp918s.imp"
short int TEMPHEAD;
// 5178 %SWITCH SW(10:31)
#line 5178 "test-new/imp918s.imp"
int SW_index;
#line 5178 "test-new/imp918s.imp"
int SW_line;
#line 5178 "test-new/imp918s.imp"
char *SW_file;
#line 5178 "test-new/imp918s.imp"
static const void *SW[22] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing};
// 5179 %IF INHEAD=0 %THEN %START
#line 5179 "test-new/imp918s.imp"
if (INHEAD != 0) goto L_04B5;
// 5180 NEST=0; %RETURN
#line 5180 "test-new/imp918s.imp"
NEST = 0;
#line 5180 "test-new/imp918s.imp"
return;
// 5181 %FINISH
#line 5181 "test-new/imp918s.imp"
L_04B5:;
// 5182 RDFORM= MODE&16
#line 5182 "test-new/imp918s.imp"
RDFORM = MODE & 16;
// 5183 NEWCC=0; STPTR=0
#line 5183 "test-new/imp918s.imp"
NEWCC = 0;
#line 5183 "test-new/imp918s.imp"
STPTR = 0;
// 5184 ADDREXP=MODE>>2&1
#line 5184 "test-new/imp918s.imp"
ADDREXP = (unsigned int)MODE >> 2 & 1;
// 5185 Label1: C=INTEGER(ADDR(ASLIST(INHEAD)))
#line 5185 "test-new/imp918s.imp"
U_1041:;
#line 5185 "test-new/imp918s.imp"
C = *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[INHEAD]));
// 5186 JJ=C&255; D=INHEAD
#line 5186 "test-new/imp918s.imp"
JJ = C & 255;
#line 5186 "test-new/imp918s.imp"
D = INHEAD;
// 5187 INHEAD=SHORTINTEGER(ADDR(ASLIST(D))+14)
#line 5187 "test-new/imp918s.imp"
INHEAD = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[D]) + 14);
// 5188 %IF JJ>=10 %THEN XTRA=INTEGER(ADDR(ASLIST(D))+4) %AND %C
#line 5188 "test-new/imp918s.imp"
if (JJ < 10) goto L_04B6;
#line 5188 "test-new/imp918s.imp"
XTRA = *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[D]) + 4);
#line 5188 "test-new/imp918s.imp"
goto U_1042;
#line 5188 "test-new/imp918s.imp"
L_04B6:;
// 5189+ ->OPERATOR
// 5190 STK(STPTR)=D
#line 5190 "test-new/imp918s.imp"
STK[STPTR] = D;
// 5191 STPTR=STPTR+1
#line 5191 "test-new/imp918s.imp"
STPTR = STPTR + 1;
// 5192 Label2:
#line 5192 "test-new/imp918s.imp"
U_1043:;
// 5193 ->Label1 %UNLESS INHEAD=0 %OR MODE=100
#line 5193 "test-new/imp918s.imp"
if (INHEAD == 0) goto L_04B7;
#line 5193 "test-new/imp918s.imp"
if (MODE == 100) goto L_04B7;
#line 5193 "test-new/imp918s.imp"
goto U_1041;
#line 5193 "test-new/imp918s.imp"
L_04B7:;
// 5194 -> FINISH
#line 5194 "test-new/imp918s.imp"
goto U_1044;
// 5195 OPERATOR:
#line 5195 "test-new/imp918s.imp"
U_1042:;
// 5196 %IF JJ<15 %THEN KK=1 %ELSE KK=2; ! UNARY OR BINARY
#line 5196 "test-new/imp918s.imp"
if (JJ >= 15) goto L_04B8;
#line 5196 "test-new/imp918s.imp"
KK = 1;
#line 5196 "test-new/imp918s.imp"
goto L_04B9;
#line 5196 "test-new/imp918s.imp"
L_04B8:;
#line 5196 "test-new/imp918s.imp"
KK = 2;
#line 5196 "test-new/imp918s.imp"
L_04B9:;
// 5197 %CYCLE KK=KK,-1,1
#line 5197 "test-new/imp918s.imp"
// %for KK = KK, -1, 1 %cycle
#line 5197 "test-new/imp918s.imp"
{
int _control, _initial = KK, _increment = -1, _final = 1;
#line 5197 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle KK = KK, -1, 1");
_control = KK = _initial - _increment;
#line 5197 "test-new/imp918s.imp"
L_04BA:
#line 5197 "test-new/imp918s.imp"
if (KK != _control) _imp_signal(4, 2, 0, "Corrupt control variable KK");
#line 5197 "test-new/imp918s.imp"
if (KK == _final) goto L_04BB;
#line 5197 "test-new/imp918s.imp"
_control += _increment;
KK -= 1;
// 5198 STPTR=STPTR-1
#line 5198 "test-new/imp918s.imp"
STPTR = STPTR - 1;
// 5199 C=STK(STPTR)
#line 5199 "test-new/imp918s.imp"
C = STK[STPTR];
// 5200 OPERAND(KK)=C
#line 5200 "test-new/imp918s.imp"
OPERAND[KK - 1] = C;
// 5201 %REPEAT
#line 5201 "test-new/imp918s.imp"
goto L_04BA;
#line 5201 "test-new/imp918s.imp"
}
#line 5201 "test-new/imp918s.imp"
L_04BB:;
// 5202 ! PTYPE=FROM1(C)>>16
// 5203 ! UNPACK; ! SET PREC ETC.
// 5204 !%if USE MC = 1 %start
// 5205 ! *L_1,C; *A_1,ASLIST
// 5206 ! *LH_1,0(1)
// 5207 ! *ST_1,PTYPE; *CVD_1,0(11)
// 5208 ! *UNPK_ROUT(5),5(3,11)
// 5209 ! *NC_ROUT(5),MASK1
// 5210 !%finish
// 5211 OPCODE=MCINST(JJ)
#line 5211 "test-new/imp918s.imp"
OPCODE = MCINST[JJ - 10];
// 5212 COMM=OPCODE>>7&1; ! BIT SET IF OPERATOR UNCOMMUTVE
#line 5212 "test-new/imp918s.imp"
COMM = (unsigned int)OPCODE >> 7 & 1;
// 5213 NEWCC=OPCODE>>8; ! 0=CC UNKNOWN- 1= CC SRITHMETIC
#line 5213 "test-new/imp918s.imp"
NEWCC = (unsigned int)OPCODE >> 8;
// 5214 ! 2= CC LOGICAL AFTER OPERATION
// 5215 OPCODE=OPCODE&63; ! OPCODE FOR INTEGER RR INST
#line 5215 "test-new/imp918s.imp"
OPCODE = OPCODE & 63;
// 5216 %IF COMM=0 %THEN CHOOSE(COMM)
#line 5216 "test-new/imp918s.imp"
if (COMM != 0) goto L_04BD;
#line 5216 "test-new/imp918s.imp"
CHOOSE(/*?*/ &COMM);
#line 5216 "test-new/imp918s.imp"
L_04BD:;
// 5217 OPND1 == RECORD(ADDR(ASLIST(OPERAND(COMM))))
#line 5217 "test-new/imp918s.imp"
OPND1 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[OPERAND[COMM - 1]]));
// 5218 OPND2== OPND1
#line 5218 "test-new/imp918s.imp"
OPND2 = (struct RD *)OPND1;
// 5219 %IF JJ>=15 %THEN OPND2==RECORD(ADDR(ASLIST(OPERAND(3-COMM))))
#line 5219 "test-new/imp918s.imp"
if (JJ < 15) goto L_04BE;
#line 5219 "test-new/imp918s.imp"
OPND2 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[OPERAND[3 - COMM - 1]]));
#line 5219 "test-new/imp918s.imp"
L_04BE:;
// 5220 %IF OPND1_FLAG<2> OPND2_FLAG %THEN CTOP(JJ)
#line 5220 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 5220 "test-new/imp918s.imp"
int tmp;
#line 5220 "test-new/imp918s.imp"
if (OPND1->FLAG >= (tmp = 2)) goto L_04BF;
// Double-sided test on 2 (Part II)
#line 5220 "test-new/imp918s.imp"
if (tmp <= OPND2->FLAG) goto L_04BF;
#line 5220 "test-new/imp918s.imp"
}
#line 5220 "test-new/imp918s.imp"
CTOP(/*?*/ &JJ);
#line 5220 "test-new/imp918s.imp"
L_04BF:;
// 5221 ->Label101 %IF JJ=0; ! CTOP CARRIED OUT
#line 5221 "test-new/imp918s.imp"
if (JJ != 0) goto L_04C0;
#line 5221 "test-new/imp918s.imp"
goto U_1045;
#line 5221 "test-new/imp918s.imp"
L_04C0:;
// 5222 TYPE=1 %IF TYPE=8
#line 5222 "test-new/imp918s.imp"
if (TYPE != 8) goto L_04C1;
#line 5222 "test-new/imp918s.imp"
TYPE = 1;
#line 5222 "test-new/imp918s.imp"
L_04C1:;
// 5223 -> SW(JJ)
#line 5223 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = JJ;
goto case_SW_dispatch;
// 5224 SW(10): ! \
#line 5224 "test-new/imp918s.imp"
case_SW_10:;
// 5225 LOAD(OPND1,-1,2)
#line 5225 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5226 FAULT(24,0) %UNLESS TYPE=1
#line 5226 "test-new/imp918s.imp"
if (TYPE == 1) goto L_04C3;
#line 5226 "test-new/imp918s.imp"
FAULT(24, 0);
#line 5226 "test-new/imp918s.imp"
L_04C3:;
// 5227 PRX(X'57',OPND1_XB,0,GLA,16)
#line 5227 "test-new/imp918s.imp"
PRX(87, OPND1->XB, 0, 13, 16);
// 5228 Label100: SET USE((TYPE&2)<<3+OPND1_XB,1,ADDR(ASLIST(OPERAND(COMM))))
#line 5228 "test-new/imp918s.imp"
U_1046:;
#line 5228 "test-new/imp918s.imp"
SETUSE(((TYPE & 2) << 3) + OPND1->XB, 1, _imp_ADDR(/*?*/ &ASLIST[OPERAND[COMM - 1]]));
// 5229 Label101: STK(STPTR)=OPERAND(COMM)
#line 5229 "test-new/imp918s.imp"
U_1045:;
#line 5229 "test-new/imp918s.imp"
STK[STPTR] = OPERAND[COMM - 1];
// 5230 STPTR=STPTR+1
#line 5230 "test-new/imp918s.imp"
STPTR = STPTR + 1;
// 5231 %IF NEWCC#0 %THEN CCSTATE=NEWCC<<16!(TYPE&2)<<3!OPND1_XB
#line 5231 "test-new/imp918s.imp"
if (NEWCC == 0) goto L_04C4;
#line 5231 "test-new/imp918s.imp"
CCSTATE = NEWCC << 16 | (TYPE & 2) << 3 | OPND1->XB;
#line 5231 "test-new/imp918s.imp"
L_04C4:;
// 5232 ->Label2; ! SAVE CONDITION CODE STATE
#line 5232 "test-new/imp918s.imp"
goto U_1043;
// 5233 SW(11): SW(13): ! NEGATE: ABS
#line 5233 "test-new/imp918s.imp"
case_SW_11:;
#line 5233 "test-new/imp918s.imp"
case_SW_13:;
// 5234 LOAD(OPND1,-1,2)
#line 5234 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5235 TEMPHEAD=0
#line 5235 "test-new/imp918s.imp"
TEMPHEAD = 0;
// 5236 %IF NOPS=1 %AND REG>=0 %THEN %START
#line 5236 "test-new/imp918s.imp"
if (NOPS != 1) goto L_04C5;
#line 5236 "test-new/imp918s.imp"
if (REG < 0) goto L_04C5;
// 5237 PUSH(TEMPHEAD,INTEGER(ADDR(OPND1)),OPND1_D)
#line 5237 "test-new/imp918s.imp"
PUSH(/*?*/ &TEMPHEAD, *_imp_INTEGER(_imp_ADDR(OPND1)), OPND1->D);
// 5238 OPND2== RECORD(ADDR(ASLIST(TEMPHEAD)))
#line 5238 "test-new/imp918s.imp"
OPND2 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[TEMPHEAD]));
// 5239 OPND1_XB=REG
#line 5239 "test-new/imp918s.imp"
OPND1->XB = REG;
// 5240 %FINISH
#line 5240 "test-new/imp918s.imp"
L_04C5:;
// 5241 PUT
#line 5241 "test-new/imp918s.imp"
PUT();
// 5242 CLEAR LIST(TEMPHEAD) %IF TEMPHEAD#0
#line 5242 "test-new/imp918s.imp"
if (TEMPHEAD == 0) goto L_04C6;
#line 5242 "test-new/imp918s.imp"
CLEARLIST(/*?*/ &TEMPHEAD);
#line 5242 "test-new/imp918s.imp"
L_04C6:;
// 5243 ->Label101
#line 5243 "test-new/imp918s.imp"
goto U_1045;
// 5244 SW(12): ! FLOAT
#line 5244 "test-new/imp918s.imp"
case_SW_12:;
// 5245 LOAD(OPND1,-1,0); ! LEAVE IN CORE
#line 5245 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
// 5246 FLOAT
#line 5246 "test-new/imp918s.imp"
FLOAT();
// 5247 TYPE=2; OPND1_FLAG=9
#line 5247 "test-new/imp918s.imp"
TYPE = 2;
#line 5247 "test-new/imp918s.imp"
OPND1->FLAG = 9;
// 5248 OPND1_XB=D; OPND1_D=-2
#line 5248 "test-new/imp918s.imp"
OPND1->XB = D;
#line 5248 "test-new/imp918s.imp"
OPND1->D = -2;
// 5249 OPND1_PTYPE=30*XTRA+2; ->Label100
#line 5249 "test-new/imp918s.imp"
OPND1->PTYPE = 30 * XTRA + 2;
#line 5249 "test-new/imp918s.imp"
goto U_1046;
// 5250 SW(14): ! STRETCH
#line 5250 "test-new/imp918s.imp"
case_SW_14:;
// 5251 LOAD(OPND1,-1,1)
#line 5251 "test-new/imp918s.imp"
LOAD(OPND1, -1, 1);
// 5252 CLAIM (FR0,D); PRR(X'2B',D,D)
#line 5252 "test-new/imp918s.imp"
CLAIM(-125424, /*?*/ &D);
#line 5252 "test-new/imp918s.imp"
PRR(43, D, D);
// 5253 CCSTATE=-1
#line 5253 "test-new/imp918s.imp"
CCSTATE = -1;
// 5254 FORGET(D+16)
#line 5254 "test-new/imp918s.imp"
FORGET(D + 16);
// 5255 LOAD(OPND1,D,2)
#line 5255 "test-new/imp918s.imp"
LOAD(OPND1, D, 2);
// 5256 OPND1_PTYPE=32; ->Label100
#line 5256 "test-new/imp918s.imp"
OPND1->PTYPE = 32;
#line 5256 "test-new/imp918s.imp"
goto U_1046;
// 5257 SW(15): ! ADD
#line 5257 "test-new/imp918s.imp"
case_SW_15:;
// 5258 Label151: LOAD(OPND1,-1,0) %UNLESS OPND1_FLAG<=2 %C
#line 5258 "test-new/imp918s.imp"
U_1047:;
#line 5258 "test-new/imp918s.imp"
if (OPND1->FLAG > 2) goto L_04BC;
#line 5258 "test-new/imp918s.imp"
if (OPND1->XB != 0) goto L_04BC;
#line 5258 "test-new/imp918s.imp"
if (OPND1->PTYPE < 100) goto L_04C7;
#line 5258 "test-new/imp918s.imp"
L_04BC:;
#line 5258 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
#line 5258 "test-new/imp918s.imp"
L_04C7:;
// 5259+ %AND OPND1_XB=0 %AND OPND1_PTYPE<100
// 5260 LOAD(OPND2,-1,1)
#line 5260 "test-new/imp918s.imp"
LOAD(OPND2, -1, 1);
// 5261 LOAD(OPND1,-1,2)%UNLESS OPND1_FLAG=9 %AND OPND1_D<0;! IN CASE RT CALL
#line 5261 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_04C8;
#line 5261 "test-new/imp918s.imp"
if (OPND1->D < 0) goto L_04C9;
#line 5261 "test-new/imp918s.imp"
L_04C8:;
#line 5261 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
#line 5261 "test-new/imp918s.imp"
L_04C9:;
// 5262 PUT; ->Label101
#line 5262 "test-new/imp918s.imp"
PUT();
#line 5262 "test-new/imp918s.imp"
goto U_1045;
// 5263 SW(16): ! SUBTRACT
#line 5263 "test-new/imp918s.imp"
case_SW_16:;
// 5264 ->Label151%UNLESS(TYPE=1 %OR TYPE=8)%AND OPND2_FLAG=0 %AND OPND2_D=1
#line 5264 "test-new/imp918s.imp"
if (TYPE == 1) goto L_04CA;
#line 5264 "test-new/imp918s.imp"
if (TYPE != 8) goto L_04CB;
#line 5264 "test-new/imp918s.imp"
L_04CA:;
#line 5264 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_04CB;
#line 5264 "test-new/imp918s.imp"
if (OPND2->D == 1) goto L_04CC;
#line 5264 "test-new/imp918s.imp"
L_04CB:;
#line 5264 "test-new/imp918s.imp"
goto U_1047;
#line 5264 "test-new/imp918s.imp"
L_04CC:;
// 5265 LOAD(OPND1,-1,2)
#line 5265 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5266 PRR(6,OPND1_XB,0); ! BCTR
#line 5266 "test-new/imp918s.imp"
PRR(6, OPND1->XB, 0);
// 5267 NEWCC=0; ->Label100; ! BCTR DOES NOT SET CC
#line 5267 "test-new/imp918s.imp"
NEWCC = 0;
#line 5267 "test-new/imp918s.imp"
goto U_1046;
// 5268 SW(17): ! EXCLUSIVE OR
#line 5268 "test-new/imp918s.imp"
case_SW_17:;
// 5269 SW(18): ! OR
#line 5269 "test-new/imp918s.imp"
case_SW_18:;
// 5270 SW(22): ! AND
#line 5270 "test-new/imp918s.imp"
case_SW_22:;
// 5271 ->Label151 %IF TYPE=1
#line 5271 "test-new/imp918s.imp"
if (TYPE != 1) goto L_04CD;
#line 5271 "test-new/imp918s.imp"
goto U_1047;
#line 5271 "test-new/imp918s.imp"
L_04CD:;
// 5272 F24: FAULT(24,0)
#line 5272 "test-new/imp918s.imp"
U_1048:;
#line 5272 "test-new/imp918s.imp"
FAULT(24, 0);
// 5273 JJ=15; OPCODE=X'1A'; ->Label151; ! CHANGE OPN TO +
#line 5273 "test-new/imp918s.imp"
JJ = 15;
#line 5273 "test-new/imp918s.imp"
OPCODE = 26;
#line 5273 "test-new/imp918s.imp"
goto U_1047;
// 5274 SW(23): ! SRL
#line 5274 "test-new/imp918s.imp"
case_SW_23:;
// 5275 SW(24): ! SLL
#line 5275 "test-new/imp918s.imp"
case_SW_24:;
// 5276 ->F24 %UNLESS TYPE=1
#line 5276 "test-new/imp918s.imp"
if (TYPE == 1) goto L_04CE;
#line 5276 "test-new/imp918s.imp"
goto U_1048;
#line 5276 "test-new/imp918s.imp"
L_04CE:;
// 5277 D=0; D=1 %IF OPND2_FLAG=0
#line 5277 "test-new/imp918s.imp"
D = 0;
#line 5277 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_04CF;
#line 5277 "test-new/imp918s.imp"
D = 1;
#line 5277 "test-new/imp918s.imp"
L_04CF:;
// 5278 LOAD(OPND1,-1,D<<1); ! MUST LOAD %IF CONST
#line 5278 "test-new/imp918s.imp"
LOAD(OPND1, -1, D << 1);
// 5279 %IF D=0 %THEN %START
#line 5279 "test-new/imp918s.imp"
if (D != 0) goto L_04D0;
// 5280 ! DIFFICULT AS MAY SHIFT BY A FN AND CANNOT SHIFT BY GR0
// 5281 LOAD(OPND2,-2,0) ;! INSPECT SHIFTER
#line 5281 "test-new/imp918s.imp"
LOAD(OPND2, -2, 0);
// 5282 LOAD(OPND1,-1,2); ! LOAD UP SHIFTED TO ANY REGISTER
#line 5282 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5283 LOAD(OPND2,-2,1)
#line 5283 "test-new/imp918s.imp"
LOAD(OPND2, -2, 1);
// 5284 %UNLESS OPND2_FLAG=9 %AND OPND2_D<0 %AND OPND2_XB>0 %THENSTART
#line 5284 "test-new/imp918s.imp"
if (OPND2->FLAG != 9) goto L_04D1;
#line 5284 "test-new/imp918s.imp"
if (OPND2->D >= 0) goto L_04D1;
#line 5284 "test-new/imp918s.imp"
if (OPND2->XB > 0) goto L_04D2;
#line 5284 "test-new/imp918s.imp"
L_04D1:;
// 5285 FIND REG(GR1,C); ! REG TO SHIFT BY (NOT GR0 !)
#line 5285 "test-new/imp918s.imp"
FINDREG(65807, /*?*/ &C);
// 5286 LOAD(OPND2,C,2); %FINISH; ! LOAD SHIFTER ( OR MOVE OUT OF GR0)
#line 5286 "test-new/imp918s.imp"
LOAD(OPND2, C, 2);
#line 5286 "test-new/imp918s.imp"
L_04D2:;
// 5287 %FINISH; ! CA NOW PLANT THE OPERATION
#line 5287 "test-new/imp918s.imp"
L_04D0:;
// 5288 PRX(X'80'+OPCODE,OPND1_XB,0,OPND2_XB,D*OPND2_D)
#line 5288 "test-new/imp918s.imp"
PRX(128 + OPCODE, OPND1->XB, 0, OPND2->XB, D * OPND2->D);
// 5289 REGISTER(OPND2_XB)=0 %IF D=0 %AND REGISTER(OPND2_XB)>=0
#line 5289 "test-new/imp918s.imp"
if (D != 0) goto L_04D3;
#line 5289 "test-new/imp918s.imp"
if (REGISTER[OPND2->XB] < 0) goto L_04D3;
#line 5289 "test-new/imp918s.imp"
REGISTER[OPND2->XB] = 0;
#line 5289 "test-new/imp918s.imp"
L_04D3:;
// 5290 ->Label100
#line 5290 "test-new/imp918s.imp"
goto U_1046;
// 5291 SW(19): ! MULT
#line 5291 "test-new/imp918s.imp"
case_SW_19:;
// 5292 ->Label151 %IF TYPE=2
#line 5292 "test-new/imp918s.imp"
if (TYPE != 2) goto L_04D4;
#line 5292 "test-new/imp918s.imp"
goto U_1047;
#line 5292 "test-new/imp918s.imp"
L_04D4:;
// 5293 LOAD PAIR(1); ! 1ST OPERAND TO ODD MEMBER
#line 5293 "test-new/imp918s.imp"
LOADPAIR(1);
// 5294 ! 2ND OPERAND TESTED ALSO
// 5295 PUT
#line 5295 "test-new/imp918s.imp"
PUT();
// 5296 D=OPND1_XB+CHECKSP
#line 5296 "test-new/imp918s.imp"
D = OPND1->XB + CHECKSP;
// 5297 REGISTER(D)=0; FORGET(D)
#line 5297 "test-new/imp918s.imp"
REGISTER[D] = 0;
#line 5297 "test-new/imp918s.imp"
FORGET(D);
// 5298 %IF CHECKSP#0 %THEN %START
#line 5298 "test-new/imp918s.imp"
if (CHECKSP == 0) goto L_04D5;
// 5299 PRX(X'8F',OPND1_XB,0,0,32)
#line 5299 "test-new/imp918s.imp"
PRX(143, OPND1->XB, 0, 0, 32);
// 5300 %FINISH %ELSE OPND1_XB=OPND1_XB+1
#line 5300 "test-new/imp918s.imp"
goto L_04D6;
#line 5300 "test-new/imp918s.imp"
L_04D5:;
#line 5300 "test-new/imp918s.imp"
OPND1->XB = OPND1->XB + 1;
#line 5300 "test-new/imp918s.imp"
L_04D6:;
// 5301 ->Label100
#line 5301 "test-new/imp918s.imp"
goto U_1046;
// 5302 SW(20): ! INTEGER DIVISION
#line 5302 "test-new/imp918s.imp"
case_SW_20:;
// 5303 ->F24 %UNLESS TYPE=1
#line 5303 "test-new/imp918s.imp"
if (TYPE == 1) goto L_04D7;
#line 5303 "test-new/imp918s.imp"
goto U_1048;
#line 5303 "test-new/imp918s.imp"
L_04D7:;
// 5304 ->Label211
#line 5304 "test-new/imp918s.imp"
goto U_1049;
// 5305 SW(21): ! NORMAL DIVISION
#line 5305 "test-new/imp918s.imp"
case_SW_21:;
// 5306 ->Label151 %IF TYPE=2
#line 5306 "test-new/imp918s.imp"
if (TYPE != 2) goto L_04D8;
#line 5306 "test-new/imp918s.imp"
goto U_1047;
#line 5306 "test-new/imp918s.imp"
L_04D8:;
// 5307 WARN(LINE)
#line 5307 "test-new/imp918s.imp"
WARN(LINE);
// 5308 Label211: LOAD PAIR(0); ! 1ST OPERAND TO EVEN REG
#line 5308 "test-new/imp918s.imp"
U_1049:;
#line 5308 "test-new/imp918s.imp"
LOADPAIR(0);
// 5309 PRX(X'8E',OPND1_XB,0,0,32); ! SRDA
#line 5309 "test-new/imp918s.imp"
PRX(142, OPND1->XB, 0, 0, 32);
// 5310 CCSTATE=-1
#line 5310 "test-new/imp918s.imp"
CCSTATE = -1;
// 5311 PUT; D=OPND1_XB
#line 5311 "test-new/imp918s.imp"
PUT();
#line 5311 "test-new/imp918s.imp"
D = OPND1->XB;
// 5312 %IF CHECKSP=1 %AND JJ=21 %THEN %START
#line 5312 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_04D9;
#line 5312 "test-new/imp918s.imp"
if (JJ != 21) goto L_04D9;
// 5313 PRR(X'12',D,D)
#line 5313 "test-new/imp918s.imp"
PRR(18, D, D);
// 5314 PCONST(X'4770C040'); %FINISH
#line 5314 "test-new/imp918s.imp"
PCONST(1198571584);
#line 5314 "test-new/imp918s.imp"
L_04D9:;
// 5315 REGISTER(D)=0; FORGET(D)
#line 5315 "test-new/imp918s.imp"
REGISTER[D] = 0;
#line 5315 "test-new/imp918s.imp"
FORGET(D);
// 5316 OPND1_XB=D+1; ->Label100
#line 5316 "test-new/imp918s.imp"
OPND1->XB = D + 1;
#line 5316 "test-new/imp918s.imp"
goto U_1046;
// 5317 SW(25): ! EXP
#line 5317 "test-new/imp918s.imp"
case_SW_25:;
// 5318 STARSTAR; ->Label100
#line 5318 "test-new/imp918s.imp"
STARSTAR();
#line 5318 "test-new/imp918s.imp"
goto U_1046;
// 5319 SW(26): ! COMPARISONS
#line 5319 "test-new/imp918s.imp"
case_SW_26:;
// 5320 SW(27): ! LOGICAL COMPARISONS (IE=&7=)
#line 5320 "test-new/imp918s.imp"
case_SW_27:;
// 5321 PTYPE=OPND1_PTYPE;! UNPACK
#line 5321 "test-new/imp918s.imp"
PTYPE = OPND1->PTYPE;
// 5322 !%if USE MC = 1 %start
// 5323 ! *L_1,PTYPE; *CVD_1,0(11)
// 5324 ! *UNPK_ROUT(5),5(3,11)
// 5325 ! *NC_ROUT(5),MASK1
// 5326 !%finish
// 5327 -> BC %IF PREC=1 %AND OPND2_FLAG=0
#line 5327 "test-new/imp918s.imp"
if (PREC != 1) goto L_04DA;
#line 5327 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_04DA;
#line 5327 "test-new/imp918s.imp"
goto U_104A;
#line 5327 "test-new/imp918s.imp"
L_04DA:;
// 5328 LOAD(OPND1,-1,0) %UNLESS OPND1_FLAG<=2 %AND ARR=0=OPND1_XB
#line 5328 "test-new/imp918s.imp"
if (OPND1->FLAG > 2) goto L_04DB;
#line 5328 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 5328 "test-new/imp918s.imp"
int tmp;
#line 5328 "test-new/imp918s.imp"
if (ARR != (tmp = 0)) goto L_04DB;
// Double-sided test on 0 (Part II)
#line 5328 "test-new/imp918s.imp"
if (tmp == OPND1->XB) goto L_04DC;
#line 5328 "test-new/imp918s.imp"
}
#line 5328 "test-new/imp918s.imp"
L_04DB:;
#line 5328 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
#line 5328 "test-new/imp918s.imp"
L_04DC:;
// 5329 CNORM:
#line 5329 "test-new/imp918s.imp"
U_104B:;
// 5330 ->Z1 %IF OPND1_FLAG=0=OPND1_D %ORC
#line 5330 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 5330 "test-new/imp918s.imp"
int tmp;
#line 5330 "test-new/imp918s.imp"
if (OPND1->FLAG != (tmp = 0)) goto L_04DD;
// Double-sided test on 0 (Part II)
#line 5330 "test-new/imp918s.imp"
if (tmp == OPND1->D) goto L_04DE;
#line 5330 "test-new/imp918s.imp"
}
#line 5330 "test-new/imp918s.imp"
L_04DD:;
#line 5330 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_04DF;
#line 5330 "test-new/imp918s.imp"
if (OPND1->XB != 12) goto L_04DF;
#line 5330 "test-new/imp918s.imp"
if (OPND1->D != 192) goto L_04DF;
#line 5330 "test-new/imp918s.imp"
L_04DE:;
#line 5330 "test-new/imp918s.imp"
goto U_104C;
#line 5330 "test-new/imp918s.imp"
L_04DF:;
// 5331+ (OPND1_FLAG=9 %AND OPND1_XB=CODER %AND OPND1_D=X'C0')
// 5332 -> Z2 %IF OPND2_FLAG=0=OPND2_D %ORC
#line 5332 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 5332 "test-new/imp918s.imp"
int tmp;
#line 5332 "test-new/imp918s.imp"
if (OPND2->FLAG != (tmp = 0)) goto L_04E0;
// Double-sided test on 0 (Part II)
#line 5332 "test-new/imp918s.imp"
if (tmp == OPND2->D) goto L_04E1;
#line 5332 "test-new/imp918s.imp"
}
#line 5332 "test-new/imp918s.imp"
L_04E0:;
#line 5332 "test-new/imp918s.imp"
if (OPND2->FLAG != 9) goto L_04E2;
#line 5332 "test-new/imp918s.imp"
if (OPND2->XB != 12) goto L_04E2;
#line 5332 "test-new/imp918s.imp"
if (OPND2->D != 192) goto L_04E2;
#line 5332 "test-new/imp918s.imp"
L_04E1:;
#line 5332 "test-new/imp918s.imp"
goto U_104D;
#line 5332 "test-new/imp918s.imp"
L_04E2:;
// 5333+ (OPND2_FLAG=9 %AND OPND2_XB=CODER %AND OPND2_D=X'C0')
// 5334 -> RX %UNLESS JJ=27 %OR PREC=1
#line 5334 "test-new/imp918s.imp"
if (JJ == 27) goto L_04E3;
#line 5334 "test-new/imp918s.imp"
if (PREC == 1) goto L_04E3;
#line 5334 "test-new/imp918s.imp"
goto U_104E;
#line 5334 "test-new/imp918s.imp"
L_04E3:;
// 5335 LOAD(OPND2,-1,3) %IF OPND2_FLAG<7;! IN CASE BOTH OPERANDS ARE FNS
#line 5335 "test-new/imp918s.imp"
if (OPND2->FLAG >= 7) goto L_04E4;
#line 5335 "test-new/imp918s.imp"
LOAD(OPND2, -1, 3);
#line 5335 "test-new/imp918s.imp"
L_04E4:;
// 5336 LOAD(OPND1,-1,3) %IF OPND1_FLAG<7
#line 5336 "test-new/imp918s.imp"
if (OPND1->FLAG >= 7) goto L_04E5;
#line 5336 "test-new/imp918s.imp"
LOAD(OPND1, -1, 3);
#line 5336 "test-new/imp918s.imp"
L_04E5:;
// 5337 -> RX %UNLESS OPND1_PTYPE=OPND2_PTYPE %AND 0<=OPND1_D<=4095 %C
#line 5337 "test-new/imp918s.imp"
if (OPND1->PTYPE != OPND2->PTYPE) goto L_04E6;
#line 5337 "test-new/imp918s.imp"
{
// Double-sided test on OPND1->D (Part I)
#line 5337 "test-new/imp918s.imp"
int tmp;
#line 5337 "test-new/imp918s.imp"
if (0 > (tmp = OPND1->D)) goto L_04E6;
// Double-sided test on OPND1->D (Part II)
#line 5337 "test-new/imp918s.imp"
if (tmp > 4095) goto L_04E6;
#line 5337 "test-new/imp918s.imp"
}
#line 5337 "test-new/imp918s.imp"
{
// Double-sided test on OPND2->D (Part I)
#line 5337 "test-new/imp918s.imp"
int tmp;
#line 5337 "test-new/imp918s.imp"
if (0 > (tmp = OPND2->D)) goto L_04E6;
// Double-sided test on OPND2->D (Part II)
#line 5337 "test-new/imp918s.imp"
if (tmp > 4095) goto L_04E6;
#line 5337 "test-new/imp918s.imp"
}
#line 5337 "test-new/imp918s.imp"
{
// Double-sided test on 16 (Part I)
#line 5337 "test-new/imp918s.imp"
int tmp;
#line 5337 "test-new/imp918s.imp"
if (OPND1->XB >= (tmp = 16)) goto L_04E6;
// Double-sided test on 16 (Part II)
#line 5337 "test-new/imp918s.imp"
if (tmp > OPND2->XB) goto L_04E7;
#line 5337 "test-new/imp918s.imp"
}
#line 5337 "test-new/imp918s.imp"
L_04E6:;
#line 5337 "test-new/imp918s.imp"
goto U_104E;
#line 5337 "test-new/imp918s.imp"
L_04E7:;
// 5338+ %AND 0<=OPND2_D<=4095 %AND OPND1_XB<16>OPND2_XB
// 5339 CCSTATE=-1
#line 5339 "test-new/imp918s.imp"
CCSTATE = -1;
// 5340 PSS(X'D5',BYTES(PREC),OPND1_XB,OPND1_D,OPND2_XB,OPND2_D)
#line 5340 "test-new/imp918s.imp"
PSS(213, BYTES[PREC], OPND1->XB, OPND1->D, OPND2->XB, OPND2->D);
// 5341 UNRESERVE(OPND2_XB)
#line 5341 "test-new/imp918s.imp"
UNRESERVE(OPND2->XB);
// 5342 Z5: UNRESERVE(OPND1_XB); ->Z4
#line 5342 "test-new/imp918s.imp"
U_104F:;
#line 5342 "test-new/imp918s.imp"
UNRESERVE(OPND1->XB);
#line 5342 "test-new/imp918s.imp"
goto U_1050;
// 5343 RX: LOAD(OPND2,-1,1)
#line 5343 "test-new/imp918s.imp"
U_104E:;
#line 5343 "test-new/imp918s.imp"
LOAD(OPND2, -1, 1);
// 5344 LOAD(OPND1,-1,2)
#line 5344 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5345 CCSTATE=-1
#line 5345 "test-new/imp918s.imp"
CCSTATE = -1;
// 5346 PUT
#line 5346 "test-new/imp918s.imp"
PUT();
// 5347 Z4:
#line 5347 "test-new/imp918s.imp"
U_1050:;
// 5348 BFFLAG=COMM-1; ! NOTE BACKWARDS OR FORWARDS
#line 5348 "test-new/imp918s.imp"
BFFLAG = COMM - 1;
// 5349 COMM=2; ->Label101; ! 2ND OPERAND MAY BE NEEDED IN
#line 5349 "test-new/imp918s.imp"
COMM = 2;
#line 5349 "test-new/imp918s.imp"
goto U_1045;
// 5350 ! DOUBLE SIDED AND IS THEREFORE
// 5351 ! TAKEN AS THE 'RESULT'
// 5352 Z1: COMM=3-COMM; ! SWITCH AROUND OPERANDS
#line 5352 "test-new/imp918s.imp"
U_104C:;
#line 5352 "test-new/imp918s.imp"
COMM = 3 - COMM;
// 5353 OPND1==OPND2
#line 5353 "test-new/imp918s.imp"
OPND1 = (struct RD *)OPND2;
// 5354 OPND2==RECORD(ADDR(ASLIST(OPERAND(3-COMM))))
#line 5354 "test-new/imp918s.imp"
OPND2 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[OPERAND[3 - COMM - 1]]));
// 5355 Z2:
#line 5355 "test-new/imp918s.imp"
U_104D:;
// 5356 LOAD(OPND1,-1,2)
#line 5356 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5357 D=FROM1(OPERAND(COMM))>>8&15
#line 5357 "test-new/imp918s.imp"
D = (unsigned int)FROM1(OPERAND[COMM - 1]) >> 8 & 15;
// 5358 C=(TYPE&2)<<3+D
#line 5358 "test-new/imp918s.imp"
C = ((TYPE & 2) << 3) + D;
// 5359 REGISTER(C)=0 %IF REGISTER(C)>0
#line 5359 "test-new/imp918s.imp"
if (REGISTER[C] <= 0) goto L_04E8;
#line 5359 "test-new/imp918s.imp"
REGISTER[C] = 0;
#line 5359 "test-new/imp918s.imp"
L_04E8:;
// 5360 -> Z4 %IF 1<<16!C=CCSTATE; ! CONDITION CODE ALREADY SET
#line 5360 "test-new/imp918s.imp"
if (1 << 16 | C != CCSTATE) goto L_04E9;
#line 5360 "test-new/imp918s.imp"
goto U_1050;
#line 5360 "test-new/imp918s.imp"
L_04E9:;
// 5361 ->Z4 %IF JJ=27 %AND 2<<16!C=CCSTATE;! CC WILL DO
#line 5361 "test-new/imp918s.imp"
if (JJ != 27) goto L_04EA;
#line 5361 "test-new/imp918s.imp"
if (2 << 16 | C != CCSTATE) goto L_04EA;
#line 5361 "test-new/imp918s.imp"
goto U_1050;
#line 5361 "test-new/imp918s.imp"
L_04EA:;
// 5362 PRR((TYPE-1)*(2-PREC>>1)*16+X'12',D,D)
#line 5362 "test-new/imp918s.imp"
PRR((TYPE - 1) * (2 - ((unsigned int)PREC >> 1)) * 16 + 18, D, D);
// 5363 CCSTATE=1<<16!C; ->Z4
#line 5363 "test-new/imp918s.imp"
CCSTATE = 1 << 16 | C;
#line 5363 "test-new/imp918s.imp"
goto U_1050;
// 5364 BC: ! BYTE/CONSTANT COMPARISONS
#line 5364 "test-new/imp918s.imp"
U_104A:;
// 5365 LOAD(OPND1,-1,3)
#line 5365 "test-new/imp918s.imp"
LOAD(OPND1, -1, 3);
// 5366 -> CNORM %UNLESS OPND1_PTYPE=11 %AND %C
#line 5366 "test-new/imp918s.imp"
if (OPND1->PTYPE != 11) goto L_04EB;
#line 5366 "test-new/imp918s.imp"
{
// Double-sided test on OPND1->D (Part I)
#line 5366 "test-new/imp918s.imp"
int tmp;
#line 5366 "test-new/imp918s.imp"
if (0 > (tmp = OPND1->D)) goto L_04EB;
// Double-sided test on OPND1->D (Part II)
#line 5366 "test-new/imp918s.imp"
if (tmp > 4095) goto L_04EB;
#line 5366 "test-new/imp918s.imp"
}
#line 5366 "test-new/imp918s.imp"
if (OPND2->D <= 255) goto L_04EC;
#line 5366 "test-new/imp918s.imp"
L_04EB:;
#line 5366 "test-new/imp918s.imp"
goto U_104B;
#line 5366 "test-new/imp918s.imp"
L_04EC:;
// 5367+ 0<=OPND1_D<=4095 %AND OPND2_D<=255
// 5368 NEST=OPND1_XB; D=NEST>>4; NEST=NEST&15
#line 5368 "test-new/imp918s.imp"
NEST = OPND1->XB;
#line 5368 "test-new/imp918s.imp"
D = (unsigned int)NEST >> 4;
#line 5368 "test-new/imp918s.imp"
NEST = NEST & 15;
// 5369 %IF D>0 %THEN %START
#line 5369 "test-new/imp918s.imp"
if (D <= 0) goto L_04ED;
// 5370 %IF 1#REGISTER(D)>=0 %AND GRUSE(D)<=1 %THENC
#line 5370 "test-new/imp918s.imp"
{
// Double-sided test on REGISTER[D] (Part I)
#line 5370 "test-new/imp918s.imp"
int tmp;
#line 5370 "test-new/imp918s.imp"
if (1 == (tmp = REGISTER[D])) goto L_04EE;
// Double-sided test on REGISTER[D] (Part II)
#line 5370 "test-new/imp918s.imp"
if (tmp < 0) goto L_04EE;
#line 5370 "test-new/imp918s.imp"
}
#line 5370 "test-new/imp918s.imp"
if (GRUSE[D] > 1) goto L_04EE;
#line 5370 "test-new/imp918s.imp"
NEST = D;
#line 5370 "test-new/imp918s.imp"
goto L_04EF;
#line 5370 "test-new/imp918s.imp"
L_04EE:;
#line 5370 "test-new/imp918s.imp"
NEST = -2;
#line 5370 "test-new/imp918s.imp"
L_04EF:;
// 5371+ NEST=D %ELSE NEST=-2; UNRESERVE(OPND1_XB)
#line 5371 "test-new/imp918s.imp"
UNRESERVE(OPND1->XB);
// 5372 DUMP(0,NEST,0,D,OPND1_XB&15); OPND1_XB=NEST;
#line 5372 "test-new/imp918s.imp"
DUMP(0, NEST, 0, D, OPND1->XB & 15);
#line 5372 "test-new/imp918s.imp"
OPND1->XB = NEST;
// 5373 FORGET(NEST); %FINISH
#line 5373 "test-new/imp918s.imp"
FORGET(NEST);
#line 5373 "test-new/imp918s.imp"
L_04ED:;
// 5374 PSI(X'95',OPND2_D,NEST,OPND1_D)
#line 5374 "test-new/imp918s.imp"
PSI(149, OPND2->D, NEST, OPND1->D);
// 5375 CCSTATE=-1; -> Z5
#line 5375 "test-new/imp918s.imp"
CCSTATE = -1;
#line 5375 "test-new/imp918s.imp"
goto U_104F;
// 5376 SW(28): ! SPECIAL MH FOR ARRAY ACCESS
#line 5376 "test-new/imp918s.imp"
case_SW_28:;
// 5377 %IF OPND1_FLAG=2 %AND OPND2_FLAG=0 %AND OPND2_D<=255%THENSTART
#line 5377 "test-new/imp918s.imp"
if (OPND1->FLAG != 2) goto L_04F0;
#line 5377 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_04F0;
#line 5377 "test-new/imp918s.imp"
if (OPND2->D > 255) goto L_04F0;
// 5378 E=OPND1_D; D=TAGS(A(E))
#line 5378 "test-new/imp918s.imp"
E = OPND1->D;
#line 5378 "test-new/imp918s.imp"
D = TAGS[A[E + 7]];
// 5379 FIND USE(C,1,9,OPND2_D<<24!D)
#line 5379 "test-new/imp918s.imp"
FINDUSE(/*?*/ &C, 1, 9, OPND2->D << 24 | D);
// 5380 %IF C>0 %AND A(E+1)=2=A(E+2) %START
#line 5380 "test-new/imp918s.imp"
if (C <= 0) goto L_04F1;
#line 5380 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 5380 "test-new/imp918s.imp"
int tmp;
#line 5380 "test-new/imp918s.imp"
if (A[E + 1 + 7] != (tmp = 2)) goto L_04F1;
// Double-sided test on 2 (Part II)
#line 5380 "test-new/imp918s.imp"
if (tmp != A[E + 2 + 7]) goto L_04F1;
#line 5380 "test-new/imp918s.imp"
}
// 5381 OPND1_FLAG=9; OPND1_XB=C; OPND1_D=-2; ->Label101
#line 5381 "test-new/imp918s.imp"
OPND1->FLAG = 9;
#line 5381 "test-new/imp918s.imp"
OPND1->XB = C;
#line 5381 "test-new/imp918s.imp"
OPND1->D = -2;
#line 5381 "test-new/imp918s.imp"
goto U_1045;
// 5382 %FINISH
#line 5382 "test-new/imp918s.imp"
L_04F1:;
// 5383 %FINISH
#line 5383 "test-new/imp918s.imp"
L_04F0:;
// 5384 LOAD(OPND1,-1,2); ! LOAD TO ANY REGISTER
#line 5384 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5385 ->Label2801 %IF OPND2_FLAG=0; ! CONSTANT SO OPTIMISE
#line 5385 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_04F2;
#line 5385 "test-new/imp918s.imp"
goto U_1051;
#line 5385 "test-new/imp918s.imp"
L_04F2:;
// 5386 LOAD(OPND2,-1,3); ! LOAD DV POINTER
#line 5386 "test-new/imp918s.imp"
LOAD(OPND2, -1, 3);
// 5387 LOAD(OPND1,-1,2); ! LOAD OF DVBASE MAY DUMP OPND!
#line 5387 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5388 PUT; ->Label100
#line 5388 "test-new/imp918s.imp"
PUT();
#line 5388 "test-new/imp918s.imp"
goto U_1046;
// 5389 Label2801: D=OPND2_D; C=OPND1_XB
#line 5389 "test-new/imp918s.imp"
U_1051:;
#line 5389 "test-new/imp918s.imp"
D = OPND2->D;
#line 5389 "test-new/imp918s.imp"
C = OPND1->XB;
// 5390 %IF D=2 %THEN PRR(X'1A',C,C) %AND CCSTATE=-1 %ELSE %START
#line 5390 "test-new/imp918s.imp"
if (D != 2) goto L_04F3;
#line 5390 "test-new/imp918s.imp"
PRR(26, C, C);
#line 5390 "test-new/imp918s.imp"
CCSTATE = -1;
#line 5390 "test-new/imp918s.imp"
goto L_04F4;
#line 5390 "test-new/imp918s.imp"
L_04F3:;
// 5391 %IF D=4 %OR D=8 %THEN PRX(X'89',C,0,0,2!D>>3) %ELSESTART
#line 5391 "test-new/imp918s.imp"
if (D == 4) goto L_04F5;
#line 5391 "test-new/imp918s.imp"
if (D != 8) goto L_04F6;
#line 5391 "test-new/imp918s.imp"
L_04F5:;
#line 5391 "test-new/imp918s.imp"
PRX(137, C, 0, 0, 2 | (unsigned int)D >> 3);
#line 5391 "test-new/imp918s.imp"
goto L_04F7;
#line 5391 "test-new/imp918s.imp"
L_04F6:;
// 5392 STORE CONST(KK,JJ,2,ADDR(D)+2)
#line 5392 "test-new/imp918s.imp"
STORECONST(/*?*/ &KK, /*?*/ &JJ, 2, _imp_ADDR(/*?*/ &D) + 2);
// 5393 DUMP(X'4C',C,JJ,0,KK)
#line 5393 "test-new/imp918s.imp"
DUMP(76, C, JJ, 0, KK);
// 5394 %FINISH; %FINISH
#line 5394 "test-new/imp918s.imp"
L_04F7:;
#line 5394 "test-new/imp918s.imp"
L_04F4:;
// 5395 REGISTER(C)=0
#line 5395 "test-new/imp918s.imp"
REGISTER[C] = 0;
// 5396 %IF GRUSE(C)#3 %OR D>255 %THEN ->Label100
#line 5396 "test-new/imp918s.imp"
if (GRUSE[C] != 3) goto L_04F8;
#line 5396 "test-new/imp918s.imp"
if (D <= 255) goto L_04F9;
#line 5396 "test-new/imp918s.imp"
L_04F8:;
#line 5396 "test-new/imp918s.imp"
goto U_1046;
#line 5396 "test-new/imp918s.imp"
L_04F9:;
// 5397 SET USE(C,9,D<<24!GRINF(C)); ->Label101
#line 5397 "test-new/imp918s.imp"
SETUSE(C, 9, D << 24 | GRINF[C]);
#line 5397 "test-new/imp918s.imp"
goto U_1045;
// 5398
// 5399 SW(29): ! ->LAB MASKS AND LAB AS OPND2
#line 5399 "test-new/imp918s.imp"
case_SW_29:;
// 5400 ! OPND1 MIDDLE OF D-SIDED
// 5401 LOAD(OPND1,-1,0) %IF INHEAD#0; ! PROTECT MIDDLE OPND IN DSIDED
#line 5401 "test-new/imp918s.imp"
if (INHEAD == 0) goto L_04FA;
#line 5401 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
#line 5401 "test-new/imp918s.imp"
L_04FA:;
// 5402 C=OPND2_XB>>(4*BFFLAG)
#line 5402 "test-new/imp918s.imp"
C = (unsigned int)OPND2->XB >> 4 * BFFLAG;
// 5403 ENTER JUMP(C&15,OPND2_D,B'11')
#line 5403 "test-new/imp918s.imp"
ENTERJUMP(C & 15, OPND2->D, 3);
// 5404 ->Label101; ! RETURN MIDDLE OPND AS RESULT
#line 5404 "test-new/imp918s.imp"
goto U_1045;
// 5405 SW(30): ! ASSIGN(=)
#line 5405 "test-new/imp918s.imp"
case_SW_30:;
// 5406 SW(31): ! ASSIGN(<-)
#line 5406 "test-new/imp918s.imp"
case_SW_31:;
// 5407 PP=OPND2_D; ! SAVE POINTER TO NAME
#line 5407 "test-new/imp918s.imp"
PP = OPND2->D;
// 5408 PT=OPND2_PTYPE; ! AND ITS ORIGINAL PTYPE
#line 5408 "test-new/imp918s.imp"
PT = OPND2->PTYPE;
// 5409 D=OPND2_FLAG; ! SAVE NAME OR R-DESCRPTOR
#line 5409 "test-new/imp918s.imp"
D = OPND2->FLAG;
// 5410 LOAD(OPND1,-1,0) %UNLESS OPND1_FLAG<=2 %AND OPND1_XB=0 %C
#line 5410 "test-new/imp918s.imp"
if (OPND1->FLAG > 2) goto L_04FB;
#line 5410 "test-new/imp918s.imp"
if (OPND1->XB != 0) goto L_04FB;
#line 5410 "test-new/imp918s.imp"
if (OPND1->PTYPE < 100) goto L_04FC;
#line 5410 "test-new/imp918s.imp"
L_04FB:;
#line 5410 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
#line 5410 "test-new/imp918s.imp"
L_04FC:;
// 5411+ %AND OPND1_PTYPE<100; ! DEAL WITH NASTY RH SIDES
// 5412 LOAD(OPND2,-1,4); ! GET ADDRESS FOR LHS
#line 5412 "test-new/imp918s.imp"
LOAD(OPND2, -1, 4);
// 5413 ->MVI %IF TYPE=1 %AND PREC=1 %AND OPND1_FLAG=0 %AND %C
#line 5413 "test-new/imp918s.imp"
if (TYPE != 1) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
if (PREC != 1) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
if (OPND1->FLAG != 0) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
if (OPND1->D > 255) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
if (OPND2->XB >= 16) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
if (OPND2->D > 4095) goto L_04FD;
#line 5413 "test-new/imp918s.imp"
goto U_1052;
#line 5413 "test-new/imp918s.imp"
L_04FD:;
// 5414+ OPND1_D<=255 %AND OPND2_XB<16 %AND OPND2_D<=4095
// 5415 %IF OPND1_FLAG#0 %AND OPND2_XB<16 %AND 0<=OPND2_D<=4095 %C
#line 5415 "test-new/imp918s.imp"
if (OPND1->FLAG == 0) goto L_04FE;
#line 5415 "test-new/imp918s.imp"
if (OPND2->XB >= 16) goto L_04FE;
#line 5415 "test-new/imp918s.imp"
{
// Double-sided test on OPND2->D (Part I)
#line 5415 "test-new/imp918s.imp"
int tmp;
#line 5415 "test-new/imp918s.imp"
if (0 > (tmp = OPND2->D)) goto L_04FE;
// Double-sided test on OPND2->D (Part II)
#line 5415 "test-new/imp918s.imp"
if (tmp > 4095) goto L_04FE;
#line 5415 "test-new/imp918s.imp"
}
#line 5415 "test-new/imp918s.imp"
if (OPND2->PTYPE != OPND1->PTYPE - 100 * (((long)OPND1->PTYPE / (long)100))) goto L_04FE;
// 5416+ %AND OPND2_PTYPE=OPND1_PTYPE-100*(OPND1_PTYPE//100) %START
// 5417 LOAD(OPND1,-1,3) %IF OPND1_FLAG<7;! STILL TRYING TO LEAVE RHS
#line 5417 "test-new/imp918s.imp"
if (OPND1->FLAG >= 7) goto L_04FF;
#line 5417 "test-new/imp918s.imp"
LOAD(OPND1, -1, 3);
#line 5417 "test-new/imp918s.imp"
L_04FF:;
// 5418 ->MVC %IF OPND2_PTYPE=OPND1_PTYPE %AND %C
#line 5418 "test-new/imp918s.imp"
if (OPND2->PTYPE != OPND1->PTYPE) goto L_0500;
#line 5418 "test-new/imp918s.imp"
{
// Double-sided test on OPND1->D (Part I)
#line 5418 "test-new/imp918s.imp"
int tmp;
#line 5418 "test-new/imp918s.imp"
if (0 > (tmp = OPND1->D)) goto L_0500;
// Double-sided test on OPND1->D (Part II)
#line 5418 "test-new/imp918s.imp"
if (tmp > 4095) goto L_0500;
#line 5418 "test-new/imp918s.imp"
}
#line 5418 "test-new/imp918s.imp"
if (16 <= OPND1->XB) goto L_0500;
#line 5418 "test-new/imp918s.imp"
goto U_1053;
#line 5418 "test-new/imp918s.imp"
L_0500:;
// 5419+ 0<=OPND1_D<=4095 %AND 16>OPND1_XB
// 5420 %FINISH
#line 5420 "test-new/imp918s.imp"
L_04FE:;
// 5421 ! ALL ATTEMPTS AT SHORT CUTTING HAVE FAILED SO ASSIGN NORMALLY
// 5422 ! IF LHS ALREADY IN A REGISTER IT IS BEST TO USE THAT REGISTER
// 5423 ! FOR ASSIGNMENT(UNLESS RHS ALREADY IN A DIFFERENT REGISTER).
// 5424 ! THIS SAVES A REGISTER WHEN COMPILING 'K=0 %IF K<0' ETC.
// 5425 ! IT IS RATHER A TEDIOUS SEARCH SO IT IS OMITTED IN NON OPTIMISING MODE
// 5426 JJJ=-1
#line 5426 "test-new/imp918s.imp"
JJJ = -1;
// 5427 %IF CHECKSP=0 %AND OPND1_D>=0 %AND PT<3 %AND D=2 %THENSTART
#line 5427 "test-new/imp918s.imp"
if (CHECKSP != 0) goto L_0501;
#line 5427 "test-new/imp918s.imp"
if (OPND1->D < 0) goto L_0501;
#line 5427 "test-new/imp918s.imp"
if (PT >= 3) goto L_0501;
#line 5427 "test-new/imp918s.imp"
if (D != 2) goto L_0501;
// 5428 C=TAGS(A(PP)); ! TAGS OF LHS
#line 5428 "test-new/imp918s.imp"
C = TAGS[A[PP + 7]];
// 5429 FIND USE(KK,PT,3,C)
#line 5429 "test-new/imp918s.imp"
FINDUSE(/*?*/ &KK, PT, 3, C);
// 5430 %IF KK>=0 %AND REGISTER(KK)=0 %THEN JJJ=KK&15
#line 5430 "test-new/imp918s.imp"
if (KK < 0) goto L_0502;
#line 5430 "test-new/imp918s.imp"
if (REGISTER[KK] != 0) goto L_0502;
#line 5430 "test-new/imp918s.imp"
JJJ = KK & 15;
#line 5430 "test-new/imp918s.imp"
L_0502:;
// 5431 %FINISH
#line 5431 "test-new/imp918s.imp"
L_0501:;
// 5432 LOAD(OPND1,JJJ,2); ! RHS TO REGISTER
#line 5432 "test-new/imp918s.imp"
LOAD(OPND1, JJJ, 2);
// 5433 PTYPE=OPND2_PTYPE;! UNPACK; ! SET TYPE & PREC FOR LHS
#line 5433 "test-new/imp918s.imp"
PTYPE = OPND2->PTYPE;
// 5434 !%if USE MC = 1 %start
// 5435 ! *L_1,PTYPE; *CVD_1,0(11)
// 5436 ! *UNPK_ROUT(5),5(3,11)
// 5437 ! *NC_ROUT(5),MASK1
// 5438 !%finish
// 5439 JJJ=8*TYPE+2*(PREC&3)-7; ! CODE FOR DUMP
#line 5439 "test-new/imp918s.imp"
JJJ = 8 * TYPE + 2 * (PREC & 3) - 7;
// 5440 DUMP(JJJ,OPND1_XB,OPND2_D,OPND2_XB>>4,OPND2_XB&15)
#line 5440 "test-new/imp918s.imp"
DUMP(JJJ, OPND1->XB, OPND2->D, (unsigned int)OPND2->XB >> 4, OPND2->XB & 15);
// 5441 %IF JJ=30 %AND CHECKS=1 %THEN %C
#line 5441 "test-new/imp918s.imp"
if (JJ != 30) goto L_0503;
#line 5441 "test-new/imp918s.imp"
if (CHECKS != 1) goto L_0503;
#line 5441 "test-new/imp918s.imp"
CHECKCAPACITY(OPND1->XB, OPND2->D, (unsigned int)OPND2->XB >> 4, OPND2->XB & 15);
#line 5441 "test-new/imp918s.imp"
L_0503:;
// 5442+ CHECK CAPACITY(OPND1_XB,OPND2_D,OPND2_XB>>4,OPND2_XB&15)
// 5443 JJJ=OPND1_XB
#line 5443 "test-new/imp918s.imp"
JJJ = OPND1->XB;
// 5444 NASS1: UNRESERVE(OPND2_XB)
#line 5444 "test-new/imp918s.imp"
U_1054:;
#line 5444 "test-new/imp918s.imp"
UNRESERVE(OPND2->XB);
// 5445 PTYPE=PT;! UNPACK; ! ORIGINAL PTYPE
#line 5445 "test-new/imp918s.imp"
PTYPE = PT;
// 5446 !%if USE MC = 1 %start
// 5447 ! *L_1,PTYPE; *CVD_1,0(11)
// 5448 ! *UNPK_ROUT(5),5(3,11)
// 5449 ! *NC_ROUT(5),MASK1
// 5450 !%finish
// 5451 COMM=1; ->Label101 %UNLESS D=2; ! ASSGN TO NAME ONLY
#line 5451 "test-new/imp918s.imp"
COMM = 1;
#line 5451 "test-new/imp918s.imp"
if (D == 2) goto L_0504;
#line 5451 "test-new/imp918s.imp"
goto U_1045;
#line 5451 "test-new/imp918s.imp"
L_0504:;
// 5452 %IF 1<=TYPE<=2 %AND ARR=0 %AND A(PP+1)=2=A(PP+2) %THEN %C
#line 5452 "test-new/imp918s.imp"
{
// Double-sided test on TYPE (Part I)
#line 5452 "test-new/imp918s.imp"
unsigned char tmp;
#line 5452 "test-new/imp918s.imp"
if (1 > (tmp = TYPE)) goto L_0505;
// Double-sided test on TYPE (Part II)
#line 5452 "test-new/imp918s.imp"
if (tmp > 2) goto L_0505;
#line 5452 "test-new/imp918s.imp"
}
#line 5452 "test-new/imp918s.imp"
if (ARR != 0) goto L_0505;
#line 5452 "test-new/imp918s.imp"
{
// Double-sided test on 2 (Part I)
#line 5452 "test-new/imp918s.imp"
int tmp;
#line 5452 "test-new/imp918s.imp"
if (A[PP + 1 + 7] != (tmp = 2)) goto L_0505;
// Double-sided test on 2 (Part II)
#line 5452 "test-new/imp918s.imp"
if (tmp != A[PP + 2 + 7]) goto L_0505;
#line 5452 "test-new/imp918s.imp"
}
#line 5452 "test-new/imp918s.imp"
NOTEASSMENT(JJJ, JJ - 28, A[PP + 7]);
#line 5452 "test-new/imp918s.imp"
L_0505:;
// 5453+ NOTE ASSMENT(JJJ,JJ-28,A(PP))
// 5454 ->Label101; ! NORMAL EXIT FREES REG USED
#line 5454 "test-new/imp918s.imp"
goto U_1045;
// 5455
// 5456 MVI: ! ASSIGN CNST(<256) TO BYTE
#line 5456 "test-new/imp918s.imp"
U_1052:;
// 5457 PSI(X'92',OPND1_D,OPND2_XB,OPND2_D)
#line 5457 "test-new/imp918s.imp"
PSI(146, OPND1->D, OPND2->XB, OPND2->D);
// 5458 NASS2: JJJ=-1; ->NASS1; ! ->NOTE ASSMENT(CAPACITY OK)
#line 5458 "test-new/imp918s.imp"
U_1055:;
#line 5458 "test-new/imp918s.imp"
JJJ = -1;
#line 5458 "test-new/imp918s.imp"
goto U_1054;
// 5459 MVC: PMVC(BYTES(PREC),OPND2_XB,OPND2_D,OPND1_XB,OPND1_D)
#line 5459 "test-new/imp918s.imp"
U_1053:;
#line 5459 "test-new/imp918s.imp"
PMVC(BYTES[PREC], OPND2->XB, OPND2->D, OPND1->XB, OPND1->D);
// 5460 UNRESERVE(OPND1_XB)
#line 5460 "test-new/imp918s.imp"
UNRESERVE(OPND1->XB);
// 5461 ->NASS2
#line 5461 "test-new/imp918s.imp"
goto U_1055;
// 5462 FINISH: C=STK(STPTR-1)
#line 5462 "test-new/imp918s.imp"
U_1044:;
#line 5462 "test-new/imp918s.imp"
C = STK[STPTR - 1];
// 5463 OPERAND(1)=C
#line 5463 "test-new/imp918s.imp"
OPERAND[0] = C;
// 5464 OPND1==RECORD(ADDR(ASLIST(C)))
#line 5464 "test-new/imp918s.imp"
OPND1 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[C]));
// 5465 LOAD(OPND1,REG,2) %UNLESS RDFORM#0 %OR (OPND1_FLAG=9 %AND %C
#line 5465 "test-new/imp918s.imp"
if (RDFORM != 0) goto L_0506;
#line 5465 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_0507;
#line 5465 "test-new/imp918s.imp"
if (OPND1->D >= 0) goto L_0507;
#line 5465 "test-new/imp918s.imp"
if (REG < 0) goto L_0506;
#line 5465 "test-new/imp918s.imp"
if (REG == OPND1->XB) goto L_0506;
#line 5465 "test-new/imp918s.imp"
L_0507:;
#line 5465 "test-new/imp918s.imp"
LOAD(OPND1, REG, 2);
#line 5465 "test-new/imp918s.imp"
L_0506:;
// 5466+ OPND1_D<0 %AND (REG<0 %OR REG=OPND1_XB))
// 5467 PTYPE=OPND1_PTYPE
#line 5467 "test-new/imp918s.imp"
PTYPE = OPND1->PTYPE;
// 5468 NEST=-1
#line 5468 "test-new/imp918s.imp"
NEST = -1;
// 5469 ! UNPACK
// 5470 !%if USE MC = 1 %start
// 5471 ! *L_1,PTYPE; *CVD_1,0(11)
// 5472 ! *UNPK_ROUT(5),5(3,11)
// 5473 ! *NC_ROUT(5),MASK1
// 5474 !%finish
// 5475 %IF OPND1_FLAG=9 %AND OPND1_D<0 %THEN %START
#line 5475 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_0508;
#line 5475 "test-new/imp918s.imp"
if (OPND1->D >= 0) goto L_0508;
// 5476 NEST=OPND1_XB
#line 5476 "test-new/imp918s.imp"
NEST = OPND1->XB;
// 5477 %IF TYPE=2 %THEN NEST=NEST+16
#line 5477 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0509;
#line 5477 "test-new/imp918s.imp"
NEST = NEST + 16;
#line 5477 "test-new/imp918s.imp"
L_0509:;
// 5478 %IF GRUSE(NEST)=1 %THEN GRINF(NEST)=0;! DONT POINT AT DEAD LIST
#line 5478 "test-new/imp918s.imp"
if (GRUSE[NEST] != 1) goto L_050A;
#line 5478 "test-new/imp918s.imp"
GRINF[NEST] = 0;
#line 5478 "test-new/imp918s.imp"
L_050A:;
// 5479 NEST=OPND1_XB
#line 5479 "test-new/imp918s.imp"
NEST = OPND1->XB;
// 5480 %IF NEST=0 %AND ADDREXP=1 %THEN %START
#line 5480 "test-new/imp918s.imp"
if (NEST != 0) goto L_050B;
#line 5480 "test-new/imp918s.imp"
if (ADDREXP != 1) goto L_050B;
// 5481 LOAD(OPND1,FINDR,2)
#line 5481 "test-new/imp918s.imp"
LOAD(OPND1, FINDR(), 2);
// 5482 FORGET(0)
#line 5482 "test-new/imp918s.imp"
FORGET(0);
// 5483 NEST=OPND1_XB
#line 5483 "test-new/imp918s.imp"
NEST = OPND1->XB;
// 5484 %FINISH
#line 5484 "test-new/imp918s.imp"
L_050B:;
// 5485 D=NEST+(TYPE&2)<<3
#line 5485 "test-new/imp918s.imp"
D = NEST + ((TYPE & 2) << 3);
// 5486 REGISTER(D)=0 %IF REGISTER(D)>0
#line 5486 "test-new/imp918s.imp"
if (REGISTER[D] <= 0) goto L_050C;
#line 5486 "test-new/imp918s.imp"
REGISTER[D] = 0;
#line 5486 "test-new/imp918s.imp"
L_050C:;
// 5487 %FINISH
#line 5487 "test-new/imp918s.imp"
L_0508:;
// 5488 %RETURN
#line 5488 "test-new/imp918s.imp"
return;
// 5489 !
// 5490 %INTEGERFN FINDR
#line 5490 "test-new/imp918s.imp"
int FINDR(void) {
// 5491 %INTEGER I,J
#line 5491 "test-new/imp918s.imp"
int I;
#line 5491 "test-new/imp918s.imp"
int J;
// 5492 {%SHORTROUTINE}
// 5493 %IF REG>=0 %THEN %START
#line 5493 "test-new/imp918s.imp"
if (REG < 0) goto L_050D;
// 5494 I=REG; ->Label1 %IF REGISTER(REG)=0; %FINISH
#line 5494 "test-new/imp918s.imp"
I = REG;
#line 5494 "test-new/imp918s.imp"
if (REGISTER[REG] != 0) goto L_050E;
#line 5494 "test-new/imp918s.imp"
goto U_1056;
#line 5494 "test-new/imp918s.imp"
L_050E:;
#line 5494 "test-new/imp918s.imp"
L_050D:;
// 5495 %IF ADDREXP=1 %THEN J=GR1 %ELSE J=GR0
#line 5495 "test-new/imp918s.imp"
if (ADDREXP != 1) goto L_050F;
#line 5495 "test-new/imp918s.imp"
J = 65807;
#line 5495 "test-new/imp918s.imp"
goto L_0510;
#line 5495 "test-new/imp918s.imp"
L_050F:;
#line 5495 "test-new/imp918s.imp"
J = 69406;
#line 5495 "test-new/imp918s.imp"
L_0510:;
// 5496 FIND REG(J,I)
#line 5496 "test-new/imp918s.imp"
FINDREG(J, /*?*/ &I);
// 5497 Label1: REGISTER(I)=1;
#line 5497 "test-new/imp918s.imp"
U_1056:;
#line 5497 "test-new/imp918s.imp"
REGISTER[I] = 1;
// 5498 %RESULT=I
#line 5498 "test-new/imp918s.imp"
return I;
// 5499 %END
#line 5499 "test-new/imp918s.imp"
} /* end of FINDR */
// 5500 %ROUTINE CHOOSE(%INTEGERNAME CHOICE)
#line 5500 "test-new/imp918s.imp"
void CHOOSE(int *CHOICE) {
// 5501 {%SHORTROUTINE}
// 5502 %BYTEINTEGER X1,X2,F1,F2
#line 5502 "test-new/imp918s.imp"
unsigned char X1;
#line 5502 "test-new/imp918s.imp"
unsigned char X2;
#line 5502 "test-new/imp918s.imp"
unsigned char F1;
#line 5502 "test-new/imp918s.imp"
unsigned char F2;
// 5503 %RECORD(RD)%NAME OPND1,OPND2
#line 5503 "test-new/imp918s.imp"
struct RD *OPND1;
#line 5503 "test-new/imp918s.imp"
struct RD *OPND2;
// 5504 OPND1==RECORD(ADDR(ASLIST(OPERAND(1))))
#line 5504 "test-new/imp918s.imp"
OPND1 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[OPERAND[0]]));
// 5505 OPND2==RECORD(ADDR(ASLIST(OPERAND(2))))
#line 5505 "test-new/imp918s.imp"
OPND2 = (struct RD *)_imp_RECORD(_imp_ADDR(/*?*/ &ASLIST[OPERAND[1]]));
// 5506 F1=OPND1_FLAG; F2=OPND2_FLAG
#line 5506 "test-new/imp918s.imp"
F1 = OPND1->FLAG;
#line 5506 "test-new/imp918s.imp"
F2 = OPND2->FLAG;
// 5507 X1=OPND1_XB; X2=OPND2_XB
#line 5507 "test-new/imp918s.imp"
X1 = OPND1->XB;
#line 5507 "test-new/imp918s.imp"
X2 = OPND2->XB;
// 5508 -> CHOS1 %IF F1=2 %AND (X1=1 %OR 1<X1=SPECREG)
#line 5508 "test-new/imp918s.imp"
if (F1 != 2) goto L_0511;
#line 5508 "test-new/imp918s.imp"
if (X1 == 1) goto L_0512;
#line 5508 "test-new/imp918s.imp"
{
// Double-sided test on X1 (Part I)
#line 5508 "test-new/imp918s.imp"
unsigned char tmp;
#line 5508 "test-new/imp918s.imp"
if (1 >= (tmp = X1)) goto L_0511;
// Double-sided test on X1 (Part II)
#line 5508 "test-new/imp918s.imp"
if (tmp != SPECREG) goto L_0511;
#line 5508 "test-new/imp918s.imp"
}
#line 5508 "test-new/imp918s.imp"
L_0512:;
#line 5508 "test-new/imp918s.imp"
goto U_1057;
#line 5508 "test-new/imp918s.imp"
L_0511:;
// 5509 -> CHOS2 %IF F2=2 %AND (X2=1 %OR 1<X2=SPECREG)
#line 5509 "test-new/imp918s.imp"
if (F2 != 2) goto L_0513;
#line 5509 "test-new/imp918s.imp"
if (X2 == 1) goto L_0514;
#line 5509 "test-new/imp918s.imp"
{
// Double-sided test on X2 (Part I)
#line 5509 "test-new/imp918s.imp"
unsigned char tmp;
#line 5509 "test-new/imp918s.imp"
if (1 >= (tmp = X2)) goto L_0513;
// Double-sided test on X2 (Part II)
#line 5509 "test-new/imp918s.imp"
if (tmp != SPECREG) goto L_0513;
#line 5509 "test-new/imp918s.imp"
}
#line 5509 "test-new/imp918s.imp"
L_0514:;
#line 5509 "test-new/imp918s.imp"
goto U_1058;
#line 5509 "test-new/imp918s.imp"
L_0513:;
// 5510 -> CHOS0 %IF F1>=7 %AND OPND1_D<0
#line 5510 "test-new/imp918s.imp"
if (F1 < 7) goto L_0515;
#line 5510 "test-new/imp918s.imp"
if (OPND1->D >= 0) goto L_0515;
#line 5510 "test-new/imp918s.imp"
goto U_1059;
#line 5510 "test-new/imp918s.imp"
L_0515:;
// 5511 -> CHOS2 %IF F2>=7 %AND OPND2_D<0
#line 5511 "test-new/imp918s.imp"
if (F2 < 7) goto L_0516;
#line 5511 "test-new/imp918s.imp"
if (OPND2->D >= 0) goto L_0516;
#line 5511 "test-new/imp918s.imp"
goto U_1058;
#line 5511 "test-new/imp918s.imp"
L_0516:;
// 5512 PTYPE=OPND1_PTYPE;! UNPACK
#line 5512 "test-new/imp918s.imp"
PTYPE = OPND1->PTYPE;
// 5513 !%if USE MC = 1 %start
// 5514 ! *L_1,PTYPE; *CVD_1,0(11)
// 5515 ! *UNPK_ROUT(5),5(3,11)
// 5516 ! *NC_ROUT(5),MASK1
// 5517 !%finish
// 5518 -> CHOS1 %IF PREC=1
#line 5518 "test-new/imp918s.imp"
if (PREC != 1) goto L_0517;
#line 5518 "test-new/imp918s.imp"
goto U_1057;
#line 5518 "test-new/imp918s.imp"
L_0517:;
// 5519 PTYPE=OPND2_PTYPE;! UNPACK
#line 5519 "test-new/imp918s.imp"
PTYPE = OPND2->PTYPE;
// 5520 !%if USE MC = 1 %start
// 5521 ! *L_1,PTYPE; *CVD_1,0(11)
// 5522 ! *UNPK_ROUT(5),5(3,11)
// 5523 ! *NC_ROUT(5),MASK1
// 5524 !%finish
// 5525 -> CHOS2 %IF PREC=1
#line 5525 "test-new/imp918s.imp"
if (PREC != 1) goto L_0518;
#line 5525 "test-new/imp918s.imp"
goto U_1058;
#line 5525 "test-new/imp918s.imp"
L_0518:;
// 5526 -> CHOS1 %IF F1=0 %AND OPND1_D>3 %AND OPCODE#X'19'
#line 5526 "test-new/imp918s.imp"
if (F1 != 0) goto L_0519;
#line 5526 "test-new/imp918s.imp"
if (OPND1->D <= 3) goto L_0519;
#line 5526 "test-new/imp918s.imp"
if (OPCODE == 25) goto L_0519;
#line 5526 "test-new/imp918s.imp"
goto U_1057;
#line 5526 "test-new/imp918s.imp"
L_0519:;
// 5527 -> CHOS2 %IF F2=0 %AND OPND2_D>3 %AND OPCODE#X'19'
#line 5527 "test-new/imp918s.imp"
if (F2 != 0) goto L_051A;
#line 5527 "test-new/imp918s.imp"
if (OPND2->D <= 3) goto L_051A;
#line 5527 "test-new/imp918s.imp"
if (OPCODE == 25) goto L_051A;
#line 5527 "test-new/imp918s.imp"
goto U_1058;
#line 5527 "test-new/imp918s.imp"
L_051A:;
// 5528 -> CHOS2 %IF OPND2_PTYPE>OPND1_PTYPE
#line 5528 "test-new/imp918s.imp"
if (OPND2->PTYPE <= OPND1->PTYPE) goto L_051B;
#line 5528 "test-new/imp918s.imp"
goto U_1058;
#line 5528 "test-new/imp918s.imp"
L_051B:;
// 5529 -> CHOS2 %IF F2>F1
#line 5529 "test-new/imp918s.imp"
if (F2 <= F1) goto L_051C;
#line 5529 "test-new/imp918s.imp"
goto U_1058;
#line 5529 "test-new/imp918s.imp"
L_051C:;
// 5530 CHOS1: CHOICE=1; ->Label99
#line 5530 "test-new/imp918s.imp"
U_1057:;
#line 5530 "test-new/imp918s.imp"
*CHOICE = 1;
#line 5530 "test-new/imp918s.imp"
goto U_105A;
// 5531 CHOS0: ->CHOS1 %UNLESS F2>7 %AND OPND2_D<0 %AND X2=REG
#line 5531 "test-new/imp918s.imp"
U_1059:;
#line 5531 "test-new/imp918s.imp"
if (F2 <= 7) goto L_051D;
#line 5531 "test-new/imp918s.imp"
if (OPND2->D >= 0) goto L_051D;
#line 5531 "test-new/imp918s.imp"
if (X2 == REG) goto L_051E;
#line 5531 "test-new/imp918s.imp"
L_051D:;
#line 5531 "test-new/imp918s.imp"
goto U_1057;
#line 5531 "test-new/imp918s.imp"
L_051E:;
// 5532 CHOS2: CHOICE=2
#line 5532 "test-new/imp918s.imp"
U_1058:;
#line 5532 "test-new/imp918s.imp"
*CHOICE = 2;
// 5533 Label99: %END
#line 5533 "test-new/imp918s.imp"
U_105A:;
#line 5533 "test-new/imp918s.imp"
return;
#line 5533 "test-new/imp918s.imp"
} /* end of CHOOSE */
// 5534 %ROUTINE LOAD(%RECORD(RD)%NAME OPND,%INTEGER REG,MODE)
#line 5534 "test-new/imp918s.imp"
void LOAD(struct RD * OPND, int REG, int MODE) {
// 5535 !***********************************************************************
// 5536 !* MODE=0 LEAVE IN STORE IF POSSIBLE *
// 5537 !* MODE=1 LEAVE IN STORE IF SUITABLE FOR RX INSTRUCTIONS *
// 5538 !* MODE=2 LOAD TO REGISTER REGARDLESS *
// 5539 !* MODE=3 LEAVE IN STORE IF SUITABLE FOR CLC INSTRUCTIONS *
// 5540 !***********************************************************************
// 5541 {%SHORTROUTINE}
// 5542 %INTEGER I,J,K,VALUE,B
#line 5542 "test-new/imp918s.imp"
int I;
#line 5542 "test-new/imp918s.imp"
int J;
#line 5542 "test-new/imp918s.imp"
int K;
#line 5542 "test-new/imp918s.imp"
int VALUE;
#line 5542 "test-new/imp918s.imp"
int B;
// 5543 {%RECORDSPEC OPND(RD)}
// 5544 %SWITCH SW(0:9)
#line 5544 "test-new/imp918s.imp"
int SW_index;
#line 5544 "test-new/imp918s.imp"
int SW_line;
#line 5544 "test-new/imp918s.imp"
char *SW_file;
#line 5544 "test-new/imp918s.imp"
static const void *SW[10] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing};
// 5545 PTYPE=OPND_PTYPE;! UNPACK
#line 5545 "test-new/imp918s.imp"
PTYPE = OPND->PTYPE;
// 5546 !%if USE MC = 1 %start
// 5547 ! *L_1,PTYPE; *CVD_1,0(11)
// 5548 ! *UNPK_ROUT(5),5(3,11)
// 5549 ! *NC_ROUT(5),MASK1
// 5550 !%finish
// 5551 PREC=PREC&3
#line 5551 "test-new/imp918s.imp"
PREC = PREC & 3;
// 5552 %IF REG<0 %THEN REG=REG-ADDREXP
#line 5552 "test-new/imp918s.imp"
if (REG >= 0) goto L_051F;
#line 5552 "test-new/imp918s.imp"
REG = REG - ADDREXP;
#line 5552 "test-new/imp918s.imp"
L_051F:;
// 5553 -> SW(OPND_FLAG)
#line 5553 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = OPND->FLAG;
goto case_SW_dispatch;
// 5554 SW(0): ! CONSTANT < 4096
#line 5554 "test-new/imp918s.imp"
case_SW_0:;
// 5555 ->Label99 %UNLESS MODE>0
#line 5555 "test-new/imp918s.imp"
if (MODE > 0) goto L_0521;
#line 5555 "test-new/imp918s.imp"
goto U_1059;
#line 5555 "test-new/imp918s.imp"
L_0521:;
// 5556 VALUE=OPND_D
#line 5556 "test-new/imp918s.imp"
VALUE = OPND->D;
// 5557 %IF CSSMODE=0 %THEN OPTSAVE(0,2,1,VALUE)
#line 5557 "test-new/imp918s.imp"
if (CSSMODE != 0) goto L_0522;
#line 5557 "test-new/imp918s.imp"
OPTSAVE(0, 2, 1, VALUE);
#line 5557 "test-new/imp918s.imp"
L_0522:;
// 5558 FIND USE(I,1,2,VALUE)
#line 5558 "test-new/imp918s.imp"
FINDUSE(/*?*/ &I, 1, 2, VALUE);
// 5559 -> NOT FOUND %IF I<0
#line 5559 "test-new/imp918s.imp"
if (I >= 0) goto L_0523;
#line 5559 "test-new/imp918s.imp"
goto U_105A;
#line 5559 "test-new/imp918s.imp"
L_0523:;
// 5560 %IF REG<0 %THEN %START
#line 5560 "test-new/imp918s.imp"
if (REG >= 0) goto L_0524;
// 5561 ->RF %IF REGISTER(I)=0
#line 5561 "test-new/imp918s.imp"
if (REGISTER[I] != 0) goto L_0525;
#line 5561 "test-new/imp918s.imp"
goto U_105B;
#line 5561 "test-new/imp918s.imp"
L_0525:;
// 5562 ->RF2 %IF REGISTER(I)<0 %AND(26<=JJ<=27 %OR 30<=JJ<=31)
#line 5562 "test-new/imp918s.imp"
if (REGISTER[I] >= 0) goto L_0526;
#line 5562 "test-new/imp918s.imp"
{
// Double-sided test on JJ (Part I)
#line 5562 "test-new/imp918s.imp"
int tmp;
#line 5562 "test-new/imp918s.imp"
if (26 > (tmp = JJ)) goto L_0527;
// Double-sided test on JJ (Part II)
#line 5562 "test-new/imp918s.imp"
if (tmp <= 27) goto L_0528;
#line 5562 "test-new/imp918s.imp"
}
#line 5562 "test-new/imp918s.imp"
L_0527:;
#line 5562 "test-new/imp918s.imp"
{
// Double-sided test on JJ (Part I)
#line 5562 "test-new/imp918s.imp"
int tmp;
#line 5562 "test-new/imp918s.imp"
if (30 > (tmp = JJ)) goto L_0526;
// Double-sided test on JJ (Part II)
#line 5562 "test-new/imp918s.imp"
if (tmp > 31) goto L_0526;
#line 5562 "test-new/imp918s.imp"
}
#line 5562 "test-new/imp918s.imp"
L_0528:;
#line 5562 "test-new/imp918s.imp"
goto U_105C;
#line 5562 "test-new/imp918s.imp"
L_0526:;
// 5563 ->RF2 %IF MODE=1
#line 5563 "test-new/imp918s.imp"
if (MODE != 1) goto L_0529;
#line 5563 "test-new/imp918s.imp"
goto U_105C;
#line 5563 "test-new/imp918s.imp"
L_0529:;
// 5564 %FINISH
#line 5564 "test-new/imp918s.imp"
L_0524:;
// 5565 REG=FINDR %IF REG<0
#line 5565 "test-new/imp918s.imp"
if (REG >= 0) goto L_052A;
#line 5565 "test-new/imp918s.imp"
REG = FINDR();
#line 5565 "test-new/imp918s.imp"
L_052A:;
// 5566 PRR(X'18',REG,I) %UNLESS REG=I
#line 5566 "test-new/imp918s.imp"
if (REG == I) goto L_052B;
#line 5566 "test-new/imp918s.imp"
PRR(24, REG, I);
#line 5566 "test-new/imp918s.imp"
L_052B:;
// 5567 REGISTER(REG)=1 %IF REGISTER(REG)=0
#line 5567 "test-new/imp918s.imp"
if (REGISTER[REG] != 0) goto L_052C;
#line 5567 "test-new/imp918s.imp"
REGISTER[REG] = 1;
#line 5567 "test-new/imp918s.imp"
L_052C:;
// 5568 SG: SET USE(REG,2,VALUE) %UNLESS REGISTER(REG)<0
#line 5568 "test-new/imp918s.imp"
U_105D:;
#line 5568 "test-new/imp918s.imp"
if (REGISTER[REG] < 0) goto L_052D;
#line 5568 "test-new/imp918s.imp"
SETUSE(REG, 2, VALUE);
#line 5568 "test-new/imp918s.imp"
L_052D:;
// 5569 Label1: OPND_PTYPE=1
#line 5569 "test-new/imp918s.imp"
U_105E:;
#line 5569 "test-new/imp918s.imp"
OPND->PTYPE = 1;
// 5570 Label2: OPND_FLAG=9
#line 5570 "test-new/imp918s.imp"
U_105F:;
#line 5570 "test-new/imp918s.imp"
OPND->FLAG = 9;
// 5571 OPND_XB=REG
#line 5571 "test-new/imp918s.imp"
OPND->XB = REG;
// 5572 OPND_D=-2
#line 5572 "test-new/imp918s.imp"
OPND->D = -2;
// 5573 ->Label99
#line 5573 "test-new/imp918s.imp"
goto U_1059;
// 5574 RF: REGISTER(I)=1
#line 5574 "test-new/imp918s.imp"
U_105B:;
#line 5574 "test-new/imp918s.imp"
REGISTER[I] = 1;
// 5575 RF2: REG=I; ->Label1
#line 5575 "test-new/imp918s.imp"
U_105C:;
#line 5575 "test-new/imp918s.imp"
REG = I;
#line 5575 "test-new/imp918s.imp"
goto U_105E;
// 5576 NOT FOUND: -> GLA COPY %IF MODE&1#0 %AND VALUE#0 %AND CSSMODE#0
#line 5576 "test-new/imp918s.imp"
U_105A:;
#line 5576 "test-new/imp918s.imp"
if (MODE & 1 == 0) goto L_052E;
#line 5576 "test-new/imp918s.imp"
if (VALUE == 0) goto L_052E;
#line 5576 "test-new/imp918s.imp"
if (CSSMODE == 0) goto L_052E;
#line 5576 "test-new/imp918s.imp"
goto U_1060;
#line 5576 "test-new/imp918s.imp"
L_052E:;
// 5577 REG=FINDR %IF REG<0
#line 5577 "test-new/imp918s.imp"
if (REG >= 0) goto L_052F;
#line 5577 "test-new/imp918s.imp"
REG = FINDR();
#line 5577 "test-new/imp918s.imp"
L_052F:;
// 5578 DUMP(0,REG,VALUE,0,0); -> SG
#line 5578 "test-new/imp918s.imp"
DUMP(0, REG, VALUE, 0, 0);
#line 5578 "test-new/imp918s.imp"
goto U_105D;
// 5579 GLA COPY:TYPE=1; K=4; PREC=0
#line 5579 "test-new/imp918s.imp"
U_1060:;
#line 5579 "test-new/imp918s.imp"
TYPE = 1;
#line 5579 "test-new/imp918s.imp"
K = 4;
#line 5579 "test-new/imp918s.imp"
PREC = 0;
// 5580 -> FULL L %UNLESS X'19'<=OPCODE<=X'1B'
#line 5580 "test-new/imp918s.imp"
{
// Double-sided test on OPCODE (Part I)
#line 5580 "test-new/imp918s.imp"
int tmp;
#line 5580 "test-new/imp918s.imp"
if (25 > (tmp = OPCODE)) goto L_0530;
// Double-sided test on OPCODE (Part II)
#line 5580 "test-new/imp918s.imp"
if (tmp <= 27) goto L_0531;
#line 5580 "test-new/imp918s.imp"
}
#line 5580 "test-new/imp918s.imp"
L_0530:;
#line 5580 "test-new/imp918s.imp"
goto U_1061;
#line 5580 "test-new/imp918s.imp"
L_0531:;
// 5581 J=CONST FIND(4,ADDR(VALUE))
#line 5581 "test-new/imp918s.imp"
J = CONSTFIND(4, _imp_ADDR(/*?*/ &VALUE));
// 5582 %UNLESS J=-1 %START
#line 5582 "test-new/imp918s.imp"
if (J == -1) goto L_0532;
// 5583 %IF J<0 %THEN BASE=CODER %ELSE BASE=GLA
#line 5583 "test-new/imp918s.imp"
if (J >= 0) goto L_0533;
#line 5583 "test-new/imp918s.imp"
BASE = 12;
#line 5583 "test-new/imp918s.imp"
goto L_0534;
#line 5583 "test-new/imp918s.imp"
L_0533:;
#line 5583 "test-new/imp918s.imp"
BASE = 13;
#line 5583 "test-new/imp918s.imp"
L_0534:;
// 5584 DISP=J&X'7FFF'; INDEX=0; ->RESET RD
#line 5584 "test-new/imp918s.imp"
DISP = J & 32767;
#line 5584 "test-new/imp918s.imp"
INDEX = 0;
#line 5584 "test-new/imp918s.imp"
goto U_1062;
// 5585 %FINISH
#line 5585 "test-new/imp918s.imp"
L_0532:;
// 5586 PREC=2; K=2
#line 5586 "test-new/imp918s.imp"
PREC = 2;
#line 5586 "test-new/imp918s.imp"
K = 2;
// 5587 FULL L: STORE CONST(BASE,DISP,K,ADDR(VALUE)+4-K)
#line 5587 "test-new/imp918s.imp"
U_1061:;
#line 5587 "test-new/imp918s.imp"
STORECONST(/*?*/ &BASE, /*?*/ &DISP, K, _imp_ADDR(/*?*/ &VALUE) + 4 - K);
// 5588 INDEX=0; ->RESET RD
#line 5588 "test-new/imp918s.imp"
INDEX = 0;
#line 5588 "test-new/imp918s.imp"
goto U_1062;
// 5589 SW(1): ! LONG CONSTANT
#line 5589 "test-new/imp918s.imp"
case_SW_1:;
// 5590 STORE CONST(BASE,DISP,BYTES(PREC),ADDR(A(OPND_D+1)))
#line 5590 "test-new/imp918s.imp"
STORECONST(/*?*/ &BASE, /*?*/ &DISP, BYTES[PREC], _imp_ADDR(/*?*/ &A[OPND->D + 1 + 7]));
// 5591 -> PICK UP %IF MODE=2
#line 5591 "test-new/imp918s.imp"
if (MODE != 2) goto L_0535;
#line 5591 "test-new/imp918s.imp"
goto U_1063;
#line 5591 "test-new/imp918s.imp"
L_0535:;
// 5592 INDEX=0; ->RESET RD
#line 5592 "test-new/imp918s.imp"
INDEX = 0;
#line 5592 "test-new/imp918s.imp"
goto U_1062;
// 5593 PICKUP: DUMP(8*(TYPE-1)+2*(PREC&3)+2,REG,DISP,0,BASE)
#line 5593 "test-new/imp918s.imp"
U_1063:;
#line 5593 "test-new/imp918s.imp"
DUMP(8 * (TYPE - 1) + 2 * (PREC & 3) + 2, REG, DISP, 0, BASE);
// 5594 MODE=0; ->Label21; ! ENSURE THAT USE IS CHANGED
#line 5594 "test-new/imp918s.imp"
MODE = 0;
#line 5594 "test-new/imp918s.imp"
goto U_1064;
// 5595 SW(2): ! NAME
#line 5595 "test-new/imp918s.imp"
case_SW_2:;
// 5596 -> LOAD %IF MODE=2
#line 5596 "test-new/imp918s.imp"
if (MODE != 2) goto L_0536;
#line 5596 "test-new/imp918s.imp"
goto U_1065;
#line 5596 "test-new/imp918s.imp"
L_0536:;
// 5597 ->STORE %IF MODE=4
#line 5597 "test-new/imp918s.imp"
if (MODE != 4) goto L_0537;
#line 5597 "test-new/imp918s.imp"
goto U_1066;
#line 5597 "test-new/imp918s.imp"
L_0537:;
// 5598 -> LOAD %IF OPND_XB&127#0 %AND PTYPE#8
#line 5598 "test-new/imp918s.imp"
if (OPND->XB & 127 == 0) goto L_0538;
#line 5598 "test-new/imp918s.imp"
if (PTYPE == 8) goto L_0538;
#line 5598 "test-new/imp918s.imp"
goto U_1065;
#line 5598 "test-new/imp918s.imp"
L_0538:;
// 5599 -> LOAD %IF MODE=0 %AND ARR>0
#line 5599 "test-new/imp918s.imp"
if (MODE != 0) goto L_0539;
#line 5599 "test-new/imp918s.imp"
if (ARR <= 0) goto L_0539;
#line 5599 "test-new/imp918s.imp"
goto U_1065;
#line 5599 "test-new/imp918s.imp"
L_0539:;
// 5600 -> DONT LOAD %IF MODE=3
#line 5600 "test-new/imp918s.imp"
if (MODE != 3) goto L_053A;
#line 5600 "test-new/imp918s.imp"
goto U_1067;
#line 5600 "test-new/imp918s.imp"
L_053A:;
// 5601 ->Label99 %IF MODE=0
#line 5601 "test-new/imp918s.imp"
if (MODE != 0) goto L_053B;
#line 5601 "test-new/imp918s.imp"
goto U_1059;
#line 5601 "test-new/imp918s.imp"
L_053B:;
// 5602 %IF MODE=1 %THEN %START
#line 5602 "test-new/imp918s.imp"
if (MODE != 1) goto L_053C;
// 5603 -> LOAD %IF PREC=1
#line 5603 "test-new/imp918s.imp"
if (PREC != 1) goto L_053D;
#line 5603 "test-new/imp918s.imp"
goto U_1065;
#line 5603 "test-new/imp918s.imp"
L_053D:;
// 5604 -> DONT LOAD %IF PREC=2 %AND X'19'<=OPCODE<=X'1B'
#line 5604 "test-new/imp918s.imp"
if (PREC != 2) goto L_053E;
#line 5604 "test-new/imp918s.imp"
{
// Double-sided test on OPCODE (Part I)
#line 5604 "test-new/imp918s.imp"
int tmp;
#line 5604 "test-new/imp918s.imp"
if (25 > (tmp = OPCODE)) goto L_053E;
// Double-sided test on OPCODE (Part II)
#line 5604 "test-new/imp918s.imp"
if (tmp > 27) goto L_053E;
#line 5604 "test-new/imp918s.imp"
}
#line 5604 "test-new/imp918s.imp"
goto U_1067;
#line 5604 "test-new/imp918s.imp"
L_053E:;
// 5605 -> LOAD %IF PREC=2
#line 5605 "test-new/imp918s.imp"
if (PREC != 2) goto L_053F;
#line 5605 "test-new/imp918s.imp"
goto U_1065;
#line 5605 "test-new/imp918s.imp"
L_053F:;
// 5606 %FINISH
#line 5606 "test-new/imp918s.imp"
L_053C:;
// 5607 DONT LOAD: P=OPND_D
#line 5607 "test-new/imp918s.imp"
U_1067:;
#line 5607 "test-new/imp918s.imp"
P = OPND->D;
// 5608 CNAME(5,REG)
#line 5608 "test-new/imp918s.imp"
CNAME(5, REG);
// 5609 ->Label21 %IF NEST>=0
#line 5609 "test-new/imp918s.imp"
if (NEST < 0) goto L_0540;
#line 5609 "test-new/imp918s.imp"
goto U_1064;
#line 5609 "test-new/imp918s.imp"
L_0540:;
// 5610 RESETRD: REGISTER(BASE)=2 %IF BASE>0 %AND REGISTER(BASE)=0
#line 5610 "test-new/imp918s.imp"
U_1062:;
#line 5610 "test-new/imp918s.imp"
if (BASE <= 0) goto L_0541;
#line 5610 "test-new/imp918s.imp"
if (REGISTER[BASE] != 0) goto L_0541;
#line 5610 "test-new/imp918s.imp"
REGISTER[BASE] = 2;
#line 5610 "test-new/imp918s.imp"
L_0541:;
// 5611 REGISTER(INDEX)=2 %IF INDEX>0 %AND REGISTER(INDEX)=0
#line 5611 "test-new/imp918s.imp"
if (INDEX <= 0) goto L_0542;
#line 5611 "test-new/imp918s.imp"
if (REGISTER[INDEX] != 0) goto L_0542;
#line 5611 "test-new/imp918s.imp"
REGISTER[INDEX] = 2;
#line 5611 "test-new/imp918s.imp"
L_0542:;
// 5612 OPND_PTYPE=10*(PREC&3)+TYPE
#line 5612 "test-new/imp918s.imp"
OPND->PTYPE = 10 * (PREC & 3) + TYPE;
// 5613 OPND_FLAG=9
#line 5613 "test-new/imp918s.imp"
OPND->FLAG = 9;
// 5614 OPND_XB=INDEX<<4!BASE
#line 5614 "test-new/imp918s.imp"
OPND->XB = INDEX << 4 | BASE;
// 5615 OPND_D=DISP; ->Label99
#line 5615 "test-new/imp918s.imp"
OPND->D = DISP;
#line 5615 "test-new/imp918s.imp"
goto U_1059;
// 5616 STORE: P=OPND_D
#line 5616 "test-new/imp918s.imp"
U_1066:;
#line 5616 "test-new/imp918s.imp"
P = OPND->D;
// 5617 CNAME(1,0); ->RESET RD
#line 5617 "test-new/imp918s.imp"
CNAME(1, 0);
#line 5617 "test-new/imp918s.imp"
goto U_1062;
// 5618 LOAD: P=OPND_D
#line 5618 "test-new/imp918s.imp"
U_1065:;
#line 5618 "test-new/imp918s.imp"
P = OPND->D;
// 5619 -> REGVAR %IF PTYPE=8
#line 5619 "test-new/imp918s.imp"
if (PTYPE != 8) goto L_0543;
#line 5619 "test-new/imp918s.imp"
goto U_1068;
#line 5619 "test-new/imp918s.imp"
L_0543:;
// 5620 CNAME(2,REG)
#line 5620 "test-new/imp918s.imp"
CNAME(2, REG);
// 5621 Label21: REG=NEST %IF REG<0
#line 5621 "test-new/imp918s.imp"
U_1064:;
#line 5621 "test-new/imp918s.imp"
if (REG >= 0) goto L_0544;
#line 5621 "test-new/imp918s.imp"
REG = NEST;
#line 5621 "test-new/imp918s.imp"
L_0544:;
// 5622 TYPE=1 %IF TYPE=8
#line 5622 "test-new/imp918s.imp"
if (TYPE != 8) goto L_0545;
#line 5622 "test-new/imp918s.imp"
TYPE = 1;
#line 5622 "test-new/imp918s.imp"
L_0545:;
// 5623 PTYPE=TYPE; K=(PTYPE&2)<<3+REG
#line 5623 "test-new/imp918s.imp"
PTYPE = TYPE;
#line 5623 "test-new/imp918s.imp"
K = ((PTYPE & 2) << 3) + REG;
// 5624 REGISTER(K)=1 %IF REGISTER(K)>=0; ! CLAIM THE REGISTER
#line 5624 "test-new/imp918s.imp"
if (REGISTER[K] < 0) goto L_0546;
#line 5624 "test-new/imp918s.imp"
REGISTER[K] = 1;
#line 5624 "test-new/imp918s.imp"
L_0546:;
// 5625 PTYPE=32 %IF PREC=3
#line 5625 "test-new/imp918s.imp"
if (PREC != 3) goto L_0547;
#line 5625 "test-new/imp918s.imp"
PTYPE = 32;
#line 5625 "test-new/imp918s.imp"
L_0547:;
// 5626 ->Label24 %IF MODE>=1 %AND GRUSE(K)>1; ! DONT CHANGE GRUSE
#line 5626 "test-new/imp918s.imp"
if (MODE < 1) goto L_0548;
#line 5626 "test-new/imp918s.imp"
if (GRUSE[K] <= 1) goto L_0548;
#line 5626 "test-new/imp918s.imp"
goto U_1069;
#line 5626 "test-new/imp918s.imp"
L_0548:;
// 5627 SET USE(K,1,ADDR(OPND))
#line 5627 "test-new/imp918s.imp"
SETUSE(K, 1, _imp_ADDR(OPND));
// 5628 Label24: OPND_PTYPE=PTYPE; ->Label2
#line 5628 "test-new/imp918s.imp"
U_1069:;
#line 5628 "test-new/imp918s.imp"
OPND->PTYPE = PTYPE;
#line 5628 "test-new/imp918s.imp"
goto U_105F;
// 5629 REGVAR: %IF OPCODE=X'19' %OR 30<=JJ<=31 %OR %C
#line 5629 "test-new/imp918s.imp"
U_1068:;
#line 5629 "test-new/imp918s.imp"
if (OPCODE == 25) goto L_0549;
#line 5629 "test-new/imp918s.imp"
{
// Double-sided test on JJ (Part I)
#line 5629 "test-new/imp918s.imp"
int tmp;
#line 5629 "test-new/imp918s.imp"
if (30 > (tmp = JJ)) goto L_054A;
// Double-sided test on JJ (Part II)
#line 5629 "test-new/imp918s.imp"
if (tmp <= 31) goto L_0549;
#line 5629 "test-new/imp918s.imp"
}
#line 5629 "test-new/imp918s.imp"
L_054A:;
#line 5629 "test-new/imp918s.imp"
if (NOPS != 1) goto L_054B;
#line 5629 "test-new/imp918s.imp"
if (OPND->XB != SPECREG) goto L_054B;
#line 5629 "test-new/imp918s.imp"
if (REG < 0) goto L_0549;
#line 5629 "test-new/imp918s.imp"
L_054B:;
#line 5629 "test-new/imp918s.imp"
if (NOPS != 0) goto L_054C;
#line 5629 "test-new/imp918s.imp"
if (REG >= 0) goto L_054C;
#line 5629 "test-new/imp918s.imp"
L_0549:;
#line 5629 "test-new/imp918s.imp"
REG = OPND->XB;
#line 5629 "test-new/imp918s.imp"
goto U_105E;
#line 5629 "test-new/imp918s.imp"
L_054C:;
// 5630+ (NOPS=1 %AND OPND_XB=SPECREG %AND REG<0) %OR %C
// 5631+ (NOPS=0 %AND REG<0) %THEN REG=OPND_XB %AND ->Label1
// 5632 REG=FINDR %IF REG<0
#line 5632 "test-new/imp918s.imp"
if (REG >= 0) goto L_054D;
#line 5632 "test-new/imp918s.imp"
REG = FINDR();
#line 5632 "test-new/imp918s.imp"
L_054D:;
// 5633 %IF REGISTER(REG)>=0 %THEN %START; ! N.B. REGVAR1=REGVAR2
#line 5633 "test-new/imp918s.imp"
if (REGISTER[REG] < 0) goto L_054E;
// 5634 FORGET(REG); GRUSE(REG)=3; GRINF(REG)=TAGS(A(P))
#line 5634 "test-new/imp918s.imp"
FORGET(REG);
#line 5634 "test-new/imp918s.imp"
GRUSE[REG] = 3;
#line 5634 "test-new/imp918s.imp"
GRINF[REG] = TAGS[A[P + 7]];
// 5635 %FINISH
#line 5635 "test-new/imp918s.imp"
L_054E:;
// 5636 CNAME(2,REG); TYPE=1; ->Label21
#line 5636 "test-new/imp918s.imp"
CNAME(2, REG);
#line 5636 "test-new/imp918s.imp"
TYPE = 1;
#line 5636 "test-new/imp918s.imp"
goto U_1064;
// 5637 SW(3): ! DOPE VECTOR ITEM
#line 5637 "test-new/imp918s.imp"
case_SW_3:;
// 5638 ! XB HAS BASE OF ARRAYHEAD D IS HEADDISP<<16!ITEM DISP. XTRA HAS TAGS
// 5639 ->Label99 %IF MODE=0
#line 5639 "test-new/imp918s.imp"
if (MODE != 0) goto L_054F;
#line 5639 "test-new/imp918s.imp"
goto U_1059;
#line 5639 "test-new/imp918s.imp"
L_054F:;
// 5640 LOAD DV(BASE,OPND_XB,OPND_D>>16,OPND_XTRA)
#line 5640 "test-new/imp918s.imp"
LOADDV(/*?*/ &BASE, OPND->XB, (unsigned int)OPND->D >> 16, OPND->XTRA);
// 5641 INDEX=0; DISP=OPND_D&X'FFFF'
#line 5641 "test-new/imp918s.imp"
INDEX = 0;
#line 5641 "test-new/imp918s.imp"
DISP = OPND->D & 65535;
// 5642 -> RESET RD; ! NOT CALLED WITH MODE=2
#line 5642 "test-new/imp918s.imp"
goto U_1062;
// 5643 SW(7):SW(8):SW(9):
#line 5643 "test-new/imp918s.imp"
case_SW_7:;
#line 5643 "test-new/imp918s.imp"
case_SW_8:;
#line 5643 "test-new/imp918s.imp"
case_SW_9:;
// 5644 ->Label99 %IF MODE=3 %OR MODE=4
#line 5644 "test-new/imp918s.imp"
if (MODE == 3) goto L_0550;
#line 5644 "test-new/imp918s.imp"
if (MODE != 4) goto L_0551;
#line 5644 "test-new/imp918s.imp"
L_0550:;
#line 5644 "test-new/imp918s.imp"
goto U_1059;
#line 5644 "test-new/imp918s.imp"
L_0551:;
// 5645 ->PROTECT %IF MODE=0
#line 5645 "test-new/imp918s.imp"
if (MODE != 0) goto L_0552;
#line 5645 "test-new/imp918s.imp"
goto U_106A;
#line 5645 "test-new/imp918s.imp"
L_0552:;
// 5646 ->Label99 %IF MODE=1 %AND(PREC=0 %OR PREC=3 %OR(PREC=2 %AND %C
#line 5646 "test-new/imp918s.imp"
if (MODE != 1) goto L_0553;
#line 5646 "test-new/imp918s.imp"
if (PREC == 0) goto L_0554;
#line 5646 "test-new/imp918s.imp"
if (PREC == 3) goto L_0554;
#line 5646 "test-new/imp918s.imp"
if (PREC != 2) goto L_0553;
#line 5646 "test-new/imp918s.imp"
{
// Double-sided test on OPCODE (Part I)
#line 5646 "test-new/imp918s.imp"
int tmp;
#line 5646 "test-new/imp918s.imp"
if (25 > (tmp = OPCODE)) goto L_0553;
// Double-sided test on OPCODE (Part II)
#line 5646 "test-new/imp918s.imp"
if (tmp > 27) goto L_0553;
#line 5646 "test-new/imp918s.imp"
}
#line 5646 "test-new/imp918s.imp"
L_0554:;
#line 5646 "test-new/imp918s.imp"
goto U_1059;
#line 5646 "test-new/imp918s.imp"
L_0553:;
// 5647+ X'19'<=OPCODE<=X'1B'))
// 5648 B=OPND_XB
#line 5648 "test-new/imp918s.imp"
B = OPND->XB;
// 5649 -> RDR %IF OPND_D<0
#line 5649 "test-new/imp918s.imp"
if (OPND->D >= 0) goto L_0555;
#line 5649 "test-new/imp918s.imp"
goto U_106B;
#line 5649 "test-new/imp918s.imp"
L_0555:;
// 5650 %IF REG<0 %AND TYPE=1 %THEN REG=FINDR;! IN CASE OF SPECREG
#line 5650 "test-new/imp918s.imp"
if (REG >= 0) goto L_0556;
#line 5650 "test-new/imp918s.imp"
if (TYPE != 1) goto L_0556;
#line 5650 "test-new/imp918s.imp"
REG = FINDR();
#line 5650 "test-new/imp918s.imp"
L_0556:;
// 5651 DUMP(TYPE<<3!2*(PREC&3)-6,REG,OPND_D,B>>4,B&15)
#line 5651 "test-new/imp918s.imp"
DUMP((TYPE << 3 | 2 * (PREC & 3)) - 6, REG, OPND->D, (unsigned int)B >> 4, B & 15);
// 5652 MODE=0; ! ENSURE USE IS CHANGED
#line 5652 "test-new/imp918s.imp"
MODE = 0;
// 5653 UNRESERVE(B); ->Label21
#line 5653 "test-new/imp918s.imp"
UNRESERVE(B);
#line 5653 "test-new/imp918s.imp"
goto U_1064;
// 5654 PROTECT: BASE=OPND_XB; INDEX=BASE>>4
#line 5654 "test-new/imp918s.imp"
U_106A:;
#line 5654 "test-new/imp918s.imp"
BASE = OPND->XB;
#line 5654 "test-new/imp918s.imp"
INDEX = (unsigned int)BASE >> 4;
// 5655 BASE=BASE&15; DISP=OPND_D; ! SAFEGUARD FROM OVERWRITING
#line 5655 "test-new/imp918s.imp"
BASE = BASE & 15;
#line 5655 "test-new/imp918s.imp"
DISP = OPND->D;
// 5656 ->RESET RD %IF OPND_D>=0
#line 5656 "test-new/imp918s.imp"
if (OPND->D < 0) goto L_0557;
#line 5656 "test-new/imp918s.imp"
goto U_1062;
#line 5656 "test-new/imp918s.imp"
L_0557:;
// 5657 K=(TYPE&2)<<3+BASE
#line 5657 "test-new/imp918s.imp"
K = ((TYPE & 2) << 3) + BASE;
// 5658 REGISTER(K)=1 %IF REGISTER(K)>=0; ! CLAIM THE REGISTER
#line 5658 "test-new/imp918s.imp"
if (REGISTER[K] < 0) goto L_0558;
#line 5658 "test-new/imp918s.imp"
REGISTER[K] = 1;
#line 5658 "test-new/imp918s.imp"
L_0558:;
// 5659 %IF GRUSE(K)=1 %THEN GRINF(K)=ADDR(OPND) %ELSE %C
#line 5659 "test-new/imp918s.imp"
if (GRUSE[K] != 1) goto L_0559;
#line 5659 "test-new/imp918s.imp"
GRINF[K] = _imp_ADDR(OPND);
#line 5659 "test-new/imp918s.imp"
goto L_055A;
#line 5659 "test-new/imp918s.imp"
L_0559:;
#line 5659 "test-new/imp918s.imp"
SETUSE(K, 1, _imp_ADDR(OPND));
#line 5659 "test-new/imp918s.imp"
L_055A:;
// 5660+ SET USE(K,1,ADDR(OPND)); ->Label99
#line 5660 "test-new/imp918s.imp"
goto U_1059;
// 5661 RDR: ->Label99 %IF REG<0 %OR REG=B
#line 5661 "test-new/imp918s.imp"
U_106B:;
#line 5661 "test-new/imp918s.imp"
if (REG < 0) goto L_055B;
#line 5661 "test-new/imp918s.imp"
if (REG != B) goto L_055C;
#line 5661 "test-new/imp918s.imp"
L_055B:;
#line 5661 "test-new/imp918s.imp"
goto U_1059;
#line 5661 "test-new/imp918s.imp"
L_055C:;
// 5662 K=B; J=X'18'
#line 5662 "test-new/imp918s.imp"
K = B;
#line 5662 "test-new/imp918s.imp"
J = 24;
// 5663 %IF TYPE=2 %THEN %START
#line 5663 "test-new/imp918s.imp"
if (TYPE != 2) goto L_055D;
// 5664 K=K+16; J=X'38'-16*(PREC&1); %FINISH
#line 5664 "test-new/imp918s.imp"
K = K + 16;
#line 5664 "test-new/imp918s.imp"
J = 56 - 16 * (PREC & 1);
#line 5664 "test-new/imp918s.imp"
L_055D:;
// 5665 PRR(J,REG,B)
#line 5665 "test-new/imp918s.imp"
PRR(J, REG, B);
// 5666 SET USE((TYPE&2)<<3+REG,GRUSE(K),GRINF(K))
#line 5666 "test-new/imp918s.imp"
SETUSE(((TYPE & 2) << 3) + REG, GRUSE[K], GRINF[K]);
// 5667 REGISTER((TYPE&2)<<3+B)=0; OPND_XB=REG
#line 5667 "test-new/imp918s.imp"
REGISTER[((TYPE & 2) << 3) + B] = 0;
#line 5667 "test-new/imp918s.imp"
OPND->XB = REG;
// 5668 Label99: TYPE=1 %IF TYPE=8 ;%END
#line 5668 "test-new/imp918s.imp"
U_1059:;
#line 5668 "test-new/imp918s.imp"
if (TYPE != 8) goto L_055E;
#line 5668 "test-new/imp918s.imp"
TYPE = 1;
#line 5668 "test-new/imp918s.imp"
L_055E:;
#line 5668 "test-new/imp918s.imp"
return;
#line 5668 "test-new/imp918s.imp"
case_SW_dispatch:
#line 5668 "test-new/imp918s.imp"
if (SW_index < 0 || SW_index > 9)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 5668 "test-new/imp918s.imp"
goto *SW[SW_index - 0];
#line 5668 "test-new/imp918s.imp"
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file,
SW_line);
#line 5668 "test-new/imp918s.imp"
} /* end of LOAD */
// 5669 %ROUTINE UNRESERVE(%INTEGER XB)
#line 5669 "test-new/imp918s.imp"
void UNRESERVE(int XB) {
// 5670 {%SHORTROUTINE}
// 5671 %INTEGER B
#line 5671 "test-new/imp918s.imp"
int B;
// 5672 B=XB&15
#line 5672 "test-new/imp918s.imp"
B = XB & 15;
// 5673 REGISTER(B)=0 %IF REGISTER(B)=2
#line 5673 "test-new/imp918s.imp"
if (REGISTER[B] != 2) goto L_055F;
#line 5673 "test-new/imp918s.imp"
REGISTER[B] = 0;
#line 5673 "test-new/imp918s.imp"
L_055F:;
// 5674 XB=XB>>4
#line 5674 "test-new/imp918s.imp"
XB = (unsigned int)XB >> 4;
// 5675 REGISTER(XB)=0 %IF REGISTER(XB)=2
#line 5675 "test-new/imp918s.imp"
if (REGISTER[XB] != 2) goto L_0560;
#line 5675 "test-new/imp918s.imp"
REGISTER[XB] = 0;
#line 5675 "test-new/imp918s.imp"
L_0560:;
// 5676 %END
#line 5676 "test-new/imp918s.imp"
return;
#line 5676 "test-new/imp918s.imp"
} /* end of UNRESERVE */
// 5677 %ROUTINE PUT
#line 5677 "test-new/imp918s.imp"
void PUT(void) {
// 5678 {%SHORTROUTINE}
// 5679 %COMMENT THIS ROUTINE PLANTS CODE TO PERFORM THE BASIC
// 5680 ! OPERATION DEFINED BY OPND1,OPND2 & OPCODE
// 5681 ! OPCODE IS IN INTEGER RR FORM
// 5682 %INTEGER I,J,K,CODE,X,B,D
#line 5682 "test-new/imp918s.imp"
int I;
#line 5682 "test-new/imp918s.imp"
int J;
#line 5682 "test-new/imp918s.imp"
int K;
#line 5682 "test-new/imp918s.imp"
int CODE;
#line 5682 "test-new/imp918s.imp"
int X;
#line 5682 "test-new/imp918s.imp"
int B;
#line 5682 "test-new/imp918s.imp"
int D;
// 5683 PTYPE=OPND2_PTYPE;! UNPACK
#line 5683 "test-new/imp918s.imp"
PTYPE = OPND2->PTYPE;
// 5684 !%if USE MC = 1 %start
// 5685 ! *L_1,PTYPE; *CVD_1,0(11)
// 5686 ! *UNPK_ROUT(5),5(3,11)
// 5687 ! *NC_ROUT(5),MASK1
// 5688 !%finish
// 5689 CODE=OPCODE
#line 5689 "test-new/imp918s.imp"
CODE = OPCODE;
// 5690 %IF TYPE=2 %THEN %START
#line 5690 "test-new/imp918s.imp"
if (TYPE != 2) goto L_0561;
// 5691 CODE=CODE+32; CODE=CODE-16 %IF PREC&3=3
#line 5691 "test-new/imp918s.imp"
CODE = CODE + 32;
#line 5691 "test-new/imp918s.imp"
if (PREC & 3 != 3) goto L_0562;
#line 5691 "test-new/imp918s.imp"
CODE = CODE - 16;
#line 5691 "test-new/imp918s.imp"
L_0562:;
// 5692 %FINISH %ELSE %START
#line 5692 "test-new/imp918s.imp"
goto L_0563;
#line 5692 "test-new/imp918s.imp"
L_0561:;
// 5693 CODE=CODE-16 %IF PREC=2; %FINISH
#line 5693 "test-new/imp918s.imp"
if (PREC != 2) goto L_0564;
#line 5693 "test-new/imp918s.imp"
CODE = CODE - 16;
#line 5693 "test-new/imp918s.imp"
L_0564:;
#line 5693 "test-new/imp918s.imp"
L_0563:;
// 5694 ->RROP %IF OPND2_D<0
#line 5694 "test-new/imp918s.imp"
if (OPND2->D >= 0) goto L_0565;
#line 5694 "test-new/imp918s.imp"
goto U_1057;
#line 5694 "test-new/imp918s.imp"
L_0565:;
// 5695 X=OPND2_XB>>4; B=OPND2_XB&15
#line 5695 "test-new/imp918s.imp"
X = (unsigned int)OPND2->XB >> 4;
#line 5695 "test-new/imp918s.imp"
B = OPND2->XB & 15;
// 5696 D=OPND2_D; CODE=CODE+64
#line 5696 "test-new/imp918s.imp"
D = OPND2->D;
#line 5696 "test-new/imp918s.imp"
CODE = CODE + 64;
// 5697 DUMP(CODE,OPND1_XB,D,X,B)
#line 5697 "test-new/imp918s.imp"
DUMP(CODE, OPND1->XB, D, X, B);
// 5698 UNRESERVE(OPND2_XB)
#line 5698 "test-new/imp918s.imp"
UNRESERVE(OPND2->XB);
// 5699 ->Label99
#line 5699 "test-new/imp918s.imp"
goto U_1058;
// 5700 RROP: PRR(CODE,OPND1_XB,OPND2_XB)
#line 5700 "test-new/imp918s.imp"
U_1057:;
#line 5700 "test-new/imp918s.imp"
PRR(CODE, OPND1->XB, OPND2->XB);
// 5701 K=(TYPE&2)<<3+OPND2_XB
#line 5701 "test-new/imp918s.imp"
K = ((TYPE & 2) << 3) + OPND2->XB;
// 5702 REGISTER(K)=0 %UNLESS REGISTER(K)<0 %OR OPND1_XB=OPND2_XB
#line 5702 "test-new/imp918s.imp"
if (REGISTER[K] < 0) goto L_0566;
#line 5702 "test-new/imp918s.imp"
if (OPND1->XB == OPND2->XB) goto L_0566;
#line 5702 "test-new/imp918s.imp"
REGISTER[K] = 0;
#line 5702 "test-new/imp918s.imp"
L_0566:;
// 5703 Label99: K=(TYPE&2)<<3+OPND1_XB
#line 5703 "test-new/imp918s.imp"
U_1058:;
#line 5703 "test-new/imp918s.imp"
K = ((TYPE & 2) << 3) + OPND1->XB;
// 5704 %IF OPCODE=X'19' %THEN %START
#line 5704 "test-new/imp918s.imp"
if (OPCODE != 25) goto L_0567;
// 5705 REGISTER(K)=0 %IF REGISTER(K)>0
#line 5705 "test-new/imp918s.imp"
if (REGISTER[K] <= 0) goto L_0568;
#line 5705 "test-new/imp918s.imp"
REGISTER[K] = 0;
#line 5705 "test-new/imp918s.imp"
L_0568:;
// 5706 %FINISH %ELSE SET USE(K,1,ADDR(OPND1))
#line 5706 "test-new/imp918s.imp"
goto L_0569;
#line 5706 "test-new/imp918s.imp"
L_0567:;
#line 5706 "test-new/imp918s.imp"
SETUSE(K, 1, _imp_ADDR(OPND1));
#line 5706 "test-new/imp918s.imp"
L_0569:;
// 5707 %END
#line 5707 "test-new/imp918s.imp"
return;
#line 5707 "test-new/imp918s.imp"
} /* end of PUT */
// ?J unused
// ?I unused
// 5708 %ROUTINE LOAD PAIR(%INTEGER ODDEVEN)
#line 5708 "test-new/imp918s.imp"
void LOADPAIR(int ODDEVEN) {
// 5709 {%SHORTROUTINE}
// 5710 ! THIS ROUTINE LOADS OPERAND 1 INTO AN EVEN0ODDPAIR
// 5711 ! THE PAIR IS CLAIMED AS LATE AS POSSIBLE
// 5712 %INTEGER PAIR,TOTHER
#line 5712 "test-new/imp918s.imp"
int PAIR;
#line 5712 "test-new/imp918s.imp"
int TOTHER;
// 5713 CYC BITS=CYC BITS!64; ! SET EVENODD PAIR BIT
#line 5713 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 64;
// 5714 LOAD(OPND1,-1,0); ! IN STORE UNLESS RT ETC
#line 5714 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
// 5715 LOAD(OPND2,-1,0)
#line 5715 "test-new/imp918s.imp"
LOAD(OPND2, -1, 0);
// 5716 -> IN STORE %UNLESS OPND1_FLAG=9 %AND OPND1_D<0
#line 5716 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_056A;
#line 5716 "test-new/imp918s.imp"
if (OPND1->D < 0) goto L_056B;
#line 5716 "test-new/imp918s.imp"
L_056A:;
#line 5716 "test-new/imp918s.imp"
goto U_106C;
#line 5716 "test-new/imp918s.imp"
L_056B:;
// 5717 TOTHER=OPND1_XB!!1
#line 5717 "test-new/imp918s.imp"
TOTHER = OPND1->XB ^ 1;
// 5718 -> INSTORE %UNLESS REGISTER(TOTHER)=0
#line 5718 "test-new/imp918s.imp"
if (REGISTER[TOTHER] == 0) goto L_056C;
#line 5718 "test-new/imp918s.imp"
goto U_106C;
#line 5718 "test-new/imp918s.imp"
L_056C:;
// 5719 REGISTER(TOTHER)=1; PAIR=TOTHER&14
#line 5719 "test-new/imp918s.imp"
REGISTER[TOTHER] = 1;
#line 5719 "test-new/imp918s.imp"
PAIR = TOTHER & 14;
// 5720 -> FIN %IF ODDEVEN+PAIR#TOTHER
#line 5720 "test-new/imp918s.imp"
if (ODDEVEN + PAIR == TOTHER) goto L_056D;
#line 5720 "test-new/imp918s.imp"
goto U_106D;
#line 5720 "test-new/imp918s.imp"
L_056D:;
// 5721 LOAD(OPND1,TOTHER,2); REGISTER(TOTHER!!1)=1; ->FIN
#line 5721 "test-new/imp918s.imp"
LOAD(OPND1, TOTHER, 2);
#line 5721 "test-new/imp918s.imp"
REGISTER[TOTHER ^ 1] = 1;
#line 5721 "test-new/imp918s.imp"
goto U_106D;
// 5722 INSTORE: CLAIM PAIR(PAIR)
#line 5722 "test-new/imp918s.imp"
U_106C:;
#line 5722 "test-new/imp918s.imp"
CLAIMPAIR(/*?*/ &PAIR);
// 5723 LOAD(OPND1,PAIR+ODDEVEN,2)
#line 5723 "test-new/imp918s.imp"
LOAD(OPND1, PAIR + ODDEVEN, 2);
// 5724 FIN: OPND1_XB=PAIR; ! ALWAYS LH MEMBER
#line 5724 "test-new/imp918s.imp"
U_106D:;
#line 5724 "test-new/imp918s.imp"
OPND1->XB = PAIR;
// 5725 REGISTER(PAIR)=2
#line 5725 "test-new/imp918s.imp"
REGISTER[PAIR] = 2;
// 5726 REGISTER(PAIR+1)=2
#line 5726 "test-new/imp918s.imp"
REGISTER[PAIR + 1] = 2;
// 5727 LOAD(OPND2,-1,1)
#line 5727 "test-new/imp918s.imp"
LOAD(OPND2, -1, 1);
// 5728 REGISTER(PAIR)=1
#line 5728 "test-new/imp918s.imp"
REGISTER[PAIR] = 1;
// 5729 REGISTER(PAIR+1)=1
#line 5729 "test-new/imp918s.imp"
REGISTER[PAIR + 1] = 1;
// 5730 %END
#line 5730 "test-new/imp918s.imp"
return;
#line 5730 "test-new/imp918s.imp"
} /* end of LOADPAIR */
// 5731 %ROUTINE CLAIM PAIR(%INTEGERNAME REG)
#line 5731 "test-new/imp918s.imp"
void CLAIMPAIR(int *REG) {
// 5732 {%SHORTROUTINE}
// 5733 %INTEGER I,J,K
#line 5733 "test-new/imp918s.imp"
int I;
#line 5733 "test-new/imp918s.imp"
int J;
#line 5733 "test-new/imp918s.imp"
int K;
// 5734 %CYCLE I=0,1,2
#line 5734 "test-new/imp918s.imp"
// %for I = 0, 1, 2 %cycle
#line 5734 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = 2;
#line 5734 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, 2");
_control = I = _initial - _increment;
#line 5734 "test-new/imp918s.imp"
L_056E:
#line 5734 "test-new/imp918s.imp"
if (I != _control) _imp_signal(4, 2, 0, "Corrupt control variable I");
#line 5734 "test-new/imp918s.imp"
if (I == _final) goto L_056F;
#line 5734 "test-new/imp918s.imp"
_control += _increment;
I += _increment;
// 5735 %CYCLE K=6,-2,-2
#line 5735 "test-new/imp918s.imp"
// %for K = 6, -2, -2 %cycle
#line 5735 "test-new/imp918s.imp"
{
int _control, _initial = 6, _increment = -2, _final = -2;
#line 5735 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle K = 6, -2, -2");
_control = K = _initial - _increment;
#line 5735 "test-new/imp918s.imp"
L_0571:
#line 5735 "test-new/imp918s.imp"
if (K != _control) _imp_signal(4, 2, 0, "Corrupt control variable K");
#line 5735 "test-new/imp918s.imp"
if (K == _final) goto L_0572;
#line 5735 "test-new/imp918s.imp"
_control += _increment;
K -= 2;
// 5736 J=K&15
#line 5736 "test-new/imp918s.imp"
J = K & 15;
// 5737 -> FOUND %IF REGISTER(J)=REGISTER(J+1)=0 %AND (I>0 %OR %C
#line 5737 "test-new/imp918s.imp"
{
// Double-sided test on REGISTER[J + 1] (Part I)
#line 5737 "test-new/imp918s.imp"
int tmp;
#line 5737 "test-new/imp918s.imp"
if (REGISTER[J] != (tmp = REGISTER[J + 1])) goto L_0574;
// Double-sided test on REGISTER[J + 1] (Part II)
#line 5737 "test-new/imp918s.imp"
if (tmp != 0) goto L_0574;
#line 5737 "test-new/imp918s.imp"
}
#line 5737 "test-new/imp918s.imp"
if (I > 0) goto L_0575;
#line 5737 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 5737 "test-new/imp918s.imp"
int tmp;
#line 5737 "test-new/imp918s.imp"
if (GRUSE[J] != (tmp = 0)) goto L_0574;
// Double-sided test on 0 (Part II)
#line 5737 "test-new/imp918s.imp"
if (tmp != GRUSE[J + 1]) goto L_0574;
#line 5737 "test-new/imp918s.imp"
}
#line 5737 "test-new/imp918s.imp"
L_0575:;
#line 5737 "test-new/imp918s.imp"
goto U_106D;
#line 5737 "test-new/imp918s.imp"
L_0574:;
// 5738+ GRUSE(J)=0=GRUSE(J+1))
// 5739 %REPEAT
#line 5739 "test-new/imp918s.imp"
goto L_0571;
#line 5739 "test-new/imp918s.imp"
}
#line 5739 "test-new/imp918s.imp"
L_0572:;
// 5740 SAVE IRS(4) %IF I=1
#line 5740 "test-new/imp918s.imp"
if (I != 1) goto L_0576;
#line 5740 "test-new/imp918s.imp"
SAVEIRS(4);
#line 5740 "test-new/imp918s.imp"
L_0576:;
// 5741 %REPEAT
#line 5741 "test-new/imp918s.imp"
goto L_056E;
#line 5741 "test-new/imp918s.imp"
}
#line 5741 "test-new/imp918s.imp"
L_056F:;
// 5742 ABORT
#line 5742 "test-new/imp918s.imp"
ABORT();
// 5743 FOUND: REGISTER(J)=1
#line 5743 "test-new/imp918s.imp"
U_106D:;
#line 5743 "test-new/imp918s.imp"
REGISTER[J] = 1;
// 5744 REGISTER(J+1)=1
#line 5744 "test-new/imp918s.imp"
REGISTER[J + 1] = 1;
// 5745 REG=J
#line 5745 "test-new/imp918s.imp"
*REG = J;
// 5746 %END
#line 5746 "test-new/imp918s.imp"
return;
#line 5746 "test-new/imp918s.imp"
} /* end of CLAIMPAIR */
// 5747 %ROUTINE CTOP(%INTEGERNAME FLAG)
#line 5747 "test-new/imp918s.imp"
void CTOP(int *FLAG) {
// 5748 {%SHORTROUTINE}
// 5749 %COMMENT ON EXIT FLAG=0 %IF OPERATION CARRIED OUT
// 5750 %INTEGER K,VAL1,VAL2,TYPEP,PRECP,OP
#line 5750 "test-new/imp918s.imp"
int K;
#line 5750 "test-new/imp918s.imp"
int VAL1;
#line 5750 "test-new/imp918s.imp"
int VAL2;
#line 5750 "test-new/imp918s.imp"
int TYPEP;
#line 5750 "test-new/imp918s.imp"
int PRECP;
#line 5750 "test-new/imp918s.imp"
int OP;
// 5751 %LONGREAL RVAL1,RVAL2
#line 5751 "test-new/imp918s.imp"
double RVAL1;
#line 5751 "test-new/imp918s.imp"
double RVAL2;
// 5752 %SWITCH SW(10:41)
#line 5752 "test-new/imp918s.imp"
int SW_index;
#line 5752 "test-new/imp918s.imp"
int SW_line;
#line 5752 "test-new/imp918s.imp"
char *SW_file;
#line 5752 "test-new/imp918s.imp"
static const void *SW[32] = {&&case_SW_10, &&case_SW_11, &&case_SW_12, &&case_SW_13, &&case_SW_14, &&case_SW_15,
&&case_SW_16, &&case_SW_17, &&case_SW_18, &&case_SW_19, &&case_SW_20, &&case_SW_21,
&&case_SW_22, &&case_SW_23, &&case_SW_24, &&case_SW_25, &&case_SW_26, &&case_SW_27,
&&case_SW_28, &&case_SW_29, &&case_SW_30, &&case_SW_31, &&case_SW_32, &&case_SW_33,
&&case_SW_34, &&case_SW_35, &&case_SW_36, &&case_SW_37, &&case_SW_38, &&case_SW_39,
&&case_SW_40, &&case_SW_41};
// 5753 NEWCC=0; !COMPILE TIME OPS CAN NOT SET CC
#line 5753 "test-new/imp918s.imp"
NEWCC = 0;
// 5754 TYPEP=TYPE; PRECP=PREC; OP=FLAG
#line 5754 "test-new/imp918s.imp"
TYPEP = TYPE;
#line 5754 "test-new/imp918s.imp"
PRECP = PREC;
#line 5754 "test-new/imp918s.imp"
OP = *FLAG;
// 5755 ->Label99 %IF OP>25
#line 5755 "test-new/imp918s.imp"
if (OP <= 25) goto L_0577;
#line 5755 "test-new/imp918s.imp"
goto U_105A;
#line 5755 "test-new/imp918s.imp"
L_0577:;
// 5756 %IF TYPEP=2 %THEN %START
#line 5756 "test-new/imp918s.imp"
if (TYPEP != 2) goto L_0578;
// 5757 FROM AR8(OPND1_D+1,RVAL1)
#line 5757 "test-new/imp918s.imp"
FROMAR8(OPND1->D + 1, /*?*/ &RVAL1);
// 5758 FROMAR8(OPND2_D+1,RVAL2)
#line 5758 "test-new/imp918s.imp"
FROMAR8(OPND2->D + 1, /*?*/ &RVAL2);
// 5759 %FINISH %ELSE %START
#line 5759 "test-new/imp918s.imp"
goto L_0579;
#line 5759 "test-new/imp918s.imp"
L_0578:;
// 5760 %IF OPND1_FLAG=0 %THEN VAL1=OPND1_D %ELSE %C
#line 5760 "test-new/imp918s.imp"
if (OPND1->FLAG != 0) goto L_057A;
#line 5760 "test-new/imp918s.imp"
VAL1 = OPND1->D;
#line 5760 "test-new/imp918s.imp"
goto L_057B;
#line 5760 "test-new/imp918s.imp"
L_057A:;
#line 5760 "test-new/imp918s.imp"
FROMAR4(OPND1->D + 1, /*?*/ &VAL1);
#line 5760 "test-new/imp918s.imp"
L_057B:;
// 5761+ FROMAR4(OPND1_D+1,VAL1)
// 5762 %IF OPND2_FLAG=0 %THEN VAL2=OPND2_D %ELSE %C
#line 5762 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_057C;
#line 5762 "test-new/imp918s.imp"
VAL2 = OPND2->D;
#line 5762 "test-new/imp918s.imp"
goto L_057D;
#line 5762 "test-new/imp918s.imp"
L_057C:;
#line 5762 "test-new/imp918s.imp"
FROMAR4(OPND2->D + 1, /*?*/ &VAL2);
#line 5762 "test-new/imp918s.imp"
L_057D:;
// 5763+ FROMAR4(OPND2_D+1,VAL2)
// 5764 %FINISH
#line 5764 "test-new/imp918s.imp"
L_0579:;
// 5765 -> SW(16*(TYPEP-1)+OP)
#line 5765 "test-new/imp918s.imp"
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 16 * (TYPEP - 1) + OP;
goto case_SW_dispatch;
// 5766 SW(10): ! \
#line 5766 "test-new/imp918s.imp"
case_SW_10:;
// 5767 VAL1=\VAL1
#line 5767 "test-new/imp918s.imp"
VAL1 = (~VAL1);
// 5768 INTEND: A(R)=1; TOAR4(R+1,VAL1)
#line 5768 "test-new/imp918s.imp"
U_105B:;
#line 5768 "test-new/imp918s.imp"
A[R + 7] = 1;
#line 5768 "test-new/imp918s.imp"
TOAR4(R + 1, VAL1);
// 5769 FLAG=0; OPND1_PTYPE=1
#line 5769 "test-new/imp918s.imp"
*FLAG = 0;
#line 5769 "test-new/imp918s.imp"
OPND1->PTYPE = 1;
// 5770 OPND1_FLAG=1; OPND1_D=R;
#line 5770 "test-new/imp918s.imp"
OPND1->FLAG = 1;
#line 5770 "test-new/imp918s.imp"
OPND1->D = R;
// 5771 R=R+3; ->Label99
#line 5771 "test-new/imp918s.imp"
R = R + 3;
#line 5771 "test-new/imp918s.imp"
goto U_105A;
// 5772 SW(11): ! INTEGER NEGATE
#line 5772 "test-new/imp918s.imp"
case_SW_11:;
// 5773 VAL1=-VAL1; -> INT END
#line 5773 "test-new/imp918s.imp"
VAL1 = -VAL1;
#line 5773 "test-new/imp918s.imp"
goto U_105B;
// 5774 SW(13): ! INTEGER ABS
#line 5774 "test-new/imp918s.imp"
case_SW_13:;
// 5775 VAL1=|VAL1|; -> INT END
#line 5775 "test-new/imp918s.imp"
VAL1 = _imp_IMOD(VAL1);
#line 5775 "test-new/imp918s.imp"
goto U_105B;
// 5776 SW(12): ! INTEGER FLOAT
#line 5776 "test-new/imp918s.imp"
case_SW_12:;
// 5777 RVAL1=VAL1; PRECP=3*XTRA
#line 5777 "test-new/imp918s.imp"
RVAL1 = VAL1;
#line 5777 "test-new/imp918s.imp"
PRECP = 3 * XTRA;
// 5778 ->REAL END %UNLESS VAL1=0
#line 5778 "test-new/imp918s.imp"
if (VAL1 == 0) goto L_057F;
#line 5778 "test-new/imp918s.imp"
goto U_105C;
#line 5778 "test-new/imp918s.imp"
L_057F:;
// 5779 CYC BITS=CYC BITS!16; ! USES PERMS CONST TABLE
#line 5779 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 16;
// 5780 OPND1_FLAG=9; OPND1_XB=CODER; ! TREAT ZERO SPECIALLY
#line 5780 "test-new/imp918s.imp"
OPND1->FLAG = 9;
#line 5780 "test-new/imp918s.imp"
OPND1->XB = 12;
// 5781 OPND1_D=X'C0'; ->Label98; ! TO ALLOW LTDR ETC
#line 5781 "test-new/imp918s.imp"
OPND1->D = 192;
#line 5781 "test-new/imp918s.imp"
goto U_105D;
// 5782 SW(30): ! STRETCH REAL
#line 5782 "test-new/imp918s.imp"
case_SW_30:;
// 5783 REAL END:A(R)=2; TOAR8(R+1,RVAL1)
#line 5783 "test-new/imp918s.imp"
U_105C:;
#line 5783 "test-new/imp918s.imp"
A[R + 7] = 2;
#line 5783 "test-new/imp918s.imp"
TOAR8(R + 1, RVAL1);
// 5784 OPND1_FLAG=1; OPND1_D=R; R=R+5
#line 5784 "test-new/imp918s.imp"
OPND1->FLAG = 1;
#line 5784 "test-new/imp918s.imp"
OPND1->D = R;
#line 5784 "test-new/imp918s.imp"
R = R + 5;
// 5785 Label98: FLAG=0; OPND1_PTYPE=10*PRECP+2
#line 5785 "test-new/imp918s.imp"
U_105D:;
#line 5785 "test-new/imp918s.imp"
*FLAG = 0;
#line 5785 "test-new/imp918s.imp"
OPND1->PTYPE = 10 * PRECP + 2;
// 5786 ->Label99
#line 5786 "test-new/imp918s.imp"
goto U_105A;
// 5787 SW(14): ! STRETCH INTEGER
#line 5787 "test-new/imp918s.imp"
case_SW_14:;
// 5788 SW(28): ! FLOAT REAL
#line 5788 "test-new/imp918s.imp"
case_SW_28:;
// 5789 ABORT
#line 5789 "test-new/imp918s.imp"
ABORT();
// 5790 SW(15): ! ADD
#line 5790 "test-new/imp918s.imp"
case_SW_15:;
// 5791 VAL1=VAL1+VAL2; -> INT END
#line 5791 "test-new/imp918s.imp"
VAL1 = VAL1 + VAL2;
#line 5791 "test-new/imp918s.imp"
goto U_105B;
// 5792 SW(16): ! MINUS
#line 5792 "test-new/imp918s.imp"
case_SW_16:;
// 5793 VAL1=VAL1-VAL2; -> INT END
#line 5793 "test-new/imp918s.imp"
VAL1 = VAL1 - VAL2;
#line 5793 "test-new/imp918s.imp"
goto U_105B;
// 5794 SW(17): ! EXCLUSIVE OR
#line 5794 "test-new/imp918s.imp"
case_SW_17:;
// 5795 VAL1=VAL1!!VAL2; -> INT END
#line 5795 "test-new/imp918s.imp"
VAL1 = VAL1 ^ VAL2;
#line 5795 "test-new/imp918s.imp"
goto U_105B;
// 5796 SW(18): ! OR
#line 5796 "test-new/imp918s.imp"
case_SW_18:;
// 5797 VAL1=VAL1!VAL2; -> INT END
#line 5797 "test-new/imp918s.imp"
VAL1 = VAL1 | VAL2;
#line 5797 "test-new/imp918s.imp"
goto U_105B;
// 5798 SW(19): ! MULT
#line 5798 "test-new/imp918s.imp"
case_SW_19:;
// 5799 VAL1=VAL1*VAL2; -> INT END
#line 5799 "test-new/imp918s.imp"
VAL1 = VAL1 * VAL2;
#line 5799 "test-new/imp918s.imp"
goto U_105B;
// 5800 SW(21): ->Label99; ! / DIVISION
#line 5800 "test-new/imp918s.imp"
case_SW_21:;
#line 5800 "test-new/imp918s.imp"
goto U_105A;
// 5801 SW(20): ->Label99 %IF VAL2=0; ! // DIVISION
#line 5801 "test-new/imp918s.imp"
case_SW_20:;
#line 5801 "test-new/imp918s.imp"
if (VAL2 != 0) goto L_0580;
#line 5801 "test-new/imp918s.imp"
goto U_105A;
#line 5801 "test-new/imp918s.imp"
L_0580:;
// 5802 VAL1=VAL1//VAL2; -> INT END
#line 5802 "test-new/imp918s.imp"
VAL1 = ((long)VAL1 / (long)VAL2);
#line 5802 "test-new/imp918s.imp"
goto U_105B;
// 5803 SW(22): ! AND
#line 5803 "test-new/imp918s.imp"
case_SW_22:;
// 5804 VAL1=VAL1&VAL2; -> INT END
#line 5804 "test-new/imp918s.imp"
VAL1 = VAL1 & VAL2;
#line 5804 "test-new/imp918s.imp"
goto U_105B;
// 5805 SW(24): ! SLL
#line 5805 "test-new/imp918s.imp"
case_SW_24:;
// 5806 VAL1=VAL1<<VAL2; -> INT END
#line 5806 "test-new/imp918s.imp"
VAL1 = VAL1 << VAL2;
#line 5806 "test-new/imp918s.imp"
goto U_105B;
// 5807 SW(23): ! SRL
#line 5807 "test-new/imp918s.imp"
case_SW_23:;
// 5808 VAL1=VAL1>>VAL2; -> INT END
#line 5808 "test-new/imp918s.imp"
VAL1 = (unsigned int)VAL1 >> VAL2;
#line 5808 "test-new/imp918s.imp"
goto U_105B;
// 5809 SW(27): ! NEGATE
#line 5809 "test-new/imp918s.imp"
case_SW_27:;
// 5810 RVAL1=-RVAL1; -> REAL END
#line 5810 "test-new/imp918s.imp"
RVAL1 = -RVAL1;
#line 5810 "test-new/imp918s.imp"
goto U_105C;
// 5811 SW(29): ! ABS
#line 5811 "test-new/imp918s.imp"
case_SW_29:;
// 5812 RVAL1=|RVAL1|; -> REAL END
#line 5812 "test-new/imp918s.imp"
RVAL1 = _imp_MOD(RVAL1);
#line 5812 "test-new/imp918s.imp"
goto U_105C;
// 5813 SW(31): ! ADD
#line 5813 "test-new/imp918s.imp"
case_SW_31:;
// 5814 RVAL1=RVAL1+RVAL2; -> REAL END
#line 5814 "test-new/imp918s.imp"
RVAL1 = RVAL1 + RVAL2;
#line 5814 "test-new/imp918s.imp"
goto U_105C;
// 5815 SW(32): ! SUBTRACT
#line 5815 "test-new/imp918s.imp"
case_SW_32:;
// 5816 RVAL1=RVAL1-RVAL2; -> REAL END
#line 5816 "test-new/imp918s.imp"
RVAL1 = RVAL1 - RVAL2;
#line 5816 "test-new/imp918s.imp"
goto U_105C;
// 5817 SW(35): ! MULT
#line 5817 "test-new/imp918s.imp"
case_SW_35:;
// 5818 RVAL1=RVAL1*RVAL2; -> REAL END
#line 5818 "test-new/imp918s.imp"
RVAL1 = RVAL1 * RVAL2;
#line 5818 "test-new/imp918s.imp"
goto U_105C;
// 5819 SW(37): ! DIVISION
#line 5819 "test-new/imp918s.imp"
case_SW_37:;
// 5820 ->Label99 %IF RVAL2=0; ! AVOID DIV BY ZERO
#line 5820 "test-new/imp918s.imp"
if (RVAL2 != 0) goto L_0581;
#line 5820 "test-new/imp918s.imp"
goto U_105A;
#line 5820 "test-new/imp918s.imp"
L_0581:;
// 5821 RVAL1=RVAL1/RVAL2; -> REAL END
#line 5821 "test-new/imp918s.imp"
RVAL1 = (double)(RVAL1 / RVAL2);
#line 5821 "test-new/imp918s.imp"
goto U_105C;
// 5822 SW(41): ! EXP
#line 5822 "test-new/imp918s.imp"
case_SW_41:;
// 5823 %IF OPND2_FLAG#0 %THEN ->Label99
#line 5823 "test-new/imp918s.imp"
if (OPND2->FLAG == 0) goto L_0582;
#line 5823 "test-new/imp918s.imp"
goto U_105A;
#line 5823 "test-new/imp918s.imp"
L_0582:;
// 5824 RVAL1=RVAL1^OPND2_D; -> REAL END
#line 5824 "test-new/imp918s.imp"
RVAL1 = _imp_REXP(RVAL1, OPND2->D);
#line 5824 "test-new/imp918s.imp"
goto U_105C;
// 5825 SW(25):SW(26):SW(33):SW(34):
#line 5825 "test-new/imp918s.imp"
case_SW_25:;
#line 5825 "test-new/imp918s.imp"
case_SW_26:;
#line 5825 "test-new/imp918s.imp"
case_SW_33:;
#line 5825 "test-new/imp918s.imp"
case_SW_34:;
// 5826 SW(36):SW(38):SW(39):SW(40):
#line 5826 "test-new/imp918s.imp"
case_SW_36:;
#line 5826 "test-new/imp918s.imp"
case_SW_38:;
#line 5826 "test-new/imp918s.imp"
case_SW_39:;
#line 5826 "test-new/imp918s.imp"
case_SW_40:;
// 5827 Label99: %END
#line 5827 "test-new/imp918s.imp"
U_105A:;
#line 5827 "test-new/imp918s.imp"
return;
#line 5827 "test-new/imp918s.imp"
case_SW_dispatch:
#line 5827 "test-new/imp918s.imp"
if (SW_index < 10 || SW_index > 41)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 5827 "test-new/imp918s.imp"
goto *SW[SW_index - 10];
#line 5827 "test-new/imp918s.imp"
} /* end of CTOP */
// ?K unused
// 5828 %ROUTINE FLOAT
#line 5828 "test-new/imp918s.imp"
void FLOAT(void) {
// 5829 {%SHORTROUTINE}
// 5830 !***********************************************************************
// 5831 !* PLANT CODE TO CONERT OPERAND1 FROM FIXED TO FLOATING *
// 5832 !***********************************************************************
// 5833 %INTEGER P1,P2,K
#line 5833 "test-new/imp918s.imp"
int P1;
#line 5833 "test-new/imp918s.imp"
int P2;
#line 5833 "test-new/imp918s.imp"
int K;
// 5834 P1=OPND1_XB; ; P2=(P1+1)&15
#line 5834 "test-new/imp918s.imp"
P1 = OPND1->XB;
#line 5834 "test-new/imp918s.imp"
P2 = P1 + 1 & 15;
// 5835 %UNLESS OPND1_FLAG=9 %AND OPND1_D<0 %AND %C
#line 5835 "test-new/imp918s.imp"
if (OPND1->FLAG != 9) goto L_0570;
#line 5835 "test-new/imp918s.imp"
if (OPND1->D >= 0) goto L_0570;
#line 5835 "test-new/imp918s.imp"
{
// Double-sided test on 0 (Part I)
#line 5835 "test-new/imp918s.imp"
int tmp;
#line 5835 "test-new/imp918s.imp"
if (REGISTER[P1] < (tmp = 0)) goto L_0570;
// Double-sided test on 0 (Part II)
#line 5835 "test-new/imp918s.imp"
if (tmp != REGISTER[P2]) goto L_0570;
#line 5835 "test-new/imp918s.imp"
}
#line 5835 "test-new/imp918s.imp"
if (GRUSE[P2] > 1) goto L_0583;
#line 5835 "test-new/imp918s.imp"
L_0570:;
// 5836+ REGISTER(P1)>=0=REGISTER(P2) %AND GRUSE(P2)>1 %START
// 5837 FIND SEQ(P1,P2)
#line 5837 "test-new/imp918s.imp"
FINDSEQ(/*?*/ &P1, /*?*/ &P2);
// 5838 LOAD(OPND1,P1,2)
#line 5838 "test-new/imp918s.imp"
LOAD(OPND1, P1, 2);
// 5839 %FINISH
#line 5839 "test-new/imp918s.imp"
L_0583:;
// 5840 PRR(X'10',P2,P1); ! LPR P2,P1
#line 5840 "test-new/imp918s.imp"
PRR(16, P2, P1);
// 5841 PRX(X'54',P1,CODER,0,X'E0'); ! N P1,=X'80000000'
#line 5841 "test-new/imp918s.imp"
PRX(84, P1, 12, 0, 224);
// 5842 PRX(X'56',P1,CODER,0,X'D0'); ! O P1,=X'4E000000'
#line 5842 "test-new/imp918s.imp"
PRX(86, P1, 12, 0, 208);
// 5843 PRX(X'90',P1,P2,WSPR,0); ! STM P1,P2,0(11)
#line 5843 "test-new/imp918s.imp"
PRX(144, P1, P2, 11, 0);
// 5844 CLAIM (FR0,K); D=K
#line 5844 "test-new/imp918s.imp"
CLAIM(-125424, /*?*/ &K);
#line 5844 "test-new/imp918s.imp"
D = K;
// 5845 PRR(X'2B',K,K); ! SDR K,K
#line 5845 "test-new/imp918s.imp"
PRR(43, K, K);
// 5846 PRX(X'6A',K,0,11,0); ! AD K,0(11)
#line 5846 "test-new/imp918s.imp"
PRX(106, K, 0, 11, 0);
// 5847 FREE AND FORGET(P1)
#line 5847 "test-new/imp918s.imp"
FREEANDFORGET(P1);
// 5848 FORGET(P2)
#line 5848 "test-new/imp918s.imp"
FORGET(P2);
// 5849 CYC BITS=CYC BITS!16; ! USES PERMS CONSTANTS
#line 5849 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 16;
// 5850 CCSTATE=-1
#line 5850 "test-new/imp918s.imp"
CCSTATE = -1;
// 5851 %END
#line 5851 "test-new/imp918s.imp"
return;
#line 5851 "test-new/imp918s.imp"
} /* end of FLOAT */
// 5852 %ROUTINE STARSTAR
#line 5852 "test-new/imp918s.imp"
void STARSTAR(void) {
// 5853 {%SHORTROUTINE}
// 5854 !***********************************************************************
// 5855 !* PLANT IN-LINE CODE FOR EXPONENTIATION *
// 5856
// 5857 !* IMP ALLOWS EXPONENTS IN INTEGER EXPRESSIONS FROM 0-63 AND *
// 5858 !* IN REAL EXPRESSIONS FROM-255 TO +255 *
// 5859 !***********************************************************************
// 5860 %INTEGER TYPEP,PRECP,COUNT,WORK,C,RREG,INTREG
#line 5860 "test-new/imp918s.imp"
int TYPEP;
#line 5860 "test-new/imp918s.imp"
int PRECP;
#line 5860 "test-new/imp918s.imp"
int COUNT;
#line 5860 "test-new/imp918s.imp"
int WORK;
#line 5860 "test-new/imp918s.imp"
int C;
#line 5860 "test-new/imp918s.imp"
int RREG;
#line 5860 "test-new/imp918s.imp"
int INTREG;
// 5861 %BYTEINTEGER VALUE
#line 5861 "test-new/imp918s.imp"
unsigned char VALUE;
// 5862 PTYPE=OPND1_PTYPE; ! INSPECT THE OPERAND
#line 5862 "test-new/imp918s.imp"
PTYPE = OPND1->PTYPE;
// 5863 ! UNPACK
// 5864 !%if USE MC = 1 %start
// 5865 ! *L_1,PTYPE; *CVD_1,0(11)
// 5866 ! *UNPK_ROUT(5),5(3,11)
// 5867 ! *NC_ROUT(5),MASK1
// 5868 !%finish
// 5869 %IF TYPE=1 %THEN WARN(LINE)
#line 5869 "test-new/imp918s.imp"
if (TYPE != 1) goto L_0584;
#line 5869 "test-new/imp918s.imp"
WARN(LINE);
#line 5869 "test-new/imp918s.imp"
L_0584:;
// 5870 TYPEP=TYPE
#line 5870 "test-new/imp918s.imp"
TYPEP = TYPE;
// 5871 %IF PREC&3=3 %THEN PRECP=16 %ELSE PRECP=0
#line 5871 "test-new/imp918s.imp"
if (PREC & 3 != 3) goto L_0585;
#line 5871 "test-new/imp918s.imp"
PRECP = 16;
#line 5871 "test-new/imp918s.imp"
goto L_0586;
#line 5871 "test-new/imp918s.imp"
L_0585:;
#line 5871 "test-new/imp918s.imp"
PRECP = 0;
#line 5871 "test-new/imp918s.imp"
L_0586:;
// 5872 VALUE=0
#line 5872 "test-new/imp918s.imp"
VALUE = 0;
// 5873 %IF OPND2_FLAG=0 %AND 1<=OPND2_D<=63*TYPE %THEN %START
#line 5873 "test-new/imp918s.imp"
if (OPND2->FLAG != 0) goto L_0587;
#line 5873 "test-new/imp918s.imp"
{
// Double-sided test on OPND2->D (Part I)
#line 5873 "test-new/imp918s.imp"
int tmp;
#line 5873 "test-new/imp918s.imp"
if (1 > (tmp = OPND2->D)) goto L_0587;
// Double-sided test on OPND2->D (Part II)
#line 5873 "test-new/imp918s.imp"
if (tmp > 63 * TYPE) goto L_0587;
#line 5873 "test-new/imp918s.imp"
}
// 5874 VALUE=OPND2_D; ! EXPONENT IS #0 AND CONSTANT
#line 5874 "test-new/imp918s.imp"
VALUE = OPND2->D;
// 5875 %FINISH
#line 5875 "test-new/imp918s.imp"
L_0587:;
// 5876 !
// 5877 ! MUST TEST BOTH OPERANDS BEFORE CLAIMING WORK REGS IN CASE EITHER OR
// 5878 ! BOTH ARE FNS AND WE ARE SHORT OF REGS SO THAT THE WORK REGS WILL
// 5879 ! NOT SURVIVE A FN CALL
// 5880 !
// 5881 LOAD(OPND1,-1,0); ! INSPECT OPERAND CALL FNS
#line 5881 "test-new/imp918s.imp"
LOAD(OPND1, -1, 0);
// 5882 LOAD(OPND2,-1,0); ! INSPECT EXPNT & CALL IF FN
#line 5882 "test-new/imp918s.imp"
LOAD(OPND2, -1, 0);
// 5883 %IF TYPEP=1 %THEN CLAIM PAIR(WORK) %ELSE CLAIM (FR0,WORK)
#line 5883 "test-new/imp918s.imp"
if (TYPEP != 1) goto L_0588;
#line 5883 "test-new/imp918s.imp"
CLAIMPAIR(/*?*/ &WORK);
#line 5883 "test-new/imp918s.imp"
goto L_0589;
#line 5883 "test-new/imp918s.imp"
L_0588:;
#line 5883 "test-new/imp918s.imp"
CLAIM(-125424, /*?*/ &WORK);
#line 5883 "test-new/imp918s.imp"
L_0589:;
// 5884 %IF VALUE#2 %THEN %START; ! TREAT **2 SPECIALLY
#line 5884 "test-new/imp918s.imp"
if (VALUE == 2) goto L_058A;
// 5885 LOAD(OPND1,-1,2); ! LOAD OPERAND TO ANY REGISTER
#line 5885 "test-new/imp918s.imp"
LOAD(OPND1, -1, 2);
// 5886 %FINISH
#line 5886 "test-new/imp918s.imp"
L_058A:;
// 5887 !
// 5888 ! IF EITHER OPERAND IS A FN IT HAS BEEN FETCHED TO A REGISTER
// 5889 ! SO NOW REGISTERS CAN BE OBTAINED FOR THE IN-LINE SUBROUTINE
// 5890 ! WORK HOLDS INITIALLY 1 PRIOR TO MULTIPLICATION
// 5891 ! INTREG HOLDS THE EXPONENT AS CALCULATED
// 5892 ! COUNT HOLDS A +VE VERSION OF INTREG FOR COUNTING THE MULTIPLIES
// 5893 ! RREG HOLD THE OPERAND.
// 5894 ! COUNT & INTREG CAN BE THE SAME REGISTER IF EXPONENT IS +VE
// 5895 !
// 5896 PLABEL=PLABEL-1; ! LABEL FOR REPITITION
#line 5896 "test-new/imp918s.imp"
PLABEL = PLABEL - 1;
// 5897 %IF VALUE=2 %THEN %START; ! TRANSPOSE X**2 TO X*X
#line 5897 "test-new/imp918s.imp"
if (VALUE != 2) goto L_058B;
// 5898 RREG= WORK+2-TYPEP
#line 5898 "test-new/imp918s.imp"
RREG = WORK + 2 - TYPEP;
// 5899 LOAD(OPND1,RREG,2);
#line 5899 "test-new/imp918s.imp"
LOAD(OPND1, RREG, 2);
// 5900 %FINISH %ELSE %START
#line 5900 "test-new/imp918s.imp"
goto L_058C;
#line 5900 "test-new/imp918s.imp"
L_058B:;
// 5901 LOAD(OPND2,-1,2); ! EXPONENT TO ANY REGISTER
#line 5901 "test-new/imp918s.imp"
LOAD(OPND2, -1, 2);
// 5902 INTREG=OPND2_XB
#line 5902 "test-new/imp918s.imp"
INTREG = OPND2->XB;
// 5903 RREG=OPND1_XB
#line 5903 "test-new/imp918s.imp"
RREG = OPND1->XB;
// 5904 %IF TYPE=2 %THEN %START; ! EXPONENT IS REAL **NOT ALLOWED
#line 5904 "test-new/imp918s.imp"
if (TYPE != 2) goto L_058D;
// 5905 FAULT(39,0)
#line 5905 "test-new/imp918s.imp"
FAULT(39, 0);
// 5906 FREE AND FORGET(INTREG+16)
#line 5906 "test-new/imp918s.imp"
FREEANDFORGET(INTREG + 16);
// 5907 %FINISH
#line 5907 "test-new/imp918s.imp"
L_058D:;
// 5908 COUNT=INTREG
#line 5908 "test-new/imp918s.imp"
COUNT = INTREG;
// 5909 !
// 5910 ! GET '1' INTO WORK IN APPROPIATE FORM
// 5911 !
// 5912 %IF TYPEP=1 %THEN PRX(X'41',WORK+1,0,0,1) %ELSE %C
#line 5912 "test-new/imp918s.imp"
if (TYPEP != 1) goto L_058E;
#line 5912 "test-new/imp918s.imp"
PRX(65, WORK + 1, 0, 0, 1);
#line 5912 "test-new/imp918s.imp"
goto L_058F;
#line 5912 "test-new/imp918s.imp"
L_058E:;
#line 5912 "test-new/imp918s.imp"
PRX(120 - PRECP, WORK, 0, 12, 200);
#line 5912 "test-new/imp918s.imp"
L_058F:;
// 5913+ PRX(X'78'-PRECP,WORK,0,CODER,X'C8'); ! LD(E) WORK,=D'1'
// 5914 !
// 5915 ! IF EXPONENT NOT KNOWN AT COMPILE TIME TO BE +VE CONSTANT MUST
// 5916 ! ALLOW FOR ZERO :- XX**0=1 FOR ALL XX
// 5917 ! ALSO ALLOW FOR X**(-N) WHICH IS 1/(X**N) FOR ALL X & N
// 5918 !
// 5919 %IF VALUE=0 %THEN %START; ! NOT +VE CONSTANT
#line 5919 "test-new/imp918s.imp"
if (VALUE != 0) goto L_0590;
// 5920 CLAIM (GR1,COUNT) %IF TYPEP=2; ! NEGATIVE REAL EXPONENTS
#line 5920 "test-new/imp918s.imp"
if (TYPEP != 2) goto L_0591;
#line 5920 "test-new/imp918s.imp"
CLAIM(65807, /*?*/ &COUNT);
#line 5920 "test-new/imp918s.imp"
L_0591:;
// 5921 PRR(X'14'-2*TYPEP,COUNT,INTREG);! LPR OR LTR
#line 5921 "test-new/imp918s.imp"
PRR(20 - 2 * TYPEP, COUNT, INTREG);
// 5922 ENTER JUMP(8,PLABEL,B'11'); ! BZ END OF EXP ROUTINE
#line 5922 "test-new/imp918s.imp"
ENTERJUMP(8, PLABEL, 3);
// 5923 !
// 5924 ! IN CHECKING MODE PLANT CODE TO CHECK RANGE OF EXPONENT
// 5925 !
// 5926 %IF CHECKSP=1 %THEN %START
#line 5926 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_0592;
// 5927 %IF TYPEP=2 %THEN PRX(X'59',COUNT,0,GLA,24) %ELSESTART
#line 5927 "test-new/imp918s.imp"
if (TYPEP != 2) goto L_0593;
#line 5927 "test-new/imp918s.imp"
PRX(89, COUNT, 0, 13, 24);
#line 5927 "test-new/imp918s.imp"
goto L_0594;
#line 5927 "test-new/imp918s.imp"
L_0593:;
// 5928 DUMP(X'41',-1,63,0,0); ! LA NEST,63
#line 5928 "test-new/imp918s.imp"
DUMP(65, -1, 63, 0, 0);
// 5929 PRR(X'15',COUNT,NEST); ! CLR COUNT,NEST
#line 5929 "test-new/imp918s.imp"
PRR(21, COUNT, NEST);
// 5930 %FINISH
#line 5930 "test-new/imp918s.imp"
L_0594:;
// 5931 PCONST(X'4720C048'); ! BH ILLEGAL EXPONENT
#line 5931 "test-new/imp918s.imp"
PCONST(1193328712);
// 5932 %FINISH
#line 5932 "test-new/imp918s.imp"
L_0592:;
// 5933 %FINISH
#line 5933 "test-new/imp918s.imp"
L_0590:;
// 5934 SET LOCAL BASE
#line 5934 "test-new/imp918s.imp"
SETLOCALBASE();
// 5935 C=CA-LOCAL ADDR; ! ADDR OF NEXT INST FOR LOOP
#line 5935 "test-new/imp918s.imp"
C = CA - LOCALADDR;
// 5936 %FINISH
#line 5936 "test-new/imp918s.imp"
L_058C:;
// 5937 PRR(32*TYPEP-4-PRECP,WORK,RREG); ! MR OR MER OR MDR
#line 5937 "test-new/imp918s.imp"
PRR(32 * TYPEP - 4 - PRECP, WORK, RREG);
// 5938 %IF TYPEP=1 %AND CHECKSP=1 %THEN %START
#line 5938 "test-new/imp918s.imp"
if (TYPEP != 1) goto L_0595;
#line 5938 "test-new/imp918s.imp"
if (CHECKSP != 1) goto L_0595;
// 5939 PRX(X'8F',WORK,0,0,32); ! SRDA TO CAUSE INTEGER OFLOW
#line 5939 "test-new/imp918s.imp"
PRX(143, WORK, 0, 0, 32);
// 5940 PRR(X'18',WORK+1,WORK); ! LR WORK+1,WORK TO RESTORE
#line 5940 "test-new/imp918s.imp"
PRR(24, WORK + 1, WORK);
// 5941 %FINISH
#line 5941 "test-new/imp918s.imp"
L_0595:;
// 5942 PRX(X'46',COUNT,LOCAL BASE,0,C) %IF VALUE#2;! BCT COUNT,AGAIN
#line 5942 "test-new/imp918s.imp"
if (VALUE == 2) goto L_0596;
#line 5942 "test-new/imp918s.imp"
PRX(70, COUNT, LOCALBASE, 0, C);
#line 5942 "test-new/imp918s.imp"
L_0596:;
// 5943 !
// 5944 ! FOR REAL EXPONENTS CHECK IF NEGATIVE AND EVALUATE INVERSE
// 5945 !
// 5946 %IF VALUE=0 %AND TYPEP=2 %THEN %START
#line 5946 "test-new/imp918s.imp"
if (VALUE != 0) goto L_0597;
#line 5946 "test-new/imp918s.imp"
if (TYPEP != 2) goto L_0597;
// 5947 PRR(X'12',INTREG,INTREG); ! LTR ON ORIGINAL EXPONENT
#line 5947 "test-new/imp918s.imp"
PRR(18, INTREG, INTREG);
// 5948 ENTER JUMP(2,PLABEL,B'11');! BP END OF EXP ROUTINE
#line 5948 "test-new/imp918s.imp"
ENTERJUMP(2, PLABEL, 3);
// 5949 PRX(X'78'-PRECP,RREG,0,CODER,X'C8');! LD(E) RREG,=D'1'
#line 5949 "test-new/imp918s.imp"
PRX(120 - PRECP, RREG, 0, 12, 200);
// 5950 CYC BITS=CYC BITS!16; ! USES PERMS CONSTANTS
#line 5950 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 16;
// 5951 PRR(X'3D'-PRECP,RREG,WORK);! DDR RREG,WORK
#line 5951 "test-new/imp918s.imp"
PRR(61 - PRECP, RREG, WORK);
// 5952 PRR(X'38'-PRECP,WORK,RREG);! LDR WORK,RREG
#line 5952 "test-new/imp918s.imp"
PRR(56 - PRECP, WORK, RREG);
// 5953 %FINISH
#line 5953 "test-new/imp918s.imp"
L_0597:;
// 5954 !
// 5955 ! ALL OVER. REAL RESULTS ARE IN FR WORK. INT RESULTS IN GR WORK+1
// 5956 ! FREE AND FORGET ANY OTHER REGISTERS
// 5957 !
// 5958 TYPE=TYPEP; PREC=3*PRECP>>4
#line 5958 "test-new/imp918s.imp"
TYPE = TYPEP;
#line 5958 "test-new/imp918s.imp"
PREC = 3 * ((unsigned int)PRECP >> 4);
// 5959 %IF VALUE #2 %THEN %START
#line 5959 "test-new/imp918s.imp"
if (VALUE == 2) goto L_0598;
// 5960 FREE AND FORGET((TYPEP&2)<<3+RREG)
#line 5960 "test-new/imp918s.imp"
FREEANDFORGET(((TYPEP & 2) << 3) + RREG);
// 5961 REGISTER(INTREG)=0
#line 5961 "test-new/imp918s.imp"
REGISTER[INTREG] = 0;
// 5962 FREE AND FORGET(COUNT)
#line 5962 "test-new/imp918s.imp"
FREEANDFORGET(COUNT);
// 5963 %FINISH
#line 5963 "test-new/imp918s.imp"
L_0598:;
// 5964 %IF TYPE=1 %THEN FREE AND FORGET(WORK)
#line 5964 "test-new/imp918s.imp"
if (TYPE != 1) goto L_0599;
#line 5964 "test-new/imp918s.imp"
FREEANDFORGET(WORK);
#line 5964 "test-new/imp918s.imp"
L_0599:;
// 5965 OPND1_PTYPE=10*PREC+TYPE
#line 5965 "test-new/imp918s.imp"
OPND1->PTYPE = 10 * PREC + TYPE;
// 5966 OPND1_XB=WORK+2-TYPEP
#line 5966 "test-new/imp918s.imp"
OPND1->XB = WORK + 2 - TYPEP;
// 5967 ENTER LAB(PLABEL,B'11'); ! LABEL AT END OF EXP ROUTINE
#line 5967 "test-new/imp918s.imp"
ENTERLAB(PLABEL, 3);
// 5968 %END
#line 5968 "test-new/imp918s.imp"
return;
#line 5968 "test-new/imp918s.imp"
} /* end of STARSTAR */
// 5969 %END
#line 5969 "test-new/imp918s.imp"
return;
#line 5969 "test-new/imp918s.imp"
case_SW_dispatch:
#line 5969 "test-new/imp918s.imp"
if (SW_index < 10 || SW_index > 31)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
#line 5969 "test-new/imp918s.imp"
goto *SW[SW_index - 10];
#line 5969 "test-new/imp918s.imp"
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
#line 5969 "test-new/imp918s.imp"
} /* end of EXPOP */
// 5970 %INTEGERFN CONST FIND(%INTEGER L,AD)
#line 5970 "test-new/imp918s.imp"
int CONSTFIND(int L, int AD) {
// 5971 !***********************************************************************
// 5972 !* FIND IF THE CONSTANT OF LENGTH 'L' STORED AT ADDRESS 'AD' *
// 5973 !* HAS ALREADY BEEN INSERTED IN THE GLA *
// 5974 !***********************************************************************
// 5975 {%SHORTROUTINE}
// 5976 %INTEGER I,J,K,LIST,C1,C2
#line 5976 "test-new/imp918s.imp"
int I;
#line 5976 "test-new/imp918s.imp"
int J;
#line 5976 "test-new/imp918s.imp"
int K;
#line 5976 "test-new/imp918s.imp"
int LIST;
#line 5976 "test-new/imp918s.imp"
int C1;
#line 5976 "test-new/imp918s.imp"
int C2;
// 5977 LIST=SHORTINTEGER(ADDR(GLAHOLES)+L)
#line 5977 "test-new/imp918s.imp"
LIST = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &GLAHOLES) + L);
// 5978 C1=0; C2=0
#line 5978 "test-new/imp918s.imp"
C1 = 0;
#line 5978 "test-new/imp918s.imp"
C2 = 0;
// 5979 ! %CYCLE I=0,1,L-1
// 5980 ! BYTEINTEGER(ADDR(C1)+I)=BYTEINTEGER(AD)
// 5981 ! AD=AD+1
// 5982 ! %REPEAT
// 5983 !%if USE MC = 1 %start
// 5984 ! *LM_1,2,L; *BCTR_1,0
// 5985 ! *MVC_C1(1),0(2)
// 5986 ! *EX_1,*-6
// 5987 !%finish
// 5988 ! %WHILE LIST>0 %CYCLE
// 5989 ! I=ADDR(ASLIST(LIST))
// 5990 ! %IF C1=INTEGER(I) %AND C2=INTEGER(I+4) %C
// 5991 ! %THEN %RESULT=INTEGER(I+8)
// 5992 ! LIST=SHORT INTEGER(I+14)
// 5993 ! %REPEAT
// 5994 !%if USE MC = 1 %start
// 5995 ! *L_1,LIST; *L_2,ASLIST
// 5996 !NEXT: *LTR_1,1; *BC_12,<MISS>
// 5997 ! *LA_3,0(1,2); *CLC_C1(8),0(3)
// 5998 ! *BC_8,<HIT>
// 5999 !AGN: *LH_1,14(1,2); *BC_15,<NEXT>
// 6000 !HIT: *L_1,8(1,2); *LM_4,15,16(7); *BCR_15,15
// 6001 !%finish
// 6002 MISS:
#line 6002 "test-new/imp918s.imp"
U_102E:;
// 6003 %RESULT=-1
#line 6003 "test-new/imp918s.imp"
return -1;
// 6004 %END
#line 6004 "test-new/imp918s.imp"
} /* end of CONSTFIND */
// ?MISS unused
// ?K unused
// ?J unused
// ?I unused
// ?AD unused
// 6005 %ROUTINE STORE CONST(%INTEGERNAME B,D,%INTEGER L,AD)
#line 6005 "test-new/imp918s.imp"
void STORECONST(int *B, int *D, int L, int AD) {
// 6006 !***********************************************************************
// 6007 !* PUT THE CONSTANT OF LENGTH 'L' AT ADDRESS 'AD' INTO THE GLA *
// 6008 !* AND RECORD ITS POSITION IN CASE THIS CONSTANT IS REUSED *
// 6009 !* A CHECK IS MADE USING 'CONST FIND' TO SEE IF THE CONSTANT HAS *
// 6010 !* BEEN INSERTED IN WHICH CASE THE OLD COPY IS REUSED *
// 6011 !***********************************************************************
// 6012 {%SHORTROUTINE}
// 6013 %INTEGER I,J,K
#line 6013 "test-new/imp918s.imp"
int I;
#line 6013 "test-new/imp918s.imp"
int J;
#line 6013 "test-new/imp918s.imp"
int K;
// 6014 %SHORTINTEGERNAME LIST
#line 6014 "test-new/imp918s.imp"
short int *LIST;
// 6015 D=-1
#line 6015 "test-new/imp918s.imp"
*D = -1;
// 6016 D=CONST FIND(L,AD) %IF GLAFLAG = 0
#line 6016 "test-new/imp918s.imp"
if (GLAFLAG != 0) goto L_059A;
#line 6016 "test-new/imp918s.imp"
*D = CONSTFIND(L, AD);
#line 6016 "test-new/imp918s.imp"
L_059A:;
// 6017 %IF D=-1 %START;! FIRST USE OF CNST
#line 6017 "test-new/imp918s.imp"
if (*D != -1) goto L_059B;
// 6018 I=0; J=0
#line 6018 "test-new/imp918s.imp"
I = 0;
#line 6018 "test-new/imp918s.imp"
J = 0;
// 6019 %CYCLE K=0,1,L-1
#line 6019 "test-new/imp918s.imp"
// %for K = 0, 1, L - 1 %cycle
#line 6019 "test-new/imp918s.imp"
{
int _control, _initial = 0, _increment = 1, _final = L - 1;
#line 6019 "test-new/imp918s.imp"
if (((_final - _initial) % _increment) != 0) _imp_signal(5, 1, 0, "Illegal cycle K = 0, 1, L - 1");
_control = K = _initial - _increment;
#line 6019 "test-new/imp918s.imp"
L_059C:
#line 6019 "test-new/imp918s.imp"
if (K != _control) _imp_signal(4, 2, 0, "Corrupt control variable K");
#line 6019 "test-new/imp918s.imp"
if (K == _final) goto L_059D;
#line 6019 "test-new/imp918s.imp"
_control += _increment;
K += _increment;
// 6020 BYTEINTEGER(ADDR(I)+K)=BYTEINTEGER(AD+K)
#line 6020 "test-new/imp918s.imp"
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &I) + K) = *_imp_BYTEINTEGER(AD + K);
// 6021 %REPEAT
#line 6021 "test-new/imp918s.imp"
goto L_059C;
#line 6021 "test-new/imp918s.imp"
}
#line 6021 "test-new/imp918s.imp"
L_059D:;
// 6022 %IF L=2 %AND GLAHOLES#0 %START
#line 6022 "test-new/imp918s.imp"
if (L != 2) goto L_059E;
#line 6022 "test-new/imp918s.imp"
if (GLAHOLES == 0) goto L_059E;
// 6023 POP(GLAHOLES,D,B)
#line 6023 "test-new/imp918s.imp"
POP(/*?*/ &GLAHOLES, D, B);
// 6024 B=13; PLUG(2,D,I>>16)
#line 6024 "test-new/imp918s.imp"
*B = 13;
#line 6024 "test-new/imp918s.imp"
PLUG(2, *D, (unsigned int)I >> 16);
// 6025 GSAVED=GSAVED+2
#line 6025 "test-new/imp918s.imp"
GSAVED = GSAVED + 2;
// 6026 %FINISH %ELSE %START
#line 6026 "test-new/imp918s.imp"
goto L_059F;
#line 6026 "test-new/imp918s.imp"
L_059E:;
// 6027 PGLA(L,L,AD)
#line 6027 "test-new/imp918s.imp"
PGLA(L, L, AD);
// 6028 D=GLACA-L; B=GLA
#line 6028 "test-new/imp918s.imp"
*D = GLACA - L;
#line 6028 "test-new/imp918s.imp"
*B = 13;
// 6029 %FINISH
#line 6029 "test-new/imp918s.imp"
L_059F:;
// 6030 LIST==SHORT INTEGER(ADDR(GLAHOLES)+L)
#line 6030 "test-new/imp918s.imp"
LIST = (short int *)_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &GLAHOLES) + L);
// 6031 PUSH123(LIST,I,J,D) %IF GLAFLAG=0
#line 6031 "test-new/imp918s.imp"
if (GLAFLAG != 0) goto L_05A0;
#line 6031 "test-new/imp918s.imp"
PUSH123(LIST, I, J, *D);
#line 6031 "test-new/imp918s.imp"
L_05A0:;
// 6032 %FINISH %ELSE %START; ! CONST ALREADY IN
#line 6032 "test-new/imp918s.imp"
goto L_05A1;
#line 6032 "test-new/imp918s.imp"
L_059B:;
// 6033 %IF D<0 %THEN %START
#line 6033 "test-new/imp918s.imp"
if (*D >= 0) goto L_05A2;
// 6034 CYC BITS=CYC BITS!16; ! SET USES PERMS CONSTS BIT
#line 6034 "test-new/imp918s.imp"
CYCBITS = CYCBITS | 16;
// 6035 B=CODER; D=D&X'FFF'
#line 6035 "test-new/imp918s.imp"
*B = 12;
#line 6035 "test-new/imp918s.imp"
*D = *D & 4095;
// 6036 %FINISH %ELSE B=GLA
#line 6036 "test-new/imp918s.imp"
goto L_05A3;
#line 6036 "test-new/imp918s.imp"
L_05A2:;
#line 6036 "test-new/imp918s.imp"
*B = 13;
#line 6036 "test-new/imp918s.imp"
L_05A3:;
// 6037 %FINISH
#line 6037 "test-new/imp918s.imp"
L_05A1:;
// 6038 %END
#line 6038 "test-new/imp918s.imp"
return;
#line 6038 "test-new/imp918s.imp"
} /* end of STORECONST */
// 6039 %ROUTINE CCOND(%INTEGER IU,FARLAB)
#line 6039 "test-new/imp918s.imp"
void CCOND(int IU, int FARLAB) {
#line 6039 "test-new/imp918s.imp"
auto void SKIPSC(void);
#line 6039 "test-new/imp918s.imp"
auto void SKIPCOND(void);
#line 6039 "test-new/imp918s.imp"
auto void CCOMP(void);
// 6040 {%SHORTROUTINE}
// 6041 !***********************************************************************
// 6042 !* COMPILES <IU><SC><RESTOFCOND>%THEN<UI1>%ELSE<UI2> *
// 6043 !* IU=1 FOR %IF =2 FOR UNLESS. FARLAB TO GO ON UI2 *
// 6044 !* THE ROUTINE MAKES FOUR PASSES THROUGH THE CONDITION *
// 6045 !* PASS 1 ANALYSES THE STRUCTURE AND DECIDES TO BRANCH ON TRUE *
// 6046 !* (TF=2) OR ON FALSE (TF=1) FOR EACH COMPARISON *
// 6047 !* PASS 2 WORKS OUT WHERE THE BRANCHES OF PASS 1 SHOULD GO TO *
// 6048 !* PASS 3 ASSIGNS LABEL NUMBERS *
// 6049 !* PASS 4 EVALUATES COMPARISIONS AND PLANTS THE CODE *
// 6050 !* *
// 6051 !* ON ENTRY P POINTS TO <SC> IN<HOLE><SC><RESTOFCOND> *
// 6052 !***********************************************************************
// 6053 ! %ROUTINESPEC WRITE CONDLIST
// 6054 %ROUTINESPEC SKIP SC
// 6055 %ROUTINESPEC SKIP COND
// 6056 %ROUTINESPEC CCOMP
// 6057 !
// 6058 ! FCOMP HAS BC MASKS FOR EACH COMPARATOR.
// 6059 ! THE FIRST 7 ARE TO BRANCH IF TRUE WITH NORMAL COMPARISON
// 6060 ! THE SECOND SEVEN ARE TO BRANCH IF TRUE WITH BACKWARDS COMPARISON
// 6061 ! THE THIRD SEVEN ARE FOR THE TEST UNDER MASK INSTRUCTION
// 6062 !
// 6063 %CONSTBYTEINTEGERARRAY FCOMP(1:21)=8,10,2,7,12,4,7,
#line 6063 "test-new/imp918s.imp"
const unsigned char FCOMP[21] = {8, 10, 2, 7, 12, 4, 7, 8, 12, 4, 7, 10, 2, 7, 8, 15, 7, 7, 8, 0, 7};
// 6064+ 8,12,4,7,10,2,7,
// 6065+ 8,15,7,7,8,0,7;
// 6066 !
// 6067 %INTEGER PIN,PP,II,L,CPTR,CMAX,LL
#line 6067 "test-new/imp918s.imp"
int PIN;
#line 6067 "test-new/imp918s.imp"
int PP;
#line 6067 "test-new/imp918s.imp"
int II;
#line 6067 "test-new/imp918s.imp"
int L;
#line 6067 "test-new/imp918s.imp"
int CPTR;
#line 6067 "test-new/imp918s.imp"
int CMAX;
#line 6067 "test-new/imp918s.imp"
int LL;
// 6068 %RECORDFORMAT CF(%BYTEINTEGER TF,CMP1,CMP2,LABU,LVL,JMP, %C
#line 6068 "test-new/imp918s.imp"
struct CF {
union {
struct {
#line 6068 "test-new/imp918s.imp"
unsigned char TF;
#line 6068 "test-new/imp918s.imp"
unsigned char CMP1;
#line 6068 "test-new/imp918s.imp"
unsigned char CMP2;
#line 6068 "test-new/imp918s.imp"
unsigned char LABU;
#line 6068 "test-new/imp918s.imp"
unsigned char LVL;
#line 6068 "test-new/imp918s.imp"
unsigned char JMP;
#line 6068 "test-new/imp918s.imp"
short int LABNO;
#line 6068 "test-new/imp918s.imp"
short int SP1;
#line 6068 "test-new/imp918s.imp"
short int SP2;
#line 6068 "test-new/imp918s.imp"
};
};
};
// 6069+ %SHORTINTEGER LABNO,SP1,SP2)
// 6070 %RECORD(CF)%ARRAY CLIST(1:30)
#line 6070 "test-new/imp918s.imp"
struct CF CLIST[30];
// 6071 %RECORD(CF)%NAME C1,C2
#line 6071 "test-new/imp918s.imp"
struct CF *C1;
#line 6071 "test-new/imp918s.imp"
struct CF *C2;
// 6072 !
// 6073 ! PASS 1. ANALYSES THE CONDITION
// 6074 !
// 6075 PIN=P; ! SAVE INITIAL AR POINTER
#line 6075 "test-new/imp918s.imp"
PIN = P;
// 6076 CPTR=1; L=3; ! LEVEL=3 TO ALLOW 2 LOWER
#line 6076 "test-new/imp918s.imp"
CPTR = 1;
#line 6076 "test-new/imp918s.imp"
L = 3;
// 6077 C1==CLIST(CPTR); ! SET UP RECORD FOR FIRST CMPARSN
#line 6077 "test-new/imp918s.imp"
C1 = (struct CF *)/*?*/ &CLIST[CPTR - 1];
// 6078 C1=0
#line 6078 "test-new/imp918s.imp"
*C1 = (struct CF){0};
// 6079 SKIP SC; ! SKIP THE 1ST CMPARSN
#line 6079 "test-new/imp918s.imp"
SKIPSC();
// 6080 SKIP COND; ! AND ANY %AND/%OR CLAUSES
#line 6080 "test-new/imp918s.imp"
SKIPCOND();
// 6081 C1_LVL=2; ! LEVEL =-1 FOR %IF/%THEN ENTRY
#line 6081 "test-new/imp918s.imp"
C1-